emacs-19.22/ 40777 12120 24 0 5475722574 10736 5ustar rmsotheremacs-19.22/GETTING.GNU.SOFTWARE100444 12241 12 10716 5444560602 14404 0ustar rolandstaff-*- text -*- Getting GNU Software, 21 Mar 93 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1992, 1993 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 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' 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 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 `/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 it tapes. A partial ftp distribution can be found on prep.ai.mit.edu. The full ftp distribution can be found on zurich.ai.mit.edu. 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/GNUinfo/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 raise 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/DISTRIB'. emacs-19.22/INSTALL100666 12120 1 53350 5470555074 12201 0ustar rmsdaemonGNU Emacs Installation Guide 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 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: 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 30 Mb of disk space (including the Emacs sources). Once installed, Emacs occupies about 20 Mb in the file system where it is installed; this includes the executable files, Lisp libraries, miscellaneous data files, and on-line documentation. If the building and installation take place in different directories, then the installation procedure momentarily requires 30+20 Mb. 2) Consult `./etc/MACHINES' to see what configuration name you should give to the `configure' program. That file sometimes 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 by inspecting its environment; if it cannot, you must find the appropriate configuration name in `./etc/MACHINES' and specify it explicitly. The `--with-x', `--with-x11', and `--with-x10' options specify which window system Emacs should support. If you don't want X support, specify `--with-x=no'. If all of these options are omitted, `configure' will try to figure out for itself whether your system has X11, 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, your compiler should be able to find these by default; these options should only be necessary if you have your X Window System files installed in unusual places. The `--run-in-place' option sets up default values for the path variables in `./Makefile' so that Emacs will expect to find its data files (lisp libraries, runnable programs, and the like) in the same locations they occupy while Emacs builds. This means that you don't have to install Emacs in order to run it; it uses its data files as they were unpacked. 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 this option is omitted, `configure' will search for GCC in your load path, and use it if present. The `--srcdir=DIR' option specifies that the configuration and build processes should look for the Emacs source code in DIR, when DIR is not the current directory. You can use `--srcdir' to build Emacs for several different machine types from a single source directory. Make separate build directories for the different configuration types, and in each one, build Emacs specifying the common source directory with `--srcdir'. The `--prefix=PREFIXDIR' option specifies where the installation process 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. 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. The `configure' program does not accept abbreviations for its options. Note that `configure' doesn't do any compilation or installation itself. It just creates the files that influence those things: `./Makefile', `build-install', 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 leaves a copy in the file `config.status'. That file is also a shell script which, when run, recreates the same configuration; it contains the verbal description as a comment. If `configure' exits with an error after disturbing the status quo, it removes `config.status'. 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, edit the file `./lisp/site-init.el' containing Emacs Lisp code to override them; you probably don't want 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"). 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. 5) Put into `./lisp/site-init.el' any Emacs Lisp code you want Emacs to load before it is dumped out. 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. This file is nonexistent in the distribution. You do not need to create it if you have nothing to put in it. 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 will be named `src/emacs'. If you want to have Emacs's executable programs and data files installed as well, run `make install'. By default, Emacs installs its files in the following directories: `/usr/local/bin' holds the executable programs users normally run - `emacs', `etags', `ctags', `b2m', and `emacsclient'. `/usr/local/lib/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.0'. 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/lib/emacs/site-lisp', then in this directory. `/usr/local/lib/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/lib/emacs/lock' contains files indicating who is editing what, so Emacs can detect editing clashes between users. `/usr/local/lib/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 program arch-lib/movemail setuid or setgid to enable it to write the lock files. We believe this is safe. 10) You are done! 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/lib. 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. `statedir' indicates where to put architecture-independent data files that Emacs modifies while it runs; it defaults to /usr/local/lib as well. We create the following subdirectories under `statedir': - `emacs/lock', containing files indicating who is editing what, so Emacs can detect editing clashes between users. `libdir' indicates where to put architecture-specific data files that Emacs refers to as it runs; it too defaults to `/usr/local/lib'. We create the following subdirectories under `libdir': - `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', `statedir', `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 `libdir'. 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' (which see), is `/usr/local/lib/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'. `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/lib/emacs/VERSION/etc'. `lockdir' indicates the directory where Emacs keeps track of its locking information. Its default value, based on `statedir' (which see), is `/usr/local/lib/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 `libdir' (which see), is `/usr/local/lib/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 Running the `configure' program performs 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) If you're going to use the make utility to build Emacs, you will still need to run `configure' first, giving theappropriate values for the variables in the sections entitled "Things `configure' Might Edit" and "Where To Install Things." Note that you may only need to change the variables `prefix' and `exec_prefix', since the rest of the variables have reasonable defaults based on them. For each Makefile variable of this type, there is a corresponding configure option; for example, to change the location of the lock directory, you might use ./configure --lockdir=/nfs/emacslock 4) If you're going to use the build-install script to build Emacs, copy `./build-ins.in' to `./build-install', and edit the definitions found at the top of the script. The `configure' script is built from `configure.in' by the `autoconf' program. However, since Emacs has configuration requirements that autoconf can't meet, `configure.in' uses an marriage of custom-baked configuration code and autoconf macros. New versions of autoconf could very well break this arrangement, so it may be wise to avoid rebuilding `configure' from `configure.in' when possible. BUILDING GNU EMACS BY HAND Once Emacs is configured, running `make' or running the shell script `build-install' 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) Cd to `./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) Cd to `./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, assigning it a new build version number by incrementing the build version stored in `./lisp/version.el'. 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 the shell script `build-install' or 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', `env', `fakemail', `hexl', `movemail', `timer', `vcdiff', `wakeup', and `yow' are used by Emacs; they do need to be copied. - The programs `etags', `ctags', `emacsclient', `b2m', and `rcs2log' are intended to be run by users; they are handled below. - The programs `make-docfile', `make-path', 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 `rcs2log' 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. The source would be handy for debugging. PROBLEMS See the file PROBLEMS in this directory for a list of various problems sometimes encountered, and what to do about them. emacs-19.22/PROBLEMS100666 12120 1 101673 5475224156 12337 0ustar rmsdaemonThis file describes various problems that have been encountered in compiling, installing and running GNU Emacs. * You configure Emacs to use a directory such as /usr/local/sun3.lib/emacs and the directory name gets mangled in the process of building Emacs. This is because building Emacs involves passing a makefile through the C preprocessor. The directory names that you specified go through that process, and if they happen to use any predefined macro names, those macro names get substituted. For example, if you are on a Sun 3, the name `sun3' is a predefined macro. This is an Emacs bug, and will be fixed; but it was too risky to fix for 19.21. For now, you must use different names for those directories (perhaps via symbolic links). * 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. * 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 xemacs, but xemacs totally fails to work. * or, temacs gets errors dumping xemacs 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. You might as well save the old alloc.o. 4) Remake xemacs. It should work now. 5) Running xemacs, 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 xemacs. 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 (xemacs) 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 * Emacs spontaneously displays "I-search: " at the bottom of the screen. This means that Control-S/Control-Q "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 flow control characters. This must be set to "no flow control" 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 flow control to the computer, or it insists on sending flow control itself no matter how much padding you give it. You are screwed! You should replace the terminal or concentrator with a properly designed one. In the mean time, some drastic measures can make Emacs semi-work. One drastic measure to ignore C-s and C-q, while sending enough padding that the terminal will not really lose any output. To make such an adjustment, you need only invoke the function enable-flow-control-on with a list of terminal types in your own .emacs file. As arguments, give it the names of one or more terminal types you use which require flow control adjustments. Here's an example: (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") If the situation is only temporary and you don't expect it to be the case the next time you use emacs (e.g. you're visiting someplace where C-s and C-q have taken over, but expect to be back to a safe part of the world in a few hours), you can just type M-x enable-flow-control at the beginning of your emacs session. An even more drastic measure is to make Emacs use flow control. To do this, evaluate the Lisp expression (set-input-mode nil t META). (The argument META should be t if you have a meta key, and nil otherwise.) Emacs will then interpret C-s and C-q as flow control commands. (More precisely, it will allow the kernel to do so as it usually does.) You will lose the ability to use them for Emacs commands. Also, as a consequence of using CBREAK mode, the terminal's Meta-key, if any, will not work, and C-g will be liable to cause a loss of output which will produce garbage on the screen. (These problems apply to 4.2BSD; they may not happen in 4.3 or VMS, and I don't know what would happen in sysV.) You can use keyboard-translate-table, as shown above, to map two other input characters (such as C-^ and C-\) into C-s and C-q, so that you can still search and quote. I have no intention of ever redesigning the Emacs command set for the assumption that terminals use C-s/C-q flow control. This flow control technique is a bad design, and terminals that need it are bad merchandise and should not be purchased. If you can get some use out of GNU Emacs on inferior terminals, I am glad, 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 may then wish to put the function help-command on some other key. I leave to you the task of deciding which key. * 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.22/README100666 12120 24 7374 5475722326 11721 0ustar rmsotherThis directory tree holds version 19.22 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. Please note that version 19 of Emacs is still in beta-test. Although you may well encounter bugs in this release, we encourage you to use it, find the bugs, and report them; your bug reports are valuable contributions to the FSF, since they allow us to notice and fix problems on machines we don't have, or in code we don't use often. See the "Bugs" node of the info tree for more information on how to report bugs. See the files `etc/NEWS' and `etc/news.texi' for information on new 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" node of the info tree for more information on how to report bugs. See `etc/MAILINGLISTS' for more information on mailing lists relating to GNU products. 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 will create two files named `build-install' (a shell script) and `Makefile' (a script for the `make' program), which help automate 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. `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. `shortnames' holds programs and data files for creating files of #define's used to convert long symbol names to distinct sort ones for C compiles that cannot distinguish more than 8 characters. `vms' holds instructions and useful files for running Emacs under VMS. emacs-19.22/move-if-change100777 13437 13 201 5205663037 13473 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.22/ChangeLog100666 12120 1 201353 5475620323 12733 0ustar rmsdaemonSat 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. * 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.22/Makefile.in100444 12120 1 42062 5475615632 13207 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 realclean # 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 MAKE = make # BSD doesn't have it as a default. # ==================== 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@ ### Libraries which should be edited into lib-src/Makefile. libsrc_libs=@libsrc_libs@ # ==================== 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. statedir=@statedir@ # 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. libdir=${exec_prefix}/lib # Where to install Emacs's man pages, and what extension they should have. mandir=@mandir@ manext=.1 # 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 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 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@ # ==================== Utility Programs for the Build ==================== # Allow the user to specify the install program. INSTALL = @INSTALL@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ # ============================= Targets ============================== # 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 src/Makefile oldXMenu/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: src/paths.h ${SUBDIR} removenullpaths=sed -e 's/^://' -e 's/:$$//' -e 's/::/:/' # 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 # src/paths.h.tmp, which isn't much. # Note that sed is not in /bin on 386bsd. src/paths.h: Makefile ${srcdir}/src/paths.h.in FRC.src.paths.h @echo "Producing \`src/paths.h' from \`src/paths.h.in'." @(lisppath=`echo ${lisppath} | ${removenullpaths}` ; \ buildlisppath=`echo ${buildlisppath} | ${removenullpaths}` ; \ sed < ${srcdir}/src/paths.h.in > src/paths.h.tmp \ -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_LOCK\).*$$;\1 "${lockdir}/";') @${srcdir}/move-if-change src/paths.h.tmp src/paths.h src: lib-src FRC.src lib-src: FRC.lib-src .RECURSIVE: ${SUBDIR} ${SUBDIR}: ${SUBDIR_MAKEFILES} FRC cd $@; $(MAKE) all $(MFLAGS) \ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' Makefile: Makefile.in config.status ./config.status src/Makefile: src/Makefile.in.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 # ==================== 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. ## 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. install: all do-install ### Note that we copy the DOC-* files from the build etc directory ### as well as lots of things from ${srcdir}/etc. do-install: mkdir (cd lib-src; \ $(MAKE) install $(MFLAGS) prefix=${prefix} \ exec_prefix=${exec_prefix} bindir=${bindir} libdir=${libdir} \ archlibdir=${archlibdir}) -set ${COPYDESTS} ; \ for dir in ${COPYDIR} ; do \ if [ `(cd $$1 && pwd)` != `(cd $${dir} && pwd)` ] ; then \ rm -rf $$1 ; \ fi ; \ shift ; \ done -set ${COPYDESTS} ; \ mkdir ${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}/*~ ; \ done) ; \ done if [ `(cd ./etc; /bin/pwd)` != `(cd ${srcdir}/etc; /bin/pwd)` ]; \ then \ echo "Copying etc/DOC* ..." ; \ (cd etc; tar -cf - DOC*)|(cd ${etcdir}; umask 0; tar -xvf - ); \ else true; fi if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \ then (cd ${srcdir}/info ; \ if [ ! -f ${infodir}/dir ] && [ -f dir ]; then \ ${INSTALL_DATA} dir ${infodir}/dir ; \ fi ; \ for f in cl* emacs* forms* gnus* info* sc* vip* ; do \ ${INSTALL_DATA} $$f ${infodir}/$$f ; \ done); \ else true; fi cd ${srcdir}/etc; for page in emacs etags ctags ; do \ ${INSTALL_DATA} $${page}.1 ${mandir}/$${page}${manext} ; \ done ${INSTALL_PROGRAM} src/emacs ${bindir}/emacs-${version} -chmod 1755 ${bindir}/emacs-${version} rm -f ${bindir}/emacs -ln ${bindir}/emacs-${version} ${bindir}/emacs ### 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 make-path ### instead of mkdir. Not all systems' mkdirs have the `-p' flag. mkdir: FRC.mkdir ./lib-src/make-path ${COPYDESTS} ${lockdir} ${infodir} ${mandir} \ ${bindir} ${datadir} ${libdir} \ `echo ${locallisppath} | sed 's/:/ /'` -chmod 777 ${COPYDESTS} ${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} libdir=${libdir} archlibdir=${archlibdir}) for dir in ${lispdir} ${etcdir} ; do \ case `(cd $${dir} ; pwd)` in \ `(cd ${srcdir} ; pwd)`* ) ;; \ * ) rm -rf $${dir} ;; \ esac ; \ case $${dir} in \ ${datadir}/emacs/${version}/* ) \ rm -rf ${datadir}/emacs/${version} \ ;; \ esac ; \ done (cd ${infodir}; rm -f cl* emacs* forms* info* vip*) (cd ${mandir}; rm -f emacs.1 etags.1 ctags.1) (cd ${bindir}; rm -f emacs-${version} emacs) ### Some makes seem to remember that they've built something called FRC, ### so you can only use a given FRC once per makefile. FRC FRC.src.paths.h FRC.src FRC.lib-src FRC.mkdir: FRC.mostlyclean FRC.clean FRC.distclean FRC.realclean: # ==================== Cleaning up and miscellanea ==================== ### `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.mostlyclean (cd src; $(MAKE) $(MFLAGS) mostlyclean) (cd oldXMenu; $(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.clean (cd src; $(MAKE) $(MFLAGS) clean) (cd oldXMenu; $(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 build-install ; \ rm -f Makefile ${SUBDIR_MAKEFILES} ; \ (cd lock ; rm -f *) distclean: FRC.distclean (cd src; $(MAKE) $(MFLAGS) distclean) (cd oldXMenu; $(MAKE) $(MFLAGS) distclean) (cd lib-src; $(MAKE) $(MFLAGS) distclean) (cd man; $(MAKE) $(MFLAGS) distclean) ${top_distclean} ### `realclean' ### 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 realclean' should not delete ### `configure' even if `configure' can be remade using a rule in the ### Makefile. More generally, `make realclean' should not delete ### anything that needs to exist in order to run `configure' and then ### begin to build the program. realclean: FRC.realclean (cd src; $(MAKE) $(MFLAGS) realclean) (cd oldXMenu; $(MAKE) $(MFLAGS) realclean) (cd lib-src; $(MAKE) $(MFLAGS) realclean) -(cd man; $(MAKE) $(MFLAGS) realclean) ${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 build-install.in configure make-dist move-if-change 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 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 src; $(MAKE) $(MFLAGS) relock) TAGS tags: lib-src (cd ${srcdir}/src; \ ../lib-src/etags *.[ch] ../lisp/*.el ../lisp/term/*.el) check: @echo "We don't have any tests for GNU Emacs yet." dist: cd ${srcdir}; make-dist info: (cd ${srcdir}/man; $(MAKE) $(MFLAGS) info) dvi: (cd ${srcdir}/man; $(MAKE) $(MFLAGS) dvi) emacs-19.22/build-ins.in100555 11732 1 11236 5452003335 13511 0ustar bfoxdaemon#!/bin/sh -x # #Shell script for building and installing Emacs. # ==================== Where To Install Things ==================== # The default location for installation. Everything is placed in # subdirectories of this directory. This directory must exist when # you start installation. The default values for many of the # variables below are expressed in terms of this one, so you may not # need to change them. prefix=/usr/local # Where to install Emacs and other binaries that people will want to # run directly (like etags). bindir=${prefix}/bin # A directory under which we will install many of Emacs's files. The # default values for many of the variables below are expressed in # terms of this one, so you may not need to change them. emacsdir=${prefix}/emacs-19.0 # Where to install and expect the architecture-independent data files # (like the tutorial and the Zippy database). datadir=${emacsdir}/etc # Where to install the elisp files distributed with Emacs. Strictly # speaking, all the elisp files should go under datadir (above), since # both elisp source and compiled elisp are completely portable, but # it's traditional to give the lisp files their own subdirectory. lispdir=${emacsdir}/lisp # Directories Emacs should search for elisp files specific to this # site (i.e. customizations), before consulting ${lispdir}. This # should be a colon-separated list of directories. locallisppath=${emacsdir}/local-lisp # Where Emacs will search to find its elisp 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=${locallisppath}:${lispdir} # Where Emacs will search for its elisp files before dumping. 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 the entry # for the directory containing the installed lisp files has been # replaced with ../lisp. This should be a colon-separated list of # directories. dumplisppath=../lisp # 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. statedir=${emacsdir} # Where to create and expect the locking directory, where the Emacs # locking code keeps track of which files are currently being edited. lockdir=${statedir}/lock # Where to install and expect executable files to be run by Emacs # rather than directly by users, and other architecture-dependent # data. libdir=${emacsdir}/arch-lib # Where to install Emacs's man pages. mandir=/usr/man/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=${prefix}/info removenullpaths="sed -e 's/^://' -e 's/:"'$'"//' -e 's/::/:/'" lisppath=`echo ${lisppath} | ${removenullpaths}` ; \ dumplisppath=`echo ${dumplisppath} | ${removenullpaths}` ; \ /bin/sed < src/paths.h.in > src/paths.h \ -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'$${lisppath}'";' \ -e 's;\(#.*PATH_DUMPLOADSEARCH\).*$$;\1 "'$${dumplisppath}'";' \ -e 's;\(#.*PATH_EXEC\).*$$;\1 "${libdir}";' \ -e 's;\(#.*PATH_DATA\).*$$;\1 "${datadir}";' \ -e 's;\(#.*PATH_LOCK\).*$$;\1 "${lockdir}/";' (cd lib-src; make) || exit 1 (cd src; make) || exit 1 # Subdirectories to install, and where they'll go. copydir=arch-lib etc info lisp copydests=${libdir} ${datadir} ${infodir} ${lispdir} # If any of the directories are below ${emacsdir} or ${statedir}, create them. for dir in ${copydests}; do case "${dir}" in ${emacsdir}/* ) if [ ! -d ${emacsdir} ]; then -mkdir ${emacsdir} -chmod 777 ${emacsdir} fi ;; ${statedir}/* ) if [ ! -d ${statedir} ]; then -mkdir ${statedir} -chmod 777 ${statedir} fi ;; esac done set ${copydests} for dir in ${copydir} ; do dest=$1 ; shift mv ${dir} ${dest} if [ $? != 0 ]; then echo mv ${dir} to ${dest} failed -- using tar to copy. if [ `/bin/pwd`/${dir} != `(cd ${dest}; /bin/pwd)` ] ; then (cd ${dir}; tar cf - . ) | (cd ${dest}; umask 0; tar xf - ) if [ $? != 0 ]; then echo "tar-copying ${dir} to ${dest} failed too. I give up." exit 1 fi for subdir in `find ${dest} -type d ! -name RCS -print` ; do rm -rf ${subdir}/RCS rm -f ${subdir}/\#* rm -f ${subdir}/*~ done fi fi done cp ${libdir}/[ce]tags ${bindir} mv src/emacs ${BINDIR}/emacs rm src/temacs chmod 777 ${bindir}/[ce]tags ${bindir}/emacs emacs-19.22/configure100777 12120 1 232506 5474276357 13111 0ustar rmsdaemon#!/bin/sh #### Configuration script for GNU Emacs #### Copyright (C) 1992 Free Software Foundation, Inc. ### Don't edit this script! ### This script was automatically generated by the `autoconf' program ### from the file `./configure.in'. ### To rebuild it, execute the command ### autoconf ### in the this directory. You must have autoconf version 1.4 or later. ### This file is part of GNU Emacs. ### GNU Emacs is free software; you can 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. ### Since Emacs has configuration requirements that autoconf can't ### meet, this file is an unholy marriage of custom-baked ### configuration code and autoconf macros. ### ### We use the m4 quoting characters [ ] (as established by the ### autoconf system) to include large sections of raw sewage - Oops, I ### mean, shell code - in the final configuration script. ### ### Usage: configure config_name ### ### If configure succeeds, it leaves its status in config.status. ### If configure fails after disturbing the status quo, ### config.status is removed. ### Remove any more than one leading "." element from the path name. ### If we don't remove them, then another "./" will be prepended to ### the file name each time we use config.status, and the program name ### will get larger and larger. This wouldn't be a problem, except ### that since progname gets recorded in all the Makefiles this script ### produces, move-if-change thinks they're different when they're ### not. ### ### It would be nice if we could put the ./ in a \( \) group and then ### apply the * operator to that, so we remove as many leading ./././'s ### as are present, but some seds (like Ultrix's sed) don't allow you to ### apply * to a \( \) group. Bleah. progname="`echo $0 | sed 's:^\./\./:\./:'`" ### Establish some default values. run_in_place= single_tree= prefix='/usr/local' exec_prefix='${prefix}' bindir='${exec_prefix}/bin' datadir='${prefix}/lib' statedir='${prefix}/lib' libdir='${exec_prefix}/lib' mandir='${prefix}/man/man1' infodir='${prefix}/info' lispdir='${datadir}/emacs/${version}/lisp' locallisppath='${datadir}/emacs/site-lisp' lisppath='${locallisppath}:${lispdir}' etcdir='${datadir}/emacs/${version}/etc' lockdir='${statedir}/emacs/lock' archlibdir='${libdir}/emacs/${version}/${configuration}' # We cannot use this variable in the case statement below, because many # /bin/sh's have broken semantics for "case". Unfortunately, you must # actually edit the clause itself. # path_options="prefix | exec_prefix | bindir | libdir | etcdir | datadir" # path_options="$path_options | archlibdir | statedir | mandir | infodir" # path_options="$path_options | lispdir | lockdir | lisppath | locallisppath" #### Usage messages. short_usage="Usage: ${progname} CONFIGURATION [-OPTION[=VALUE] ...] Set compilation and installation parameters for GNU Emacs, and report. CONFIGURATION specifies the machine and operating system to build for. --with-x Support the X Window System. --with-x=no Don't support X. --x-includes=DIR Search for X header files in DIR. --x-libraries=DIR Search for X libraries in DIR. --with-gcc Use GCC to compile Emacs. --with-gcc=no Don't use GCC to compile Emacs. --run-in-place Use libraries and data files directly out of the source tree. --single-tree=DIR Has the effect of creating a directory tree at DIR which looks like: .../DIR/bin/CONFIGNAME (emacs, etags, etc.) .../DIR/bin/CONFIGNAME/etc (movemail, etc.) .../DIR/common/lisp (emacs' lisp files) .../DIR/common/site-lisp (local lisp files) .../DIR/common/lib (DOC, TUTORIAL, etc.) .../DIR/common/lock (lockfiles) --srcdir=DIR Look for the Emacs source files in DIR. --prefix=DIR Install files below DIR. Defaults to \`${prefix}'. You may also specify any of the \`path' variables found in Makefile.in, including --bindir, --libdir, --etcdir, --infodir, and so on. This allows you to override a single default location when configuring. If successful, ${progname} leaves its status in config.status. If unsuccessful after disturbing the status quo, it removes config.status." #### Option processing. ### Record all the arguments, so we can save them in config.status. arguments="$@" ### Shell Magic: Quote the quoted arguments in ARGUMENTS. At a later date, ### in order to get the arguments back in $@, we have to do an ### `eval set x "$quoted_arguments"; shift'. quoted_arguments= for i in "$@"; do quoted_arguments="$quoted_arguments '$i'" done ### Don't use shift -- that destroys the argument list, which autoconf needs ### to produce config.status. It turns out that "set - ${arguments}" doesn't ### work portably. ### However, it also turns out that many shells cannot expand ${10} at all. ### So using an index variable doesn't work either. It is possible to use ### some shell magic to make 'set x "$arguments"; shift' work portably. while [ $# != 0 ]; do arg="$1"; shift case "${arg}" in ## Anything starting with a hyphen we assume is an option. -* ) ## Separate the switch name from the value it's being given. case "${arg}" in -*=*) opt=`echo ${arg} | sed 's:^-*\([^=]*\)=.*$:\1:'` val=`echo ${arg} | sed 's:^-*[^=]*=\(.*\)$:\1:'` valomitted=no ;; -*) ## If FOO is a boolean argument, --FOO is equivalent to ## --FOO=yes. Otherwise, the value comes from the next ## argument - see below. opt=`echo ${arg} | sed 's:^-*\(.*\)$:\1:'` val="yes" valomitted=yes ;; esac ## Change `-' in the option name to `_'. optname="${opt}" opt="`echo ${opt} | tr - _`" ## Process the option. case "${opt}" in ## Has the user specified which window systems they want to support? "with_x" | "with_x11" | "with_x10" ) ## Make sure the value given was either "yes" or "no". case "${val}" in y | ye | yes ) val=yes ;; n | no ) val=no ;; * ) (echo "${progname}: the \`--${optname}' option is supposed to have a boolean value. Set it to either \`yes' or \`no'." echo "${short_usage}") >&2 exit 1 ;; esac eval "${opt}=\"${val}\"" ;; ## Has the user specified whether or not they want GCC? "with_gcc" | "with_gnu_cc" ) ## Make sure the value given was either "yes" or "no". case "${val}" in y | ye | yes ) val=yes ;; n | no ) val=no ;; * ) (echo "${progname}: the \`--${optname}' option is supposed to have a boolean value. Set it to either \`yes' or \`no'." echo "${short_usage}") >&2 exit 1 ;; esac eval "${opt}=\"${val}\"" ;; ## Has the user specified a source directory? "srcdir" ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then ## Get the next argument from the argument list, if there is one. if [ $# = 0 ]; then (echo "${progname}: You must give a value for the \`--${optname}' option, as in \`--${optname}=FOO'." echo "${short_usage}") >&2 exit 1 fi val="$1"; shift fi srcdir="${val}" ;; ## Has the user tried to tell us where the X files are? ## 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. "x_includes" ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then ## Get the next argument from the argument list, if there is one. if [ $# = 0 ]; then (echo "${progname}: You must give a value for the \`--${optname}' option, as in \`--${optname}=/usr/local/X11/include'." echo "${short_usage}") >&2 exit 1 fi val="$1"; shift fi x_includes="${val}" ;; "x_libraries" ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then ## Get the next argument from the argument list, if there is one. if [ $# = 0 ]; then (echo "${progname}: You must give a value for the \`--${optname}' option, as in \`--${optname}=/usr/local/X11/lib'." echo "${short_usage}") >&2 exit 1 fi val="$1"; shift fi x_libraries="${val}" ;; ## Should this use the "development configuration"? "run_in_place" ) single_tree= run_in_place=1 ;; ## Should this use the "single tree" configuration? "single_tree" ) run_in_place= single_tree=1 ;; ## Has the user specified one of the path options? prefix | exec_prefix | bindir | libdir | etcdir | datadir | \ archlibdir | statedir | mandir | infodir | lispdir | lockdir | \ lisppath | locallisppath ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then if [ $# = 0 ]; then (echo \ "$progname: You must give a value for the \`--${optname}' option,"; echo \ "as in \`--${optname}=`eval echo '$'$optname`.'" echo "$short_usage") >&2 exit 1 fi val="$1"; shift fi eval "${opt}=\"${val}\"" eval "${opt}_specified=1" ;; ## Verbose flag, tested by autoconf macros. "verbose" ) verbose=yes ;; ## Has the user asked for some help? "usage" | "help" ) if [ "x$PAGER" = x ] then echo "${short_usage}" | more else echo "${short_usage}" | $PAGER fi exit ;; ## We ignore all other options silently. esac ;; ## Anything not starting with a hyphen we assume is a ## configuration name. *) configuration=${arg} ;; esac done ### Get the arguments back. See the diatribe on Shell Magic above. eval set x "$quoted_arguments"; shift if [ "${configuration}" = "" ]; then echo '- You did not tell me what kind of host system you want to configure. - I will attempt to guess the kind of system this is.' 1>&2 guesssys=`echo ${progname} | sed 's/configure$/config.guess/'` if configuration=`${guesssys}` ; then echo "- Looks like this is a ${configuration}" 1>&2 else echo '- Failed to guess the system type. You need to tell me.' 1>&2 echo "${short_usage}" >&2 exit 1 fi fi #### Decide where the source is. case "${srcdir}" in ## If it's not specified, see if `.' or `..' might work. "" ) confdir=`echo $0 | sed 's|//|/|' | sed 's|/[^/]*$||'` if [ -f $confdir/src/lisp.h -a -f $confdir/lisp/version.el ]; then srcdir="${confdir}" else if [ -f "./src/lisp.h" -a -f "./lisp/version.el" ]; then srcdir='.' else if [ -f "../src/lisp.h" -a -f "../lisp/version.el" ]; then srcdir='..' else (echo "\ ${progname}: Neither the current directory nor its parent seem to contain the Emacs sources. If you do not want to build Emacs in its source tree, you should run \`${progname}' in the directory in which you wish to build Emacs, using its \`--srcdir' option to say where the sources may be found." echo "${short_usage}") >&2 exit 1 fi fi fi ;; ## Otherwise, check if the directory they specified is okay. * ) if [ ! -d "${srcdir}" -o ! -f "${srcdir}/src/lisp.h" -o ! -f "${srcdir}/lisp/version.el" ]; then (echo "\ ${progname}: The directory specified with the \`--srcdir' option, \`${srcdir}', doesn't seem to contain the Emacs sources. You should either run the \`${progname}' script at the top of the Emacs source tree, or use the \`--srcdir' option to specify where the Emacs sources are." echo "${short_usage}") >&2 exit 1 fi ;; esac #### 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. case "${srcdir}" in /* ) ;; . ) ## We may be able to use the $PWD environment variable to make this ## absolute. But sometimes PWD is inaccurate. if [ "${PWD}" != "" ] && [ "`(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 [ `pwd` != `(cd ${srcdir} && pwd)` ] \ && [ -f "${srcdir}/src/config.h" ] ; then (echo "${progname}: WARNING: The directory tree \`${srcdir}' is being used" echo " as a build directory right now; it has been configured in its own" echo " right. To configure in another directory as well, you MUST" echo " use GNU make. If you do not have GNU make, then you must" echo " now do \`make distclean' in ${srcdir}," echo " and then run ${progname} again.") >&2 extrasub='/^VPATH[ ]*=/c\ vpath %.c $(srcdir)\ vpath %.h $(srcdir)\ vpath %.y $(srcdir)\ vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ vpath %.in $(srcdir)' fi ### Make the necessary directories, if they don't exist. for dir in ./src ./lib-src ./cpp ./oldXMenu ./etc ; do if [ ! -d ${dir} ]; then mkdir ${dir} fi done #### 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. echo "Checking the configuration name." if canonical=`${srcdir}/config.sub "${configuration}"` ; then : ; else exit $? fi ### 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='false' case "${canonical}" in ## 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 ;; ## Altos 3068 m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;; ## Amdahl UTS 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;; ## Appallings - I mean, Apollos - running Domain m68*-apollo* ) machine=apollo opsys=bsd4-2 ;; ## 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 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* ) machine=convex opsys=bsd4-3 ;; ## Cubix QBx/386 i386-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; ## Cydra 5 cydra*-cydrome-sysv* ) machine=cydra5 opsys=usg5-3 ;; ## Data General AViiON Machines 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-ultrix* | mips-dec-bsd* ) machine=pmax opsys=bsd4-3 ;; mips-dec-osf* ) machine=pmax opsys=osf1 ;; ## Motorola Delta machines m68*-motorola-sysv* ) machine=delta opsys=usg5-3 ;; m88k-motorola-sysv4* ) machine=delta88k opsys=usg5-4 ;; 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 ;; ## Honeywell XPS100 xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;; ## HP 9000 series 200 or 300 m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;; m68*-hp-netbsd* ) machine=hp9000s300 opsys=netbsd ;; ## HP/UX 7, 8 and 9 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 ;; *) machine=hp9000s300 opsys=hpux ;; esac ;; ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux7* ) machine=hp9000s800 opsys=hpux ;; hppa*-hp-hpux8* ) machine=hp9000s800 opsys=hpux8 ;; hppa*-hp-hpux9* ) machine=hp9000s800 opsys=hpux9 ;; ## 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=hp9000s800 opsys=hpux8 ;; *.08.* ) machine=hp9000s800 opsys=hpux8 ;; *.09.* ) machine=hp9000s800 opsys=hpux9 ;; *) machine=hp9000s800 opsys=hpux ;; esac ;; ## Orion machines orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;; clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;; ## IBM machines i386-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; i386-ibm-aix1.[23]* | i386-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;; rs6000-ibm-aix3.1* ) machine=ibmrs6000 opsys=aix3-1 ;; rs6000-ibm-aix3.2* | rs6000-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[34]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL i386-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry i386-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; ## Unspecified sysv on an ncr machine defaults to svr4. i[34]86-ncr-sysv* ) machine=intel386 opsys=usg5-4 ;; ## Intel 860 i860-*-sysvr4* ) machine=i860 opsys=usg5-4 ;; ## 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-irix5.* ) machine=iris4d opsys=irix5-0 ;; mips-sgi-irix4.* | mips-sgi-irix* ) machine=iris4d opsys=irix4-0 ;; ## 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 ;; mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;; mips-mips-* ) machine=mips opsys=usg5-2-2 ;; ## NeXT m68*-next-mach* | m68*-next-bsd* ) machine=next opsys=mach2 ;; ## 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 ;; ## SONY machines m68*-sony-bsd4.2* ) machine=news opsys=bsd4-2 ;; m68*-sony-bsd4.3* ) machine=news opsys=bsd4-3 ;; m68*-sony-newsos3*) machine=news opsys=bsd4-3 ;; mips-sony-bsd* ) machine=news-risc opsys=bsd4-3 ;; ## Stride m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;; ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* ) case "${canonical}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; i[34]86* ) machine=sun386 ;; sparc* ) machine=sparc ;; * ) unported=true ;; esac case "${canonical}" in ## The Sun386 didn't get past 4.0. i386-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.3* ) opsys=sunos4-1-3 ;; *-sunos4* | *-sunos ) opsys=sunos4-1 ;; *-sunos5* | *-solaris* ) opsys=sol2 ;; * ) opsys=bsd4-2 ;; esac ;; ## 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 ;; *-bsd386* ) opsys=bsd386 ;; *-sysv[01]* | *-sysvr[01]* ) opsys=usg5-0 ;; *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;; *-vms* ) opsys=vms ;; * ) unported=true 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[34]86-*-* ) machine=intel386 case "${canonical}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2* ) opsys=isc2-2 ;; *-isc* ) opsys=isc3-0 ;; *-esix5* ) opsys=esix5r4 ;; *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; *-linux* ) opsys=linux ;; *-sco3.2v4* ) opsys=sco4 ;; *-bsd386* ) opsys=bsd386 ;; *-386bsd* ) opsys=386bsd ;; *-netbsd* ) opsys=netbsd ;; ## Otherwise, we'll fall through to the generic opsys code at the bottom. esac ;; * ) unported=true ;; 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 [ x"${opsys}" = x ]; then case "${canonical}" in *-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 | *-sysvr4 ) opsys=usg5-4 ;; *-sysv4.2 | *-sysvr4.2 ) opsys=usg5-4-2 ;; * ) unported=true ;; esac fi if $unported ; then (echo "${progname}: Emacs hasn't been ported to \`${canonical}' systems." echo "${progname}: Check \`etc/MACHINES' for recognized configuration names." ) >&2 exit 1 fi machfile="m/${machine}.h" opsysfile="s/${opsys}.h" trap 'rm -fr conftest* confdefs* core; exit 1' 1 3 15 trap 'rm -f confdefs*' 0 # NLS nuisances. # 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 rm -f conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo > confdefs.h compile='${CC-cc} $CFLAGS conftest.c -o conftest $LIBS >/dev/null 2>&1' # 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. unique_file=lisp # Find the source files, if location was not specified. if test -z "$srcdir"; then srcdirdefaulted=yes # Try the directory containing this script, then `..'. prog=$0 confdir=`echo $prog|sed 's%/[^/][^/]*$%%'` test "X$confdir" = "X$prog" && confdir=. srcdir=$confdir if test ! -r $srcdir/$unique_file; then srcdir=.. fi fi if test ! -r $srcdir/$unique_file; then if test x$srcdirdefaulted = xyes; then echo "configure: Can not find sources in \`${confdir}' or \`..'." 1>&2 else echo "configure: Can not find sources in \`${srcdir}'." 1>&2 fi exit 1 fi # Preserve a srcdir of `.' to avoid automounter screwups with pwd. # But we can't avoid them for `..', to make subdirectories work. case $srcdir in .|/*|~*) ;; *) srcdir=`cd $srcdir; pwd` ;; # Make relative path absolute. esac # Save the original args to write them into config.status later. configure_args="$*" #### Choose a compiler. case ${with_gcc} in "yes" ) CC="gcc" GCC=1 ;; "no" ) CC="cc" ;; * ) if test -z "$CC"; then # Extract the first word of `gcc', so it can be a program name with args. set dummy gcc; word=$2 echo checking for $word IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" for dir in $PATH; do test -z "$dir" && dir=. if test -f $dir/$word; then CC="gcc" break fi done IFS="$saveifs" fi test -z "$CC" && CC="cc" test -n "$CC" && test -n "$verbose" && echo " setting CC to $CC" # Find out if we are using GNU C, under whatever name. cat > conftest.c < conftest.out 2>&1 if egrep yes conftest.out >/dev/null 2>&1; then GCC=1 # For later tests. fi rm -f conftest* esac #### 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 checking for ln -s rm -f conftestdata if ln -s X conftestdata 2>/dev/null then rm -f conftestdata LN_S="ln -s" else LN_S=ln fi echo checking how to run the C preprocessor if test -z "$CPP"; then # This must be in double quotes, not single quotes, because CPP may get # substituted into the Makefile and ``${CC-cc}'' will simply confuse # make. It must be expanded now. CPP="${CC-cc} -E" cat > conftest.c < Syntax Error EOF err=`eval "($CPP conftest.c >/dev/null) 2>&1"` if test -z "$err"; then : else rm -rf conftest* CPP=/lib/cpp fi rm -f conftest* fi test ".${verbose}" != "." && echo " setting CPP to $CPP" # Make sure to not get the incompatible SysV /etc/install and # /usr/sbin/install, which might be in PATH before a BSD-like install, # or the SunOS /usr/etc/install directory, or the AIX /bin/install, # or the AFS install, which mishandles nonexistent args, or # /usr/ucb/install on SVR4, which tries to use the nonexistent group # `staff'. On most BSDish systems install is in /usr/bin, not /usr/ucb # anyway. Sigh. if test "z${INSTALL}" = "z" ; then echo checking for install IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" for dir in $PATH; do test -z "$dir" && dir=. case $dir in /etc|/usr/sbin|/usr/etc|/usr/afsws/bin|/usr/ucb) ;; *) if test -f $dir/installbsd; then INSTALL="$dir/installbsd -c" # OSF1 INSTALL_PROGRAM='$(INSTALL)' INSTALL_DATA='$(INSTALL) -m 644' break fi if test -f $dir/install; then if grep dspmsg $dir/install >/dev/null 2>&1; then : # AIX else INSTALL="$dir/install -c" INSTALL_PROGRAM='$(INSTALL)' INSTALL_DATA='$(INSTALL) -m 644' break fi fi ;; esac done IFS="$saveifs" fi if test -z "$INSTALL"; then if test -f ${srcdir}/install.sh; then # We want the top-level source directory, not the subdir's srcdir, # so expand srcdir now rather than in the Makefile. INSTALL="${srcdir}/install.sh -c" else echo "warning: ${srcdir}/install.sh not found; using cp" INSTALL=cp fi fi test -n "$verbose" && echo " setting INSTALL to $INSTALL" INSTALL_PROGRAM=${INSTALL_PROGRAM-'$(INSTALL)'} test -n "$verbose" && echo " setting INSTALL_PROGRAM to $INSTALL_PROGRAM" INSTALL_DATA=${INSTALL_DATA-'$(INSTALL)'} test -n "$verbose" && echo " setting INSTALL_DATA to $INSTALL_DATA" for p in 'bison -y' byacc do if test -z "$YACC"; then # Extract the first word of `$p', so it can be a program name with args. set dummy $p; word=$2 echo checking for $word IFS="${IFS= }"; saveifs="$IFS"; IFS="${IFS}:" for dir in $PATH; do test -z "$dir" && dir=. if test -f $dir/$word; then YACC="$p" break fi done IFS="$saveifs" fi test -n "$YACC" && test -n "$verbose" && echo " setting YACC to $YACC" test -n "$YACC" && break done test -n "$YACC" || YACC="yacc" for hdr in sys/timeb.h sys/time.h unistd.h do trhdr=HAVE_`echo $hdr | tr '[a-z]./' '[A-Z]__'` echo checking for ${hdr} cat > conftest.c < EOF err=`eval "($CPP conftest.c >/dev/null) 2>&1"` if test -z "$err"; then rm -rf conftest* { test -n "$verbose" && \ echo " defining ${trhdr}" echo "#define" ${trhdr} 1 >> confdefs.h DEFS="$DEFS -D${trhdr}=1" SEDDEFS="${SEDDEFS}\${SEDdA}${trhdr}\${SEDdB}${trhdr}\${SEDdC}1\${SEDdD} \${SEDuA}${trhdr}\${SEDuB}${trhdr}\${SEDuC}1\${SEDuD} \${SEDeA}${trhdr}\${SEDeB}${trhdr}\${SEDeC}1\${SEDeD} " } fi rm -f conftest* done echo checking for ANSI C header files cat > conftest.c < #include #include #include EOF err=`eval "($CPP conftest.c >/dev/null) 2>&1"` if test -z "$err"; then rm -rf conftest* # SunOS 4.x string.h does not declare mem*, contrary to ANSI. echo '#include "confdefs.h" #include ' > conftest.c eval "$CPP conftest.c > conftest.out 2>&1" if egrep "memchr" conftest.out >/dev/null 2>&1; then rm -rf conftest* # SGI's /bin/cc from Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. cat > conftest.c < #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 $compile if test -s conftest && (./conftest; exit) 2>/dev/null; then { test -n "$verbose" && \ echo " defining STDC_HEADERS" echo "#define" STDC_HEADERS 1 >> confdefs.h DEFS="$DEFS -DSTDC_HEADERS=1" SEDDEFS="${SEDDEFS}\${SEDdA}STDC_HEADERS\${SEDdB}STDC_HEADERS\${SEDdC}1\${SEDdD} \${SEDuA}STDC_HEADERS\${SEDuB}STDC_HEADERS\${SEDuC}1\${SEDuD} \${SEDeA}STDC_HEADERS\${SEDeB}STDC_HEADERS\${SEDeC}1\${SEDeD} " } fi rm -fr conftest* fi rm -f conftest* fi rm -f conftest* echo checking for whether time.h and sys/time.h may both be included cat > conftest.c < #include #include int main() { exit(0); } int t() { struct tm *tp; } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining TIME_WITH_SYS_TIME" echo "#define" TIME_WITH_SYS_TIME 1 >> confdefs.h DEFS="$DEFS -DTIME_WITH_SYS_TIME=1" SEDDEFS="${SEDDEFS}\${SEDdA}TIME_WITH_SYS_TIME\${SEDdB}TIME_WITH_SYS_TIME\${SEDdC}1\${SEDdD} \${SEDuA}TIME_WITH_SYS_TIME\${SEDuB}TIME_WITH_SYS_TIME\${SEDuC}1\${SEDuD} \${SEDeA}TIME_WITH_SYS_TIME\${SEDeB}TIME_WITH_SYS_TIME\${SEDeC}1\${SEDeD} " } fi rm -f conftest* echo checking for return type of signal handlers cat > conftest.c < #include #ifdef signal #undef signal #endif extern void (*signal ()) (); int main() { exit(0); } int t() { int i; } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining" RETSIGTYPE to be void echo "#define" RETSIGTYPE void >> confdefs.h DEFS="$DEFS -DRETSIGTYPE=void" SEDDEFS="${SEDDEFS}\${SEDdA}RETSIGTYPE\${SEDdB}RETSIGTYPE\${SEDdC}void\${SEDdD} \${SEDuA}RETSIGTYPE\${SEDuB}RETSIGTYPE\${SEDuC}void\${SEDuD} \${SEDeA}RETSIGTYPE\${SEDeB}RETSIGTYPE\${SEDeC}void\${SEDeD} " } else rm -rf conftest* { test -n "$verbose" && \ echo " defining" RETSIGTYPE to be int echo "#define" RETSIGTYPE int >> confdefs.h DEFS="$DEFS -DRETSIGTYPE=int" SEDDEFS="${SEDDEFS}\${SEDdA}RETSIGTYPE\${SEDdB}RETSIGTYPE\${SEDdC}int\${SEDdD} \${SEDuA}RETSIGTYPE\${SEDuB}RETSIGTYPE\${SEDuC}int\${SEDuD} \${SEDeA}RETSIGTYPE\${SEDeB}RETSIGTYPE\${SEDeC}int\${SEDeD} " } fi rm -f conftest* echo checking for struct tm in time.h cat > conftest.c < #include int main() { exit(0); } int t() { struct tm *tp; tp->tm_sec; } EOF if eval $compile; then : else rm -rf conftest* { test -n "$verbose" && \ echo " defining TM_IN_SYS_TIME" echo "#define" TM_IN_SYS_TIME 1 >> confdefs.h DEFS="$DEFS -DTM_IN_SYS_TIME=1" SEDDEFS="${SEDDEFS}\${SEDdA}TM_IN_SYS_TIME\${SEDdB}TM_IN_SYS_TIME\${SEDdC}1\${SEDdD} \${SEDuA}TM_IN_SYS_TIME\${SEDuB}TM_IN_SYS_TIME\${SEDuC}1\${SEDuD} \${SEDeA}TM_IN_SYS_TIME\${SEDeB}TM_IN_SYS_TIME\${SEDeC}1\${SEDeD} " } fi rm -f conftest* decl='#include ' case "$DEFS" in *TM_IN_SYS_TIME*) decl="$decl #include " ;; *) decl="$decl #include " ;; esac echo checking for tm_zone in struct tm cat > conftest.c <> confdefs.h DEFS="$DEFS -DHAVE_TM_ZONE=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_TM_ZONE\${SEDdB}HAVE_TM_ZONE\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_TM_ZONE\${SEDuB}HAVE_TM_ZONE\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_TM_ZONE\${SEDeB}HAVE_TM_ZONE\${SEDeC}1\${SEDeD} " } else rm -rf conftest* no_tm_zone=1 fi rm -f conftest* if test -n "$no_tm_zone"; then echo checking for tzname cat > conftest.c < #ifndef tzname /* For SGI. */ extern char *tzname[]; /* RS6000 and others want it this way. */ #endif int main() { exit(0); } int t() { atoi(*tzname); } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining HAVE_TZNAME" echo "#define" HAVE_TZNAME 1 >> confdefs.h DEFS="$DEFS -DHAVE_TZNAME=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_TZNAME\${SEDdB}HAVE_TZNAME\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_TZNAME\${SEDuB}HAVE_TZNAME\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_TZNAME\${SEDeB}HAVE_TZNAME\${SEDeC}1\${SEDeD} " } fi rm -f conftest* fi prog='/* Ultrix mips cc rejects this. */ typedef int charset[2]; const charset x; /* SunOS 4.1.1 cc rejects this. */ char const *const *ccp; char **p; /* AIX XL C 1.02.0.0 rejects this. It does not let you subtract one const X* pointer from another in an arm of an if-expression whose if-part is not a constant expression */ const char *g = "string"; ccp = &g + (g ? g-g : 0); /* HPUX 7.0 cc rejects these. */ ++ccp; p = (char**) ccp; ccp = (char const *const *) p; { /* SCO 3.2v4 cc rejects this. */ char *t; char const *s = 0 ? (char *) 0 : (char const *) 0; *t++ = 0; } { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ int x[] = {25,17}; const int *foo = &x[0]; ++foo; } { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ typedef const int *iptr; iptr p = 0; ++p; } { /* AIX XL C 1.02.0.0 rejects this saying "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ struct s { int j; const int *ap[3]; }; struct s *b; b->j = 5; } { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ const int foo = 10; }' echo checking for lack of working const cat > conftest.c <> confdefs.h DEFS="$DEFS -Dconst=" SEDDEFS="${SEDDEFS}\${SEDdA}const\${SEDdB}const\${SEDdC}\${SEDdD} \${SEDuA}const\${SEDuB}const\${SEDuC}\${SEDuD} \${SEDeA}const\${SEDeB}const\${SEDeC}\${SEDeD} " } fi rm -f conftest* echo checking for long file names some_dir_failed=false # 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 dir in `eval echo . /tmp /var/tmp /usr/tmp $prefix/lib $exec_prefix/lib` ; do test -d $dir || continue test -w $dir || continue # It's less confusing to not echo anything here. (echo 1 > $dir/conftest9012345) 2>/dev/null (echo 2 > $dir/conftest9012346) 2>/dev/null val=`cat $dir/conftest9012345 2>/dev/null` test -f $dir/conftest9012345 && test "$val" = 1 || some_dir_failed=true rm -f $dir/conftest9012345 $dir/conftest9012346 2> /dev/null done $some_dir_failed || { test -n "$verbose" && \ echo " defining HAVE_LONG_FILE_NAMES" echo "#define" HAVE_LONG_FILE_NAMES 1 >> confdefs.h DEFS="$DEFS -DHAVE_LONG_FILE_NAMES=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_LONG_FILE_NAMES\${SEDdB}HAVE_LONG_FILE_NAMES\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_LONG_FILE_NAMES\${SEDuB}HAVE_LONG_FILE_NAMES\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_LONG_FILE_NAMES\${SEDeB}HAVE_LONG_FILE_NAMES\${SEDeC}1\${SEDeD} " } #### Choose a window system. echo "Checking window system." window_system='' case "${with_x}" in yes ) window_system=${window_system}x11 ;; no ) window_system=${window_system}none esac case "${with_x11}" in yes ) window_system=${window_system}x11 ;; esac case "${with_x10}" in yes ) window_system=${window_system}x10 ;; esac case "${window_system}" in "none" | "x11" | "x10" ) ;; "" ) # --x-includes or --x-libraries implies --with-x11. if [ -n "${x_includes}" ] || [ -n "${x_libraries}" ]; then window_system=x11 else echo " No window system specified. Looking for X11." # If the user didn't specify a window system and we found X11, use it. if [ -r /usr/lib/libX11.a \ -o -d /usr/include/X11 \ -o -d /usr/X386/include \ -o -d ${x_includes}/X11 ]; then window_system=x11 fi fi ;; * ) echo "Don't specify a window system more than once." >&2 exit 1 ;; esac case "${window_system}" in "" | "x11" ) ### If the user hasn't specified where we should find X, try ### letting autoconf figure that out. if [ -z "${x_includes}" ] && [ -z "${x_libraries}" ]; then # If we find X, set shell vars x_includes and x_libraries to the paths. no_x=true echo checking for X include and library files with xmkmf rm -fr conftestdir if mkdir conftestdir; then cd conftestdir cat > Imakefile <<'EOF' acfindx: @echo 'im_incroot="$(INCROOT)"; im_usrlibdir="$(USRLIBDIR)"; 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 | grep -v make` # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. if test ! -f $im_usrlibdir/libX11.a && test -f $im_libdir/libX11.a; then im_usrlibdir=$im_libdir fi case "$im_incroot" in /usr/include) ;; *) x_includes="$im_incroot" ;; esac case "$im_usrlibdir" in /usr/lib | /lib) ;; *) x_libraries="$im_usrlibdir" ;; esac fi cd .. rm -fr conftestdir fi if test -z "$im_usrlibdir"; then echo checking for X include and library files directly if test ".$x_direct_test_library" = . ; then x_direct_test_library=Xt fi cat > conftest.c < EOF err=`eval "($CPP conftest.c >/dev/null) 2>&1"` if test -z "$err"; then rm -rf conftest* no_x= else rm -rf conftest* for dir in \ /usr/local/include \ /usr/unsupported/include \ /usr/x386/include \ /usr/local/x11r5/include \ /usr/include/X11R6 \ /usr/include/X11R5 \ /usr/include/X11R4 \ /usr/X11R6/include \ /usr/X11R5/include \ /usr/X11/include \ /usr/openwin/include \ /usr/openwin/share/include \ /usr/lpp/Xamples/include \ /usr/athena/include \ ; \ do if test -r $dir/X11/Intrinsic.h; then x_includes=$dir; no_x= break fi done fi rm -f conftest* # Check for the libraries. First see if replacing the `include' by # `lib' works. LIBS_save="${LIBS}" LIBS="${LIBS} -l"$x_direct_test_library"" have_lib="" echo checking for -l"$x_direct_test_library" cat > conftest.c < ${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} \ | grep 'configure___' \ | sed -e 's/^configure___ \([^=]*=\)\(.*\)$/\1"\2"/'` 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 [ "${system_malloc}" = "yes" ]; then GNU_MALLOC=no GNU_MALLOC_reason=" (The GNU allocators don't work with this system configuration.)" fi if [ x"${REL_ALLOC}" = x ]; then REL_ALLOC=${GNU_MALLOC} fi LISP_FLOAT_TYPE=yes #### Add the libraries to LIBS and check for some functions. DEFS="$c_switch_system $DEFS" LIBS="$libsrc_libs" LIBS_save="${LIBS}" LIBS="${LIBS} -ldnet" have_lib="" echo checking for -ldnet cat > conftest.c <> confdefs.h DEFS="$DEFS -DHAVE_LIBDNET=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_LIBDNET\${SEDdB}HAVE_LIBDNET\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_LIBDNET\${SEDuB}HAVE_LIBDNET\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_LIBDNET\${SEDeB}HAVE_LIBDNET\${SEDeC}1\${SEDeD} " } LIBS="${LIBS} -ldnet" fi LIBS_save="${LIBS}" LIBS="${LIBS} -lXbsd" have_lib="" echo checking for -lXbsd cat > conftest.c < conftest.c < int main() { exit(0); } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_${func}) || defined (__stub___${func}) choke me #else /* Override any gcc2 internal prototype to avoid an error. */ extern char ${func}(); ${func}(); #endif } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining ${trfunc}" echo "#define" ${trfunc} 1 >> confdefs.h DEFS="$DEFS -D${trfunc}=1" SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} \${SEDuA}${trfunc}\${SEDuB}${trfunc}\${SEDuC}1\${SEDuD} \${SEDeA}${trfunc}\${SEDeB}${trfunc}\${SEDeC}1\${SEDeD} " } fi rm -f conftest* done fi # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! echo checking for working alloca.h cat > conftest.c < int main() { exit(0); } int t() { char *p = alloca(2 * sizeof(int)); } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining HAVE_ALLOCA_H" echo "#define" HAVE_ALLOCA_H 1 >> confdefs.h DEFS="$DEFS -DHAVE_ALLOCA_H=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_ALLOCA_H\${SEDdB}HAVE_ALLOCA_H\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_ALLOCA_H\${SEDuB}HAVE_ALLOCA_H\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_ALLOCA_H\${SEDeB}HAVE_ALLOCA_H\${SEDeC}1\${SEDeD} " } fi rm -f conftest* decl="#ifdef __GNUC__ #define alloca __builtin_alloca #else #if HAVE_ALLOCA_H #include #else #ifdef _AIX #pragma alloca #else char *alloca (); #endif #endif #endif " echo checking for alloca cat > conftest.c < conftest.c < conftest.out 2>&1" if egrep "winnitude" conftest.out >/dev/null 2>&1; then rm -rf conftest* echo checking for _getb67 cat > conftest.c < int main() { exit(0); } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub__getb67) || defined (__stub____getb67) choke me #else /* Override any gcc2 internal prototype to avoid an error. */ extern char _getb67(); _getb67(); #endif } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining" CRAY_STACKSEG_END to be _getb67 echo "#define" CRAY_STACKSEG_END _getb67 >> confdefs.h DEFS="$DEFS -DCRAY_STACKSEG_END=_getb67" SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}_getb67\${SEDdD} \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}_getb67\${SEDuD} \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}_getb67\${SEDeD} " } else rm -rf conftest* echo checking for GETB67 cat > conftest.c < int main() { exit(0); } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_GETB67) || defined (__stub___GETB67) choke me #else /* Override any gcc2 internal prototype to avoid an error. */ extern char GETB67(); GETB67(); #endif } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining" CRAY_STACKSEG_END to be GETB67 echo "#define" CRAY_STACKSEG_END GETB67 >> confdefs.h DEFS="$DEFS -DCRAY_STACKSEG_END=GETB67" SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}GETB67\${SEDdD} \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}GETB67\${SEDuD} \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}GETB67\${SEDeD} " } else rm -rf conftest* echo checking for getb67 cat > conftest.c < int main() { exit(0); } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_getb67) || defined (__stub___getb67) choke me #else /* Override any gcc2 internal prototype to avoid an error. */ extern char getb67(); getb67(); #endif } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining" CRAY_STACKSEG_END to be getb67 echo "#define" CRAY_STACKSEG_END getb67 >> confdefs.h DEFS="$DEFS -DCRAY_STACKSEG_END=getb67" SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}getb67\${SEDdD} \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}getb67\${SEDuD} \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}getb67\${SEDeD} " } fi rm -f conftest* fi rm -f conftest* fi rm -f conftest* fi rm -f conftest* fi rm -f conftest* if test -n "$alloca_missing"; then # The SVR3 libPW and SVR4 libucb both contain incompatible functions # that cause trouble. Some versions do not even contain alloca or # contain a buggy version. If you still want to use their alloca, # use ar to extract alloca.o from them instead of compiling alloca.c. ALLOCA=alloca.o { test -n "$verbose" && \ echo " defining C_ALLOCA" echo "#define" C_ALLOCA 1 >> confdefs.h DEFS="$DEFS -DC_ALLOCA=1" SEDDEFS="${SEDDEFS}\${SEDdA}C_ALLOCA\${SEDdB}C_ALLOCA\${SEDdC}1\${SEDdD} \${SEDuA}C_ALLOCA\${SEDuB}C_ALLOCA\${SEDuC}1\${SEDuD} \${SEDeA}C_ALLOCA\${SEDeB}C_ALLOCA\${SEDeC}1\${SEDeD} " } echo 'checking stack direction for C alloca' echo checking whether cross-compiling # If we cannot run a trivial program, we must be cross compiling. cat > conftest.c </dev/null; then : else cross_compiling=1 fi rm -fr conftest* if test -n "$cross_compiling" then { test -n "$verbose" && \ echo " defining" STACK_DIRECTION to be 0 echo "#define" STACK_DIRECTION 0 >> confdefs.h DEFS="$DEFS -DSTACK_DIRECTION=0" SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}0\${SEDdD} \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}0\${SEDuD} \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}0\${SEDeD} " } else cat > conftest.c < addr) ? 1 : -1; } main () { exit (find_stack_direction() < 0); } EOF eval $compile if test -s conftest && (./conftest; exit) 2>/dev/null; then { test -n "$verbose" && \ echo " defining" STACK_DIRECTION to be 1 echo "#define" STACK_DIRECTION 1 >> confdefs.h DEFS="$DEFS -DSTACK_DIRECTION=1" SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}1\${SEDdD} \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}1\${SEDuD} \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}1\${SEDeD} " } else { test -n "$verbose" && \ echo " defining" STACK_DIRECTION to be -1 echo "#define" STACK_DIRECTION -1 >> confdefs.h DEFS="$DEFS -DSTACK_DIRECTION=-1" SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}-1\${SEDdD} \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}-1\${SEDuD} \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}-1\${SEDeD} " } fi fi rm -fr conftest* fi # logb and frexp are found in -lm on most systems. LIBS_save="${LIBS}" LIBS="${LIBS} -lm" have_lib="" echo checking for -lm cat > conftest.c <> confdefs.h DEFS="$DEFS -DHAVE_LIBM=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_LIBM\${SEDdB}HAVE_LIBM\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_LIBM\${SEDuB}HAVE_LIBM\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_LIBM\${SEDeB}HAVE_LIBM\${SEDeC}1\${SEDeD} " } LIBS="${LIBS} -lm" fi for func in gettimeofday gethostname dup2 rename closedir mkdir rmdir random bcopy logb frexp ftime res_init do trfunc=HAVE_`echo $func | tr '[a-z]' '[A-Z]'` echo checking for ${func} cat > conftest.c < int main() { exit(0); } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_${func}) || defined (__stub___${func}) choke me #else /* Override any gcc2 internal prototype to avoid an error. */ extern char ${func}(); ${func}(); #endif } EOF if eval $compile; then rm -rf conftest* { test -n "$verbose" && \ echo " defining ${trfunc}" echo "#define" ${trfunc} 1 >> confdefs.h DEFS="$DEFS -D${trfunc}=1" SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} \${SEDuA}${trfunc}\${SEDuB}${trfunc}\${SEDuC}1\${SEDuD} \${SEDeA}${trfunc}\${SEDeB}${trfunc}\${SEDeC}1\${SEDeD} " } fi rm -f conftest* done ok_so_far=true echo checking for socket cat > conftest.c < int main() { exit(0); } int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_socket) || defined (__stub___socket) choke me #else /* Override any gcc2 internal prototype to avoid an error. */ extern char socket(); socket(); #endif } EOF if eval $compile; then : else rm -rf conftest* ok_so_far= fi rm -f conftest* if test -n "$ok_so_far"; then echo checking for netinet/in.h cat > conftest.c < EOF err=`eval "($CPP conftest.c >/dev/null) 2>&1"` if test -z "$err"; then : else rm -rf conftest* ok_so_far= fi rm -f conftest* fi if test -n "$ok_so_far"; then echo checking for arpa/inet.h cat > conftest.c < EOF err=`eval "($CPP conftest.c >/dev/null) 2>&1"` if test -z "$err"; then : else rm -rf conftest* ok_so_far= fi rm -f conftest* fi if test -n "$ok_so_far"; then { test -n "$verbose" && \ echo " defining HAVE_INET_SOCKETS" echo "#define" HAVE_INET_SOCKETS 1 >> confdefs.h DEFS="$DEFS -DHAVE_INET_SOCKETS=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_INET_SOCKETS\${SEDdB}HAVE_INET_SOCKETS\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_INET_SOCKETS\${SEDuB}HAVE_INET_SOCKETS\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_INET_SOCKETS\${SEDeB}HAVE_INET_SOCKETS\${SEDeC}1\${SEDeD} " } fi #### Find out which version of Emacs this is. version=`grep 'defconst[ ]*emacs-version' ${srcdir}/lisp/version.el \ | sed -e 's/^.*"\([0-9][0-9]*\.[0-9][0-9]*\)\..*$/\1/'` if [ x"${version}" = x ]; then echo "${progname}: can't find current emacs version in \`${srcdir}/lisp/version.el'." >&2 exit 1 fi if [ -f /usr/lpp/X11/bin/smt.exp ]; then { test -n "$verbose" && \ echo " defining HAVE_AIX_SMT_EXP" echo "#define" HAVE_AIX_SMT_EXP 1 >> confdefs.h DEFS="$DEFS -DHAVE_AIX_SMT_EXP=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_AIX_SMT_EXP\${SEDdB}HAVE_AIX_SMT_EXP\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_AIX_SMT_EXP\${SEDuB}HAVE_AIX_SMT_EXP\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_AIX_SMT_EXP\${SEDeB}HAVE_AIX_SMT_EXP\${SEDeC}1\${SEDeD} " } fi #### Specify what sort of things we'll be editing into Makefile and config.h. ### Use configuration here uncanonicalized to avoid exceeding size limits. { test -n "$verbose" && \ echo " defining" config_machfile to be "\"${machfile}\"" echo "#define" config_machfile "\"${machfile}\"" >> confdefs.h DEFS="$DEFS -Dconfig_machfile="\"${machfile}\""" SEDDEFS="${SEDDEFS}\${SEDdA}config_machfile\${SEDdB}config_machfile\${SEDdC}"\"${machfile}\""\${SEDdD} \${SEDuA}config_machfile\${SEDuB}config_machfile\${SEDuC}"\"${machfile}\""\${SEDuD} \${SEDeA}config_machfile\${SEDeB}config_machfile\${SEDeC}"\"${machfile}\""\${SEDeD} " } { test -n "$verbose" && \ echo " defining" config_opsysfile to be "\"${opsysfile}\"" echo "#define" config_opsysfile "\"${opsysfile}\"" >> confdefs.h DEFS="$DEFS -Dconfig_opsysfile="\"${opsysfile}\""" SEDDEFS="${SEDDEFS}\${SEDdA}config_opsysfile\${SEDdB}config_opsysfile\${SEDdC}"\"${opsysfile}\""\${SEDdD} \${SEDuA}config_opsysfile\${SEDuB}config_opsysfile\${SEDuC}"\"${opsysfile}\""\${SEDuD} \${SEDeA}config_opsysfile\${SEDeB}config_opsysfile\${SEDeC}"\"${opsysfile}\""\${SEDeD} " } { test -n "$verbose" && \ echo " defining" LD_SWITCH_X_SITE to be ${LD_SWITCH_X_SITE} echo "#define" LD_SWITCH_X_SITE ${LD_SWITCH_X_SITE} >> confdefs.h DEFS="$DEFS -DLD_SWITCH_X_SITE=${LD_SWITCH_X_SITE}" SEDDEFS="${SEDDEFS}\${SEDdA}LD_SWITCH_X_SITE\${SEDdB}LD_SWITCH_X_SITE\${SEDdC}${LD_SWITCH_X_SITE}\${SEDdD} \${SEDuA}LD_SWITCH_X_SITE\${SEDuB}LD_SWITCH_X_SITE\${SEDuC}${LD_SWITCH_X_SITE}\${SEDuD} \${SEDeA}LD_SWITCH_X_SITE\${SEDeB}LD_SWITCH_X_SITE\${SEDeC}${LD_SWITCH_X_SITE}\${SEDeD} " } { test -n "$verbose" && \ echo " defining" C_SWITCH_X_SITE to be ${C_SWITCH_X_SITE} echo "#define" C_SWITCH_X_SITE ${C_SWITCH_X_SITE} >> confdefs.h DEFS="$DEFS -DC_SWITCH_X_SITE=${C_SWITCH_X_SITE}" SEDDEFS="${SEDDEFS}\${SEDdA}C_SWITCH_X_SITE\${SEDdB}C_SWITCH_X_SITE\${SEDdC}${C_SWITCH_X_SITE}\${SEDdD} \${SEDuA}C_SWITCH_X_SITE\${SEDuB}C_SWITCH_X_SITE\${SEDuC}${C_SWITCH_X_SITE}\${SEDuD} \${SEDeA}C_SWITCH_X_SITE\${SEDeB}C_SWITCH_X_SITE\${SEDeC}${C_SWITCH_X_SITE}\${SEDeD} " } { test -n "$verbose" && \ echo " defining" UNEXEC_SRC to be ${UNEXEC_SRC} echo "#define" UNEXEC_SRC ${UNEXEC_SRC} >> confdefs.h DEFS="$DEFS -DUNEXEC_SRC=${UNEXEC_SRC}" SEDDEFS="${SEDDEFS}\${SEDdA}UNEXEC_SRC\${SEDdB}UNEXEC_SRC\${SEDdC}${UNEXEC_SRC}\${SEDdD} \${SEDuA}UNEXEC_SRC\${SEDuB}UNEXEC_SRC\${SEDuC}${UNEXEC_SRC}\${SEDuD} \${SEDeA}UNEXEC_SRC\${SEDeB}UNEXEC_SRC\${SEDeC}${UNEXEC_SRC}\${SEDeD} " } if [ "${HAVE_X_WINDOWS}" = "yes" ] ; then { test -n "$verbose" && \ echo " defining HAVE_X_WINDOWS" echo "#define" HAVE_X_WINDOWS 1 >> confdefs.h DEFS="$DEFS -DHAVE_X_WINDOWS=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X_WINDOWS\${SEDdB}HAVE_X_WINDOWS\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_X_WINDOWS\${SEDuB}HAVE_X_WINDOWS\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_X_WINDOWS\${SEDeB}HAVE_X_WINDOWS\${SEDeC}1\${SEDeD} " } fi if [ "${HAVE_X11}" = "yes" ] ; then { test -n "$verbose" && \ echo " defining HAVE_X11" echo "#define" HAVE_X11 1 >> confdefs.h DEFS="$DEFS -DHAVE_X11=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X11\${SEDdB}HAVE_X11\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_X11\${SEDuB}HAVE_X11\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_X11\${SEDeB}HAVE_X11\${SEDeC}1\${SEDeD} " } fi if [ "${HAVE_XFREE386}" = "yes" ] ; then { test -n "$verbose" && \ echo " defining HAVE_XFREE386" echo "#define" HAVE_XFREE386 1 >> confdefs.h DEFS="$DEFS -DHAVE_XFREE386=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_XFREE386\${SEDdB}HAVE_XFREE386\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_XFREE386\${SEDuB}HAVE_XFREE386\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_XFREE386\${SEDeB}HAVE_XFREE386\${SEDeC}1\${SEDeD} " } fi if [ "${HAVE_X_MENU}" = "yes" ] ; then { test -n "$verbose" && \ echo " defining HAVE_X_MENU" echo "#define" HAVE_X_MENU 1 >> confdefs.h DEFS="$DEFS -DHAVE_X_MENU=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X_MENU\${SEDdB}HAVE_X_MENU\${SEDdC}1\${SEDdD} \${SEDuA}HAVE_X_MENU\${SEDuB}HAVE_X_MENU\${SEDuC}1\${SEDuD} \${SEDeA}HAVE_X_MENU\${SEDeB}HAVE_X_MENU\${SEDeC}1\${SEDeD} " } fi if [ "${GNU_MALLOC}" = "yes" ] ; then { test -n "$verbose" && \ echo " defining GNU_MALLOC" echo "#define" GNU_MALLOC 1 >> confdefs.h DEFS="$DEFS -DGNU_MALLOC=1" SEDDEFS="${SEDDEFS}\${SEDdA}GNU_MALLOC\${SEDdB}GNU_MALLOC\${SEDdC}1\${SEDdD} \${SEDuA}GNU_MALLOC\${SEDuB}GNU_MALLOC\${SEDuC}1\${SEDuD} \${SEDeA}GNU_MALLOC\${SEDeB}GNU_MALLOC\${SEDeC}1\${SEDeD} " } fi if [ "${REL_ALLOC}" = "yes" ] ; then { test -n "$verbose" && \ echo " defining REL_ALLOC" echo "#define" REL_ALLOC 1 >> confdefs.h DEFS="$DEFS -DREL_ALLOC=1" SEDDEFS="${SEDDEFS}\${SEDdA}REL_ALLOC\${SEDdB}REL_ALLOC\${SEDdC}1\${SEDdD} \${SEDuA}REL_ALLOC\${SEDuB}REL_ALLOC\${SEDuC}1\${SEDuD} \${SEDeA}REL_ALLOC\${SEDeB}REL_ALLOC\${SEDeC}1\${SEDeD} " } fi if [ "${LISP_FLOAT_TYPE}" = "yes" ] ; then { test -n "$verbose" && \ echo " defining LISP_FLOAT_TYPE" echo "#define" LISP_FLOAT_TYPE 1 >> confdefs.h DEFS="$DEFS -DLISP_FLOAT_TYPE=1" SEDDEFS="${SEDDEFS}\${SEDdA}LISP_FLOAT_TYPE\${SEDdB}LISP_FLOAT_TYPE\${SEDdC}1\${SEDdD} \${SEDuA}LISP_FLOAT_TYPE\${SEDuB}LISP_FLOAT_TYPE\${SEDuC}1\${SEDuD} \${SEDeA}LISP_FLOAT_TYPE\${SEDeB}LISP_FLOAT_TYPE\${SEDeC}1\${SEDeD} " } fi # ====================== Developer's configuration ======================= # The following assignments make sense if you're running Emacs on a single # machine, one version at a time, and you want changes to the lisp and etc # directories in the source tree to show up immediately in your working # environment. It saves a great deal of disk space by not duplicating the # lisp and etc directories. if [ "$run_in_place" = "1" ]; then lispdir='${srcdir}/lisp' locallisppath='${srcdir}/site-lisp' etcdir='${srcdir}/etc' lockdir='${srcdir}/lock' archlibdir='${srcdir}/lib-src' infodir='${srcdir}/info' elif [ "$single_tree" = "1" ]; then if [ "$exec_prefix_specified" = "" ]; then exec_prefix='${prefix}' fi if [ "$bindir_specified" = "" ]; then bindir='${exec_prefix}/bin/${configuration}' fi if [ "$datadir_specified" = "" ]; then datadir='${prefix}/common' fi if [ "$statedir_specified" = "" ]; then statedir='${prefix}/common' fi if [ "$libdir_specified" = "" ]; then libdir='${bindir}' fi if [ "$lispdir_specified" = "" ]; then lispdir='${prefix}/common/lisp' fi if [ "$locallisppath_specified" = "" ]; then locallisppath='${prefix}/common/site-lisp' fi if [ "$lockdir_specified" = "" ]; then lockdir='${prefix}/common/lock' fi if [ "$archlibdir_specified" = "" ]; then archlibdir='${libdir}/etc' fi if [ "$etcdir_specified" = "" ]; then etcdir='${prefix}/common/data' fi 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}${x_includes+ Where do we find X Windows header files? }${x_includes}${x_libraries+ Where do we find X Windows libraries? }${x_libraries} " # Remove any trailing slashes in these variables. test -n "${prefix}" && prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` test -n "${exec_prefix}" && exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` # Set default prefixes. if test -n "$prefix"; then test -z "$exec_prefix" && exec_prefix='${prefix}' prsub="s%^prefix\\([ ]*\\)=\\([ ]*\\).*$%prefix\\1=\\2$prefix%" fi if test -n "$exec_prefix"; then prsub="$prsub s%^exec_prefix\\([ ]*\\)=\\([ ]*\\).*$%exec_prefix\\1=\\2$exec_prefix%" fi # Quote sed substitution magic chars in DEFS. cat >conftest.def < config.status </dev/null | sed 1q`: # # $0 $configure_args for arg do case "\$arg" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo running \${CONFIG_SHELL-/bin/sh} $0 $configure_args exec \${CONFIG_SHELL-/bin/sh} $0 $configure_args ;; *) echo "Usage: config.status --recheck" 2>&1; exit 1 ;; esac done trap 'rm -fr Makefile lib-src/Makefile oldXMenu/Makefile src/Makefile.in src/config.h conftest*; exit 1' 1 3 15 CC='$CC' LN_S='$LN_S' CPP='$CPP' INSTALL='$INSTALL' INSTALL_PROGRAM='$INSTALL_PROGRAM' INSTALL_DATA='$INSTALL_DATA' YACC='$YACC' ALLOCA='$ALLOCA' configuration='$configuration' version='$version' srcdir='$srcdir' prefix='$prefix' exec_prefix='$exec_prefix' bindir='$bindir' datadir='$datadir' statedir='$statedir' libdir='$libdir' mandir='$mandir' infodir='$infodir' lispdir='$lispdir' locallisppath='$locallisppath' lisppath='$lisppath' etcdir='$etcdir' lockdir='$lockdir' archlibdir='$archlibdir' c_switch_system='$c_switch_system' libsrc_libs='$libsrc_libs' LD_SWITCH_X_SITE='$LD_SWITCH_X_SITE' C_SWITCH_X_SITE='$C_SWITCH_X_SITE' CFLAGS='$CFLAGS' LIBS='$LIBS' prefix='$prefix' exec_prefix='$exec_prefix' prsub='$prsub' extrasub='$extrasub' EOF cat >> config.status <<\EOF top_srcdir=$srcdir CONFIG_FILES=${CONFIG_FILES-"Makefile lib-src/Makefile oldXMenu/Makefile src/Makefile.in"} for file in .. ${CONFIG_FILES}; do if test "x$file" != x..; then srcdir=$top_srcdir # Remove last slash and all that follows it. Not all systems have dirname. dir=`echo $file|sed 's%/[^/][^/]*$%%'` if test "$dir" != "$file"; then test "$top_srcdir" != . && srcdir=$top_srcdir/$dir test ! -d "$dir" && mkdir "$dir" fi echo creating "$file" rm -f "$file" comment_str="Generated automatically from `echo $file|sed 's|.*/||'`.in by configure." case "$file" in *.c | *.h | *.C | *.cc | *.m ) echo "/* $comment_str */" > "$file" ;; * ) echo "# $comment_str" > "$file" ;; esac sed -e " $prsub $extrasub s%@CC@%$CC%g s%@LN_S@%$LN_S%g s%@CPP@%$CPP%g s%@INSTALL@%$INSTALL%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g s%@INSTALL_DATA@%$INSTALL_DATA%g s%@YACC@%$YACC%g s%@ALLOCA@%$ALLOCA%g s%@configuration@%$configuration%g s%@version@%$version%g s%@srcdir@%$srcdir%g s%@prefix@%$prefix%g s%@exec_prefix@%$exec_prefix%g s%@bindir@%$bindir%g s%@datadir@%$datadir%g s%@statedir@%$statedir%g s%@libdir@%$libdir%g s%@mandir@%$mandir%g s%@infodir@%$infodir%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%@c_switch_system@%$c_switch_system%g s%@libsrc_libs@%$libsrc_libs%g s%@LD_SWITCH_X_SITE@%$LD_SWITCH_X_SITE%g s%@C_SWITCH_X_SITE@%$C_SWITCH_X_SITE%g s%@CFLAGS@%$CFLAGS%g s%@LIBS@%$LIBS%g s%@DEFS@%-DHAVE_CONFIG_H%" $top_srcdir/${file}.in >> $file fi; done CONFIG_HEADERS=${CONFIG_HEADERS-"src/config.h"} for file in .. ${CONFIG_HEADERS}; do if test "x$file" != x..; then echo creating $file # These sed commands are put into SEDDEFS when defining a macro. # They are broken into pieces to make the sed script easier to manage. # They 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. # Each defining turns into a single global substitution command. # Hopefully no one uses "!" as a variable value. # Other candidates for the sed separators, like , and @, do get used. # # SEDd sets the value in "#define NAME VALUE" lines. SEDdA='s!^\([ ]*\)#\([ ]*define[ ][ ]*\)' SEDdB='\([ ][ ]*\)[^ ]*!\1#\2' SEDdC='\3' SEDdD='!g' # SEDu turns "#undef NAME" with trailing blanks into "#define NAME VALUE". SEDuA='s!^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' SEDuB='\([ ]\)!\1#\2define\3' SEDuC=' ' SEDuD='\4!g' # SEDe turns "#undef NAME" without trailing blanks into "#define NAME VALUE". SEDeA='s!^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' SEDeB='$!\1#\2define\3' SEDeC=' ' SEDeD='!g' rm -f conftest.sed EOF # Turn off quoting long enough to insert the sed commands. rm -f conftest.sh cat > conftest.sh < conftest.s1 # Like head -20. sed 1,${maxshlines}d conftest.sh > conftest.s2 # Like tail +21. # Write a limited-size here document to append to conftest.sed. echo 'cat >> conftest.sed <> config.status cat conftest.s1 >> config.status echo 'CONFEOF' >> config.status rm -f conftest.s1 conftest.sh mv conftest.s2 conftest.sh done rm -f conftest.sh # Now back to your regularly scheduled config.status. cat >> config.status <<\EOF # This sed command replaces #undef's 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 in # src/config.h. cat >> conftest.sed <<\CONFEOF s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */, CONFEOF rm -f conftest.h # Break up the sed commands because old seds have small limits. maxsedlines=20 cp $top_srcdir/$file.in conftest.h1 while : do lines=`grep -c . conftest.sed` if test -z "$lines" || test "$lines" -eq 0; then break; fi rm -f conftest.s1 conftest.s2 conftest.h2 sed ${maxsedlines}q conftest.sed > conftest.s1 # Like head -20. sed 1,${maxsedlines}d conftest.sed > conftest.s2 # Like tail +21. sed -f conftest.s1 < conftest.h1 > conftest.h2 rm -f conftest.s1 conftest.h1 conftest.sed mv conftest.h2 conftest.h1 mv conftest.s2 conftest.sed done rm -f conftest.sed conftest.h echo "/* $file. Generated automatically by configure. */" > conftest.h cat conftest.h1 >> conftest.h rm -f conftest.h1 if cmp -s $file conftest.h 2>/dev/null; then # The file exists and we would not be changing it. echo "$file is unchanged" rm -f conftest.h else rm -f $file mv conftest.h $file fi fi; done exit 0 EOF chmod +x config.status ${CONFIG_SHELL-/bin/sh} config.status # Build src/Makefile from ${srcdir}/src/Makefile.in. This must be done # after src/config.h is built, since we rely on that file. Only do the # build if "config.status" is present, since it's non-presence indicates # an error occured. status=$? if [ ! -f ./config.status ]; then exit $status fi topsrcdir=${srcdir} # We discard all lines in Makefile.in that start with `# Generated' or /**/# # because some cpps get confused by them. # Really we should preserve them somehow into Makefile, # but that is beyond my level of shell programming. makefile_command='echo "creating src/Makefile"; topsrcdir='"${topsrcdir}"'; ( cd ./src; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\ ' -e '\''s/^ / /'\'' '\ ' | sed -n -e '\''/^..*$/p'\'' '\ ' > Makefile.new; chmod 444 Makefile.new; mv -f Makefile.new Makefile; rm -f junk.c junk.cpp; )' eval `echo $makefile_command` # AC-OUTPUT has created `config.status' already. We need to add the above # commands to re-create `src/Makefile', and we need to insert them before # the final "exit 0" which appears at the end of `config.status'. config.new echo $makefile_command >>config.new echo exit 0 >>config.new mv -f config.new config.status chmod +x config.status # Don't let the fact that we just rewrote config.status make Makefile think # that it is now newer. We have just rewritten all of the Makefiles as well. MFS="Makefile src/Makefile src/Makefile.in lib-src/Makefile oldXMenu/Makefile" for file in $MFS; do chmod a+w $file; touch $file; chmod 444 $file done exit 0 emacs-19.22/configure.in100555 12120 1 116747 5473627166 13515 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. You must have autoconf dnl version 1.4 or later. dnl dnl The following text appears in the resulting `configure' script, dnl explaining how to rebuild it. [#!/bin/sh #### Configuration script for GNU Emacs #### Copyright (C) 1992 Free Software Foundation, Inc. ### Don't edit this script! ### This script was automatically generated by the `autoconf' program ### from the file `./configure.in'. ### To rebuild it, execute the command ### autoconf ### in the this directory. You must have autoconf version 1.4 or later. ### This file is part of GNU Emacs. ### GNU Emacs is free software; you can 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. ### Since Emacs has configuration requirements that autoconf can't ### meet, this file is an unholy marriage of custom-baked ### configuration code and autoconf macros. ### ### We use the m4 quoting characters [ ] (as established by the ### autoconf system) to include large sections of raw sewage - Oops, I ### mean, shell code - in the final configuration script. ### ### Usage: configure config_name ### ### If configure succeeds, it leaves its status in config.status. ### If configure fails after disturbing the status quo, ### config.status is removed. ### Remove any more than one leading "." element from the path name. ### If we don't remove them, then another "./" will be prepended to ### the file name each time we use config.status, and the program name ### will get larger and larger. This wouldn't be a problem, except ### that since progname gets recorded in all the Makefiles this script ### produces, move-if-change thinks they're different when they're ### not. ### ### It would be nice if we could put the ./ in a \( \) group and then ### apply the * operator to that, so we remove as many leading ./././'s ### as are present, but some seds (like Ultrix's sed) don't allow you to ### apply * to a \( \) group. Bleah. progname="`echo $0 | sed 's:^\./\./:\./:'`" ### Establish some default values. run_in_place= single_tree= prefix='/usr/local' exec_prefix='${prefix}' bindir='${exec_prefix}/bin' datadir='${prefix}/lib' statedir='${prefix}/lib' libdir='${exec_prefix}/lib' mandir='${prefix}/man/man1' infodir='${prefix}/info' lispdir='${datadir}/emacs/${version}/lisp' locallisppath='${datadir}/emacs/site-lisp' lisppath='${locallisppath}:${lispdir}' etcdir='${datadir}/emacs/${version}/etc' lockdir='${statedir}/emacs/lock' archlibdir='${libdir}/emacs/${version}/${configuration}' # We cannot use this variable in the case statement below, because many # /bin/sh's have broken semantics for "case". Unfortunately, you must # actually edit the clause itself. # path_options="prefix | exec_prefix | bindir | libdir | etcdir | datadir" # path_options="$path_options | archlibdir | statedir | mandir | infodir" # path_options="$path_options | lispdir | lockdir | lisppath | locallisppath" #### Usage messages. short_usage="Usage: ${progname} CONFIGURATION [-OPTION[=VALUE] ...] Set compilation and installation parameters for GNU Emacs, and report. CONFIGURATION specifies the machine and operating system to build for. --with-x Support the X Window System. --with-x=no Don't support X. --x-includes=DIR Search for X header files in DIR. --x-libraries=DIR Search for X libraries in DIR. --with-gcc Use GCC to compile Emacs. --with-gcc=no Don't use GCC to compile Emacs. --run-in-place Use libraries and data files directly out of the source tree. --single-tree=DIR Has the effect of creating a directory tree at DIR which looks like: .../DIR/bin/CONFIGNAME (emacs, etags, etc.) .../DIR/bin/CONFIGNAME/etc (movemail, etc.) .../DIR/common/lisp (emacs' lisp files) .../DIR/common/site-lisp (local lisp files) .../DIR/common/lib (DOC, TUTORIAL, etc.) .../DIR/common/lock (lockfiles) --srcdir=DIR Look for the Emacs source files in DIR. --prefix=DIR Install files below DIR. Defaults to \`${prefix}'. You may also specify any of the \`path' variables found in Makefile.in, including --bindir, --libdir, --etcdir, --infodir, and so on. This allows you to override a single default location when configuring. If successful, ${progname} leaves its status in config.status. If unsuccessful after disturbing the status quo, it removes config.status." #### Option processing. ### Record all the arguments, so we can save them in config.status. arguments="$@" ### Shell Magic: Quote the quoted arguments in ARGUMENTS. At a later date, ### in order to get the arguments back in $@, we have to do an ### `eval set x "$quoted_arguments"; shift'. quoted_arguments= for i in "$@"; do quoted_arguments="$quoted_arguments '$i'" done ### Don't use shift -- that destroys the argument list, which autoconf needs ### to produce config.status. It turns out that "set - ${arguments}" doesn't ### work portably. ### However, it also turns out that many shells cannot expand ${10} at all. ### So using an index variable doesn't work either. It is possible to use ### some shell magic to make 'set x "$arguments"; shift' work portably. while [ $# != 0 ]; do arg="$1"; shift case "${arg}" in ## Anything starting with a hyphen we assume is an option. -* ) ## Separate the switch name from the value it's being given. case "${arg}" in -*=*) opt=`echo ${arg} | sed 's:^-*\([^=]*\)=.*$:\1:'` val=`echo ${arg} | sed 's:^-*[^=]*=\(.*\)$:\1:'` valomitted=no ;; -*) ## If FOO is a boolean argument, --FOO is equivalent to ## --FOO=yes. Otherwise, the value comes from the next ## argument - see below. opt=`echo ${arg} | sed 's:^-*\(.*\)$:\1:'` val="yes" valomitted=yes ;; esac ## Change `-' in the option name to `_'. optname="${opt}" opt="`echo ${opt} | tr - _`" ## Process the option. case "${opt}" in ## Has the user specified which window systems they want to support? "with_x" | "with_x11" | "with_x10" ) ## Make sure the value given was either "yes" or "no". case "${val}" in y | ye | yes ) val=yes ;; n | no ) val=no ;; * ) (echo "${progname}: the \`--${optname}' option is supposed to have a boolean value. Set it to either \`yes' or \`no'." echo "${short_usage}") >&2 exit 1 ;; esac eval "${opt}=\"${val}\"" ;; ## Has the user specified whether or not they want GCC? "with_gcc" | "with_gnu_cc" ) ## Make sure the value given was either "yes" or "no". case "${val}" in y | ye | yes ) val=yes ;; n | no ) val=no ;; * ) (echo "${progname}: the \`--${optname}' option is supposed to have a boolean value. Set it to either \`yes' or \`no'." echo "${short_usage}") >&2 exit 1 ;; esac eval "${opt}=\"${val}\"" ;; ## Has the user specified a source directory? "srcdir" ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then ## Get the next argument from the argument list, if there is one. if [ $# = 0 ]; then (echo "${progname}: You must give a value for the \`--${optname}' option, as in \`--${optname}=FOO'." echo "${short_usage}") >&2 exit 1 fi val="$1"; shift fi srcdir="${val}" ;; ## Has the user tried to tell us where the X files are? ## 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. "x_includes" ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then ## Get the next argument from the argument list, if there is one. if [ $# = 0 ]; then (echo "${progname}: You must give a value for the \`--${optname}' option, as in \`--${optname}=/usr/local/X11/include'." echo "${short_usage}") >&2 exit 1 fi val="$1"; shift fi x_includes="${val}" ;; "x_libraries" ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then ## Get the next argument from the argument list, if there is one. if [ $# = 0 ]; then (echo "${progname}: You must give a value for the \`--${optname}' option, as in \`--${optname}=/usr/local/X11/lib'." echo "${short_usage}") >&2 exit 1 fi val="$1"; shift fi x_libraries="${val}" ;; ## Should this use the "development configuration"? "run_in_place" ) single_tree= run_in_place=1 ;; ## Should this use the "single tree" configuration? "single_tree" ) run_in_place= single_tree=1 ;; ## Has the user specified one of the path options? prefix | exec_prefix | bindir | libdir | etcdir | datadir | \ archlibdir | statedir | mandir | infodir | lispdir | lockdir | \ lisppath | locallisppath ) ## If the value was omitted, get it from the next argument. if [ "${valomitted}" = "yes" ]; then if [ $# = 0 ]; then (echo \ "$progname: You must give a value for the \`--${optname}' option,"; echo \ "as in \`--${optname}=`eval echo '$'$optname`.'" echo "$short_usage") >&2 exit 1 fi val="$1"; shift fi eval "${opt}=\"${val}\"" eval "${opt}_specified=1" ;; ## Verbose flag, tested by autoconf macros. "verbose" ) verbose=yes ;; ## Has the user asked for some help? "usage" | "help" ) if [ "x$PAGER" = x ] then echo "${short_usage}" | more else echo "${short_usage}" | $PAGER fi exit ;; ## We ignore all other options silently. esac ;; ## Anything not starting with a hyphen we assume is a ## configuration name. *) configuration=${arg} ;; esac done ### Get the arguments back. See the diatribe on Shell Magic above. eval set x "$quoted_arguments"; shift if [ "${configuration}" = "" ]; then echo '- You did not tell me what kind of host system you want to configure. - I will attempt to guess the kind of system this is.' 1>&2 guesssys=`echo ${progname} | sed 's/configure$/config.guess/'` if configuration=`${guesssys}` ; then echo "- Looks like this is a ${configuration}" 1>&2 else echo '- Failed to guess the system type. You need to tell me.' 1>&2 echo "${short_usage}" >&2 exit 1 fi fi #### Decide where the source is. case "${srcdir}" in ## If it's not specified, see if `.' or `..' might work. "" ) confdir=`echo $0 | sed 's|//|/|' | sed 's|/[^/]*$||'` if [ -f $confdir/src/lisp.h -a -f $confdir/lisp/version.el ]; then srcdir="${confdir}" else if [ -f "./src/lisp.h" -a -f "./lisp/version.el" ]; then srcdir='.' else if [ -f "../src/lisp.h" -a -f "../lisp/version.el" ]; then srcdir='..' else (echo "\ ${progname}: Neither the current directory nor its parent seem to contain the Emacs sources. If you do not want to build Emacs in its source tree, you should run \`${progname}' in the directory in which you wish to build Emacs, using its \`--srcdir' option to say where the sources may be found." echo "${short_usage}") >&2 exit 1 fi fi fi ;; ## Otherwise, check if the directory they specified is okay. * ) if [ ! -d "${srcdir}" -o ! -f "${srcdir}/src/lisp.h" -o ! -f "${srcdir}/lisp/version.el" ]; then (echo "\ ${progname}: The directory specified with the \`--srcdir' option, \`${srcdir}', doesn't seem to contain the Emacs sources. You should either run the \`${progname}' script at the top of the Emacs source tree, or use the \`--srcdir' option to specify where the Emacs sources are." echo "${short_usage}") >&2 exit 1 fi ;; esac #### 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. case "${srcdir}" in /* ) ;; . ) ## We may be able to use the $PWD environment variable to make this ## absolute. But sometimes PWD is inaccurate. if [ "${PWD}" != "" ] && [ "`(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 [ `pwd` != `(cd ${srcdir} && pwd)` ] \ && [ -f "${srcdir}/src/config.h" ] ; then (echo "${progname}: WARNING: The directory tree \`${srcdir}' is being used" echo " as a build directory right now; it has been configured in its own" echo " right. To configure in another directory as well, you MUST" echo " use GNU make. If you do not have GNU make, then you must" echo " now do \`make distclean' in ${srcdir}," echo " and then run ${progname} again.") >&2 extrasub='/^VPATH[ ]*=/c\ vpath %.c $(srcdir)\ vpath %.h $(srcdir)\ vpath %.y $(srcdir)\ vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ vpath %.in $(srcdir)' fi ### Make the necessary directories, if they don't exist. for dir in ./src ./lib-src ./cpp ./oldXMenu ./etc ; do if [ ! -d ${dir} ]; then mkdir ${dir} fi done #### 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. echo "Checking the configuration name." if canonical=`${srcdir}/config.sub "${configuration}"` ; then : ; else exit $? fi ### 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='false' case "${canonical}" in ## 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 ;; ## Altos 3068 m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;; ## Amdahl UTS 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;; ## Appallings - I mean, Apollos - running Domain m68*-apollo* ) machine=apollo opsys=bsd4-2 ;; ## 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 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* ) machine=convex opsys=bsd4-3 ;; ## Cubix QBx/386 i386-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; ## Cydra 5 cydra*-cydrome-sysv* ) machine=cydra5 opsys=usg5-3 ;; ## Data General AViiON Machines 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-ultrix* | mips-dec-bsd* ) machine=pmax opsys=bsd4-3 ;; mips-dec-osf* ) machine=pmax opsys=osf1 ;; ## Motorola Delta machines m68*-motorola-sysv* ) machine=delta opsys=usg5-3 ;; m88k-motorola-sysv4* ) machine=delta88k opsys=usg5-4 ;; 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 ;; ## Honeywell XPS100 xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;; ## HP 9000 series 200 or 300 m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;; m68*-hp-netbsd* ) machine=hp9000s300 opsys=netbsd ;; ## HP/UX 7, 8 and 9 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 ;; *) machine=hp9000s300 opsys=hpux ;; esac ;; ## HP 9000 series 700 and 800, running HP/UX hppa*-hp-hpux7* ) machine=hp9000s800 opsys=hpux ;; hppa*-hp-hpux8* ) machine=hp9000s800 opsys=hpux8 ;; hppa*-hp-hpux9* ) machine=hp9000s800 opsys=hpux9 ;; ## 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=hp9000s800 opsys=hpux8 ;; *.08.* ) machine=hp9000s800 opsys=hpux8 ;; *.09.* ) machine=hp9000s800 opsys=hpux9 ;; *) machine=hp9000s800 opsys=hpux ;; esac ;; ## Orion machines orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;; clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;; ## IBM machines i386-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; i386-ibm-aix1.[23]* | i386-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;; rs6000-ibm-aix3.1* ) machine=ibmrs6000 opsys=aix3-1 ;; rs6000-ibm-aix3.2* | rs6000-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[34]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL i386-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry i386-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; ## Unspecified sysv on an ncr machine defaults to svr4. i[34]86-ncr-sysv* ) machine=intel386 opsys=usg5-4 ;; ## Intel 860 i860-*-sysvr4* ) machine=i860 opsys=usg5-4 ;; ## 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-irix5.* ) machine=iris4d opsys=irix5-0 ;; mips-sgi-irix4.* | mips-sgi-irix* ) machine=iris4d opsys=irix4-0 ;; ## 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 ;; mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;; mips-mips-* ) machine=mips opsys=usg5-2-2 ;; ## NeXT m68*-next-mach* | m68*-next-bsd* ) machine=next opsys=mach2 ;; ## 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 ;; ## SONY machines m68*-sony-bsd4.2* ) machine=news opsys=bsd4-2 ;; m68*-sony-bsd4.3* ) machine=news opsys=bsd4-3 ;; m68*-sony-newsos3*) machine=news opsys=bsd4-3 ;; mips-sony-bsd* ) machine=news-risc opsys=bsd4-3 ;; ## Stride m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;; ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* ) case "${canonical}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; i[34]86* ) machine=sun386 ;; sparc* ) machine=sparc ;; * ) unported=true ;; esac case "${canonical}" in ## The Sun386 didn't get past 4.0. i386-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.3* ) opsys=sunos4-1-3 ;; *-sunos4* | *-sunos ) opsys=sunos4-1 ;; *-sunos5* | *-solaris* ) opsys=sol2 ;; * ) opsys=bsd4-2 ;; esac ;; ## 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 ;; *-bsd386* ) opsys=bsd386 ;; *-sysv[01]* | *-sysvr[01]* ) opsys=usg5-0 ;; *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;; *-vms* ) opsys=vms ;; * ) unported=true 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[34]86-*-* ) machine=intel386 case "${canonical}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2* ) opsys=isc2-2 ;; *-isc* ) opsys=isc3-0 ;; *-esix5* ) opsys=esix5r4 ;; *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; *-linux* ) opsys=linux ;; *-sco3.2v4* ) opsys=sco4 ;; *-bsd386* ) opsys=bsd386 ;; *-386bsd* ) opsys=386bsd ;; *-netbsd* ) opsys=netbsd ;; ## Otherwise, we'll fall through to the generic opsys code at the bottom. esac ;; * ) unported=true ;; 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 [ x"${opsys}" = x ]; then case "${canonical}" in *-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 | *-sysvr4 ) opsys=usg5-4 ;; *-sysv4.2 | *-sysvr4.2 ) opsys=usg5-4-2 ;; * ) unported=true ;; esac fi if $unported ; then (echo "${progname}: Emacs hasn't been ported to \`${canonical}' systems." echo "${progname}: Check \`etc/MACHINES' for recognized configuration names." ) >&2 exit 1 fi machfile="m/${machine}.h" opsysfile="s/${opsys}.h" ] AC_PREPARE(lisp) AC_CONFIG_HEADER(src/config.h) [ #### Choose a compiler. case ${with_gcc} in "yes" ) CC="gcc" GCC=1 ;; "no" ) CC="cc" ;; * ) ] AC_PROG_CC [ esac #### 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_LN_S AC_PROG_CPP AC_PROG_INSTALL AC_PROG_YACC dnl checks for UNIX variants that set `DEFS' dnl checks for header files AC_HAVE_HEADERS(sys/timeb.h sys/time.h unistd.h) AC_STDC_HEADERS AC_TIME_WITH_SYS_TIME dnl checks for typedefs AC_RETSIGTYPE dnl checks for structure members AC_STRUCT_TM AC_TIMEZONE dnl checks for compiler characteristics AC_CONST dnl checks for operating system services AC_LONG_FILE_NAMES dnl other checks for UNIX variants [ #### Choose a window system. echo "Checking window system." window_system='' case "${with_x}" in yes ) window_system=${window_system}x11 ;; no ) window_system=${window_system}none esac case "${with_x11}" in yes ) window_system=${window_system}x11 ;; esac case "${with_x10}" in yes ) window_system=${window_system}x10 ;; esac case "${window_system}" in "none" | "x11" | "x10" ) ;; "" ) # --x-includes or --x-libraries implies --with-x11. if [ -n "${x_includes}" ] || [ -n "${x_libraries}" ]; then window_system=x11 else echo " No window system specified. Looking for X11." # If the user didn't specify a window system and we found X11, use it. if [ -r /usr/lib/libX11.a \ -o -d /usr/include/X11 \ -o -d /usr/X386/include \ -o -d ${x_includes}/X11 ]; then window_system=x11 fi fi ;; * ) echo "Don't specify a window system more than once." >&2 exit 1 ;; esac case "${window_system}" in "" | "x11" ) ### If the user hasn't specified where we should find X, try ### letting autoconf figure that out. if [ -z "${x_includes}" ] && [ -z "${x_libraries}" ]; then ] AC_FIND_X [ fi if [ -n "${x_includes}" ] || [ -n "${x_libraries}" ]; then window_system=x11 fi ;; esac [ -z "${window_system}" ] && window_system=none [ -n "${x_libraries}" ] && LD_SWITCH_X_SITE="-L${x_libraries}" [ -n "${x_includes}" ] && C_SWITCH_X_SITE="-I${x_includes}" # Avoid forcing the search of /usr/include before fixed include files. if [ "$C_SWITCH_X_SITE" = "-I/usr/include" ]; then C_SWITCH_X_SITE=" " fi case "${window_system}" in x11 ) HAVE_X_WINDOWS=yes HAVE_X11=yes echo " Using X11." ;; x10 ) HAVE_X_WINDOWS=yes HAVE_X11=no echo " Using X10." ;; none ) HAVE_X_WINDOWS=no HAVE_X11=no echo " Using no window system." ;; esac ### 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 #### Extract some information from the operating system and machine files. echo "Examining the machine- and system-dependent files to find out" echo " - which libraries the lib-src programs will want, and" echo " - whether the GNU malloc routines are usable." ### 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 configure___ libsrc_libs=LIBS_MACHINE LIBS_SYSTEM configure___ c_switch_system=C_SWITCH_SYSTEM #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 __GNUC__ configure___ CFLAGS=C_DEBUG_SWITCH C_OPTIMIZE_SWITCH #else configure___ CFLAGS=C_DEBUG_SWITCH #endif ' > ${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} \ | grep 'configure___' \ | sed -e 's/^configure___ \([^=]*=\)\(.*\)$/\1"\2"/'` 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 [ "${system_malloc}" = "yes" ]; then GNU_MALLOC=no GNU_MALLOC_reason=" (The GNU allocators don't work with this system configuration.)" fi if [ x"${REL_ALLOC}" = x ]; then REL_ALLOC=${GNU_MALLOC} fi LISP_FLOAT_TYPE=yes #### Add the libraries to LIBS and check for some functions. ] DEFS="$c_switch_system $DEFS" LIBS="$libsrc_libs" dnl If found, this defines HAVE_LIBDNET, which m/pmax.h checks, dnl and also adds -ldnet to LIBS, which Autoconf uses for checks. AC_HAVE_LIBRARY(-ldnet) AC_HAVE_LIBRARY(-lXbsd, LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd") echo checking for XFree86 if test -d /usr/X386/include; then HAVE_XFREE386=yes test -z "${C_SWITCH_X_SITE}" && C_SWITCH_X_SITE="-I/usr/X386/include" fi if test "${HAVE_X11}" = "yes"; then DEFS="$C_SWITCH_X_SITE $DEFS" LIBS="$LD_SWITCH_X_SITE $LIBX $LIBS" AC_HAVE_FUNCS(XrmSetDatabase XScreenResourceString XScreenNumberOfScreen) fi AC_ALLOCA # logb and frexp are found in -lm on most systems. AC_HAVE_LIBRARY(-lm) AC_HAVE_FUNCS(gettimeofday gethostname dup2 rename closedir mkdir rmdir random bcopy logb frexp ftime res_init) ok_so_far=true AC_FUNC_CHECK(socket, , ok_so_far=) if test -n "$ok_so_far"; then AC_HEADER_CHECK(netinet/in.h, , ok_so_far=) fi if test -n "$ok_so_far"; then AC_HEADER_CHECK(arpa/inet.h, , ok_so_far=) fi if test -n "$ok_so_far"; then AC_DEFINE(HAVE_INET_SOCKETS) fi [ #### Find out which version of Emacs this is. version=`grep 'defconst[ ]*emacs-version' ${srcdir}/lisp/version.el \ | sed -e 's/^.*"\([0-9][0-9]*\.[0-9][0-9]*\)\..*$/\1/'` if [ x"${version}" = x ]; then echo "${progname}: can't find current emacs version in \`${srcdir}/lisp/version.el'." >&2 exit 1 fi if [ -f /usr/lpp/X11/bin/smt.exp ]; then ] AC_DEFINE(HAVE_AIX_SMT_EXP) [ fi #### Specify what sort of things we'll be editing into Makefile and config.h. ### Use configuration here uncanonicalized to avoid exceeding size limits. ] AC_SUBST(configuration) AC_SUBST(version) AC_SUBST(srcdir) AC_SUBST(prefix) AC_SUBST(exec_prefix) AC_SUBST(bindir) AC_SUBST(datadir) AC_SUBST(statedir) AC_SUBST(libdir) 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(c_switch_system) AC_SUBST(libsrc_libs) AC_SUBST(LD_SWITCH_X_SITE) AC_SUBST(C_SWITCH_X_SITE) AC_SUBST(CFLAGS) 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(C_SWITCH_X_SITE, ${C_SWITCH_X_SITE}) AC_DEFINE_UNQUOTED(UNEXEC_SRC, ${UNEXEC_SRC}) [ if [ "${HAVE_X_WINDOWS}" = "yes" ] ; then ] AC_DEFINE(HAVE_X_WINDOWS) [ fi if [ "${HAVE_X11}" = "yes" ] ; then ] AC_DEFINE(HAVE_X11) [ fi if [ "${HAVE_XFREE386}" = "yes" ] ; then ] AC_DEFINE(HAVE_XFREE386) [ fi if [ "${HAVE_X_MENU}" = "yes" ] ; then ] AC_DEFINE(HAVE_X_MENU) [ fi if [ "${GNU_MALLOC}" = "yes" ] ; then ] AC_DEFINE(GNU_MALLOC) [ fi if [ "${REL_ALLOC}" = "yes" ] ; then ] AC_DEFINE(REL_ALLOC) [ fi if [ "${LISP_FLOAT_TYPE}" = "yes" ] ; then ] AC_DEFINE(LISP_FLOAT_TYPE) [ fi # ====================== Developer's configuration ======================= # The following assignments make sense if you're running Emacs on a single # machine, one version at a time, and you want changes to the lisp and etc # directories in the source tree to show up immediately in your working # environment. It saves a great deal of disk space by not duplicating the # lisp and etc directories. if [ "$run_in_place" = "1" ]; then lispdir='${srcdir}/lisp' locallisppath='${srcdir}/site-lisp' etcdir='${srcdir}/etc' lockdir='${srcdir}/lock' archlibdir='${srcdir}/lib-src' infodir='${srcdir}/info' elif [ "$single_tree" = "1" ]; then if [ "$exec_prefix_specified" = "" ]; then exec_prefix='${prefix}' fi if [ "$bindir_specified" = "" ]; then bindir='${exec_prefix}/bin/${configuration}' fi if [ "$datadir_specified" = "" ]; then datadir='${prefix}/common' fi if [ "$statedir_specified" = "" ]; then statedir='${prefix}/common' fi if [ "$libdir_specified" = "" ]; then libdir='${bindir}' fi if [ "$lispdir_specified" = "" ]; then lispdir='${prefix}/common/lisp' fi if [ "$locallisppath_specified" = "" ]; then locallisppath='${prefix}/common/site-lisp' fi if [ "$lockdir_specified" = "" ]; then lockdir='${prefix}/common/lock' fi if [ "$archlibdir_specified" = "" ]; then archlibdir='${libdir}/etc' fi if [ "$etcdir_specified" = "" ]; then etcdir='${prefix}/common/data' fi 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}${x_includes+ Where do we find X Windows header files? }${x_includes}${x_libraries+ Where do we find X Windows libraries? }${x_libraries} " # Remove any trailing slashes in these variables. test -n "${prefix}" && prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` test -n "${exec_prefix}" && exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` ] AC_OUTPUT(Makefile lib-src/Makefile oldXMenu/Makefile src/Makefile.in) [ # Build src/Makefile from ${srcdir}/src/Makefile.in. This must be done # after src/config.h is built, since we rely on that file. Only do the # build if "config.status" is present, since it's non-presence indicates # an error occured. status=$? if [ ! -f ./config.status ]; then exit $status fi topsrcdir=${srcdir} # We discard all lines in Makefile.in that start with `# Generated' or /**/# # because some cpps get confused by them. # Really we should preserve them somehow into Makefile, # but that is beyond my level of shell programming. makefile_command='echo "creating src/Makefile"; topsrcdir='"${topsrcdir}"'; ( cd ./src; rm -f junk.c; sed -e '\''s/^# Generated.*//'\'' -e '\''s%/\*\*/#.*%%'\'' < Makefile.in > junk.c; eval `echo ${CPP} -I. -I${topsrcdir}/src ${CPPFLAGS} junk.c \>junk.cpp`; < junk.cpp '\ ' sed -e '\''s/^#.*//'\'' '\ ' -e '\''s/^[ \f\t][ \f\t]*$//'\'' '\ ' -e '\''s/^ / /'\'' '\ ' | sed -n -e '\''/^..*$/p'\'' '\ ' > Makefile.new; chmod 444 Makefile.new; mv -f Makefile.new Makefile; rm -f junk.c junk.cpp; )' eval `echo $makefile_command` # AC-OUTPUT has created `config.status' already. We need to add the above # commands to re-create `src/Makefile', and we need to insert them before # the final "exit 0" which appears at the end of `config.status'. config.new echo $makefile_command >>config.new echo exit 0 >>config.new mv -f config.new config.status chmod +x config.status # Don't let the fact that we just rewrote config.status make Makefile think # that it is now newer. We have just rewritten all of the Makefiles as well. MFS="Makefile src/Makefile src/Makefile.in lib-src/Makefile oldXMenu/Makefile" for file in $MFS; do chmod a+w $file; touch $file; chmod 444 $file done exit 0 ] emacs-19.22/make-dist100755 12120 1 26623 5475300140 12736 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. 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. version=`grep 'defconst[ ]*emacs-version' lisp/version.el \ | sed -e 's/^.*"\([0-9][0-9]*\.[0-9][0-9]*\)\..*$/\1/'` if [ ! "${version}" ]; then echo "${progname}: can't find current emacs version in \`./lisp/version.el'." >&2 exit 1 fi if grep -s "GNU Emacs version ${version}" ./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.in getdate.c YACC="bison -y") 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 move-if-change ${tempdir} ln ChangeLog Makefile.in build-ins.in configure configure.in ${tempdir} ln make-dist vpath.sed ${tempdir} ### Copy these files; they're cross-filesystem symlinks. 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." # I think we're not going to distribute anything in external-lisp, so # I've removed it from this list. for subdir in lisp lisp/term site-lisp \ src src/m src/s src/bitmaps lib-src oldXMenu \ etc lock cpp info man shortnames vms; do 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 OChangeLog README dired.todo ../${tempdir}/lisp cd ../${tempdir}/lisp rm -f TAGS =* rm -f site-init site-init.el site-init.elc rm -f site-load site-load.el site-load.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 \`external-lisp'." ### ### Don't distribute =*.el files or TAGS. ### (cd external-lisp ### ln [a-zA-Z]*.el ../${tempdir}/external-lisp ### ln [a-zA-Z]*.elc ../${tempdir}/external-lisp ### ln ChangeLog README ../${tempdir}/external-lisp ### rm -f =* TAGS) echo "Making links to \`src'." ### Don't distribute =*.[ch] files, or the configured versions of ### config.h.in, paths.h.in, or Makefile.in.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.in ChangeLog OChangeLog config.h.in paths.h.in \ ../${tempdir}/src ln .gdbinit .dbxinit ../${tempdir}/src ln *.opt vms-pp.trans ../${tempdir}/src cd ../${tempdir}/src rm -f config.h paths.h Makefile 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 ln README [a-zA-Z0-9]*.h ../../${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] [a-zA-Z]*.lex ../${tempdir}/lib-src ln ChangeLog Makefile.in README testfile vcdiff rcs2log ../${tempdir}/lib-src ln emacs.csh rcs-checkin ../${tempdir}/lib-src cd ../${tempdir}/lib-src rm -f getdate.tab.c y.tab.c y.tab.h rm -f =* TAGS) 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 \`etc'." ### Don't distribute = files, TAGS, DOC files, backups, autosaves, or ### tex litter. (cd etc ln `ls -d * | grep -v 'RCS' | grep -v 'Old'` ../${tempdir}/etc cd ../${tempdir}/etc rm -f DOC* *~ \#*\# *.dvi *.log *,v =* core rm -f TAGS) 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 && ln Makefile ../${tempdir}/man ln ChangeLog split-man ../${tempdir}/man cp texinfo.tex texindex.c ../${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 \`shortnames'." (cd shortnames ln *.c ../${tempdir}/shortnames ln Makefile reserved special ../${tempdir}/shortnames) 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 # I think we're not going to distribute anything in external-lisp, so # I've removed it from this list. for subdir in lisp src lib-src info shortnames; 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. echo "Breaking intra-tree links." find ${tempdir} ! -type d -links +2 \ -exec cp -p {} $$ \; -exec rm -f {} \; -exec mv $$ {} \; 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.22/vpath.sed100444 12241 12 366 5444577321 13264 0ustar rolandstaff/^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 ymakefile $(srcdir)\ vpath %.c $(srcdir)\ vpath %.h $(srcdir)\ \ emacs-19.22/config.sub100777 12120 24 34571 5475722324 13041 0ustar rmsother#!/bin/sh # Configuration validation subroutine script, version 1.1. # Copyright (C) 1991, 1992, 1993 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. # 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. # 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 ;; 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[34]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) 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[34]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-* \ | sh-* | powerpc-*) ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. vaxv) basic_machine=vax-dec os=-sysv ;; vms) basic_machine=vax-dec os=-vms ;; i370-ibm* | ibm*) basic_machine=i370-ibm os=-mvs ;; # I'm not sure what "Sysv32" means. Should this be sysv3.2? i[34]86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv32 ;; i[34]86v4*) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv4 ;; i[34]86v) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv ;; i[34]86sol2) basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-solaris2 ;; spur) basic_machine=spur-unknown ;; paragon) basic_machine=i860-intel os=-osf ;; alliant | fx80) basic_machine=fx80-alliant ;; 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 ;; m88k-omron*) basic_machine=m88k-omron ;; merlin) basic_machine=ns32k-utek os=-sysv ;; crds | unos) basic_machine=m68k-crds ;; elxsi) basic_machine=elxsi-elxsi os=-bsd ;; encore | umax | mmax) basic_machine=ns32k-encore ;; genix) basic_machine=ns32k-ns ;; iris | iris4d) basic_machine=mips-sgi case $os in -irix*) ;; *) os=-irix4 ;; esac ;; news | news700 | news800 | news900) basic_machine=m68k-sony os=-newsos ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) basic_machine=m68000-att ;; 3b*) basic_machine=we32k-att ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) basic_machine=m68k-motorola ;; balance) basic_machine=ns32k-sequent os=-dynix ;; pc532) basic_machine=ns32k-pc532 ;; symmetry) basic_machine=i386-sequent os=-dynix ;; 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 ;; sun3) basic_machine=m68k-sun ;; sun4) basic_machine=sparc-sun ;; pbd) basic_machine=sparc-tti ;; pbb) basic_machine=m68k-tti ;; sun386 | sun386i | roadrunner) basic_machine=i386-sun ;; ps2) basic_machine=i386-ibm ;; fx2800) basic_machine=i860-alliant ;; next) basic_machine=m68k-next os=-bsd ;; amiga) basic_machine=m68k-cbm ;; amigados) basic_machine=m68k-cbm os=-amigados ;; amigaunix | amix) basic_machine=m68k-cbm os=-sysv4 ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp ;; hp9k31[0-9] | hp9k2[0-9][0-9]) basic_machine=m68000-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 ;; h3050r* | hiux*) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; pa-hitachi) basic_machine=hppa1.1-hitachi os=-hiuxwe2 ;; isi68 | isi) basic_machine=m68k-isi os=-sysv ;; apollo68) basic_machine=m68k-apollo os=-sysv ;; altos | altos3068) basic_machine=m68k-altos ;; miniframe) basic_machine=m68000-convergent ;; tower | tower-32) basic_machine=m68k-ncr ;; news-3600 | risc-news) basic_machine=mips-sony os=-newsos ;; decstation | decstation-3100 | pmax | pmin | dec3100 | decstatn) basic_machine=mips-dec ;; magnum | m3230) basic_machine=mips-mips os=-sysv ;; gmicro) basic_machine=tron-gmicro os=-sysv ;; rtpc | rtpc-*) basic_machine=romp-ibm ;; am29k) basic_machine=a29k-none os=-bsd ;; amdahl) basic_machine=580-amdahl os=-sysv ;; cray | ymp) basic_machine=ymp-cray os=-unicos ;; cray2) basic_machine=cray2-cray os=-unicos ;; xmp) basic_machine=xmp-cray os=-unicos ;; delta88) basic_machine=m88k-motorola os=-sysv3 ;; dpx2* | dpx2*-bull) basic_machine=m68k-bull os=-sysv3 ;; sps7) basic_machine=m68k-bull os=-sysv2 ;; ebmon29k) basic_machine=a29k-amd os=-ebmon ;; h8300hms) basic_machine=h8300-hitachi os=-hms ;; sh) basic_machine=sh-hitachi os=-hms ;; harris) basic_machine=m88k-harris os=-sysv3 ;; 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 os=-hpux ;; hp9k3[2-9][0-9]) basic_machine=m68k-hp os=-hpux ;; ncr3000) basic_machine=i486-ncr os=-sysv4 ;; news1000) basic_machine=m68030-sony os=-newsos ;; nindy960) basic_machine=i960-intel os=-nindy ;; pn) basic_machine=pn-gould ;; np1) basic_machine=np1-gould ;; ultra3) basic_machine=a29k-nyu os=-sym1 ;; vxworks960) basic_machine=i960-wrs os=-vxworks ;; vxworks68) basic_machine=m68k-wrs os=-vxworks ;; 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 ;; 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 ;; # 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[34]* | -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* | -riscix* | -lynxos*) ;; -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 ;; -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 $1 | 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 ;; *-dec | vax-*) os=-ultrix4.2 ;; 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 ;; m88k-omron*) os=-luna ;; *-sequent) os=-bsd ;; *-crds) os=-unos ;; *-ns) os=-genix ;; i370-*) os=-mvs ;; *-next) os=-bsd ;; i[34]86-*) os=-sco3.2v2 ;; *-gould) os=-sysv ;; *-highlevel) os=-bsd ;; *-encore) os=-bsd ;; *-sgi) os=-irix ;; *-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 ;; esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` ;; esac echo $basic_machine$os emacs-19.22/config.guess100777 12120 24 16364 5475722325 13377 0ustar rmsother#!/bin/sh # This script attempts to guess a canonical system name. # Copyright (C) 1992, 1993 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., 675 Mass Ave, Cambridge, MA 02139, USA. */ # # 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). # 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 # Note: order is significant - the case branches are not exclusive. case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in alpha:OSF1:1.*:*) # 1.2 uses "1.2" for uname -r. echo alpha-dec-osf${UNAME_RELEASE} exit 0 ;; alpha:OSF1:V1.*:*) # 1.3 uses "V1.3" for uname -r. echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^V//'` exit 0 ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit 0;; sun4*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; sun4*:SunOS:*:*) echo sparc-sun-sunos${UNAME_RELEASE} exit 0 ;; sun3*:SunOS:*:*) echo m68k-sun-sunos${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:*:5*:RISCos) echo mips-mips-riscos${UNAME_RELEASE} exit 0 ;; m88k:*:4*:R4*) echo m88k-motorola-sysv4 exit 0 ;; m88k:*:3*:R3*) echo m88k-motorola-sysv3 exit 0 ;; AViiON:dgux:*:*) echo m88k-dg-dgux${UNAME_RELEASE} exit 0 ;; M88*:*:R3*:*) # Delta 88k system running SVR3 echo m88k-motorola-sysv3 exit 0 ;; *:IRIX:*:*) echo mips-sgi-irix${UNAME_RELEASE} exit 0 ;; i[34]86:AIX:*:*) echo i386-ibm-aix exit 0 ;; *:AIX:2:3) echo rs6000-ibm-aix3.2 exit 0 ;; *:AIX:*:*) echo rs6000-ibm-aix exit 0 ;; *:BOSX:*:*) echo rs6000-bull-bosx exit 0 ;; DPX/2?00:B.O.S.:*:*) echo m68k-bull-sysv3 exit 0 ;; 9000/31?:HP-UX:*:*) echo m68000-hp-hpux exit 0 ;; 9000/[34]??:HP-UX:*:*) echo m68k-hp-hpux 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/7??:HP-UX:*:* | 9000/8?7:HP-UX:*:* ) echo hppa1.1-hp-hpux exit 0 ;; 9000/8??:HP-UX:*:*) echo hppa1.0-hp-hpux exit 0 ;; 3050*:HI-UX:*:*) sed 's/^ //' << EOF >dummy.c #include int main () { long cpu = sysconf (_SC_CPU_VERSION); if (CPU_IS_HP_MC68K (cpu)) puts ("m68k-hitachi-hiuxwe2"); else 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 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?7:4.3bsd:*:* ) echo hppa1.1-hp-bsd exit 0 ;; 9000/8??:4.3bsd:*:*) echo hppa1.0-hp-bsd exit 0 ;; C1*:ConvexOS:*:*) echo c1-convex-bsd exit 0 ;; C2*:ConvexOS:*:*) echo c2-convex-bsd exit 0 ;; CRAY*X-MP:UNICOS:*:*) echo xmp-cray-unicos exit 0 ;; CRAY*Y-MP:UNICOS:*:*) echo ymp-cray-unicos exit 0 ;; CRAY-2:UNICOS:*:*) echo cray2-cray-unicos exit 0 ;; hp3[0-9][05]:NetBSD:*:*) echo m68k-hp-netbsd${UNAME_RELEASE} exit 0 ;; i[34]86:NetBSD:*:*) echo ${UNAME_MACHINE}-unknown-netbsd${UNAME_RELEASE} exit 0 ;; i[34]86:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux exit 0 ;; i[34]86:UNIX_SV:4.*:*) if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} else echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE} fi exit 0 ;; i[34]86:*:3.2:*) if /bin/uname -X 2>/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-sysv3.2 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:*) uname -p 2>/dev/null | grep 86 >/dev/null \ && echo i486-ncr-sysv4 && exit 0 ;; m680[234]0:LynxOS:2.2*:*) echo m68k-lynx-lynxos${UNAME_RELEASE} exit 0 ;; i[34]86:LynxOS:2.2*:*) echo i386-lynx-lynxos${UNAME_RELEASE} exit 0 ;; TSUNAMI:LynxOS:2.2*:*) echo sparc-lynx-lynxos${UNAME_RELEASE} 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 <&2 exit 1 emacs-19.22/install.sh100777 12120 24 4212 5475722325 13031 0ustar rmsother#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5; it is not part of GNU. # # $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $ # # 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}" instcmd="$mvprog" chmodcmd="" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" 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;; *) if [ x"$src" = x ] then src=$1 else dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 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` fi # Make a temp file name in the proper directory. dstdir=`dirname $dst` dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp # and set any options; do chmod last to preserve setuid bits if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi # Now rename the file to the real destination. $doit $rmcmd $dst $doit $mvcmd $dsttmp $dst exit 0 emacs-19.22/lisp/ 40777 12120 24 0 5475727677 11716 5ustar rmsotheremacs-19.22/lisp/term/ 40777 12120 24 0 5475722441 12645 5ustar rmsotheremacs-19.22/lisp/term/AT386.el100466 74777 1 4244 5351764747 14313 0ustar ericdaemon;; 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.22/lisp/term/apollo.el100444 12120 1 32 5402026713 14561 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.22/lisp/term/bg-mouse.el100444 12120 1 25570 5257324270 15116 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.22/lisp/term/bobcat.el100444 12120 1 140 5402026572 14550 0ustar rmsdaemon;;; HP terminals usually encourage using ^H as the rubout character (load "term/keyswap" nil t) emacs-19.22/lisp/term/keyswap.el100444 12120 1 2362 5402026624 15027 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.22/lisp/term/lk201.el100666 12120 1 4641 5423334270 14207 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~" [insertchar]) (define-key function-key-map "\e[3~" [deletechar]) (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[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. (define-key function-key-map "\e[23~" [?\e]) (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 "\eOM" [kp-enter]) (define-key function-key-map "\eOl" [kp-separator]) (define-key function-key-map "\eOm" [kp-subtract]) (define-key function-key-map "\eOn" [kp-period]) (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.22/lisp/term/news.el100444 12120 1 5236 5402026473 14325 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-period]) (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.22/lisp/term/sun-curs.el100444 74777 1 15345 5363036765 15340 0ustar ericdaemon;;; 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.22/lisp/term/sun-fns.el100444 13437 1 54537 5405344467 15137 0ustar jimbdaemon;;; 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.22/lisp/term/sun-mouse.el100444 13437 1 60024 5405344500 15451 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.22/lisp/term/sun.el100444 12120 1 23261 5471657241 14205 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.22/lisp/term/sup-mouse.el100444 12120 1 13570 5257330247 15333 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.22/lisp/term/tvi970.el100444 74777 1 10247 5351766437 14622 0ustar ericdaemon;;; 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.22/lisp/term/vt100-led.el100444 12120 1 3654 5257335722 14777 0ustar rmsdaemon;;; 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.22/lisp/term/vt100.el100444 12120 1 4074 5402026103 14210 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.22/lisp/term/vt102.el100666 12120 1 32 5402027043 14152 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.22/lisp/term/vt125.el100666 12120 1 32 5402027050 14155 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.22/lisp/term/vt200.el100444 12120 1 334 5410016710 14166 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.22/lisp/term/vt201.el100666 12120 1 335 5410016627 14205 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.22/lisp/term/vt220.el100666 12120 1 335 5410016643 14204 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.22/lisp/term/vt240.el100666 12120 1 334 5410016704 14203 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.22/lisp/term/vt300.el100666 12120 1 32 5402027100 14144 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.22/lisp/term/vt320.el100666 12120 1 32 5402027104 14152 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.22/lisp/term/vt400.el100666 12120 1 32 5402027111 14147 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.22/lisp/term/vt420.el100666 12120 1 32 5402027115 14155 0ustar rmsdaemon(load "term/vt100" nil t) emacs-19.22/lisp/term/wyse50.el100444 13437 1 11361 5405344503 14655 0ustar jimbdaemon;;; wyse50.el --- terminal support code for Wyse 50 ;; Copyright (C) 1989, 1993 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! (setq kill-emacs-hook (function (lambda () (interactive) (send-string-to-terminal (concat "\ea23R" (1+ (frame-width)) "C\eG0"))))) ;;; wyse50.el ends here emacs-19.22/lisp/term/x-win.el100444 12120 1 43217 5425322652 14437 0ustar rmsdaemon;;; x-win.el --- parse switches controlling interface with X window system ;; Copyright (C) 1993 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) (setq command-switch-alist (append '(("-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)) command-switch-alist)) (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) (setq initial-frame-alist (append initial-frame-alist (x-parse-geometry (car x-invocation-args))) 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) "Here the X-related command line options in ARGS are processed, 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." (setq x-invocation-args args args nil) (while x-invocation-args (let* ((this-switch (car x-invocation-args)) (aelt (assoc this-switch command-switch-alist))) (setq x-invocation-args (cdr x-invocation-args)) (if aelt (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" "medium goldenrod" "MediumGoldenrod" "green" "Green" "dark green" "DarkGreen" "dark olive green" "DarkOliveGreen" "forest green" "ForestGreen" "lime green" "LimeGreen" "medium forest green" "MediumForestGreen" "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 () "Return a list of colors supported by the current X-Display." (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 (x-color-defined-p this-color) (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) (let ((foo (selected-frame))) (make-frame-invisible foo) (make-frame-visible foo)))) (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) ;; Map certain keypad keys into ASCII characters ;; 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.") ;;; Make TEXT, a string, the primary X selection. ;;; Also, set the value of X cut buffer 0, for backward compatibility ;;; with older X applications. ;;; gildea@lcs.mit.edu says it's not desirable to put kills ;;; in the clipboard. (defun x-select-text (text &optional push) ;; Don't send the cut buffer too much text. ;; It becomes slow, and if really big it causes errors. (if (< (length text) x-cut-buffer-max) (x-set-cut-buffer text push) (x-set-cut-buffer "" push)) (x-set-selection 'PRIMARY text) (setq x-last-selected-text text)) ;;; Return the value of the current X selection. For compatibility ;;; with older X applications, this checks cut buffer 0 before ;;; retrieving the value of the primary selection. (defun x-cut-buffer-or-selection-value () (let (text) ;; Consult the selection, then the cut buffer. Treat empty strings ;; as if they were unset. (setq text (x-get-selection 'PRIMARY)) (if (string= text "") (setq text nil)) (or text (setq text (x-get-cut-buffer 0))) (if (string= text "") (setq text nil)) (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 ?-)))) (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)) ;; 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"))) (if res-geometry (setq initial-frame-alist (append initial-frame-alist (x-parse-geometry res-geometry))))) ;; 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) ;;; x-win.el ends here emacs-19.22/lisp/term/apollo.elc100666 13437 1 737 5416177204 15131 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:24:35 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/apollo.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (load "term/vt100" nil t) emacs-19.22/lisp/term/bg-mouse.elc100666 74777 1 14512 5416177231 15434 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:24:56 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/bg-mouse.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar bg-mouse-fast-select-window nil "\ *Non-nil for mouse hits to select new window, then execute; else just select.") (byte-code "ÀÂÂÅÇÉ\nË ÍÀ‡" [1 bg-button-r 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] 1) (defalias 'bg-mouse-report #[(prefix-arg) "À !ˆÂ SÀ !Ã¥^Å SÀ !Æ¥ZÀÈ!ɦ\nË \" Í Ï !Ñ SU‰?…FÓ8SU?…[?…[ Õ8SY =…l ?‰ƒw‚xÚƒ‚‚ƒÚƒ‚ŽÚ\\\\Þà\n\\!\"! @Z\"A@Z#„¹ƒÊä !ˆå!!ˆä!‚é„ÔƒÛå!!‚éä !ˆ&…éå!!.‡" [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 "\ 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" "P"]) (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 "\ Move point to location of BitGraph mouse." nil]) (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 "\ Set mark at location of BitGraph mouse." nil]) (defalias 'bg-yank #[nil "À \n\"ˆÃà ‡" [bg-move-point-to-x-y bg-mouse-x bg-mouse-y yank this-command] 3 "\ Move point to location of BitGraph mouse and yank." "*"]) (defalias (quote yank-pop-1) #[nil "ÀÁ!‡" [yank-pop 1] 2 nil "*"]) (defalias 'bg-yank-or-pop #[nil "Á=ƒ\nÂÃ!‡Ä ‡" [last-command yank yank-pop 1 bg-yank] 2 "\ Move point to location of BitGraph mouse and yank. If last command was a yank, do a yank-pop." "*"]) (byte-code "ÀÀ‡" [8388607 bg-most-positive-fixnum] 1) (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 "\ 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." nil]) (defalias 'bg-mouse-line-to-top #[nil "À !‡" [scroll-up bg-mouse-y] 2 "\ Scroll the line pointed to by the BitGraph mouse to the top of the window." nil]) (defalias 'bg-mouse-line-to-center #[nil "À ‰Â [Ã\\\\\\Ã¥!‡" [scroll-up bg-mouse-y window-height 2] 5 "\ Scroll the line pointed to by the BitGraph mouse to the center of the window" nil]) (defalias 'bg-mouse-line-to-bottom #[nil "À Âà Z\\!‡" [scroll-up bg-mouse-y 2 window-height] 4 "\ Scroll the line pointed to by the mouse to the bottom of the window." nil]) (defalias (quote bg-kill-region) #[nil "ÀÁ  \"‡" [kill-region region-beginning region-end] 3 nil "*"]) (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 "\ 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)." nil]) (defalias 'bg-get-tty-num #[(term-char) "ÀÁ ÂZ ÀYƒ\" ÅXƒ\" Æ_ \\Á ÂZ‰‚ Â\\=„2È ˆÉÊ!ˆ *‡" [0 read-char 48 char num 9 10 term-char bg-program-mouse error "Invalid data format in bg-mouse command: mouse reinitialized."] 4 "\ 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-move-point-to-x-y #[(x y) "À !ˆi  ÅVƒ SÆ \\\\!*‡" [move-to-window-line y window-hscroll scroll-offset zero-column 0 move-to-column x] 4 "\ Position cursor in window coordinates. X and Y are 0-based character positions in the window."]) (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 "\ Find window corresponding to screen coordinates. X and Y are 0-based character positions on the screen."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅ!„Ç À‡" [defalias bg-command-execute #[(bg-command) "À !ƒ\n !‡Ã ‡" [commandp bg-command command-execute ding] 2] bg-program-mouse #[nil "ÀÁ!‡" [send-string-to-terminal ":0;7;;;360;512;9;16;9;16c"] 2] keymapp mouse-map make-keymap] 3) (defalias 'bind-bg-mouse-click #[(click-code function) "À  ! #‡" [define-key mouse-map char-to-string click-code function] 4 "\ Bind bg-mouse CLICK-CODE to run FUNCTION."]) (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.22/lisp/term/news.elc100666 13437 1 1715 5416177234 14637 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:24:59 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/news.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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-period] "p" [kp-0] "r" [kp-2] "t" [kp-4] "v" [kp-6] "x" [kp-8]] 4) emacs-19.22/lisp/term/sun-mouse.elc100666 13437 1 40702 5416177300 15627 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:25:35 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/sun-mouse.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (defalias 'make-mousemap #[nil "ÀÁB‡" [mousemap nil] 2 "\ Returns a new mousemap."]) (defalias 'copy-mousemap #[(mousemap) "À !‡" [copy-alist mousemap] 2 "\ Return a copy of mousemap."]) (defalias 'define-mouse #[(mousemap mouse-list def) "ÀÁ\n! #‡" [mousemap-set mouse-list-to-mouse-code mouse-list mousemap def] 4 "\ 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 'global-set-mouse #[(mouse-list def) "À \n #‡" [define-mouse current-global-mousemap mouse-list def] 4 "\ 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." "xMouse event: \nxDefinition: "]) (defalias 'local-set-mouse #[(mouse-list def) "„Á  #‡" [current-local-mousemap make-mousemap define-mouse mouse-list def] 4 "\ 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." "xMouse event: \nxDefinition: "]) (defalias 'use-global-mousemap #[(mousemap) "‰‡" [mousemap current-global-mousemap] 2 "\ Selects MOUSEMAP as the global mousemap."]) (defalias 'use-local-mousemap #[(mousemap) "‰‡" [mousemap current-local-mousemap] 2 "\ Selects MOUSEMAP as the local mousemap. nil for MOUSEMAP means no local mousemap."]) (defalias 'logtest #[(x y) "À \n\"ÃU?‡" [logand x y 0] 3 "\ True if any bits set in X are also set in Y. Just like the Common Lisp function of the same name."]) (byte-code "ÀÂÄÆÈÉÊ\"ˆÈËÌ\"ˆÈÍÎ\"ˆÈÏÐ\"ˆÈÑÒ\"ˆÈÓÔ\"ˆÈÕÖ\"ˆÈ×Ø\"ˆÈÙÚ\"ˆÈÛÜ\"ˆÈÝÞ\"ˆÈßà\"‡" [7 sm::ButtonBits 56 sm::ShiftmaskBits 64 sm::DoubleBits 128 sm::UpBits defalias sm::hit-code (macro . #[(hit) "ÀÁ\nE‡" [nth 0 hit] 3]) sm::hit-button (macro . #[(hit) "ÀÁÂà EE‡" [logand sm::ButtonBits nth 0 hit] 5]) sm::hit-shiftmask (macro . #[(hit) "ÀÁÂà EE‡" [logand sm::ShiftmaskBits nth 0 hit] 5]) sm::hit-double (macro . #[(hit) "ÀÁÂà EE‡" [logand sm::DoubleBits nth 0 hit] 5]) sm::hit-up (macro . #[(hit) "ÀÁÂà EE‡" [logand sm::UpBits nth 0 hit] 5]) sm::hit-x (macro . #[(hit) "ÀÁ\nE‡" [nth 1 hit] 3]) sm::hit-y (macro . #[(hit) "ÀÁ\nE‡" [nth 2 hit] 3]) sm::hit-delta (macro . #[(hit) "ÀÁ\nE‡" [nth 3 hit] 3]) sm::hit-up-p (macro . #[(hit) "ÀÁ DDD‡" [not zerop sm::hit-up hit] 4]) sm::loc-w (macro . #[(loc) "ÀÁ\nE‡" [nth 0 loc] 3]) sm::loc-x (macro . #[(loc) "ÀÁ\nE‡" [nth 1 loc] 3]) sm::loc-y (macro . #[(loc) "ÀÁ\nE‡" [nth 2 loc] 3])] 3) (defalias 'eval-in-buffer '(macro . #[(buffer &rest forms) "ÀÁÂÃÄÅDD\"ÈEE‡" [let ((StartBuffer (current-buffer))) unwind-protect append progn set-buffer buffer forms (set-buffer StartBuffer)] 7 "\ Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."])) (put (quote eval-in-buffer) (quote lisp-indent-function) 1) (defalias 'eval-in-window '(macro . #[(window &rest forms) "ÀÁÂÃÄÅDD\"ÈEE‡" [let ((OriginallySelectedWindow (selected-window))) unwind-protect append progn select-window window forms (select-window OriginallySelectedWindow)] 7 "\ Switch to WINDOW, evaluate FORMS, return to original window."])) (put (quote eval-in-window) (quote lisp-indent-function) 1) (defalias 'eval-in-windows '(macro . #[(form &optional yesmini) "ÀÁÂÃÄ ÆÇÈÉÊË EDEDEDÍEE‡" [let ((OriginallySelectedWindow (selected-window))) unwind-protect while progn form not eq OriginallySelectedWindow select-window next-window nil yesmini (select-window OriginallySelectedWindow)] 13 "\ 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."])) (put (quote eval-in-window) (quote lisp-indent-function) 0) (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 "\ Move cursor to window location X, Y. Handles wrapped and horizontally scrolled lines correctly."]) (defalias 'minibuffer-window-p #[(window) "À Á !8U‡" [frame-height 3 window-edges window] 4 "\ True iff this WINDOW is minibuffer."]) (defalias 'sun-mouse-handler #[(&optional hit) "„Á ÂA@Ã8\"‰@ A@à 8Å \" 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 "\ 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." nil]) (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 "\ Read and return next mouse-hit, include possible double click"]) (defalias 'mouse-hit-read #[nil "À‰à ‰‰\nBÄšƒÅÆÇ\nŸÈ#!*‡" [nil char char-list read-char 13 read mapconcat char-to-string ""] 5 "\ Read mouse-hit list from keyboard. Like (read 'read-char), but that uses minibuffer, and mucks up last-command."]) (defvar mouse-prefix1 24 "\ First char of mouse-prefix. Used to detect double clicks and chords.") (defvar mouse-prefix2 0 "\ Second char of mouse-prefix. Used to detect double clicks and chords.") (defalias 'mouse-second-hit #[(hit-wait) "À !?…T ‰ šƒÀÅ!ƒ CÇ‚S ‰ š„4 CÊ ˆÇ‚RË  Í @\"ÏU„OÐ Å 8Z!‚Q )))‡" [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 "\ Returns the next mouse hit occurring within HIT-WAIT milliseconds."]) (defalias 'sm::window-xy #[(x y) "ÀÁ†\n E‡" [found (byte-code "À ÂŽÃÀ !‰@ A@Å 8Æ 8 \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 "\ Find window containing screen coordinates X and Y. Returns list (window x y) where x and y are relative to window."]) (defalias 'sm::window-region #[(loc) "@A@Á8Å !SÆ !SÉ !ƒ!Ê‚W\nYƒ,Ë‚W Yƒ7Ì‚W ƒV  ZYƒV Î \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 "\ Parse LOC into a region symbol. Returns one of (text scrollbar modeline minibuffer)"]) (defalias 'window-line-end #[(w x y) "À ÂŽÃ !ˆŠÅÆ \"+‡" [selected-window OriginallySelectedWindow ((select-window OriginallySelectedWindow)) select-window w move-to-loc frame-width y] 3 "\ Return WINDOW column (ignore X) containing end of line Y"]) (byte-code "À‡" [((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 nil] 1) (defalias 'mouse-event-code #[(hit loc) "À @Âà !!\"‡" [logior hit mouse-region-to-code sm::window-region loc] 5 "\ Maps MOUSE-HIT and LOC into a mouse-code."]) (defalias 'mouse-region-to-code #[(region) " žA‡" [region sm::keyword-alist] 2 "\ Returns partial mouse-code for specified REGION."]) (defalias 'mouse-list-to-mouse-code #[(mouse-list) "ÀÁÂà \"\"‡" [apply logior mapcar #[(x) " žA‡" [x sm::keyword-alist] 2] mouse-list] 5 "\ Map a MOUSE-LIST to a mouse-code."]) (defalias 'mouse-code-to-mouse-list #[(mouse-code) "ÀÁÂà \"\"‡" [apply nconc mapcar #[(x) "À \nA\"… \n@C‡" [logtest mouse-code x] 3] sm::keyword-alist] 5 "\ Map a MOUSE-CODE to a mouse-list."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias mousemap-set #[(code mousemap value) "A\n ž‰ƒ ¡‚\n B B¡*‡" [mousemap alist code assq-result value] 4] mousemap-get #[(code mousemap) " AžA‡" [code mousemap] 2]] 3) (defalias 'mouse-lookup #[(mouse-code) "À \n\"† À \"‡" [mousemap-get mouse-code current-local-mousemap current-global-mousemap] 3 "\ Look up MOUSE-EVENT and return the definition. nil means undefined."]) (defalias 'mouse-mask-lookup #[(mask list) "À\nƒà \n@@\"ƒ\n@ B\nA‰„ )‡" [nil result list logtest mask] 4 "\ 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-union #[(l l-unique) "\nƒ\n@‰@ ž„ B)\nA‰„ )‡" [l-unique result l code-form-pair] 3 "\ 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-first-preferred #[(l1 l2) "À À\nÃ\"\"‡" [mouse-union l2 l1 nil] 5 "\ 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-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 "\ Return a list of (code . function) pairs, where each code is currently set in the REGION."]) (defalias 'one-line-doc-string #[(function) ":ƒ @‰‚Á!‰„Â\"ÄÅ\n\"ˆ\nƉ•O)‡" [function documentation doc "No documentation." string-match "^.*$" 0] 4 "\ Returns first line of documentation string for FUNCTION. If there is no documentation string, then the string \"No documentation\" is returned."]) (defalias (quote print-mouse-format) #[(binding) "À @!ˆÀÂ!ˆÃÄ A\"ˆÅ ˆÀÆ!ˆÀÇ @!!ˆÅ ‡" [princ binding ": " mapcar #[(mouse-list) "À !ˆÀÂ!‡" [princ mouse-list " "] 2] terpri " " one-line-doc-string] 3]) (defalias 'print-mouse-bindings #[(region) "ÀÁ !\"‡" [mapcar print-mouse-format sm::event-bindings region] 4 "\ Prints mouse-event bindings for REGION."]) (defalias 'sm::event-bindings #[(region) "À !‰ƒ: @Æ A \"‰ƒ'È @!AB¡ˆ‚2 AÈ @!CB B* A‰„\n *‡" [mouse-code-function-pairs-of-region region nil result mouse-bindings code-function-pair assoc current-entry mouse-code-to-mouse-list] 4 "\ Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION, where each mouse-list is bound to the function in REGION."]) (defalias 'describe-mouse-bindings #[nil "ÀÁÂ!ˆÃ ˆÁÄ!ˆÃ ˆÅÆ!ˆÃ ˆÁÇ!ˆÃ ˆÁÈ!ˆÃ ˆÅÉ!ˆÃ ˆÁÊ!ˆÃ ˆÁË!ˆÃ ˆÅÌ!‘‡" ["*Help*" princ "Text Region" terpri "---- ------" print-mouse-bindings text "Modeline Region" "-------- ------" modeline "Scrollbar Region" "--------- ------" scrollbar] 3 "\ Lists all current mouse-event bindings." nil]) (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 "\ Print a short description of the function bound to MOUSE-LIST." "xDescibe mouse list briefly: "]) (defalias (quote mouse-help-menu) #[(function-and-binding) "À @!Âà @!CÀ A!CD!B‡" [prin1-to-string function-and-binding menu-create one-line-doc-string] 5]) (defalias 'mouse-help-region #[(w x y &optional region) "†\nÁ\n E!ÅÆÇ!\"ÉÊ!CB! Ì\nÍ  $ˆ+·" [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 "\ Displays a menu of mouse functions callable in this region."]) (defalias 'menu-create #[(items) "ÀÁ\n\"‡" [apply vector items] 3 "\ Functional form for defmenu, given a list of ITEMS returns a menu. Each ITEM is a (STRING . VALUE) pair."]) (defalias 'defmenu '(macro . #[(menu &rest itemlist) "À  !E‡" [defconst menu menu-create itemlist] 4 "\ Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs. See sun-menu-evaluate for interpretation of ITEMS."])) (defalias 'sun-menu-evaluate #[(*menu-window* *menu-x* *menu-y* menu) "9ƒJÁ Æ%!‡" [menu eval sun-menu-internal *menu-window* *menu-x* *menu-y* 4] 7 "\ 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-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 "\ 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 'sm::font-size #[nil "ÀÁ!ÀÂ!‰@ @¥ A A¥*B‡" [sun-get-frame-data 14 18 chr pix] 4 "\ Returns font size in pixels: (cons Ysize Xsize)"]) (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") (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 "\ If sunfns.c uses this function must be here!"]) (defalias 'sun-yank-selection #[nil "ÀÁ!ˆÂà !‡" [set-mark-command nil insert-string sun-get-selection] 2 "\ Set mark and yank the contents of the current sunwindows selection. Insert contents into the current buffer at point." "*"]) (defalias 'sun-select-region #[(beg end) "À \n{!‡" [sun-set-selection beg end] 3 "\ Set the sunwindows selection to the region in the current buffer." "r"]) (defalias 'suspend-emacstool #[(&optional stuffstring) "ÀÁ!ˆ\nƒ Ã\n!ˆÃÄ!ˆÀÅ!‡" [run-hooks suspend-hook stuffstring send-string-to-terminal "" suspend-resume-hook] 2 "\ 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." nil]) (byte-code "ÀÁ!ˆÂÁÃ\"ˆÄÅ!„Æ ÇÈ!‡" [make-variable-buffer-local current-local-mousemap set-default nil boundp current-global-mousemap make-mousemap provide sun-mouse] 3) emacs-19.22/lisp/term/sun.elc100666 13437 1 12000 5471657455 14506 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 05:51:24 1993 ;;; from file /home/fsf/rms/e19/lisp/term/sun.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defalias 'ignore-key #[nil "À ‡" [ignore] 1 "\ interactive version of ignore" nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias scroll-down-in-place #[(n) "À !ˆÂ !‡" [previous-line n scroll-down] 2 nil "p"] scroll-up-in-place #[(n) "À !ˆÂ !‡" [next-line n scroll-up] 2 nil "p"]] 3) (defalias 'kill-region-and-unmark #[(beg end) "À \n\"ˆÃÅÆ!‡" [kill-region beg end kill-region-and-unmark this-command set-mark-command t] 3 "\ Like kill-region, but pops the mark [which equals point, anyway.]" "r"]) (defalias 'select-previous-complex-command #[nil "À ÁUƒ ÂÃ!‡ÄÃ!‡" [minibuffer-depth 0 repeat-complex-command 1 previous-complex-command] 2 "\ Select Previous-complex-command" nil]) (defalias 'rerun-prev-command #[nil "À @!‡" [eval command-history] 2 "\ Repeat Previous-complex-command." nil]) (defvar grep-arg nil "\ Default arg for RE-search") (defalias (quote grep-arg) #[nil "Á>ƒ\n‡ @Å @! A@… ÈÉ\"‰\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]) (defalias 'research-forward #[nil "ÀÁ !‡" [re-search-forward grep-arg] 2 "\ Repeat RE search forward." nil]) (defalias 'research-backward #[nil "ÀÁ !‡" [re-search-backward grep-arg] 2 "\ Repeat RE search backward." nil]) (defvar sun-esc-bracket nil "\ *If non-nil, rebind ESC [ as prefix for Sun function keys.") (byte-code "ÀÁ!„  à Š#ˆÃ ÆÇ#ˆÃ ÈÉ#ˆÃ ÊË#ˆÃ ÌÍ#ˆÃ ÎÏ#ˆÃ ÐÑ#ˆÃ ÒÓ#ˆÃ ÔÕ#ˆÃ Ö×#ˆÃ ØÙ#ˆÃ ÚÛ#ˆÃ ÜÝ#ˆÃ Þß#ˆÃ àá#ˆÃ âã#ˆÃ äå#ˆÃ æç#ˆÃ èé#ˆÃ êë#ˆìíî\"ˆìïð\"ˆìñò\"ˆìóô\"ˆìõö\"ˆì÷ø\"ˆìùú\"ˆìûü\"ˆìýþ\"ˆìÿ@\"ˆìAB\"ˆìCD\"ˆìEF\"ˆìGH\"ˆìIJ\"ˆìKL\"ˆìMN\"ˆOƒÿPÅ!ˆÀ‡" [boundp sun-raw-prefix make-sparse-keymap 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) (defvar sun-raw-prefix-hooks nil "\ List of forms to evaluate after setting sun-raw-prefix.") (byte-code "‰ƒ @!ˆ A‰„)ÃÄ!„Ň" [sun-raw-prefix-hooks hooks eval boundp meta-flag t] 3) (defvar suntool-map (make-sparse-keymap) "\ *Keymap for Emacstool bindings.") (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) (defvar suntool-map-hooks nil "\ List of forms to evaluate after setting suntool-map.") (byte-code "‰ƒ @!ˆ A‰„)‡" [suntool-map-hooks hooks eval] 3) (autoload (quote sun-mouse-handler) "sun-mouse" "\ Sun Emacstool handler for mouse blips (not loaded)." t) (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 "\ Set up Emacstool window, if you know you are in an emacstool."]) (defalias 'sun-mouse-once #[nil "À ˆÁ ‡" [emacstool-init sun-mouse-handler] 1 "\ Converts to emacstool and sun-mouse-handler on first mouse hit." nil]) (define-key ctl-x-map "" (quote sun-mouse-once)) emacs-19.22/lisp/term/sup-mouse.elc100666 13437 1 6445 5416177335 15627 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:26:04 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/sup-mouse.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar sup-mouse-fast-select-window nil "\ *Non-nil for mouse hits to select new window, then execute; else just select.") (byte-code "ÀÂÄÆÈ Ê Ì ÎÐÀ‡" [0 mouse-left 1 mouse-center 2 mouse-right 4 mouse-2left 5 mouse-2center 6 mouse-2right 8 mouse-3left 9 mouse-3center 10 mouse-3right] 1) (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 "\ 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" nil]) (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 "\ Read from terminal until TERM-CHAR is read, and return intervening number. Upon non-numeric not matching TERM-CHAR signal an error."]) (defalias 'sup-move-point-to-x-y #[(x y) "À !ˆÂ !‡" [move-to-window-line y move-to-column x] 2 "\ Position cursor in window coordinates. X and Y are 0-based character positions in the window."]) (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 "\ Find window corresponding to frame coordinates. X and Y are 0-based character positions on the frame."]) emacs-19.22/lisp/term/tvi970.elc100666 13437 1 4307 5416177340 14723 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:26:08 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/tvi970.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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) (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''.") (defalias 'tvi970-set-keypad-mode #[(&optional arg) "„ ?‚Â!ÃVÄ ƒÅ‚Æ!‡" [arg tvi970-keypad-numeric prefix-numeric-value 0 send-string-to-terminal "=" ">"] 2 "\ 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." "P"]) (tvi970-set-keypad-mode 1) emacs-19.22/lisp/term/vt100-led.elc100666 13437 1 2332 5416177343 15274 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:26:11 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/vt100-led.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar led-state (make-vector 5 nil) "\ The internal state of the LEDs. Choices are nil, t, `flash. Element 0 is not used.") (defalias 'led-flash #[(l) " ÂIˆÃ ‡" [led-state l flash led-update] 3 "\ Flash LED l."]) (defalias 'led-off #[(&optional l) "ƒ Â!ÃIˆ‚Ä Ã\"ˆÅ ‡" [l led-state prefix-numeric-value nil fillarray led-update] 3 "\ Turn off vt100 led number L. With no argument, turn them all off." "P"]) (defalias 'led-on #[(l) " ÂIˆÃ ‡" [led-state l t led-update] 3 "\ Turn on LED l."]) (defalias 'led-update #[nil "ÀÁ ÆU„6 H‰É=ƒ\" ÊË !Q‚.ƒ. ÊË !Q) T‰‚ Ì ÍRÎ !+‡" ["[?0" "[0" 1 l o f 5 led-state s flash ";" int-to-string "q" "t" send-string-to-terminal] 5 "\ Update the terminal's LEDs to reflect the internal state."]) (provide (quote vt100-led)) emacs-19.22/lisp/term/vt100.elc100666 13437 1 1663 5416177345 14542 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:26:12 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/vt100.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (load "term/lk201" nil t) (defconst vt100-wide-mode (byte-code "À ÁU‡" [frame-width 132] 2) "\ t if vt100 is in 132-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 "\ Toggle 132/80 column mode for vt100s. With positive argument, switch to 132-column mode. With negative argument, switch to 80-column mode." "P"]) emacs-19.22/lisp/term/vt200.elc100666 13437 1 1044 5416177346 14535 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:26:13 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/vt200.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂÃ#ˆÄ ÆÇ#‡" [load "term/vt100" nil t define-key function-key-map "[23~" [27]] 4) emacs-19.22/lisp/term/wyse50.elc100666 13437 1 4052 5416177350 15013 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:26:16 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/wyse50.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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]) (" " [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]) (" " [funct-right]) (" " [funct-left]) (" " [funct-return]) (" " [funct-tab]))] 4) (defalias 'enable-arrow-keys #[nil "ÀÁÂ\"ˆÃÄM‡" [mapcar #[(key-definition) "À @ A@\"‡" [global-set-key key-definition] 3] (("" nil) (" " nil) ("\n" nil) (" " nil) ("" nil) ("r" nil)) enable-arrow-keys nil] 3 "\ 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 " nil]) (byte-code "À‡" [#[nil "ÀÁ TÃQ!‡" [send-string-to-terminal "a23R" frame-width "CG0"] 4 nil nil] kill-emacs-hook nil] 1) emacs-19.22/lisp/term/x-win.elc100666 13437 1 23746 5426347450 14755 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Fri Jul 30 21:47:19 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term/x-win.el ;;; emacs version 19.17.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 "This file was compiled for Emacs 19")) (byte-code "Á=„ ÂÃÄ \"ˆÅÆ!ˆÅÇ!ˆÅÈ!ˆÅÉ!ˆÅÊ!ˆÅË!ˆÌÍ!„-Î ÏÐ\"ÒÔÕÖ\"ˆÔ×Ø\"ˆÔÙÚ\"ˆÔÛÜ\"ˆÔÝÞ\"ˆÔßà\"‡" [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 boundp x-command-line-resources nil append (("-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)) command-switch-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 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] x-handle-iconic #[(switch) "À B‰‡" [(visibility . icon) initial-frame-alist] 2] 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] x-handle-xrm-switch #[(switch) ":„ ÁÂà #ˆ@A‰‡" [x-invocation-args error "%s: missing argument to `%s' option" invocation-name switch x-command-line-resources] 4] x-handle-geometry #[(switch) "À  @!\" A‰‡" [append initial-frame-alist x-parse-geometry x-invocation-args] 4] x-handle-name-rn-switch #[(switch) ":„ ÁÂà #ˆ@A Ƙ…!Ç BB‰‡" [x-invocation-args error "%s: missing argument to `%s' option" invocation-name switch x-resource-name "-name" name initial-frame-alist] 4]] 3) (defvar x-display-name nil "\ The X display name specifying server and X frame.") (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅŇ" [defalias x-handle-display #[(switch) "@A‰‡" [x-invocation-args x-display-name] 2] boundp x-invocation-args nil] 3) (defalias 'x-handle-args #[(args) " ƒ* @Ä \" Aƒ\"A !ˆ‚& B*‚Ÿ‰‡" [args x-invocation-args nil this-switch assoc command-switch-alist aelt] 3 "\ Here the X-related command line options in ARGS are processed, 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."]) (byte-code "ÀÂÄÆÈ Ê Ì ÎÐÒÔÖØÚÜÞà!â#ä%æ'è)ê+ì-î/ð1ò3ô5ö7ø9ú;ü=þ?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™À‡" [0 x-pointer-X-cursor 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] 1) (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" "medium goldenrod" "MediumGoldenrod" "green" "Green" "dark green" "DarkGreen" "dark olive green" "DarkOliveGreen" "forest green" "ForestGreen" "lime green" "LimeGreen" "medium forest green" "MediumForestGreen" "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.") (defalias 'x-defined-colors #[nil "Á‰ ƒ @ AÅ !ƒ \nB‚\n+‡" [x-colors nil defined-colors this-color all-colors x-color-defined-p] 3 "\ Return a list of colors supported by the current X-Display."]) (defalias 'iconify-or-deiconify-frame #[nil "ÀÁ žAÂ=ƒ à ‡Ä Æ !ˆÇ !)‡" [visibility frame-parameters t iconify-frame selected-frame foo make-frame-invisible make-frame-visible] 2 "\ Iconify the selected frame, or deiconify if it's currently an icon." nil]) (byte-code "ÀÁ #ˆÄ ÆÇ#ˆÄ ÈÉ#ˆÄ ÊË#ˆÄ ÌÍ#ˆÄ ÎÏ#ˆÄ ÐÑ#ˆÄ ÒÓ#ˆÄ ÔÕ#ˆÄ Ö×#ˆÄ ØÙ#ˆÄ ÚÛ#ˆÄ ÜÝ#ˆÄ Þß#ˆÄ àá#ˆâãäå#ˆâæäå#ˆâçäè#ˆâéäê#ˆâëäì#ˆâíäî#ˆâïäð#ˆñò!„ó2ó‡" [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] [11] [return] [13] [escape] [27] [M-backspace] [-8388481] [M-delete] [-8388481] [M-tab] [-8388599] [M-linefeed] [-8388598] [M-clear] [-8388597] [M-return] [-8388595] [M-escape] [-8388581] put backspace ascii-character 127 delete tab 9 linefeed 10 clear 12 return 13 escape 27 boundp x-last-selected-text nil] 4) (defvar x-cut-buffer-max 20000 "\ Max number of characters to put in the cut buffer.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅ!;„3È Ê ËÌ\"‰ ƒ2 ÍIˆ‚)Ά?ÐÑ!‰\"ˆÓÕ Ö¥×Z^ÙÚÛ\"‰ƒeÝß!\")à!Ùâã\"‰$ƒËå$\"ƒæ'B'*Ùèé\"*ë,*ƒ–í*!,)Àîï\"ˆðñî\"ˆÁ2Ã3à4ȇ" [defalias x-select-text #[(text &optional push) "G WƒÂ \"ˆ‚ÂÄ \"ˆÅÆ\"ˆ‰‡" [text x-cut-buffer-max x-set-cut-buffer push "" x-set-selection PRIMARY x-last-selected-text] 3] x-cut-buffer-or-selection-value #[nil "ÀÂÃ!‰ĘƒÀ „ÅÆ! ĘƒÀ „&À‚C =ƒ1À‚C ˜ƒ? À‚C ‰)‡" [nil text x-get-selection PRIMARY "" x-get-cut-buffer 0 x-last-selected-text] 3] x-handle-args command-line-args x-resource-name nil i invocation-name string-match "[.*]" 45 x-open-connection x-display-name getenv "DISPLAY" x-command-line-resources x-create-frame-with-faces frame-creation-function x-server-max-request-size 2 100 x-cut-buffer-max x-get-resource "geometry" "Geometry" res-geometry append initial-frame-alist x-parse-geometry t case-fold-search "reverseVideo" "ReverseVideo" rv "^\\(true\\|yes\\|on\\)$" (reverse . t) default-frame-alist "selectionTimeout" "SelectionTimeout" res-selection-timeout 20000 x-selection-timeout string-to-number x-win-suspend-error #[nil "ÀÁ!‡" [error "Suspending an emacs running under X makes no sense"] 2] add-hook suspend-hook interprogram-cut-function interprogram-paste-function split-window-keep-point] 5) emacs-19.22/lisp/term/README100444 13437 1 20354 5405344473 14067 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.22/lisp/abbrev.el100444 74777 1 24353 5353347765 14056 0ustar ericdaemon;;; 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))) (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line. (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))) (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)))))) (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.22/lisp/abbrevlist.el100444 12241 12 3412 5444560656 15111 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.22/lisp/ada.el100444 74777 1 50656 5353347766 13350 0ustar ericdaemon;;; ada.el --- Ada editing support package in GNUlisp. v1.0 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ;; Author: Vincent Broman ;; 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: ;; Created May 1987. ;; (borrows heavily from Mick Jordan's Modula-2 package for GNU, ;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.) ;;; Code: (setq auto-mode-alist (cons (cons "\\.ada$" 'ada-mode) auto-mode-alist)) (defvar ada-mode-syntax-table nil "Syntax table in use in Ada-mode buffers.") (let ((table (make-syntax-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) (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) (modify-syntax-entry ?\; "." table) (modify-syntax-entry ?\' "." table) (modify-syntax-entry ?\" "\"" table) (setq ada-mode-syntax-table table)) (defvar ada-mode-map nil "Keymap used in Ada mode.") (let ((map (make-sparse-keymap))) (define-key map "\C-m" 'ada-newline) (define-key map "\C-?" 'backward-delete-char-untabify) (define-key map "\C-i" 'ada-tab) (define-key map "\C-c\C-i" 'ada-untab) (define-key map "\C-c<" 'ada-backward-to-same-indent) (define-key map "\C-c>" 'ada-forward-to-same-indent) (define-key map "\C-ch" 'ada-header) (define-key map "\C-c(" 'ada-paired-parens) (define-key map "\C-c-" 'ada-inline-comment) (define-key map "\C-c\C-a" 'ada-array) (define-key map "\C-cb" 'ada-exception-block) (define-key map "\C-cd" 'ada-declare-block) (define-key map "\C-c\C-e" 'ada-exception) (define-key map "\C-cc" 'ada-case) (define-key map "\C-c\C-k" 'ada-package-spec) (define-key map "\C-ck" 'ada-package-body) (define-key map "\C-c\C-p" 'ada-procedure-spec) (define-key map "\C-cp" 'ada-subprogram-body) (define-key map "\C-c\C-f" 'ada-function-spec) (define-key map "\C-cf" 'ada-for-loop) (define-key map "\C-cl" 'ada-loop) (define-key map "\C-ci" 'ada-if) (define-key map "\C-cI" 'ada-elsif) (define-key map "\C-ce" 'ada-else) (define-key map "\C-c\C-v" 'ada-private) (define-key map "\C-c\C-r" 'ada-record) (define-key map "\C-c\C-s" 'ada-subtype) (define-key map "\C-cs" 'ada-separate) (define-key map "\C-c\C-t" 'ada-type) (define-key map "\C-ct" 'ada-tabsize) ;; (define-key map "\C-c\C-u" 'ada-use) ;; (define-key map "\C-c\C-w" 'ada-with) (define-key map "\C-cw" 'ada-while-loop) (define-key map "\C-c\C-w" 'ada-when) (define-key map "\C-cx" 'ada-exit) (define-key map "\C-cC" 'ada-compile) (define-key map "\C-cB" 'ada-bind) (define-key map "\C-cE" 'ada-find-listing) (define-key map "\C-cL" 'ada-library-name) (define-key map "\C-cO" 'ada-options-for-bind) (setq ada-mode-map map)) (defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.") (defun ada-mode () "This is a mode intended to support program development in Ada. Most control constructs and declarations of Ada can be inserted in the buffer by typing Control-C followed by a character mnemonic for the construct. \\\\[ada-array] array \\[ada-exception-block] exception block \\[ada-exception] exception \\[ada-declare-block] declare block \\[ada-package-spec] package spec \\[ada-package-body] package body \\[ada-procedure-spec] procedure spec \\[ada-subprogram-body] proc/func body \\[ada-function-spec] func spec \\[ada-for-loop] for loop \\[ada-if] if \\[ada-elsif] elsif \\[ada-else] else \\[ada-private] private \\[ada-loop] loop \\[ada-record] record \\[ada-case] case \\[ada-subtype] subtype \\[ada-separate] separate \\[ada-type] type \\[ada-tabsize] tab spacing for indents \\[ada-when] when \\[ada-while] while \\[ada-exit] exit \\[ada-paired-parens] paired parens \\[ada-inline-comment] inline comment \\[ada-header] header spec \\[ada-compile] compile \\[ada-bind] bind \\[ada-find-listing] find error list \\[ada-library-name] name library \\[ada-options-for-bind] options for bind \\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line having the same (or lesser) level of indentation. Variable `ada-indent' controls the number of spaces for indent/undent." (interactive) (kill-all-local-variables) (use-local-map ada-mode-map) (setq major-mode 'ada-mode) (setq mode-name "Ada") (make-local-variable 'comment-column) (setq comment-column 41) (make-local-variable 'end-comment-column) (setq end-comment-column 72) (set-syntax-table ada-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 'ada-mode-hook)) (defun ada-tabsize (s) "Changes spacing used for indentation. The prefix argument is used as the new spacing." (interactive "p") (setq ada-indent s)) (defun ada-newline () "Start new line and indent to current tab stop." (interactive) (let ((ada-cc (current-indentation))) (newline) (indent-to ada-cc))) (defun ada-tab () "Indent to next tab stop." (interactive) (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent))) (defun ada-untab () "Delete backwards to previous tab stop." (interactive) (backward-delete-char-untabify ada-indent nil)) (defun ada-go-to-this-indent (step indent-level) "Move point repeatedly by STEP lines until the current line has given INDENT-LEVEL or less, or the start or end of the buffer is reached. Ignore blank lines, statement labels and block or loop names." (while (and (zerop (forward-line step)) (or (looking-at "^[ ]*$") (looking-at "^[ ]*--") (looking-at "^<<[A-Za-z0-9_]+>>") (looking-at "^[A-Za-z0-9_]+:") (> (current-indentation) indent-level))) nil)) (defun ada-backward-to-same-indent () "Move point backwards to nearest line with same indentation or less. If not found, point is left at the top of the buffer." (interactive) (ada-go-to-this-indent -1 (current-indentation)) (back-to-indentation)) (defun ada-forward-to-same-indent () "Move point forwards to nearest line with same indentation or less. If not found, point is left at the start of the last line in the buffer." (interactive) (ada-go-to-this-indent 1 (current-indentation)) (back-to-indentation)) (defun ada-array () "Insert array type definition. Uses the minibuffer to prompt for component type and index subtypes." (interactive) (insert "array ()") (backward-char) (insert (read-string "index subtype[s]: ")) (end-of-line) (insert " of ;") (backward-char) (insert (read-string "component-type: ")) (end-of-line)) (defun ada-case () "Build skeleton case statement. Uses the minibuffer to prompt for the selector expression. Also builds the first when clause." (interactive) (insert "case ") (insert (read-string "selector expression: ") " is") (ada-newline) (ada-newline) (insert "end case;") (end-of-line 0) (ada-tab) (ada-tab) (ada-when)) (defun ada-declare-block () "Insert a block with a declare part. Indent for the first declaration." (interactive) (let ((ada-block-name (read-string "[block name]: "))) (insert "declare") (cond ( (not (string-equal ada-block-name "")) (beginning-of-line) (open-line 1) (insert ada-block-name ":") (next-line 1) (end-of-line))) (ada-newline) (ada-newline) (insert "begin") (ada-newline) (ada-newline) (if (string-equal ada-block-name "") (insert "end;") (insert "end " ada-block-name ";")) ) (end-of-line -2) (ada-tab)) (defun ada-exception-block () "Insert a block with an exception part. Indent for the first line of code." (interactive) (let ((block-name (read-string "[block name]: "))) (insert "begin") (cond ( (not (string-equal block-name "")) (beginning-of-line) (open-line 1) (insert block-name ":") (next-line 1) (end-of-line))) (ada-newline) (ada-newline) (insert "exception") (ada-newline) (ada-newline) (cond ( (string-equal block-name "") (insert "end;")) ( t (insert "end " block-name ";"))) ) (end-of-line -2) (ada-tab)) (defun ada-exception () "Insert an indented exception part into a block." (interactive) (ada-untab) (insert "exception") (ada-newline) (ada-tab)) (defun ada-else () "Add an else clause inside an if-then-end-if clause." (interactive) (ada-untab) (insert "else") (ada-newline) (ada-tab)) (defun ada-exit () "Insert an exit statement, prompting for loop name and condition." (interactive) (insert "exit") (let ((ada-loop-name (read-string "[name of loop to exit]: "))) (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name))) (let ((ada-exit-condition (read-string "[exit condition]: "))) (if (not (string-equal ada-exit-condition "")) (if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition) (insert " " ada-exit-condition) (insert " when " ada-exit-condition)))) (insert ";")) (defun ada-when () "Start a case statement alternative with a when clause." (interactive) (ada-untab) ; we were indented in code for the last alternative. (insert "when ") (insert (read-string "'|'-delimited choice list: ") " =>") (ada-newline) (ada-tab)) (defun ada-for-loop () "Build a skeleton for-loop statement, prompting for the loop parameters." (interactive) (insert "for ") (let* ((ada-loop-name (read-string "[loop name]: ")) (ada-loop-is-named (not (string-equal ada-loop-name "")))) (if ada-loop-is-named (progn (beginning-of-line) (open-line 1) (insert ada-loop-name ":") (next-line 1) (end-of-line 1))) (insert (read-string "loop variable: ") " in ") (insert (read-string "range: ") " loop") (ada-newline) (ada-newline) (insert "end loop") (if ada-loop-is-named (insert " " ada-loop-name)) (insert ";")) (end-of-line 0) (ada-tab)) (defun ada-header () "Insert a comment block containing the module title, author, etc." (interactive) (insert "--\n-- Title: \t") (insert (read-string "Title: ")) (insert "\n-- Created:\t" (current-time-string)) (insert "\n-- Author: \t" (user-full-name)) (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n")) (defun ada-if () "Insert skeleton if statment, prompting for a boolean-expression." (interactive) (insert "if ") (insert (read-string "condition: ") " then") (ada-newline) (ada-newline) (insert "end if;") (end-of-line 0) (ada-tab)) (defun ada-elsif () "Add an elsif clause to an if statement, prompting for the boolean-expression." (interactive) (ada-untab) (insert "elsif ") (insert (read-string "condition: ") " then") (ada-newline) (ada-tab)) (defun ada-loop () "Insert a skeleton loop statement. The exit statement is added by hand." (interactive) (insert "loop ") (let* ((ada-loop-name (read-string "[loop name]: ")) (ada-loop-is-named (not (string-equal ada-loop-name "")))) (if ada-loop-is-named (progn (beginning-of-line) (open-line 1) (insert ada-loop-name ":") (forward-line 1) (end-of-line 1))) (ada-newline) (ada-newline) (insert "end loop") (if ada-loop-is-named (insert " " ada-loop-name)) (insert ";")) (end-of-line 0) (ada-tab)) (defun ada-package-spec () "Insert a skeleton package specification." (interactive) (insert "package ") (let ((ada-package-name (read-string "package name: " ))) (insert ada-package-name " is") (ada-newline) (ada-newline) (insert "end " ada-package-name ";") (end-of-line 0) (ada-tab))) (defun ada-package-body () "Insert a skeleton package body -- includes a begin statement." (interactive) (insert "package body ") (let ((ada-package-name (read-string "package name: " ))) (insert ada-package-name " is") (ada-newline) (ada-newline) (insert "begin") (ada-newline) (insert "end " ada-package-name ";") (end-of-line -1) (ada-tab))) (defun ada-private () "Undent and start a private section of a package spec. Reindent." (interactive) (ada-untab) (insert "private") (ada-newline) (ada-tab)) (defun ada-get-arg-list () "Read from the user a procedure or function argument list. Add parens unless arguments absent, and insert into buffer. Individual arguments are arranged vertically if entered one at a time. Arguments ending with `;' are presumed single and stacked." (insert " (") (let ((ada-arg-indent (current-column)) (ada-args (read-string "[arguments]: "))) (if (string-equal ada-args "") (backward-delete-char 2) (progn (while (string-match ";$" ada-args) (insert ada-args) (newline) (indent-to ada-arg-indent) (setq ada-args (read-string "next argument: "))) (insert ada-args ")"))))) (defun ada-function-spec () "Insert a function specification. Prompts for name and arguments." (interactive) (insert "function ") (insert (read-string "function name: ")) (ada-get-arg-list) (insert " return ") (insert (read-string "result type: "))) (defun ada-procedure-spec () "Insert a procedure specification, prompting for its name and arguments." (interactive) (insert "procedure ") (insert (read-string "procedure name: " )) (ada-get-arg-list)) (defun get-ada-subprogram-name () "Return (without moving point or mark) a pair whose CAR is the name of the function or procedure whose spec immediately precedes point, and whose CDR is the column number where the procedure/function keyword was found." (save-excursion (let ((ada-proc-indent 0)) (if (re-search-backward ;;;; Unfortunately, comments are not ignored in this string search. "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t) (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>") (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>")) (progn (setq ada-proc-indent (current-column)) (forward-word 2) (let ((p2 (point))) (forward-word -1) (cons (buffer-substring (point) p2) ada-proc-indent))) (get-ada-subprogram-name)) (cons "NAME?" ada-proc-indent))))) (defun ada-subprogram-body () "Insert frame for subprogram body. Invoke right after `ada-function-spec' or `ada-procedure-spec'." (interactive) (insert " is") (let ((ada-subprogram-name-col (get-ada-subprogram-name))) (newline) (indent-to (cdr ada-subprogram-name-col)) (ada-newline) (insert "begin") (ada-newline) (ada-newline) (insert "end " (car ada-subprogram-name-col) ";")) (end-of-line -2) (ada-tab)) (defun ada-separate () "Finish a body stub with `is separate'." (interactive) (insert " is") (ada-newline) (ada-tab) (insert "separate;") (ada-newline) (ada-untab)) ;(defun ada-with () ; "Inserts a with clause, prompting for the list of units depended upon." ; (interactive) ; (insert "with ") ; (insert (read-string "list of units depended upon: ") ";")) ; ;(defun ada-use () ; "Inserts a use clause, prompting for the list of packages used." ; (interactive) ; (insert "use ") ; (insert (read-string "list of packages to use: ") ";")) (defun ada-record () "Insert a skeleton record type declaration." (interactive) (insert "record") (ada-newline) (ada-newline) (insert "end record;") (end-of-line 0) (ada-tab)) (defun ada-subtype () "Start insertion of a subtype declaration, prompting for the subtype name." (interactive) (insert "subtype " (read-string "subtype name: ") " is ;") (backward-char) (message "insert subtype indication.")) (defun ada-type () "Start insertion of a type declaration, prompting for the type name." (interactive) (insert "type " (read-string "type name: ")) (let ((disc-part (read-string "discriminant specs: "))) (if (not (string-equal disc-part "")) (insert "(" disc-part ")"))) (insert " is ") (message "insert type definition.")) (defun ada-while-loop () (interactive) (insert "while ") (let* ((ada-loop-name (read-string "loop name: ")) (ada-loop-is-named (not (string-equal ada-loop-name "")))) (if ada-loop-is-named (progn (beginning-of-line) (open-line 1) (insert ada-loop-name ":") (next-line 1) (end-of-line 1))) (insert (read-string "entry condition: ") " loop") (ada-newline) (ada-newline) (insert "end loop") (if ada-loop-is-named (insert " " ada-loop-name)) (insert ";")) (end-of-line 0) (ada-tab)) (defun ada-paired-parens () "Insert a pair of round parentheses, placing point between them." (interactive) (insert "()") (backward-char)) (defun ada-inline-comment () "Start a comment after the end of the line, indented at least `comment-column' spaces. If starting after `end-comment-column', start a new line." (interactive) (end-of-line) (if (> (current-column) end-comment-column) (newline)) (if (< (current-column) comment-column) (indent-to comment-column)) (insert " -- ")) (defun ada-display-comment () "Inserts three comment lines, making a display comment." (interactive) (insert "--\n-- \n--") (end-of-line 0)) ;; Much of this is specific to Ada-Ed (defvar ada-lib-dir-name "lib" "*Current Ada program library directory.") (defvar ada-bind-opts "" "*Options to supply for binding.") (defun ada-library-name (ada-lib-name) "Specify name of Ada library directory for later compilations." (interactive "DName of Ada library directory: ") (setq ada-lib-dir-name ada-lib-name)) (defun ada-options-for-bind () "Specify options, such as -m and -i, needed for `ada-bind'." (setq ada-bind-opts (read-string "-m and -i options for `ada-bind': "))) (defun ada-compile (arg) "Save the current buffer and compile it into the current program library. Initialize the library if a prefix arg is given." (interactive "P") (let* ((ada-init (if (null arg) "" "-n ")) (ada-source-file (buffer-name))) (compile (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file)))) (defun ada-find-listing () "Find listing file for ada source in current buffer, using other window." (interactive) (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis")) (search-forward "*** ERROR")) (defun ada-bind () "Bind the current program library, using the current binding options." (interactive) (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name))) ;;; ada.el ends here emacs-19.22/lisp/add-log.el100444 12120 1 41330 5474537214 13735 0ustar rmsdaemon;;; add-log.el --- change log maintenance commands for Emacs ;; Copyright (C) 1985, 1986, 1988, 1993 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.") ;; This MUST not be autoloaded, since user-login-name ;; cannot be known at Emacs dump time. (defvar add-log-full-name (user-full-name) "*Full name of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by the `user-full-name' function.") ;; This MUST not be autoloaded, since user-login-name ;; cannot be known at Emacs dump time. (defvar add-log-mailing-address (concat (user-login-name) "@" (system-name)) "*Electronic mail address of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by `user-login-name', followed by an `@' character, followed by the value returned by `system-name'.") (defun change-log-name () (or change-log-default-name (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog"))) ;;;###autoload (defun prompt-for-change-log-name () "Prompt for a change log name." (let ((default (change-log-name))) (expand-file-name (read-file-name (format "Log file (default %s): " default) nil default)))) ;;;###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 is a name to try first. If FILE-NAME is nil, use the value of `change-log-default-name' if non-nil. Failing that, use \"ChangeLog\" in the current directory. If the file does not exist in the named directory, successive parent directories are tried. Once a file is found, `change-log-default-name' is set locally in the current buffer to the complete file name." (or file-name (setq file-name (or change-log-default-name ;; Chase links in the source file ;; and use the change log in the dir where it points. (and buffer-file-name (file-name-directory (file-chase-links buffer-file-name))) default-directory))) (if (and (eq file-name change-log-default-name) (assq 'change-log-default-name (buffer-local-variables))) ;; Don't do the searching if we already have a buffer-local value. file-name (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))) (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 (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) (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 \\*") (beginning-of-line) (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: (set (make-local-variable 'paragraph-start) "^\\s *$\\|^\f") (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^\f\\|^\\sw") ;; Let all entries for one day behave as one page. ;; Match null string on the date-line so that the date-line ;; is grouped with what follows. (set (make-local-variable 'page-delimiter) "^\\<\\|^\f") (set (make-local-variable 'version-control) 'never) (set (make-local-variable 'adaptive-fill-regexp) "\\s *") (run-hooks 'change-log-mode-hook)) (defvar change-log-mode-map nil "Keymap for Change Log major mode.") (if change-log-mode-map nil (setq change-log-mode-map (make-sparse-keymap)) (define-key change-log-mode-map "\M-q" 'change-log-fill-paragraph)) ;; It might be nice to have a general feature to replace this. The idea I ;; have is a variable giving a regexp matching text which should not be ;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(". ;; But I don't feel up to implementing that today. (defun change-log-fill-paragraph (&optional justify) "Fill the paragraph, but preserve open parentheses at beginning of lines. Prefix arg means justify as well." (interactive "P") (let ((paragraph-separate (concat paragraph-separate "\\|^\\s *\\s(")) (paragraph-start (concat paragraph-start "\\|^\\s *\\s("))) (fill-paragraph justify))) (defvar add-log-current-defun-header-regexp "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ \t]*[:=]" "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.") (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), 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)) ;; If we are now precisely a 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)) (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)) (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 (forward-line 1) (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)))) ;; Ordinary C function syntax. (setq beg (point)) (if (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. (if (and (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)) (buffer-substring (point) (progn (backward-sexp 1) (point)))))))))) ((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]+\\([^,]+\\)," 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))) (provide 'add-log) ;;; add-log.el ends here emacs-19.22/lisp/advice.el100444 12120 1 557061 5474467203 13716 0ustar rmsdaemon;;; advice.el --- advice mechanism for Emacs Lisp functions ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Created: 12 Dec 1992 ;; Version: advice.el,v 2.1 1993/05/26 00:07:58 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| ;; Advice mechanism for Emacs Lisp functions| ;; 1993/05/26 00:07:58|2.1|~/packages/advice.el.Z| ;;; Commentary: ;; @ 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 ;; - Provides generally accessible function definition (after) hooks ;; - Forward advice is possible (an application of definition hooks), 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 ;; - Allows definition of load-hooks for arbitrary Emacs Lisp files without ;; modification of these files ;; @ How to get the latest advice.el: ;; ================================== ;; You can get the latest version of this package either via anonymous ftp ;; from ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/advice.el, ;; or send email to hans@cs.buffalo.edu and I'll mail it to you. ;; @ Overview, or how to read this file: ;; ===================================== ;; Advice has enough features now to justify an info file, however, I ;; didn't have the time yet to do all the necessary formatting. So, ;; until I do have the time or some kind soul does it for me I crammed ;; everything into the source file. Because about 50% of this file is ;; documentation it should be in outline-mode by default, but it is not. ;; If you choose to use outline-mode set `outline-regexp' to `";; @+"' ;; and use `M-x hide-body' to see just the headings. Use the various ;; other outline-mode functions to move around in the text. If you use ;; Lucid Emacs, you'll just have to wait until `selective-display' ;; works properly in order to be able to use outline-mode, sorry. ;; ;; And yes, I know: Documentation is for wimps. ;; ;; 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: ;; =============== ;; - 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. ;; - This package was developed under GNU Emacs 18.59 and Lucid Emacs 19.6. ;; It was adapted and tested for GNU Emacs 19.8 and seems to work ok for ;; Epoch 4.2. For different Emacs environments your mileage may vary. ;; @ 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.el, or have otherwise enlightening ;; comments feel free to send me email at . ;; @ Safety Rules and Emergency Exits: ;; =================================== ;; Before we begin: CAUTION!! ;; advice.el 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' it ;; generates advised definitions of the `documentation' function, and, ;; if definition hooks are enabled (e.g., for forward advice), also of ;; `defun', `defmacro' and `fset' (if you use Jamie Zawinski's (jwz) ;; optimizing byte-compiler as standardly used in GNU Emacs-19 and ;; Lucid Emacs-19 (Lemacs), then enabling definition hooks will also ;; redefine the `byte-code' subr). All these changes 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.el 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.el 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.el 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.el 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. ;; @ Installation: ;; =============== ;; Put this file somewhere into your Emacs `load-path' and byte-compile it. ;; Both steps are mandatory! You cannot (and would not want to) run advice ;; uncompiled, and because there is bootstrapping going on the byte-compiler ;; needs to preload advice in order to compile it, hence, it has to find it ;; in your `load-path' (you can preload advice.el "by hand" before you compile ;; it if you don't want to put it into your `load-path'). Once you have ;; compiled advice put the following autoload declarations into your .emacs ;; to load it on demand ;; ;; (autoload 'defadvice "advice" "Define a piece of advice" nil t) ;; (autoload 'ad-add-advice "advice" "Add a piece of advice") ;; (autoload 'ad-start-advice "advice" "Start advice magic" t) ;; ;; or explicitly load it with (require 'advice) or (load "advice"). ;; @@ Preloading: ;; ============== ;; If you preload the complete advice.el or its autoloads into a dumped Emacs ;; image and you use jwz's byte-compiler make sure advice gets loaded after the ;; byte-compiler runtime support is loaded so that `ad-use-jwz-byte-compiler' ;; receives the proper initial value. ;; @ Customization: ;; ================ ;; Part of the advice magic does not start until you call `ad-start-advice' ;; which you can either do interactively, explicitly in your .emacs, or by ;; putting ;; ;; (setq ad-start-advice-on-load t) ;; ;; into your .emacs which will automatically start advice when the file gets ;; loaded. ;; If you want to be able to forward advise functions, that is to advise them ;; when they are not yet defined or defined as autoloads, then you should put ;; the following into your .emacs ;; ;; (setq ad-activate-on-definition t) ;; ;; which will activate all advice at the time the function gets actually ;; defined/loaded. The value of this variable will not have any effect until ;; `ad-start-advice' gets executed. ;; If you use a v18 Emacs but use jwz's byte-compiler and want to use ;; forward advice make sure that `ad-use-jwz-byte-compiler' has a non-NIL ;; value after advice.el got loaded. If it doesn't set it explicitly in ;; your .emacs with ;; ;; (setq ad-use-jwz-byte-compiler t) ;; ;; Also make sure that you read the paragraph on forward advice below to ;; find out about the trade-offs involved for this combination of features. ;; 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. ;; @ 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: ;; =============== ;; - GNU Emacs-19: GNU'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. ;; - 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 GNU 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 this was a case of forward advice if the original ;; definition of the function was compiled. 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, function definition hooks: ;; ============================================= ;; 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 function defining functions `defun', `defmacro' ;; and `fset' that check for advice information whenever they define a ;; function. If advice information was found and forward advice is enabled ;; then the advice will immediately get activated when the function gets ;; defined. ;; @@@ Enabling forward advice: ;; ============================ ;; Forward advice is enabled by setting `ad-activate-on-definition' to t ;; and then calling `ad-start-advice' which can either be done interactively, ;; directly with `(ad-start-advice)' in your .emacs, or by setting ;; `ad-start-advice-on-load' to t before advice gets loaded. For example, ;; putting the following into your .emacs will enable forward advice: ;; ;; (setq ad-start-advice-on-load t) ;; (setq ad-activate-on-definition t) ;; ;; "Activation on definition" 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. ;; If jwz's byte-compiler is used then `ad-use-jwz-byte-compiler' should ;; be t in order to make forward advice work with functions defined in ;; compiled files generated by that compiler. In v19s which use this ;; compiler the value of this variable will be correct automatically. ;; If you use a v18 Emacs in conjunction with jwz's compiler and you want ;; to use forward advice then you should check its value after loading ;; advice. If it is nil set it explicitly with ;; ;; (setq ad-use-jwz-byte-compiler t) ;; ;; along with `ad-activate-on-definition' before you start advice (see above). ;; IMPORTANT: A v18 Emacs + jwz's compiler + forward advice means performance ;; tradeoffs which are described below. ;; @@@ Forward advice with compiled files generated by jwz's byte-compiler: ;; ======================================================================== ;; The v18 byte-compiler only uses `defun/defmacro' to define compiled ;; functions, hence, providing advised versions of these functions was ;; sufficient to achieve forward advice. With the advent of Jamie Zawinski's ;; optimizing byte-compiler which is now standardly used in GNU Emacs-19 and ;; Lemacs things became more complicated. jwz's compiler defines functions ;; in hunks of byte-code without explicit usage of `defun/defmacro'. To ;; still provide forward advice even in this scenario, advice defines an ;; advised version of the `byte-code' subr that scans its arguments for ;; function definitions during the loading of compiled files. While this is ;; no problem in a v19 Emacs, because it uses a new datatype for compiled ;; code objects and the `byte-code' subr is only rarely used at all, it ;; presents a major problem in a v18 Emacs because there calls to ;; `byte-code' are the only means of executing compiled code (every body of ;; a compiled function contains a call to `byte-code'). Because the advised ;; `byte-code' has to perform some extra checks every call to a compiled ;; function becomes more expensive. ;; Enabling forward advice leads to performance degradation in the following ;; situations: ;; - A v18 Emacs is used and the value of `ad-use-jwz-byte-compiler' is t ;; (either because jwz's byte-compiler is used instead of the standard v18 ;; compiler, or some compiled files generated by jwz's compiler are used). ;; - A v19 Emacs is used with some old-style v18 compiled files. ;; Some performance experiments I conducted showed that function call intensive ;; code (such as the highly recursive byte-compiler itself) slows down by a ;; factor of 1.8. Function call intensive code that runs while a file gets ;; loaded can slow down by a factor of 6! For the v19 scenario this performance ;; lossage would only apply to code that was loaded from old v18 compiled ;; files. ;; MORAL: If you use a v18 Emacs in conjunction with jwz's byte-compiler you ;; should think twice whether you really need forward advice. There are some ;; alternatives to forward advice described below that might give you what ;; you need without the loss of performance (that performance loss probably ;; outweighs by far any performance gain due to the optimizing nature of jwz's ;; compiler). ;; @@@ Alternatives to automatic activation of forward advice: ;; =========================================================== ;; If you use a v18 Emacs in conjunction with jwz's compiler, or you simply ;; don't trust the automatic activation mechanism of forward advice, then ;; you can use some of the following alternatives to get around that: ;; - Preload the file that contains the definition of the function that you ;; want to advice. Inelegant and wasteful, but it works. ;; - If the package that contains the definition of the function you want to ;; advise has any mode hooks, and the advised function is only used once such ;; a mode has been entered, then you can activate the advice in the mode ;; hook. Just put a form like `(ad-activate 'my-advised-fn t)' into the ;; hook definition. The caching mechanism will reuse advised definitions, ;; so calling that mode hook over and over again will not construct ;; advised definitions over and over again, so you won't loose any ;; performance. ;; - If your Emacs comes with file load hooks (such as v19's ;; `after-load-alist' mechanism), then you can put the activation form ;; into that, for example, add `("myfile" (ad-activate 'my-advised-fn t))' ;; to it to activate the advice right ater "myfile" got loaded. ;; @@@ Function definition hooks: ;; ============================== ;; Automatic activation of forward advice is implemented as an application ;; of a more general function definition hook mechanism. After a function ;; gets re/defined with `defun/defmacro/fset' or via a hunk of byte-code ;; during the loading of a byte-compiled file, and function definition hooks ;; are enabled, then all hook functions stored in `ad-definition-hooks' are ;; run with the variable `ad-defined-function' bound to the name of the ;; currently defined function. ;; Function definition hooks can be enabled with ;; ;; (setq ad-enable-definition-hooks t) ;; ;; before advice gets started with `ad-start-advice'. Setting ;; `ad-activate-on-definition' to t automatically enables definition hooks ;; regardless of the value of `ad-enable-definition-hooks'. ;; @@@ Wish list: ;; ============== ;; - The implementation of definition hooks for v19 compiled files would be ;; safer if jwz's byte-compiler used something like `byte-code-tl' instead ;; of `byte-code' to execute hunks of function defining byte-code at the ;; top level of compiled files. ;; - Definition hooks should be implemented directly as part of the C-code ;; that implements `fset', because then advice.el wouldn't have to use all ;; these dirty hacks to achieve this functionality. ;; @@ 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.el :-). 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 GNU 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 an elisp 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.el 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 ;; GNU 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.el 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. ;;; Change Log: ;; advice.el,v ;; Revision 2.1 1993/05/26 00:07:58 hans ;; * advise `defalias' and `define-function' to properly handle forward ;; advice in GNU Emacs-19.7 and later ;; * fix minor bug in `ad-preactivate-advice' ;; * merge with FSF installation of version 2.0 ;; ;; Revision 2.0 1993/05/18 01:29:02 hans ;; * Totally revamped: Now also works with v19s, function indirection ;; instead of body copying for original function calls, caching of ;; advised definitions, en/disable mechanism, more and better ;; interactive functions, forward advice support for jwz's compiler, ;; definition hooks, portable argument access, argument list definition ;; for advised functions, preactivation mechanism, pretty comprehensive ;; docs (still no info file) ;; ;; Revision 1.8 1992/12/15 22:54:45 hans ;; * Replaced non-standard `member' with `memq'. ;; ;; Revision 1.7 1992/12/14 22:41:49 hans ;; * First publicly released version ;; ;; Revision 1.1 1992/12/12 05:37:33 hans ;; * Created ;;; 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") ;; For the odd case that ``' does not have an autoload definition in some ;; Emacs we autoload it here. It is only needed for compilation, hence, ;; I don't want to unconditionally `require' it (re-autoloading ``' after ;; this file got preloaded will properly redefine this autoload): (if (not (fboundp '`)) (autoload '` "backquote")) ;; @@ Variable definitions: ;; ======================== (defconst ad-version "2.1") (defconst ad-emacs19-p (not (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) "Non-NIL if we run Emacs version 19 or higher. This will be true for GNU Emacs-19 as well as Lemacs.") (defconst ad-lemacs-p (and ad-emacs19-p (string-match "Lucid" emacs-version)) "Non-NIL if we run Lucid's version of Emacs-19.") ;;;###autoload (defvar ad-start-advice-on-load t "*Non-NIL will start advice magic when this file gets loaded. Also see function `ad-start-advice'.") ;;;###autoload (defvar ad-activate-on-definition nil "*Non-NIL means automatic advice activation at function definition. Set this variable to t if you want to enable forward advice (which is automatic advice activation of a previously undefined function at the point the function gets defined/loaded/autoloaded). The value of this variable takes effect only during the execution of `ad-start-advice'. If non-NIL it will enable definition hooks regardless of the value of `ad-enable-definition-hooks'.") ;;;###autoload (defvar ad-redefinition-action 'warn "*Defines what to do with redefinitions during 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-definition-hooks nil "*List of hooks to be run after a function definition. The variable `ad-defined-function' will be bound to the name of the currently defined function when the hook function is run.") ;;;###autoload (defvar ad-enable-definition-hooks nil "*Non-NIL will enable hooks to be run on function definition. Setting this variable is a noop unless the value of `ad-activate-on-definition' (which see) is NIL.") ;; The following autoload depends on proper preloading of the runtime ;; support of jwz's byte-compiler for accurate initialization: ;;;###autoload (defvar ad-use-jwz-byte-compiler ;; True if jwz's bytecomp-runtime is loaded: (fboundp 'eval-when-compile) "*Non-NIL means Jamie Zawinski's v19 byte-compiler will be used. If you use a v18 Emacs and don't use jwz's optimizing byte-compiler (the normal case) then this variable should be NIL, because otherwise enabling definition hooks (e.g., for forward advice) will redefine the `byte-code' subr which will lead to some performance degradation for byte-compiled code.") ;; @@ `fset/byte-code' hack for jwz's byte-compiler: ;; ================================================= ;; Because byte-compiled files that were generated by jwz's byte-compiler ;; (as standardly used in v19s) define compiled functions and macros via ;; `fset' and `byte-code' instead of `defun/defmacro' we have to advise ;; `fset' similar to `defun/defmacro' and redefine `byte-code' to allow ;; proper forward advice; hence, we have to make sure that there are ;; proper primitive versions around that can be used by the advice package ;; itself. ;; ;; Wish: A `byte-code-tl' function to be used at the top level of byte- ;; compiled files which could be advised for the purpose of forward ;; advice without creating all that trouble caused by redefining ;; `byte-code'. (if (not (fboundp 'ad-real-fset)) (progn (fset 'ad-real-fset (symbol-function 'fset)) ;; Copy byte-compiler properties: (put 'ad-real-fset 'byte-compile (get 'fset 'byte-compile)) (put 'ad-real-fset 'byte-opcode (get 'fset 'byte-opcode)))) (if (not (fboundp 'ad-real-byte-code)) (fset 'ad-real-byte-code (symbol-function 'byte-code))) ;; @@ 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 ( []) {body-form}*) which will iterate over the list yielded by binding to the current head at every iteration. If 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 [])." (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)) ;; @@ 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 ( []) ;; {body-form}*) ;;Also see `ad-dolist'. On each iteration 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 ({}*) [docstring] [(interactive ...)] {body-form}*)" (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))) ;; @@ 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-real-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 the same for v18s and v19s): (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))) ;; GNU Emacs-19/Lemacs cross-compatibility ;; (compiled-function-p is an obsolete function in GNU Emacs-19): (if (and (not (fboundp 'byte-code-function-p)) (fboundp 'compiled-function-p)) (ad-real-fset 'byte-code-function-p 'compiled-function-p)) (defmacro ad-v19-compiled-p (definition) ;;"non-NIL if DEFINITION is a compiled object of a v19 Emacs." (` (and ad-emacs19-p (or (byte-code-function-p (, definition)) (and (ad-macro-p (, definition)) (byte-code-function-p (ad-lambdafy (, definition)))))))) (defmacro ad-v19-compiled-code (compiled-definition) ;;"Returns the byte-code object of a v19 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-v19-compiled-p definition) (aref (ad-v19-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, if we ;;have a v19 Emacs try to retrieve it from the docstring and cache it under ;;that property, or otherwise use `(&rest ad-subr-args)'." (if (ad-subr-args-defined-p subr-name) (ad-get-subr-args subr-name) (let ((doc (if ad-emacs19-p (documentation subr-name)))) (cond ((and doc (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-v19-compiled-p definition) (condition-case nodoc (aref (ad-v19-compiled-code definition) 4) (error nil)) (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-v19-compiled-p definition) (and (commandp definition) (list 'interactive (aref (ad-v19-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-v19-compiled-p definition) (setq definition (ad-v19-compiled-code definition)) ;; build a standard (byte-code ...) form from the v19 code ;; (I don't think I ever use this): (list (list 'byte-code (aref definition 1) (aref definition 2) (aref definition 3)))) ((consp definition) (nthcdr (+ (if (ad-docstring definition) 1 0) (if (ad-interactive-form definition) 1 0)) (cdr (cdr (ad-lambda-expression definition))))))) (defun ad-compiled-p (definition) ;;"non-NIL if DEFINITION is byte-compiled." (or (ad-v19-compiled-p definition) (memq (car-safe (car (ad-body-forms definition))) '(byte-code ad-real-byte-code)))) ;; 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))))) ;; Need this because the v18 `byte-compile' can't compile macros: (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) (or (progn (require 'byte-compile "bytecomp") (byte-compile function)) ;; If we get here we must have a macro and a ;; standard non-optimizing v18 byte-compiler: (and (ad-macro-p (symbol-function function)) (ad-real-fset function (ad-macrofy (byte-compile-lambda (ad-lambda-expression (symbol-function function))))))))) (defun ad-real-byte-codify (function) ;;"Compile FUNCTION and use `ad-real-byte-code' in the compiled body. ;;This is needed when forward advice with jwz-byte-compiled files is used in ;;order to avoid infinite recursion and keep efficiency as high as possible." (ad-compile-function function) (let ((definition (symbol-function function))) (cond ((ad-v19-compiled-p definition)) ((ad-compiled-p definition) ;; Use ad-real-byte-code in the body of function: (setcar (car (ad-body-forms definition)) 'ad-real-byte-code))))) ;; @@ 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) (let ((advice-docstring (ad-docstring (ad-advice-definition advice)))) ;; Always show advice name/class even if there is no docstring: (format "%s (%s):%s%s" (ad-advice-name advice) class (if advice-docstring "\n" "") (or advice-docstring "")))) (defun ad-make-advised-docstring (function) ;;"Constructs a documentation string for the advised FUNCTION. ;;It concatenates the original documentation with the documentation ;;strings of the individual pieces of advice. Name and class of every ;;advice will be displayed too. 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)) (origdoc ;; Use this wacky apply construction to avoid an Lemacs compiler ;; warning (its `documentation' has only 1 arg as opposed to GNU ;; Emacs-19's version which has an optional `raw' arg): (apply 'documentation origdef (if (and ad-emacs19-p (not ad-lemacs-p)) ;; If we have GNU Emacs-19 retrieve raw doc, because ;; key substitution will be taken care of later anyway: '(t))))) (concat (or origdoc "") (if origdoc "\n\n" "\n") ;; Always inform about advice even if there is no origdoc: "This " (symbol-name (ad-definition-type origdef)) " is advised with the following advice(s):" ;; Combine advice docstrings: (mapconcat (function (lambda (class) (mapconcat (function (lambda (advice) (concat "\n\n" (ad-make-single-advice-docstring advice class)))) (ad-get-enabled-advices function class) ""))) ad-advice-classes "")))) ;; @@@ 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 (for v18 byte-compilers the ;; `defadvice' needs to be in the body of a `defun' for that to occur). ;; 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 function nil) (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-real-fset function old-definition) (fmakunbound function))))) (defun ad-activate-advised-definition (function compile) ;;"Redefines FUNCTION with its advised definition from cache or scratch. ;;If COMPILE is true the resulting FUNCTION will be compiled. 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-real-fset function (or verified-cached-definition (ad-make-advised-definition function))) (if 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-real-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 (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. With an argument (compile is non-NIL) the resulting function (or a compilable cached definition) will also be compiled. 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 (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-real-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. With a prefix argument or if the current definition is compiled compile the resulting advised definition." (interactive (list (ad-read-advised-function "Update advised definition of: " 'ad-is-active))) (if (ad-is-active function) (ad-activate function (or compile (ad-compiled-p (symbol-function function)))))) (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-real-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. With prefix argument compiles resulting advised definitions." (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 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. With prefix argument compiles resulting advised definitions." (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. With prefix argument compiles resulting advised definitions." (interactive "P") (ad-do-advised-functions (function) (ad-activate function))) (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 ignore-errors (ad-recover function) (error nil)))) ;; Completion alist of legal `defadvice' flags (defvar ad-defadvice-flags '(("protect") ("disable") ("activate") ("compile") ("preactivate"))) ;;;###autoload (defmacro defadvice (function args &rest body) "Defines a piece of advice for FUNCTION (a symbol). (defadvice ( [] [] {}*) [ [] [] ] {}* ) ::= name of the function to be advised ::= before | around | after | activation | deactivation ::= non-NIL symbol that names this piece of advice ::= first | last | (optional, defaults to `first', see also `ad-add-advice') ::= 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. ::= protect | disable | activate | compile | preactivate All flags can be specified with unambiguous initial substrings. ::= optional documentation for this piece of advice ::= optional interactive form to be used for the advised function. The first one found in before/around/after advices will be used. ::= 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 the 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 (with a v18 byte-compiler put the defadvice into the body of a defun). 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: (` (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 '(, 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-real-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-real-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 `defun', `defmacro', `fset' and `documentation' ;; =========================================================== ;; Use the advice mechanism to advise defun/defmacro/fset so we can forward ;; advise functions that might be defined later during load/autoload. ;; Enabling forward advice was the original motivation for doing this, it ;; has now been generalized to running definition hooks so other packages ;; can make use of this sort of functionality too. (defvar ad-defined-function nil) (defun ad-activate-defined-function (&optional function) "Activates the advice of an advised and defined FUNCTION. If the current definition of FUNCTION is byte-compiled then the advised definition will be compiled too. FUNCTION defaults to the value of `ad-defined-function'." (if (and (null function) ad-defined-function) (setq function ad-defined-function)) (if (and (ad-is-advised function) (ad-real-definition function)) (ad-activate function (ad-compiled-p (symbol-function function))))) ;; Define some subr arglists for the benefit of v18. Do this here because ;; they have to be available at compile/preactivation time. Use the same ;; as defined in Lemacs' DOC file: (cond ((not ad-emacs19-p) (ad-define-subr-args 'documentation '(fun1)) (ad-define-subr-args 'fset '(sym newdef)))) ;; A kludge to get `defadvice's compiled with a v18 compiler: (defun ad-execute-defadvices () (defadvice defun (after ad-definition-hooks first disable preact) "Whenever a function gets re/defined with `defun' all hook functions in `ad-definition-hooks' will be run after the re/definition with `ad-defined-function' bound to the name of the function." (let ((ad-defined-function (ad-get-arg 0))) (run-hooks 'ad-definition-hooks))) (defadvice defmacro (after ad-definition-hooks first disable preact) "Whenever a macro gets re/defined with `defmacro' all hook functions in `ad-definition-hooks' will be run after the re/definition with `ad-defined-function' bound to the name of the function." (let ((ad-defined-function (ad-get-arg 0))) (run-hooks 'ad-definition-hooks))) (defadvice fset (after ad-definition-hooks first disable preact) "Whenever a function gets re/defined with `fset' all hook functions in `ad-definition-hooks' will be run after the re/definition with `ad-defined-function' bound to the name of the function. This advice was mainly created to handle forward-advice for byte-compiled files created by jwz's byte-compiler used in Lemacs. CAUTION: If you need the primitive `fset' behavior either deactivate its advice or use `ad-real-fset' instead!" (let ((ad-defined-function (ad-get-arg 0))) (run-hooks 'ad-definition-hooks))) ;; Needed for GNU Emacs-19 (in v18s and Lemacs this is just a noop): (defadvice defalias (after ad-definition-hooks first disable preact) "Whenever a function gets re/defined with `defalias' all hook functions in `ad-definition-hooks' will be run after the re/definition with `ad-defined-function' bound to the name of the function. This advice was mainly created to handle forward-advice for byte-compiled files created by jwz's byte-compiler used in GNU Emacs-19." (let ((ad-defined-function (ad-get-arg 0))) ;; The new `byte-compile' uses `defalias' to set the definition which ;; leads to infinite recursion if it gets to use the advised version ;; (with `fset' this didn't matter because the compiled `byte-compile' ;; called it via its byte-code). Should there be a general provision to ;; avoid recursive application of definition hooks? (ad-with-originals (defalias) (run-hooks 'ad-definition-hooks)))) ;; Needed for GNU Emacs-19 (seems to be an identical copy of `defalias', ;; it is used by simple.el and might be used later, hence, advise it): (defadvice define-function (after ad-definition-hooks first disable preact) "Whenever a function gets re/defined with `define-function' all hook functions in `ad-definition-hooks' will be run after the re/definition with `ad-defined-function' bound to the name of the function." (let ((ad-defined-function (ad-get-arg 0))) (ad-with-originals (define-function) (run-hooks 'ad-definition-hooks)))) (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 GNU Emacs-19's optional `raw' argument: (if (not (ad-get-arg 1)) (setq ad-return-value (substitute-command-keys ad-return-value)))))))) ) ;; end of ad-execute-defadvices ;; Only run this once we are compiled. Expanding the defadvices ;; with only interpreted advice functions available takes forever: (if (ad-compiled-p (symbol-function 'ad-execute-defadvices)) (ad-execute-defadvices)) ;; @@ Forward advice support for jwz's byte-compiler (M-x serious-HACK-mode-on) ;; ============================================================================ ;; Jamie Zawinski's optimizing byte-compiler used in v19 (and by some daring ;; folks in v18) produces compiled files that do not define functions via ;; explicit calls to `defun/defmacro', it rather uses `fset' for functions with ;; documentation strings, and hunks of byte-code for sets of functions without ;; any documentation. In Jamie's byte-compiler a series of compiled functions ;; without docstrings get hunked as ;; (progn (fset 'f1 ) (fset 'f2 ) ...). ;; The resulting progn will be compiled and the compiled form will be written ;; to the compiled file as `(byte-code [progn-code] [constants] [depth])'. To ;; handle forward advice we have to know when functions get defined so we can ;; activate any advice there might be. For standard v18 byte-compiled files ;; we can do this by simply advising `defun/defmacro' because these subrs are ;; evaluated explicitly when such a file is loaded. For Jamie's v19 compiler ;; our only choice is to additionally advise `fset' and change the subr ;; `byte-code' such that it analyzes its byte-code string looking for fset's ;; when we are currently loading a file. In v19 the general overhead caused ;; by the advice of `byte-code' shouldn't be too bad, because byte-compiled ;; functions do not call byte-code explicitly (as done in v18). In v18 this ;; is a problem because with the changed `byte-code' function function calls ;; become more expensive. ;; ;; Wish-List: ;; - special defining functions for use in byte-compiled files, e.g., ;; `byte-compile-fset' and `byte-code-tl' which do the same as their ;; standard brothers, but which can be advised for forward advice without ;; the problems that advising `byte-code' generates. ;; - More generally, a symbol definition hook that could be used for ;; forward advice and related purposes. ;; ;; Until then: For the analysis of the byte-code string we simply scan it for ;; an `fset' opcode (M in ascii) that is preceded by two constant references, ;; the first of which points to the function name and the second to its code. ;; A constant reference can either be a simple one-byte one, or a three-byte ;; one if the function has more than 64 constants. The scanning can pretty ;; efficiently be done with a regular expression. Here it goes: ;; Have to hardcode these opcodes if I don't ;; want to require the byte-compiler: (defvar byte-constant 192) (defvar byte-constant-limit 64) (defvar byte-constant2 129) (defvar byte-fset 77) ;; Matches a byte-compiled fset operation with two constant arguments: (defvar ad-byte-code-fset-regexp (let* ((constant-reference (format "[%s-%s]" (char-to-string byte-constant) (char-to-string (+ byte-constant (1- byte-constant-limit))))) (constant2-reference ;; \0 makes it necessary to use concat instead of format in 18.57: (concat (char-to-string byte-constant2) "[\0-\377][\0-\377]")) (fset-opcode (char-to-string byte-fset))) (concat "\\(" constant-reference "\\|" constant2-reference "\\)" "\\(" constant-reference "\\|" constant2-reference "\\)" fset-opcode))) (defun ad-find-fset-in-byte-code (code constants start) ;;"Finds the first two-constant fset operation in CODE after START. ;;Returns a three element list consisting of the name of the defined ;;function, its code (both taken from the CONSTANTS vector), and an ;;advanced start index." (let ((start ;; The odd case that this regexp matches something that isn't an ;; actual fset operation is handled by additional tests and a ;; condition handler in ad-scan-byte-code-for-fsets: (string-match ad-byte-code-fset-regexp code start)) name-index code-index) (cond (start (cond ((= (aref code start) byte-constant2) (setq name-index (+ (aref code (setq start (1+ start))) (* (aref code (setq start (1+ start))) 256))) (setq start (1+ start))) (t (setq name-index (- (aref code start) byte-constant)) (setq start (1+ start)))) (cond ((= (aref code start) byte-constant2) (setq code-index (+ (aref code (setq start (1+ start))) (* (aref code (setq start (1+ start))) 256))) (setq start (1+ start))) (t (setq code-index (- (aref code start) byte-constant)) (setq start (1+ start)))) (list (aref constants name-index) (aref constants code-index) ;; start points to fset opcode: start)) (t nil)))) (defun ad-scan-byte-code-for-fsets (ad-code ad-constants) ;; In case anything in here goes wrong we reset `byte-code' to its real ;; identity. In particular, the handler of the condition-case uses ;; `byte-code', so it better be the real one if we have an error: (ad-real-fset 'byte-code (symbol-function 'ad-real-byte-code)) (condition-case ignore-errors (let ((fset-args '(0 0 0))) (while (setq fset-args (ad-find-fset-in-byte-code ad-code ad-constants (car (cdr (cdr fset-args))))) (if (and (symbolp (car fset-args)) (fboundp (car fset-args)) (eq (symbol-function (car fset-args)) (car (cdr fset-args)))) ;; We've found an fset that was executed during this call ;; to byte-code, and whose definition is still eq to the ;; current definition of the defined function: (let ((ad-defined-function (car fset-args))) (run-hooks 'ad-definition-hooks)))) ;; Everything worked fine, readvise `byte-code': (ad-real-fset 'byte-code (symbol-function 'ad-advised-byte-code))) (error nil))) ;; CAUTION: Don't try this at home!! Changing `byte-code' is a ;; pretty suicidal activity. ;; To allow v19 forward advice we cannot advise `byte-code' as a subr as ;; we did for `defun' etc., because `ad-subr-args' of the advised ;; `byte-code' would shield references to `ad-subr-args' in the body of ;; v18 compiled advised subrs such as `defun', and, more importantly, the ;; changed version of `byte-code' has to be as small and efficient as ;; possible because it is used in every call to a compiled function. ;; Hence, we previously saved its original definition and redefine it as ;; the following function - yuck: ;; The arguments will scope around the body of every byte-compiled ;; function, hence they have to be obscure enough to not be equal to any ;; global or argument variable referenced by any compiled function: (defun ad-advised-byte-code-definition (ad-cOdE ad-cOnStAnTs ad-dEpTh) "Modified version of `byte-code' subr used by the advice package. `byte-code' has been modified to allow automatic activation of forward advice for functions that are defined in byte-compiled files generated by jwz's byte-compiler (as standardly used in v19s). See `ad-real-byte-code' for original documentation." (prog1 (ad-real-byte-code ad-cOdE ad-cOnStAnTs ad-dEpTh) (if load-in-progress (ad-scan-byte-code-for-fsets ad-cOdE ad-cOnStAnTs)))) (ad-real-byte-codify 'ad-advised-byte-code-definition) ;; ad-advised-byte-code cannot be defined with `defun', because that would ;; use `byte-code' for its body --> major disaster if forward advice is ;; enabled and this file gets loaded: (ad-real-fset 'ad-advised-byte-code (symbol-function 'ad-advised-byte-code-definition)) (defun ad-recover-byte-code () "Recovers the real `byte-code' functionality." (interactive) (ad-real-fset 'byte-code (symbol-function 'ad-real-byte-code))) ;; Make sure this is usable even if `byte-code' is screwed up: (ad-real-byte-codify 'ad-recover-byte-code) ;; Store original stack sizes because we might have to change them: (defvar ad-orig-max-lisp-eval-depth max-lisp-eval-depth) (defvar ad-orig-max-specpdl-size max-specpdl-size) (defun ad-adjust-stack-sizes (&optional reset) "Increases stack sizes for the advised `byte-code' function. When called with a prefix argument the stack sizes will be reset to their original values. Calling this function should only be necessary if you get stack overflows because you run highly recursive v18 compiled code in a v19 Emacs with definition hooks enabled." (interactive "P") (cond (reset (setq max-lisp-eval-depth ad-orig-max-lisp-eval-depth) (setq max-specpdl-size ad-orig-max-specpdl-size)) (t ;; The redefined `byte-code' needs more execution stack ;; (5 cells per function invocation) and variable stack ;; (3 vars per function invocation): (setq max-lisp-eval-depth (* ad-orig-max-lisp-eval-depth 3)) (setq max-specpdl-size (+ ad-orig-max-specpdl-size (* (/ max-lisp-eval-depth 5) 3)))))) (defun ad-enable-definition-hooks () ;;"Enables definition hooks by redefining definition primitives. ;;Activates the advice of defun/defmacro/fset and possibly redefines ;;`byte-code' if a v19 byte-compiler is used. Redefining these primitives ;;might lead to problems. Use `ad-disable-definition-hooks' or ;;`ad-stop-advice' in such a case to establish a safe state." (ad-dolist (definer '(defun defmacro fset defalias define-function)) (ad-enable-advice definer 'after 'ad-definition-hooks) (ad-activate definer 'compile)) (cond (ad-use-jwz-byte-compiler (ad-real-byte-codify 'ad-advised-byte-code) (ad-real-byte-codify 'ad-scan-byte-code-for-fsets) ;; Now redefine byte-code... (ad-real-fset 'byte-code (symbol-function 'ad-advised-byte-code)) ;; Only increase stack sizes in v18s, even though old-fashioned ;; v18 byte-code might be run in a v19, in which case one can call ;; `ad-adjust-stack-sizes' interactively if stacks become too small: (if (not ad-emacs19-p) (ad-adjust-stack-sizes))))) (defun ad-disable-definition-hooks () ;;"Disables definition hooks by resetting definition primitives." (ad-recover-byte-code) (ad-dolist (definer '(defun defmacro fset defalias define-function)) (ad-disable-advice definer 'after 'ad-definition-hooks) (ad-update definer)) (if (not ad-emacs19-p) (ad-adjust-stack-sizes 'reset))) (ad-real-byte-codify 'ad-disable-definition-hooks) ;; @@ Starting, stopping and recovering from the advice package magic: ;; =================================================================== ;;;###autoload (defun ad-start-advice () "Redefines some primitives to start the advice magic. If `ad-activate-on-definition' is t then advice information will automatically get activated whenever an advised function gets defined or redefined. This will enable goodies such as forward advice and automatically enable function definition hooks. If its value is nil but the value of `ad-enable-definition-hooks' is t then definition hooks will be enabled without having automatic advice activation, otherwise function definition hooks will be disabled too. If definition hooks are enabled then functions stored in `ad-definition-hooks' are run whenever a function gets defined or redefined." (interactive) (ad-enable-advice 'documentation 'after 'ad-advised-docstring) (ad-activate 'documentation 'compile) (if (or ad-activate-on-definition ad-enable-definition-hooks) (ad-enable-definition-hooks) (ad-disable-definition-hooks)) (setq ad-definition-hooks (if ad-activate-on-definition (if (memq 'ad-activate-defined-function ad-definition-hooks) ad-definition-hooks (cons 'ad-activate-defined-function ad-definition-hooks)) (delq 'ad-activate-defined-function ad-definition-hooks)))) (defun ad-stop-advice () "Undefines some primitives to stop the advice magic. This can also be used to recover from advice related emergencies." (interactive) (ad-recover-byte-code) (ad-disable-advice 'documentation 'after 'ad-advised-docstring) (ad-update 'documentation) (ad-disable-definition-hooks) (setq ad-definition-hooks (delq 'ad-activate-defined-function ad-definition-hooks))) (ad-real-byte-codify 'ad-stop-advice) (defun ad-recover-normality () "Undoes all advice related redefinitions and unadvises everything. Use only in REAL emergencies." (interactive) (ad-recover-byte-code) (ad-recover-all) (setq ad-advised-functions nil)) (ad-real-byte-codify 'ad-recover-normality) (if (and ad-start-advice-on-load ;; ...but only if we are compiled: (ad-compiled-p (symbol-function 'ad-execute-defadvices))) (ad-start-advice)) (provide 'advice) ;;; advice.el ends here emacs-19.22/lisp/allout.el100444 13437 1 332304 5405347261 14101 0ustar jimbdaemon;;;_* Allout - An extensive outline-mode for Emacs. ;;; Note - the lines beginning with ';;;_' are outline topic headers. ;;; Load this file (or 'eval-current-buffer') and revisit the ;;; file to give it a whirl. ;;;_ + Provide (provide 'outline) ;;;_ + Package Identification Stuff ;;;_ - Author: Ken Manheimer ;;;_ - Maintainer: Ken Manheimer ;;;_ - Created: Dec 1991 - first release to usenet ;;;_ - Version: $Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $|| ;;;_ - Keywords: outline mode ;;;_ - LCD Archive Entry ;; LCD Archive Entry: ;; allout|Ken Manheimer|klm@nist.gov ;; |A more thorough outline-mode ;; |27-May-1993|$Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $|| ;;;_ - Description ;; A full-fledged outline mode, based on the original rudimentary ;; GNU emacs outline functionality. ;; ;; Ken Manheimer Nat'l Inst of Standards and Technology ;; klm@nist.gov (301)975-3539 (Formerly Nat'l Bureau of Standards) ;; NIST Shared File Service Manager and Developer ;;;_ - Copyright ;; Copyright (C) 1992, 1993 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. ;;;_ + User Customization variables ;;;_ - Topic Header configuration ;;;_ = outline-header-prefix (defvar outline-header-prefix "." "* Leading string for greater than level 0 topic headers.") (make-variable-buffer-local 'outline-header-prefix) ;;;_ = outline-header-subtraction (defvar outline-header-subtraction (1- (length outline-header-prefix)) "* Leading string for greater than level 0 topic headers.") (make-variable-buffer-local 'outline-header-subtraction) ;;;_ = outline-primary-bullet (defvar outline-primary-bullet "*") ;; Changing this var disables any ;; backwards compatibility with ;; the original outline mode. (make-variable-buffer-local 'outline-primary-bullet) ;;;_ = outline-plain-bullets-string (defvar outline-plain-bullets-string "" "* 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, ']', among any bullets. You must run 'set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation.") (setq outline-plain-bullets-string (concat outline-primary-bullet "+-:.;,")) (make-variable-buffer-local 'outline-plain-bullets-string) ;;;_ = outline-distinctive-bullets-string (defvar outline-distinctive-bullets-string "" "* The bullets used for distinguishing outline topics. These bullets are not offered among the regular rotation, and are not changed when automatically rebulleting, as when shifting the level of a topic. See 'outline-plain-bullets-string' for the other kind of bullets. DO NOT include the close-square-bracket, ']', among any bullets. You must run 'set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation.") (setq outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~") (make-variable-buffer-local 'outline-distinctive-bullets-string) ;;;_ > outline-numbered-bullet () (defvar outline-numbered-bullet () "* Bullet signifying outline prefixes which are to be numbered. Leave it nil if you don't want any numbering, or set it to a string with the bullet you want to be used.") (setq outline-numbered-bullet "#") (make-variable-buffer-local 'outline-numbered-bullet) ;;;_ = outline-file-xref-bullet (defvar outline-file-xref-bullet "@" "* Set this var to the bullet you want to use for file cross-references. Set it 'nil' if you want to inhibit this capability.") ;;;_ - Miscellaneous customization ;;;_ = outline-stylish-prefixes (defvar outline-stylish-prefixes t "*A true value for this var makes the topic-prefix creation and modification functions vary the prefix bullet char according to level. Otherwise, only asterisks ('*') and distinctive bullets are used. This is how an outline can look with stylish prefixes: * Top level .* A topic . + One level 3 subtopic . . One level 4 subtopic . + Another level 3 subtopic . . A level 4 subtopic . #2 A distinguished, numbered level 4 subtopic . ! A distinguished ('!') level 4 subtopic . #4 Another numbered level 4 subtopic This would be an outline with stylish prefixes inhibited: * Top level .* A topic .! A distinctive (but measly) subtopic . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*' 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 t.") (make-variable-buffer-local 'outline-stylish-prefixes) ;;;_ = outline-old-style-prefixes (defvar outline-old-style-prefixes nil "*Setting this var causes the topic-prefix creation and modification functions to make only asterix-padded prefixes, so they look exactly like the old style prefixes. Both old and new style prefixes are always respected by the topic maneuvering functions.") (make-variable-buffer-local 'outline-old-style-prefixes) ;;;_ = outline-enwrap-isearch-mode ; Spiffy dynamic-exposure ; during searches requires ; Dan LaLiberte's isearch-mode: (defvar outline-enwrap-isearch-mode "isearch-mode.el" "* Set this var to the name of the (non-compiled) elisp code for isearch-mode, if you have Dan LaLiberte's 'isearch-mode' stuff and want isearches to reveal hidden stuff encountered in the course of a search, and reconceal it if you go past. Set it nil if you don't have the package, or don't want to use this feature.") ;;;_ = outline-use-hanging-indents (defvar outline-use-hanging-indents t "* Set this var non-nil if you have Kyle E Jones' filladapt stuff, and you want outline to fill topics as hanging indents to the bullets.") (make-variable-buffer-local 'outline-use-hanging-indents) ;;;_ = outline-reindent-bodies (defvar outline-reindent-bodies t "* Set this var non-nil if you want topic depth adjustments to reindent hanging bodies (ie, bodies lines indented to beginning of heading text). The performance hit is small. Avoid this strenuously when using outline mode on program code. It's great for text, though.") (make-variable-buffer-local 'outline-reindent-bodies) ;;;_ = outline-mode-keys ;;; You have to restart outline-mode - '(outline-mode t)' - to have ;;; any changes take hold. (defvar outline-mode-keys () "Assoc list of outline-mode-keybindings, for common reference in setting up major and minor-mode keybindings.") (setq outline-mode-keys '( ; Motion commands: ("\C-c\C-n" outline-next-visible-heading) ("\C-c\C-p" outline-previous-visible-heading) ("\C-c\C-u" outline-up-current-level) ("\C-c\C-f" outline-forward-current-level) ("\C-c\C-b" outline-backward-current-level) ("\C-c\C-a" outline-beginning-of-current-entry) ("\C-c\C-e" outline-end-of-current-entry) ; Exposure commands: ("\C-c\C-i" outline-show-current-children) ("\C-c\C-s" outline-show-current-subtree) ("\C-c\C-h" outline-hide-current-subtree) ("\C-c\C-o" outline-show-current-entry) ("\C-c!" outline-show-all) ; Alteration commands: ("\C-c " open-sibtopic) ("\C-c." open-subtopic) ("\C-c," open-supertopic) ("\C-c'" outline-shift-in) ("\C-c>" outline-shift-in) ("\C-c<" outline-shift-out) ("\C-c\C-m" outline-rebullet-topic) ("\C-cb" outline-rebullet-current-heading) ("\C-c#" outline-number-siblings) ("\C-k" outline-kill-line) ("\C-y" outline-yank) ("\M-y" outline-yank-pop) ("\C-c\C-k" outline-kill-topic) ; Miscellaneous commands: ("\C-c@" outline-resolve-xref) ("\C-cc" outline-copy-exposed))) ;;;_ + Code - no user customizations below. ;;;_ #1 Outline Format and Internal Mode Configuration ;;;_ : 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 composed from the elements of 'outline-plain-bullets-string' and 'outline-distinctive-bullets-string'.") (make-variable-buffer-local 'outline-bullets-string) ;;;_ = 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, this is an outline-regexp for outline headers at the beginning of the buffer. (match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local 'outline-line-bob-regexp) ;;;_ > 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) ) ;;;_ > 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) ;;;_ > set-outline-regexp () (defun set-outline-regexp () " Generate proper topic-header regexp form for outline functions, from 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-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 "\\([\C-j\C-m]\\)\\(" outline-regexp "\\)")) (setq outline-bob-regexp (concat "\\(\\`\\)\\(" outline-regexp "\\)")) ) ;;;_ : Key bindings ;;;_ = Generic minor keybindings control ;;;_ ; Stallman's suggestion (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\C-n" 'outline-next-visible-heading) (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading) (define-key outline-mode-map "\C-c\C-i" 'show-children) (define-key outline-mode-map "\C-c\C-s" 'show-subtree) (define-key outline-mode-map "\C-c\C-h" 'hide-subtree) (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading) (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level) (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level)) (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) (setq minor-mode-alist (append minor-mode-alist (list '(outline-minor-mode " Outl")))) (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 "\C-c" (lookup-key outline-mode-map "\C-c"))) (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))) (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))) ;;;_ ; minor-bind-keys (keys-assoc) (defun minor-bind-keys (keys-assoc) " Establish BINDINGS assoc list in current buffer, returning a list for subsequent use by minor-unbind-keys to resume overloaded local bindings." (interactive) ;; Cycle thru key list, registering prevailing local binding for key, if ;; any (for prospective resumption by outline-minor-unbind-keys), then ;; overloading it with outline-mode one. (let ((local-map (or (current-local-map) (make-sparse-keymap))) key new-func unbinding-registry prevailing-func) (while keys-assoc (setq curr-key (car (car keys-assoc))) (setq new-func (car (cdr (car keys-assoc)))) (setq prevailing-func (local-key-binding curr-key)) (if (not (symbolp prevailing-func)) (setq prevailing-func nil)) ;; Register key being changed, prevailing local binding, & new binding: (setq unbinding-registry (cons (list curr-key (local-key-binding curr-key) new-func) unbinding-registry)) ; Make the binding: (define-key local-map curr-key new-func) ; Increment for next iteration: (setq keys-assoc (cdr keys-assoc))) ; Establish modified map: (use-local-map local-map) ; Return the registry: unbinding-registry) ) ;;;_ ; minor-relinquish-keys (unbinding-registry) (defun minor-relinquish-keys (unbinding-registry) " Given registry of MODAL-BINDINGS, as produced by minor-bind-keys, resume the former local keybindings of those keys that retain the local bindings set by minor-bind-keys. Changed local bindings are left alone, so other minor (user or modal) bindings are not disrupted. Returns a list of those registrations which were not, because of tampering subsequent to the registration by minor-bind-keys, resumed." (interactive) (let (residue curr-item curr-key curr-resume curr-relinquish) (while unbinding-registry (setq curr-item (car unbinding-registry)) (setq curr-key (car curr-item)) (setq curr-resume (car (cdr curr-item))) (setq curr-relinquish (car (cdr (cdr curr-item)))) (if (equal (local-key-binding curr-key) curr-relinquish) (if curr-resume ;; Was a local binding to be resumed - do so: (local-set-key curr-key curr-resume) (local-unset-key curr-key)) ;; Bindings been tampered with since registration - leave it be, and ;; register so on residue list: (setq residue (cons residue curr-item))) (setq unbinding-registry (cdr unbinding-registry))) residue) ) ;;;_ = outline-minor-prior-keys (defvar outline-minor-prior-keys () "Former key bindings assoc-list, for resumption from outline minor-mode.") (make-variable-buffer-local 'outline-minor-prior-keys) ; Both major and minor mode ; bindings are dictated by ; this list - put your ; settings here. ;;;_ > outline-minor-bind-keys () (defun outline-minor-bind-keys () " Establish outline-mode keybindings as MINOR modality of current buffer." (setq outline-minor-prior-keys (minor-bind-keys outline-mode-keys))) ;;;_ > outline-minor-relinquish-keys () (defun outline-minor-relinquish-keys () " Resurrect local keybindings as they were before outline-minor-bind-keys." (minor-relinquish-keys outline-minor-prior-keys) ) ;;;_ : Mode-Specific Variables Maintenance ;;;_ = outline-mode-prior-settings (defvar outline-mode-prior-settings nil "For internal use by outline mode, registers 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 information for later reference, or performs resumption of outline-mode specific values. First arg is NAME of variable affected. optional second arg is list containing outline-mode-specific VALUE to be impose 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: (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))))) ) ;;;_ : Overall ;;;_ = outline-mode (defvar outline-mode () "Allout outline mode minor-mode flag.") (make-variable-buffer-local 'outline-mode) ;;;_ > outline-mode (&optional toggle) (defun outline-mode (&optional toggle) " Set minor mode for editing outlines with selective display. Look below the description of the bindings for explanation of the terminology use in outline-mode commands. (Note - this is not a proper minor mode, because it does affect key bindings. It's not too improper, however, because it does resurrect any bindings which have not been tampered with since it changed them.) Exposure Commands Movement Commands C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading C-c C-i outline-show-current-children C-c C-p outline-previous-visible-heading C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level C-c ! outline-show-all C-c C-b outline-backward-current-level outline-hide-current-leaves C-c C-e outline-end-of-current-entry C-c C-a outline-beginning-of-current-entry Topic Header Generation Commands C-c open-sibtopic Create a new sibling after current topic C-c . open-subtopic ... an offspring of current topic C-c , open-supertopic ... a sibling of the current topic's parent Level and Prefix Adjustment Commands 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, all others set suitable according to depth C-c b 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. Killing and Yanking - all keep siblings numbering reconciled as appropriate C-k outline-kill-line Regular kill line, but respects numbering ,etc C-c C-k outline-kill-topic Kill current topic, including offspring 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 outline sans all hidden stuff to another buffer whose name is derived from the current one - \"XXX exposed\" M-x outlinify-sticky Activate outline mode for current buffer and establish -*- outline -*- mode specifier as well as file local vars to automatically set exposure. Try it. Terminology Topic: A basic cohesive component of an emacs outline, which can be closed (made hidden), opened (revealed), generated, traversed, and shifted as units, using outline-mode functions. A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below). Exposure: Hidden (~closed~) topics are represented by ellipses ('...') at the end of the visible SUPERTOPIC which contains them, rather than by their actual text. Hidden topics are still susceptible to editing and regular movement functions, they just are not displayed normally, effectively collapsed into the ellipses which represent them. Outline mode provides the means to selectively expose topics based on their NESTING. SUBTOPICS of a topic can be hidden and subsequently revealed based on their DEPTH relative to the supertopic from which the exposure is being done. The BODIES of a topic do not generally become visible except during exposure of entire subtrees (see documentation for '-current-subtree'), or when the entry is explicitly exposed with the 'outline-show-entry' function, or (if you have a special version of isearch installed) when encountered by incremental searches. The CURRENT topic is the more recent visible one before or including the text cursor. Header: The initial portion of an outline topic. It is composed of a topic header PREFIX at the beginning of the line, followed by text to the end of the EFFECTIVE LINE. Body: Any subsequent lines of text following a topic header and preceding the next one. This is also referred to as the entry for a topic. Prefix: The text which distinguishes topic headers from normal text lines. There are two forms, both of which start at the beginning of the topic header (EFFECTIVE) line. The length of the prefix represents the DEPTH of the topic. The fundamental sort begins either with solely an asterisk ('*') or else dot ('.') followed by zero or more spaces and then an outline BULLET. [Note - you can now designate your own, arbitrary HEADER-LEAD string, by setting the variable 'outline-header-prefix'.] The second form is for backwards compatibility with the original emacs outline mode, and consists solely of asterisks. Both sorts are recognized by all outline commands. The first sort is generated by outline topic production commands if the emacs variable outline-old-style-prefixes is nil, otherwise the second style is used. Bullet: An outline prefix bullet is one of the characters on either of the outline bullet string vars, 'outline-plain-bullets-string' and 'outline-distinctive-bullets-string'. (See their documentation for more details.) The default choice of bullet for any prefix depends on the DEPTH of the topic. Depth and Nesting: The length of a topic header prefix, from the initial character to the bullet (inclusive), represents the depth of the topic. A topic is considered to contain the subsequent topics of greater depth up to the next topic of the same depth, and the contained topics are recursively considered to be nested within all containing topics. Contained topics are called subtopics. Immediate subtopics are called 'children'. Containing topics are supertopicsimmediate supertopics are 'parents'. Contained topics of the same depth are called siblings. Effective line: The regular ascii text in which form outlines are saved are manipulated in outline-mode to engage emacs' selective-display faculty. The upshot is that the effective end of an outline line can be terminated by either a normal Unix newline char, \n, or the special outline-mode eol, ^M. This only matters at the user level when you're doing searches which key on the end of line character." (interactive "P") (let* ((active (and (boundp 'outline-mode) outline-mode)) (toggle (and toggle (or (and (listp toggle)(car toggle)) toggle))) (explicit-activation (and toggle (or (symbolp toggle) (and (natnump toggle) (not (zerop toggle))))))) (cond ((and (not explicit-activation) (or active toggle)) ;; Activation not explicitly requested, and either in active ;; state or deactivation specifically requested: (outline-minor-relinquish-keys) (outline-resumptions 'selective-display) (outline-resumptions 'indent-tabs-mode) (outline-resumptions 'paragraph-start) (outline-resumptions 'paragraph-separate) (setq outline-mode nil)) ;; Deactivation *not* indicated. ((not active) ;; Not already active - activate: (outline-minor-bind-keys) (outline-resumptions 'selective-display '(t)) (outline-resumptions 'indent-tabs-mode '(nil)) (or (assq 'outline-mode minor-mode-alist) (setq minor-mode-alist (cons '(outline-mode " Outline") minor-mode-alist))) (set-outline-regexp) (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 "\\)"))) (if outline-enwrap-isearch-mode (outline-enwrap-isearch)) (if (and outline-use-hanging-indents (boundp 'filladapt-prefix-table)) ;; Add outline-prefix recognition to filladapt - not standard: (progn (setq filladapt-prefix-table (cons (cons (concat "\\(" outline-regexp "\\) ") 'filladapt-hanging-list) filladapt-prefix-table)) (setq filladapt-hanging-list-prefixes (cons outline-regexp filladapt-hanging-list-prefixes)))) (run-hooks 'outline-mode-hook) (setq outline-mode t)) ) ; cond ) ; let* ) ; defun ;;;_ #2 Internal Position State-Tracking Variables ;;; All basic outline functions which 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) ;;;_ #3 Exposure Control ;;;_ : Fundamental ;;;_ > outline-flag-region (from to flag) (defun outline-flag-region (from to flag) " Hides or shows lines from FROM to TO, according to FLAG. Uses emacs selective-display, where text is show if FLAG put at beginning of line is `\\n' (newline character), while text is hidden if FLAG is `\\^M' (control-M). returns nil iff no changes were effected." (let ((buffer-read-only nil)) (subst-char-in-region from to (if (= flag ?\n) ?\^M ?\n) flag t))) ;;;_ > outline-flag-current-subtree (flag) (defun outline-flag-current-subtree (flag) (save-excursion (outline-back-to-current-heading) (outline-flag-region (point) (progn (outline-end-of-current-subtree) (point)) flag))) ;;;_ : Topic-specific ;;;_ > 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 directly following this heading, or hide it 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-show-entry () ; outline-show-entry basically for isearch dynamic exposure, as is... (defun outline-show-entry () " Like outline-show-current-entry, but reveals an entry that is nested within hidden topics." (interactive) (save-excursion (outline-goto-prefix) (outline-flag-region (if (not (bobp)) (1- (point)) (point)) (progn (outline-pre-next-preface) (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." (interactive) (save-excursion (outline-goto-prefix) (outline-flag-region (if (not (bobp)) (1- (point)) (point)) (progn (outline-pre-next-preface) (if (looking-at "\C-m") (point) (1- (point)))) ?\C-m))) ;;;_ > outline-show-current-subtree () (defun outline-show-current-subtree () "Show everything after this heading at deeper levels." (interactive) (outline-flag-current-subtree ?\n)) ;;;_ > outline-hide-current-subtree (&optional just-close) (defun outline-hide-current-subtree (&optional just-close) " Hide everything after this heading at deeper levels, or if it's already closed, and optional arg JUST-CLOSE is nil, hide the current level." (interactive) (let ((orig-eol (save-excursion (end-of-line)(outline-goto-prefix)(end-of-line)(point)))) (outline-flag-current-subtree ?\^M) (if (and (= orig-eol (save-excursion (goto-char orig-eol) (end-of-line) (point))) ;; Structure didn't change - try hiding current level: (if (not just-close) (outline-up-current-level 1 t))) (outline-hide-current-subtree)))) ;;;_ > outline-show-current-branches () (defun outline-show-current-branches () "Show all subheadings of this heading, but not their bodies." (interactive) (outline-show-current-children 1000)) ;;;_ > outline-hide-current-leaves () (defun outline-hide-current-leaves () "Hide all body after this heading at deeper levels." (interactive) (outline-back-to-current-heading) (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) (point)))) ;;;_ > outline-show-current-children (&optional level) (defun outline-show-current-children (&optional level) " Show all direct subheadings of this heading. Optional LEVEL specifies how many levels below the current level should be shown." (interactive "p") (or level (setq level 1)) (save-excursion (save-restriction (beginning-of-line) (setq level (+ level (progn (outline-back-to-current-heading) (outline-recent-depth)))) (narrow-to-region (point) (progn (outline-end-of-current-subtree) (1+ (point)))) (goto-char (point-min)) (while (and (not (eobp)) (outline-next-heading)) (if (<= (outline-recent-depth) level) (save-excursion (let ((end (1+ (point)))) (forward-char -1) (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1)) (outline-flag-region (point) end ?\n)))))))) ;;;_ : Region and beyond ;;;_ > outline-show-all () (defun outline-show-all () "Show all of the text in the buffer." (interactive) (outline-flag-region (point-min) (point-max) ?\n)) ;;;_ > 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\^M][\n\^M]") 2 1))))))) ;;;_ > outline-expose () (defun outline-expose (spec &rest followers) "Dictate wholesale exposure scheme for current topic, according to SPEC. SPEC is either a number or a list of specs. Optional successive args dictate exposure for subsequent siblings of current topic. Numbers, the symbols '*' and '+', and the null list dictate different exposure depths for the corresponding topic. Numbers indicate the depth to open, with negative numbers first forcing a close, and then opening to their absolute value. Positive numbers jsut reopen, and 0 just closes. '*' completely opens the topic, including bodies, and '+' shows all the sub headers, but not the bodies. 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, as the SPEC as a whole does for the parent topic. Optional FOLLOWER elements dictate exposure for subsequent siblings of the parent topic." (interactive "xExposure spec: ") (save-excursion (let ((start-point (progn (outline-goto-prefix)(point))) done) (cond ((null spec) nil) ((symbolp spec) (if (eq spec '*) (outline-show-current-subtree)) (if (eq spec '+) (outline-show-current-branches))) ((numberp spec) (if (zerop spec) ;; Just hide if zero: (outline-hide-current-subtree t) (if (> 0 spec) ;; Close before opening if negative: (progn (outline-hide-current-subtree) (setq spec (* -1 spec)))) (outline-show-current-children spec))) ((listp spec) (outline-expose (car spec)) (if (and (outline-descend-to-depth (+ (outline-current-depth) 1)) (not (outline-hidden-p))) (while (and (setq spec (cdr spec)) (not done)) (outline-expose (car spec)) (setq done (not (outline-next-sibling))))))))) (while (and followers (outline-next-sibling)) (outline-expose (car followers)) (setq followers (cdr followers))) ) ;;;_ > outline-exposure '() (defmacro outline-exposure (&rest spec) " Literal frontend for 'outline-expose', passes arguments unevaluated, so you needn't quote them." (cons 'outline-expose (mapcar '(lambda (x) (list 'quote x)) spec))) ;;;_ #4 Navigation ;;;_ : Position Assessment ;;;_ . Residual state - from most recent outline context operation. ;;;_ > outline-recent-depth () (defun 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 () (defun 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 () (defun 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)) ;;;_ . Active position evaluation - if you can't use the residual state. ;;;_ > outline-on-current-heading-p () (defun outline-on-current-heading-p () " Return prefix beginning point if point is on same line as current visible topic's header line." (save-excursion (beginning-of-line) (and (looking-at outline-regexp) (setq outline-recent-prefix-end (match-end 0) outline-recent-prefix-beginning (match-beginning 0))))) ;;;_ > outline-hidden-p () (defun outline-hidden-p () "True if point is in hidden text." (interactive) (save-excursion (and (re-search-backward "[\C-j\C-m]" (point-min) t) (looking-at "\C-m")))) ;;;_ > outline-current-depth () (defun outline-current-depth () " Return the depth to which the current containing visible topic is nested in the outline." (save-excursion (if (outline-back-to-current-heading) (max 1 (- outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction)) 0))) ;;;_ > outline-depth () (defun outline-depth () " Like outline-current-depth, but respects hidden as well as visible topics." (save-excursion (if (outline-goto-prefix) (outline-recent-depth) (progn (setq outline-recent-prefix-end (point) outline-recent-prefix-beginning (point)) 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)))) ;;;_ : Within Topic ;;;_ > outline-goto-prefix () (defun outline-goto-prefix () " Put point at beginning of outline prefix for current topic, visible or not. Returns a list of char address of the beginning of the prefix and the end of it, or nil if none." (cond ((and (or (save-excursion (beginning-of-line) (bobp)) (memq (preceding-char) '(?\n ?\^M))) (looking-at outline-regexp)) (setq outline-recent-prefix-end (match-end 0) outline-recent-prefix-beginning (goto-char (match-beginning 0)))) ((re-search-backward outline-line-boundary-regexp ;; unbounded search, ;; stay at limit and return nil if failed: nil 1) (setq outline-recent-prefix-end (match-end 2) outline-recent-prefix-beginning (goto-char (match-beginning 2)))) ;; We should be at the beginning of the buffer if the last ;; condition failed. line-boundary-regexp doesn't cover topic ;; at bob - Check for it. ((looking-at outline-regexp) (setq outline-recent-prefix-end (match-end 0) outline-recent-prefix-beginning (goto-char (match-beginning 0))))) ) ;;;_ > outline-end-of-prefix () (defun outline-end-of-prefix () " Position cursor at beginning of header text." (if (not (outline-goto-prefix)) nil (let ((match-data (match-data))) (goto-char (match-end 0)) (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-back-to-current-heading () (defun outline-back-to-current-heading () " Move to heading line of current visible topic, or beginning of heading if already on visible heading line." (beginning-of-line) (prog1 (or (outline-on-current-heading-p) (and (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move) (setq outline-recent-prefix-end (match-end 1) outline-recent-prefix-beginning (match-beginning 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) (progn (goto-char (match-beginning 0)) (setq outline-recent-prefix-end (match-end 2) outline-recent-prefix-beginning (match-beginning 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 ((opoint (point)) (level (outline-recent-depth))) (outline-next-heading) (while (and (not (eobp)) (> (outline-recent-depth) level)) (outline-next-heading)) (if (not (eobp)) (forward-char -1)) (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1)))) ;;;_ > outline-beginning-of-current-entry () (defun outline-beginning-of-current-entry () " Position the point at the beginning of the body of the current topic." (interactive) (outline-end-of-prefix)) ;;;_ > outline-beginning-of-current-entry () (defun outline-end-of-current-entry () " Position the point at the end of the current topic's 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 to the heading line of which the present line is a subheading. With argument, move up ARG levels. Don't return an error if second, optional argument DONT-COMPLAIN, is non-nil." (interactive "p") (outline-back-to-current-heading) (let ((present-level (outline-recent-depth))) ;; Loop for iterating arg: (while (and (> (outline-recent-depth) 1) (> arg 0) (not (bobp))) ;; Loop for going back over current or greater depth: (while (and (not (< (outline-recent-depth) present-level)) (outline-previous-visible-heading 1))) (setq present-level (outline-current-depth)) (setq arg (- arg 1))) ) (prog1 (if (<= arg 0) outline-recent-prefix-beginning (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))) ) ;;;_ : Linear ;;;_ > outline-next-visible-heading (arg) (defun outline-next-visible-heading (arg) " Move to the next visible heading line. With argument, repeats, backward if negative." (interactive "p") (if (< arg 0) (beginning-of-line) (end-of-line)) (if (re-search-forward (concat "^\\(" outline-regexp "\\)") nil 'go arg) (progn (outline-end-of-prefix) (setq outline-recent-prefix-end (match-end 1) outline-recent-prefix-beginning (match-beginning 1)))) ) ;;;_ > 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-next-heading (&optional backward) (defun outline-next-heading (&optional backward) " Move to the heading for the topic (possibly invisible) before this one. Optional arg BACKWARD means search for most recent prior heading. Returns the location of the heading, or nil if none found." (if (and backward (bobp)) nil (if backward (outline-goto-prefix) (if (and (bobp) (not (eobp))) (forward-char 1))) (if (if backward ;; searches are unbounded and return nil if failed: (or (re-search-backward outline-line-boundary-regexp nil 0) (looking-at outline-bob-regexp)) (re-search-forward outline-line-boundary-regexp nil 0)) (progn;; Got some valid location state - set vars: (setq outline-recent-prefix-end (or (match-end 2) outline-recent-prefix-end)) (goto-char (setq outline-recent-prefix-beginning (or (match-beginning 2) outline-recent-prefix-beginning)))) ) ) ) ;;;_ > outline-previous-heading () (defun outline-previous-heading () " Move to the next (possibly invisible) heading line. Optional repeat-count arg means go that number of headings. Return the location of the beginning of the heading, or nil if not found." (outline-next-heading t) ) ;;;_ > outline-next-sibling (&optional backward) (defun outline-next-sibling (&optional backward) " Like outline-forward-current-level, but respects invisible topics. Go backward if optional arg BACKWARD is non-nil. Return depth if successful, nil otherwise." (if (and backward (bobp)) nil (let ((start-depth (outline-depth)) (start-point (point)) last-good) (while (and (not (if backward (bobp) (eobp))) (if backward (outline-previous-heading) (outline-next-heading)) (> (outline-recent-depth) start-depth))) (if (and (not (eobp)) (and (> (outline-depth) 0) (= (outline-recent-depth) start-depth))) outline-recent-prefix-beginning (goto-char start-point) nil) ) ) ) ;;;_ > outline-previous-sibling (&optional arg) (defun outline-previous-sibling (&optional arg) " Like outline-forward-current-level, but goes backwards and respects invisible topics. Optional repeat count means go number backward. Note that the beginning of a level is (currently) defined by this implementation to be the first of previous successor topics of equal or greater depth. Return depth if successful, nil otherwise." (outline-next-sibling t) ) ;;;_ > 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." (while (outline-previous-sibling)) (prog1 (outline-recent-depth) (if (interactive-p) (outline-end-of-prefix))) ) ;;;_ > outline-forward-current-level (arg &optional backward) (defun outline-forward-current-level (arg &optional backward) " Position the point at the next heading of the same level, taking optional repeat-count. Returns that position, else nil if is not found." (interactive "p") (outline-back-to-current-heading) (let ((amt (if arg (if (< arg 0) ;; Negative arg - invert direction. (progn (setq backward (not backward)) (abs arg)) arg);; Positive arg - just use it. 1)));; No arg - use 1: (while (and (> amt 0) (outline-next-sibling backward)) (setq amt (1- amt))) (if (interactive-p) (outline-end-of-prefix)) (if (> amt 0) (error "This is the %s topic on level %d." (if backward "first" "last") (outline-current-depth)) t) ) ) ;;;_ > outline-backward-current-level (arg) (defun outline-backward-current-level (arg) " Position the point at the previous heading of the same level, taking optional repeat-count. Returns that position, else nil if is not found." (interactive "p") (unwind-protect (outline-forward-current-level arg t) (outline-end-of-prefix)) ) ;;;_ : Search with Dynamic Exposure (requires isearch-mode) ;;;_ = outline-search-reconceal (defvar outline-search-reconceal nil "Used for outline isearch provisions, to 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 "Variable used by isearch-terminate/outline-provisions and isearch-done/outline-provisions to distinguish between a conclusion and cancellation of a search.") ;;;_ > outline-enwrap-isearch () (defun outline-enwrap-isearch () " Impose isearch-mode wrappers so isearch progressively exposes and reconceals hidden topics when working in outline mode, but works 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 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, registering 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 (and (boundp 'outline-mode) outline-mode) (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, according to reconceal state registration." (if (and (boundp 'outline-mode) outline-mode 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 (boundp 'outline-mode) outline-mode 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 (boundp 'outline-mode) outline-mode outline-enwrap-isearch-mode) (progn (save-excursion (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: (progn (message "(exposing destination)")(sit-for 0) ;; Ensure target topic's siblings are exposed: (outline-ascend-to-depth (1- (outline-current-depth))) ;; Ensure that the target topic's ancestors are exposed (while (outline-hidden-p) (outline-show-current-children)) (outline-show-current-children) (outline-show-current-entry))) (outline-isearch-arrival-business)) (if (not (and (boundp 'outline-search-quitting) outline-search-quitting)) (outline-show-current-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 around isearch which exposes and conceals hidden outline portions encountered in the course of searching." (if (not (and (boundp 'outline-mode) outline-mode 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))) ) ) ;;;_ #5 Manipulation ;;;_ : 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, but offer one suitable for current depth DEPTH as default." (let* ((default-bullet (or current-bullet (outline-bullet-for-depth depth))) (choice (solicit-char-in-string (format "Select bullet: %s ('%s' default): " outline-bullets-string default-bullet) (string-sans-char outline-bullets-string ?\\) 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 it's 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) (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 DEPTH, or for current depth if none specified." ;; 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. " Generate a topic prefix suitable for optional arg DEPTH, or current depth if not specified. 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 require this function counting back the index for each successive sibling)." ;; 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 current-bullet (not (string= outline-numbered-bullet current-bullet))) current-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)))))) ) ) ;;;_ > open-topic (relative-depth &optional before) (defun 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 preceding 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 (not (> relative-depth 0)) ;; not descending, (save-excursion ;; preceded by a blank line? (forward-line -1) (looking-at "^\\s-*$"))) (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: (if before (progn (outline-back-to-current-heading) (setq doing-beginning (bobp)) (if (and (not (outline-previous-sibling)) (not (bobp))) (outline-previous-heading)))) (if (and (<= depth ref-depth) (= ref-depth (outline-current-depth))) ;; Not going inwards, don't snug up: (if doing-beginning (open-line (if dbl-space 2 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) (open-line 1))) (end-of-line)) ;;(if doing-beginning (goto-char doing-beginning)) (if (not (bobp)) (newline (if dbl-space 2 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-subtopic (arg) (defun 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") (open-topic 1 (> 0 arg))) ;;;_ > open-sibtopic (arg) (defun 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") (open-topic 0 (> 0 arg))) ;;;_ > open-supertopic (arg) (defun 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") (open-topic -1 (> 0 arg))) ;;;_ : Outline Alteration ;;;_ . Topic Form Modification ;;;_ > outline-reindent-body (old-depth new-depth) (defun outline-reindent-body (old-depth new-depth) " Reindent body lines which were indented at old-depth to new-depth. Note that refill of indented paragraphs is not done, and tabs are not accommodated. ('untabify' your outline if you want to preserve hanging body indents.)" (save-excursion (save-restriction (outline-goto-prefix) (forward-char 1) (let* ((old-spaces-expr (make-string (1+ old-depth) ?\ )) (new-spaces-expr (concat (make-string (1+ new-depth) ?\ ) ;; spaces followed by non-space: "\\1"))) (while (and (re-search-forward "[\C-j\C-m]" nil t) (not (looking-at outline-regexp))) (if (looking-at old-spaces-expr) (replace-match new-spaces-expr))))))) ;;;_ > outline-rebullet-current-heading (arg) (defun outline-rebullet-current-heading (arg) " Like non-interactive version 'outline-rebullet-heading', but work on (only) 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 ...) (defvar current-bullet nil "Variable local to outline-rebullet-heading,but referenced by outline-make-topic-prefix, also. Should be resolved with explicitly parameterized communication between the two, if suitable.") (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 topic's 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))) ;; Don't need to reinsert identical one: (if (and (= current-depth new-depth) (string= current-bullet (substring new-prefix (1- (length new-prefix))))) t ;; New prefix probably different from old: ;; get rid of old one: (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]+")) (delete-region (match-beginning 0)(match-end 0))) ;; Put in new prefix: (insert-string new-prefix) ) ;; Reindent the body if elected and depth changed: (if (and outline-reindent-bodies (not (= new-depth current-depth))) (outline-reindent-body current-depth new-depth)) ;; Recursively rectify successive siblings if selected: (if do-successors (save-excursion (while (outline-next-sibling) (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 ) ) ;;;_ > 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-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 ((index (if (not denumber) 1)) (use-bullet (equal '(16) denumber)) (more t)) (while more (outline-rebullet-heading use-bullet ;;; solicit nil ;;; depth t ;;; number-control index ;;; index nil) ;;; do-successors (if index (setq index (1+ index))) (setq more (outline-next-sibling))) ) ) ) ;;;_ > outline-shift-in (arg) (defun outline-shift-in (arg) " Decrease prefix 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 prefix 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 (boundp 'outline-mode) outline-mode ; 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)) (ascender depth)) (kill-line arg) (sit-for 0) (save-excursion (if (not (looking-at outline-regexp)) (outline-next-heading)) (if (> (outline-depth) depth) ;; An intervening parent was removed from after a subtree: (setq depth (outline-recent-depth))) (while (and (> (outline-depth) 0) (> (outline-recent-depth) ascender) (outline-ascend-to-depth (setq ascender (1- ascender))))) ;; Have to try going forward until we find another at ;; desired depth: (if (and outline-numbered-bullet (outline-descend-to-depth depth)) (outline-rebullet-heading nil ;;; solicit depth ;;; depth nil ;;; number-control nil ;;; index t) ;;; do-successors ) ) ) ) ) ;;;_ > outline-kill-topic () (defun outline-kill-topic () " Kill topic together with subtopics." ;; 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 (outline-back-to-current-heading)) (depth (outline-recent-depth))) (outline-end-of-current-subtree) (if (not (eobp)) (forward-char 1)) (kill-region beg (point)) (sit-for 0) (save-excursion (if (and outline-numbered-bullet (outline-descend-to-depth depth)) (outline-rebullet-heading nil ;;; solicit depth ;;; depth nil ;;; number-control nil ;;; index t) ;;; do-successors ) ) ) ) ;;;_ > outline-yank (&optional arg) (defun outline-yank (&optional arg) " Like regular yank, except 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. If these two 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 from 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. Outline-yank-pop is used with outline-yank just as normal yank-pop is used with normal yank in non-outline buffers." (interactive "*P") (setq this-command 'yank) (if (not (and (boundp 'outline-mode) outline-mode)) ;; Outline irrelevant - just do regular yank: (yank arg) ;; Outline *is* relevant: (let ((beginning (point)) topic-yanked established-depth) ; Depth of the prefix into which we're yanking. ;; Get current depth and numbering ... Oops, not doing anything ;; with the number just yet... (if (and (eolp) (save-excursion (beginning-of-line) (looking-at outline-regexp))) (setq established-depth (- (match-end 0) (match-beginning 0)))) (yank arg) (exchange-dot-and-mark) (if (and established-depth ; the established stuff qualifies. ;; The yanked stuff also qualifies - is topic(s): (looking-at (concat "\\(" outline-regexp "\\)"))) ;; Ok, adjust the depth of the yanked stuff. Note that the ;; stuff may have more than a single root, so we have to ;; iterate over all the top level ones yanked, and do them in ;; such a way that the adjustment of one new one won't affect ;; any of the other new ones. We use the focus of the ;; narrowed region to successively exclude processed siblings. (let* ((yanked-beg (match-beginning 1)) (yanked-end (match-end 1)) (yanked-bullet (buffer-substring (1- yanked-end) yanked-end)) (yanked-depth (- yanked-end yanked-beg)) (depth-diff (- established-depth yanked-depth)) done (more t)) (setq topic-yanked t) (save-excursion (save-restriction (narrow-to-region yanked-beg (mark)) ;; First trim off excessive blank line at end, if any: (goto-char (point-max)) (if (looking-at "^$") (delete-char -1)) (goto-char (point-min)) ;; Work backwards, with each shallowest level, ;; successively excluding the last processed topic ;; from the narrow region: (goto-char (point-max)) (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 depth-diff (outline-depth) (point))) (if (setq more (not (bobp))) (progn (widen) (forward-char -1) (narrow-to-region yanked-beg (point))))))) ;; Preserve new bullet if it's a distinctive one, otherwise ;; use old one: (if (string-match yanked-bullet outline-distinctive-bullets-string) (delete-region (save-excursion (beginning-of-line) (point)) yanked-beg) (delete-region yanked-beg (+ yanked-beg established-depth)) ;; and extraneous digits and a space: (while (looking-at "[0-9]") (delete-char 1)) (if (looking-at " ") (delete-char 1)) ) (goto-char yanked-beg) ) ;; Not established-depth or looking-at... (setq topic-yanked (looking-at outline-regexp)) (exchange-dot-and-mark)) (if (and topic-yanked outline-numbered-bullet) (progn ;; Renumber, in case necessary: (sit-for 0) (save-excursion (goto-char beginning) (if (outline-goto-prefix) (outline-rebullet-heading nil ;;; solicit (outline-depth) ;;; depth nil ;;; number-control nil ;;; index t) ;;; do-successors ) ) ) ) ) ) ) ;;;_ > outline-yank-pop (&optional arg) (defun outline-yank-pop (&optional arg) " Just like yank-pop, but works like outline-yank when popping topics just after fresh outline prefixes. Adapts level of popped stuff to level of fresh prefix." (interactive "*p") (if (not (eq last-command 'yank)) (error "Previous command was not a yank")) (setq this-command 'yank) (delete-region (point) (mark)) (rotate-yank-pointer arg) (outline-yank) ) ;;;_ : 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 (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)) ) ) ) ) ;;;_ > outline-to-entry-end - Unmaintained compatibility - ignore this! ;------------------------------------------------------------------- ; Something added solely for use by a "smart menu" package someone got ; off the net. I have no idea whether this is appropriate code. (defvar next-entry-exists nil "Used by outline-to-entry-end, dunno why.") (defun outline-to-entry-end (&optional include-sub-entries curr-entry-level) " Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil. CURR-ENTRY-LEVEL is an integer representing the length of the current level string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil, CURR-ENTRY-LEVEL is not needed." (while (and (setq next-entry-exists (re-search-forward outline-regexp nil t)) include-sub-entries (save-excursion (beginning-of-line) (> (outline-depth) curr-entry-level)))) (if next-entry-exists (progn (beginning-of-line) (point)) (goto-char (point-max)))) ;;; Outline topic prefix and level adjustment funcs: ;;;_ #6 miscellaneous ;;;_ > outline-copy-exposed (&optional workbuf) (defun outline-copy-exposed (&optional workbuf) " Duplicate buffer to other buffer, sans hidden stuff. Without repeat count, this simple-minded function just generates the new buffer by concatenating the current buffer name with \" exposed\", and doing a 'get-buffer' on it." (interactive) (if (not workbuf) (setq workbuf (concat (buffer-name) " exposed"))) (let ((buf (current-buffer))) (if (not (get-buffer workbuf)) (generate-new-buffer workbuf)) (pop-to-buffer workbuf) (erase-buffer) (insert-buffer buf) (replace-regexp "\^M[^\^M\^J]*" "") (goto-char (point-min)) ) ) ;;;_ > outlinify-sticky () (defun outlinify-sticky (&optional arg) " Activate outline mode and establish file eval to set initial exposure. Invoke with a string argument to designate a string to prepend to topic prefixs, or with a universal argument to be prompted for the string to be used. Suitable defaults are provided for lisp, emacs-lisp, c, c++, awk, sh, csh, and perl modes." (interactive "P") (outline-mode t) (cond (arg (if (stringp arg) ;; Use arg as the header-prefix: (outline-lead-with-comment-string arg) ;; Otherwise, let function solicit string: (setq arg (outline-lead-with-comment-string)))) ((member major-mode '(emacs-lisp-mode lisp-mode)) (setq arg (outline-lead-with-comment-string ";;;_"))) ((member major-mode '(awk-mode csh-mode sh-mode perl-mode)) ;; Bare '#' (ie, not '#_') so we don't break the magic number: (setq arg (outline-lead-with-comment-string "#"))) ((eq major-mode 'c++-mode) (setq arg (outline-lead-with-comment-string "//_"))) ((eq major-mode 'c-mode) ;; User's will have to know to close off the comments: (setq arg (outline-lead-with-comment-string "/*_")))) (let* ((lead-prefix (format "%s%s" (concat outline-header-prefix (if arg " " "")) outline-primary-bullet)) (lead-line (format "%s%s %s\n%s %s\n %s %s %s" (if arg outline-header-prefix "") outline-primary-bullet "Local emacs vars." "'(This topic sets initial outline exposure" "of the file when loaded by emacs," "Encapsulate it in comments if" "file is a program" "otherwise ignore it,"))) (save-excursion ; Put a topic at the top, if ; none there already: (goto-char (point-min)) (if (not (looking-at outline-regexp)) (insert-string (if (not arg) outline-primary-bullet (format "%s%s\n" outline-header-prefix outline-primary-bullet)))) ; File-vars stuff, at the bottom: (goto-char (point-max)) ; Insert preamble: (insert-string (format "\n\n%s\n%s %s %s\n%s %s " lead-line lead-prefix "local" "variables:" lead-prefix "eval:")) ; Insert outline-mode activation: (insert-string (format "%s\n\t\t%s\n\t\t\t%s\n" "(condition-case err" "(save-excursion" "(outline-mode t)")) ; Conditionally insert prefix ; leader customization: (if arg (insert-string (format "\t\t\t(%s \"%s\")\n" "outline-lead-with-comment-string" arg))) ; Insert announcement and ; exposure control: (insert-string (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s" "(message \"Adjusting '%s' visibility\"" "(buffer-name))" "(goto-char 0)" "(outline-exposure -1 0))" "(error (message " "\"Failed file var 'allout' provisions\")))")) ; Insert postamble: (insert-string (format "\n%s End: )\n" lead-prefix))))) ;;;_ > 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 t)) (read-char)))) (if (null (string-match 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) ) ;;;_ > string-sans-char (string char) (defun string-sans-char (string char) " Return a copy of STRING that lacks all instances of CHAR." (cond ((string= string "") "") ((= (aref string 0) char) (string-sans-char (substring string 1) char)) ((concat (substring string 0 1) (string-sans-char (substring string 1) char))))) ;;;_* Local emacs vars. '( Local variables: eval: (save-excursion (if (not (condition-case err (outline-mode t) (wrong-number-of-arguments nil))) (progn (message "Allout outline-mode not loaded, not adjusting buffer exposure") (sit-for 1)) (message "Adjusting '%s' visibility" (buffer-name)) (outline-lead-with-comment-string ";;;_") (goto-char 0) (outline-exposure (-1 () () () 1) 0))) End: ) emacs-19.22/lisp/ange-ftp.el100444 12120 1 620153 5475053023 14145 0ustar rmsdaemon;;; ange-ftp.el --- transparent FTP support for GNU Emacs ;;; Copyright (C) 1989, 1990, 1991, 1992, 1993 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 ;;; a password is created from the name of the user and the hostname ;;; of the machine on which GNU Emacs is running; 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. ;;; 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-process can be used to 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 messages from the ftp process that start a multiline reply.") (defvar ange-ftp-good-msgs "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark" "*Regular expression matching messages from the ftp process that indicate that the action that was initiated has completed successfully.") ;; 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:\\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye") "*Regular expression matching messages from the ftp process 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 messages from the FTP process that indicate something has gone drastically wrong attempting the action that was initiated and 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 messages from the rlogin / telnet process that indicates that logging in to the gateway machine has gone wrong.") (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 a password of user@host when logging in as the anonymous user. If a string then use that as the password. If nil then prompt the user for a password.") (defvar ange-ftp-dumb-unix-host-regexp nil "*If non-nil, if the host being ftp'd to matches this regexp then the FTP process uses the \'dir\' command to get directory information.") (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 ".*" "*If a host being FTP'd to matches this regexp then the ftp process is started locally, otherwise the FTP process is started on \`ange-ftp-gateway-host\' instead.") (defvar ange-ftp-gateway-program-interactive nil "*If non-nil then the gateway program is expected to connect to the gateway machine and eventually give a shell prompt. Both telnet and rlogin do something like this.") (defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh") "*Name of program to spawn a shell on the gateway machine. Valid candidates are rsh (remsh on hp-ux), telnet and rlogin. See also the gateway variable above.") (defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *" "*Regexp used to detect that the logging-in sequence is completed on the gateway machine and that 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") "*Command to use after logging in to the gateway machine to stop the terminal echoing each command and to strip out trailing ^M characters.") (defvar ange-ftp-smart-gateway nil "*If the gateway FTP is smart enough to use proxy server, then don't bother telnetting etc, just issue a user@host command instead.") (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 on gateway machine. 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 retrying if a 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. ;;;; ------------------------------------------------------------ (defconst ange-ftp-version "$Revision: 1.37 $") (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") ;;; ------------------------------------------------------------ ;;; Match-data support (stolen from Kyle I think) ;;; ------------------------------------------------------------ (defmacro ange-ftp-save-match-data (&rest body) "Execute the BODY forms, restoring the global value of the match data. Also makes matching case-sensitive within BODY." (let ((original (make-symbol "match-data")) case-fold-search) (list 'let (list (list original '(match-data))) (list 'unwind-protect (cons 'progn body) (list 'store-match-data original))))) (put 'ange-ftp-save-match-data 'lisp-indent-hook 0) (put 'ange-ftp-save-match-data 'edebug-form-hook '(&rest form)) ;;; ------------------------------------------------------------ ;;; 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 (>= (length msg) max) (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." (ange-ftp-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) (ange-ftp-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 (concat (user-login-name) "@" (system-name)))) ;; 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) (defun ange-ftp-parse-netrc-token (token limit) "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." (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)))))) (defun ange-ftp-parse-netrc-group () "Extract the values for the tokens \`machine\', \`login\', \`password\' and \`account\' in the current buffer. If successful, record the information found." (beginning-of-line) (let ((start (point)) (end (progn (re-search-forward "machine\\|default" (point-max) 'end 2) (point))) machine login password account) (goto-char start) (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))) (defun ange-ftp-parse-netrc () "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." ;; 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 (ange-ftp-chase-symlinks (ange-ftp-real-expand-file-name ange-ftp-netrc-filename))) (attr (ange-ftp-real-file-attributes file))) (if (and attr ; file exists. (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed (ange-ftp-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)) (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)))))) (defun ange-ftp-generate-root-prefixes () "Return a list of prefixes of the form 'user@host:' to be used when completion is done in the root directory." (ange-ftp-parse-netrc) (ange-ftp-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) (defun ange-ftp-ftp-name (name) "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." (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 (ange-ftp-save-match-data (if (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))))) (defun ange-ftp-replace-name-component (fullname name) "Take a FULLNAME that matches according to ange-ftp-name-format and replace the name component with NAME." (ange-ftp-save-match-data (if (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)) (defun ange-ftp-ftp-process-buffer (host user) "Return the name of the buffer that collects output from the ftp process connected to the given HOST and USER pair." (concat "*ftp " user "@" host "*")) (defun ange-ftp-error (host user msg) "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." (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)) (progn (make-local-variable 'make-backup-files) (setq make-backup-files ange-ftp-make-backup-files) (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)) ((string-match ange-ftp-fatal-msgs line) (delete-process proc) (setq ange-ftp-process-busy nil ange-ftp-process-result-line line)) ((string-match ange-ftp-multi-msgs line) (setq ange-ftp-process-multi-skip t)) (ange-ftp-process-multi-skip t) (t (setq ange-ftp-process-busy nil ange-ftp-process-result-line line)))) (defun ange-ftp-process-log-string (proc str) "For a given PROCESS, log the given STRING at the end of its associated buffer." (let ((old-buffer (current-buffer))) (unwind-protect (let (moving) (set-buffer (process-buffer proc)) (setq moving (= (point) (process-mark proc))) (save-excursion ;; Insert the text, moving the process-marker. (goto-char (process-mark proc)) (insert str) (set-marker (process-mark proc) (point))) (if moving (goto-char (process-mark proc)))) (set-buffer old-buffer)))) (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-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) (defun ange-ftp-call-cont (cont result line) "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." (if cont (if (and (listp cont) (not (eq (car cont) 'lambda))) (apply (car cont) result line (cdr cont)) (funcall cont result line)))) (defun ange-ftp-process-filter (proc str) "Build up a complete line of output from the ftp PROCESS and pass it on to ange-ftp-process-handle-line to deal with." (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 (ange-ftp-save-match-data (set-buffer (process-buffer proc)) ;; handle hash mark printing (and ange-ftp-hash-mark-unit ange-ftp-process-busy (string-match "^#+$" str) (setq str (ange-ftp-process-handle-hash str))) (ange-ftp-process-log-string proc str) (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." (ange-ftp-save-match-data (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) (ange-ftp-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 (ange-ftp-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) (ange-ftp-save-match-data (ange-ftp-process-log-string proc str) (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)) (proc (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)) (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. (ange-ftp-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 ((proc (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)) (ftp-prog (if use-gateway ange-ftp-gateway-ftp-program-name ange-ftp-ftp-program-name)) (args (append (list ftp-prog) ange-ftp-ftp-program-args)) proc) (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 () (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 ""))) (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 ((result (ange-ftp-raw-send-cmd proc (format "open %s" (ange-ftp-nslookup-host host)) (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 (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))))))) (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))) (ange-ftp-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 the process object for a FTP process 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 (ange-ftp-use-smart-gateway-p 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 "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 "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 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. (ange-ftp-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. ;;;; ------------------------------------------------------------ (defun ange-ftp-dumb-unix-host (host) "Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands to take switch arguments." (and ange-ftp-dumb-unix-host-regexp (ange-ftp-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 "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 "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 "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 shouldn't be anchored with a trailing $ so that it will 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))) (defun ange-ftp-parse-dired-listing (&optional switches) "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." (ange-ftp-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) (ange-ftp-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))))) (defmacro ange-ftp-get-file-part (name) "Given NAME, return the file part that can be used for looking up the file's entry in a hashtable." (` (let ((file (file-name-nondirectory (, name)))) (if (string-equal file "") "." file)))) (defmacro ange-ftp-allow-child-lookup (dir 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." (` (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) "Replace the file entry information hashtable with one that doesn't have any entries for the given HOST, USER pair." (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))) (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))) (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) (ange-ftp-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 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"))))) (setq name (ange-ftp-real-expand-file-name name)) ;; see if hit real expand-file-name bug... this will probably annoy ;; some Apollo people. I'll wait until they shout, however. (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." (ange-ftp-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, where 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 (ange-ftp-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 (ange-ftp-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) (ange-ftp-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 (ange-ftp-binary-file filename)) (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 (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) (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 (ange-ftp-binary-file filename)) (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))) (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 (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)))) (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)) (ange-ftp-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))) 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 binary) "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)) (binary (if (or f-parsed t-parsed) (ange-ftp-binary-file filename)))) (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 binary) (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 "\\|"))) (ange-ftp-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))) (bin1 (ange-ftp-binary-file fn1))) (ange-ftp-copy-file-internal fn1 tmp1 t nil (format "Getting %s" fn1)) tmp1)))) (defun ange-ftp-load (file &rest args) (if (ange-ftp-ftp-name file) (let ((copy (ange-ftp-file-local-copy file))) (unwind-protect (apply 'load copy args) (delete-file copy))) (apply 'ange-ftp-real-load file args))) ;; 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 (ange-ftp-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)))) ;;; 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) (let (file-name-handler-alist) (apply operation args))))) ;;; This regexp takes care of real ange-ftp file names (with a slash ;;; and colon). ;;;###autoload (or (assoc "^/[^/:]*[^/:]:" file-name-handler-alist) (setq file-name-handler-alist (cons '("^/[^/:]*[^/:]:" . ange-ftp-hook-function) file-name-handler-alist))) ;;; This regexp recognizes and absolute filenames with only one component, ;;; for the sake of hostname completion. ;;;###autoload (or (assoc "^/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function) file-name-handler-alist))) ;;; 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) ;; 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-real-file-name-directory (&rest args) (let (file-name-handler-alist) (apply 'file-name-directory args))) (defun ange-ftp-real-file-name-nondirectory (&rest args) (let (file-name-handler-alist) (apply 'file-name-nondirectory args))) (defun ange-ftp-real-file-name-as-directory (&rest args) (let (file-name-handler-alist) (apply 'file-name-as-directory args))) (defun ange-ftp-real-directory-file-name (&rest args) (let (file-name-handler-alist) (apply 'directory-file-name args))) (defun ange-ftp-real-expand-file-name (&rest args) (let (file-name-handler-alist) (apply 'expand-file-name args))) (defun ange-ftp-real-make-directory (&rest args) (let (file-name-handler-alist) (apply 'make-directory args))) (defun ange-ftp-real-delete-directory (&rest args) (let (file-name-handler-alist) (apply 'delete-directory args))) (defun ange-ftp-real-insert-file-contents (&rest args) (let (file-name-handler-alist) (apply 'insert-file-contents args))) (defun ange-ftp-real-directory-files (&rest args) (let (file-name-handler-alist) (apply 'directory-files args))) (defun ange-ftp-real-file-directory-p (&rest args) (let (file-name-handler-alist) (apply 'file-directory-p args))) (defun ange-ftp-real-file-writable-p (&rest args) (let (file-name-handler-alist) (apply 'file-writable-p args))) (defun ange-ftp-real-file-readable-p (&rest args) (let (file-name-handler-alist) (apply 'file-readable-p args))) (defun ange-ftp-real-file-executable-p (&rest args) (let (file-name-handler-alist) (apply 'file-executable-p args))) (defun ange-ftp-real-file-symlink-p (&rest args) (let (file-name-handler-alist) (apply 'file-symlink-p args))) (defun ange-ftp-real-delete-file (&rest args) (let (file-name-handler-alist) (apply 'delete-file args))) (defun ange-ftp-real-read-file-name-internal (&rest args) (let (file-name-handler-alist) (apply 'read-file-name-internal args))) (defun ange-ftp-real-verify-visited-file-modtime (&rest args) (let (file-name-handler-alist) (apply 'verify-visited-file-modtime args))) (defun ange-ftp-real-file-exists-p (&rest args) (let (file-name-handler-alist) (apply 'file-exists-p args))) (defun ange-ftp-real-write-region (&rest args) (let (file-name-handler-alist) (apply 'write-region args))) (defun ange-ftp-real-backup-buffer (&rest args) (let (file-name-handler-alist) (apply 'backup-buffer args))) (defun ange-ftp-real-copy-file (&rest args) (let (file-name-handler-alist) (apply 'copy-file args))) (defun ange-ftp-real-rename-file (&rest args) (let (file-name-handler-alist) (apply 'rename-file args))) (defun ange-ftp-real-file-attributes (&rest args) (let (file-name-handler-alist) (apply 'file-attributes args))) (defun ange-ftp-real-file-name-all-completions (&rest args) (let (file-name-handler-alist) (apply 'file-name-all-completions args))) (defun ange-ftp-real-file-name-completion (&rest args) (let (file-name-handler-alist) (apply 'file-name-completion args))) (defun ange-ftp-real-insert-directory (&rest args) (let (file-name-handler-alist) (apply 'insert-directory args))) (defun ange-ftp-real-file-name-sans-versions (&rest args) (let (file-name-handler-alist) (apply 'file-name-sans-versions args))) (defun ange-ftp-real-shell-command (&rest args) (let (file-name-handler-alist) (apply 'shell-command args))) (defun ange-ftp-real-load (&rest args) (let (file-name-handler-alist) (apply 'load 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 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)))) (defvar ange-ftp-remote-shell-file-name (if (memq system-type '(hpux usg-unix-v)) ; hope that's right "remsh" "rsh") "Name of command to run a remote shell, for ange-ftp.") ;;; 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 ange-ftp-remote-shell-file-name 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 ; (ange-ftp-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)) ; (ange-ftp-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) (ange-ftp-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 (ange-ftp-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)) (ange-ftp-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) (ange-ftp-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))) (ange-ftp-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) (ange-ftp-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) (ange-ftp-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) (ange-ftp-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 (ange-ftp-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)) (ange-ftp-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) (ange-ftp-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 (ange-ftp-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)) (ange-ftp-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.22/lisp/appt.el100444 12120 1 44017 5472044401 13364 0ustar rmsdaemon;;; appt.el --- appointment notification functions. ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. ;; Author: Neil Mager ;; Version: 2.1 ;; 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) ;;; (autoload 'appt-make-list "appt.el" nil t) ;;; (setq diary-display-hook ;;; (list 'appt-make-list 'prepare-fancy-diary-buffer)) ;;; ;;; ;;; 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. ;;; ;;; Code: ;;;###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 10 "*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 5 "*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 1 "*Number of minutes to wait between checking the appointment list.") (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. 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))) ;; If the time is 12:01am, we should update our ;; appointments to todays list. (if (= cur-comp-time 1) (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))) (appt-disp-window min-to-app new-time (car (cdr (car appt-time-msg-list))))) ;;; 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 updates - from time.el (save-excursion (set-buffer (other-buffer))) (set-buffer-modified-p (buffer-modified-p)) (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) (save-window-excursion ;; Make sure we're not in the minibuffer ;; before splitting the window. (if (= (frame-height) (nth 3 (window-edges (selected-window)))) nil (appt-select-lowest-window) (split-window)) (let* ((this-buffer (current-buffer)) (appt-disp-buf (set-buffer (get-buffer-create "appt-buf")))) (setq mode-line-format (concat "-------------------- Appointment in " min-to-app " minutes. " new-time " %-")) (pop-to-buffer appt-disp-buf) (insert-string appt-msg) (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf)) (set-buffer-modified-p nil) (if appt-audible (beep 1)) (sit-for appt-display-duration) (if appt-audible (beep 1)) (kill-buffer appt-disp-buf)))) ;; Select the lowest window on the frame. (defun appt-select-lowest-window () (setq lowest-window (selected-window)) (let* ((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))) (setq tmp-appt-msg-list nil))) (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" ;;;###autoload (defun appt-make-list () (setq appt-time-msg-list nil) (save-excursion (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 "")) (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)) (setq display-time-hook 'appt-check) ;;; appt.el ends here emacs-19.22/lisp/apropos.el100444 12120 1 32271 5404766042 14111 0ustar rmsdaemon;;; apropos.el --- faster apropos commands. ;; Copyright (C) 1989 Free Software Foundation, Inc. ;; Author: Joe Wells ;; 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. ;;; Code: (defvar apropos-do-all nil "*Whether `apropos' and `super-apropos' should do everything that they can. Makes them run 2 or 3 times slower. Set this non-nil if you have a fast machine.") ;; If there isn't already a lisp variable named internal-doc-file-name, create ;; it and document it. This is so the code will work right after RMS adds ;; internal-doc-file-name. ;(or (boundp 'internal-doc-file-name) ; (setq internal-doc-file-name (concat data-directory "DOC"))) ;(or (documentation-property 'internal-doc-file-name 'variable-documentation) ; (put 'internal-doc-file-name 'variable-documentation ; "The complete pathname of the documentation file that contains all ;documentation for functions and variables defined before Emacs is dumped.")) ;;;###autoload (defun apropos (regexp &optional do-all pred) "Show all symbols whose names contain matches for REGEXP. If optional argument DO-ALL is non-nil, does more (time-consuming) work such as showing key bindings. Optional argument PRED is called with each symbol, and if it returns nil, the symbol is not shown. Returns list of symbols and documentation found." (interactive "sApropos (regexp): \nP") (setq do-all (or apropos-do-all do-all)) (let ((apropos-accumulate (apropos-internal regexp pred))) (if (null apropos-accumulate) (message "No apropos matches for `%s'" regexp) (apropos-get-doc apropos-accumulate) (with-output-to-temp-buffer "*Help*" (apropos-print-matches apropos-accumulate regexp nil do-all))) apropos-accumulate)) ;; If "C-h a" still has its original binding of command-apropos, change it to ;; use fast-command-apropos. I don't use substitute-key-definition because ;; it's slow. ;(if (eq 'command-apropos (lookup-key help-map "a")) ; (define-key help-map "a" 'fast-command-apropos)) ;; Takes LIST of symbols and adds documentation. Modifies LIST in place. ;; Resulting alist is of form ((symbol fn-doc var-doc) ...). Should only be ;; called by apropos. Returns LIST. (defun apropos-get-doc (list) (let ((p list) fn-doc var-doc symbol) (while (consp p) (setq symbol (car p) fn-doc (and (fboundp symbol) (documentation symbol)) var-doc (documentation-property symbol 'variable-documentation) fn-doc (and fn-doc (substring fn-doc 0 (string-match "\n" fn-doc))) var-doc (and var-doc (substring var-doc 0 (string-match "\n" var-doc)))) (setcar p (list symbol fn-doc var-doc)) (setq p (cdr p))) list)) ;;;###autoload (defun super-apropos (regexp &optional do-all) "Show symbols whose names/documentation contain matches for REGEXP. If optional argument DO-ALL is non-nil, does more (time-consuming) work such as showing key bindings and documentation that is not stored in the documentation file. Returns list of symbols and documentation found." (interactive "sSuper Apropos: \nP") (setq do-all (or apropos-do-all do-all)) (let (apropos-accumulate fn-doc var-doc item) (setq apropos-accumulate (super-apropos-check-doc-file regexp)) (if (null apropos-accumulate) (message "No apropos matches for `%s'" regexp) (if do-all (mapatoms 'super-apropos-accumulate)) (with-output-to-temp-buffer "*Help*" (apropos-print-matches apropos-accumulate nil t do-all))) apropos-accumulate)) ;; Finds all documentation related to REGEXP in internal-doc-file-name. ;; Returns an alist of form ((symbol fn-doc var-doc) ...). (defun super-apropos-check-doc-file (regexp) (let* ((doc-file (concat data-directory internal-doc-file-name)) (doc-buffer (find-file-noselect doc-file t)) ;; (doc-buffer (or (get-file-buffer doc-file) ;; (find-file-noselect doc-file))) type symbol doc sym-list) (save-excursion (set-buffer doc-buffer) ;; a user said he might accidentally edit the doc file (setq buffer-read-only t) (bury-buffer doc-buffer) (goto-char (point-min)) (while (re-search-forward regexp nil t) (search-backward "\C-_") (setq type (if (eq ?F (char-after (1+ (point)))) 1 ;function documentation 2) ;variable documentation symbol (progn (forward-char 2) (read doc-buffer)) doc (buffer-substring (point) (progn (if (search-forward "\C-_" nil 'move) (1- (point)) (point)))) item (assq symbol sym-list)) (or item (setq item (list symbol nil nil) sym-list (cons item sym-list))) (setcar (nthcdr type item) doc))) sym-list)) ;; This is passed as the argument to map-atoms, so it is called once for every ;; symbol in obarray. Takes one argument SYMBOL, and finds any memory-resident ;; documentation on that symbol if it matches a variable regexp. WARNING: this ;; function depends on the symbols fn-doc var-doc regexp and item being bound ;; correctly when it is called!" (defun super-apropos-accumulate (symbol) (cond ((string-match regexp (symbol-name symbol)) (setq item (apropos-get-accum-item symbol)) (setcar (cdr item) (or (safe-documentation symbol) (nth 1 item))) (setcar (nthcdr 2 item) (or (safe-documentation-property symbol) (nth 2 item)))) (t (and (setq fn-doc (safe-documentation symbol)) (string-match regexp fn-doc) (setcar (cdr (apropos-get-accum-item symbol)) fn-doc)) (and (setq var-doc (safe-documentation-property symbol)) (string-match regexp var-doc) (setcar (nthcdr 2 (apropos-get-accum-item symbol)) var-doc)))) nil) ;; Prints the symbols and documentation in alist MATCHES of form ((symbol ;; fn-doc var-doc) ...). Uses optional argument REGEXP to speed up searching ;; for keybindings. The names of all symbols in MATCHES must match REGEXP. ;; Displays in the buffer pointed to by standard-output. Optional argument ;; SPACING means put blank lines in between each symbol's documentation. ;; Optional argument DO-ALL means do more time-consuming work, specifically, ;; consulting key bindings. Should only be called within a ;; with-output-to-temp-buffer. (defun apropos-print-matches (matches &optional regexp spacing do-all) (setq matches (sort matches (function (lambda (a b) (string-lessp (car a) (car b)))))) (let ((p matches) (old-buffer (current-buffer)) item keys-done symbol tem) (save-excursion (set-buffer standard-output) (or matches (princ "No matches found.")) (while (consp p) (setq item (car p) symbol (car item) p (cdr p)) (or (not spacing) (bobp) (terpri)) (princ symbol) ;print symbol name ;; don't calculate key-bindings unless needed (cond ((and do-all (commandp symbol) (not keys-done)) (save-excursion (set-buffer old-buffer) (apropos-match-keys matches regexp)) (setq keys-done t))) (cond ((and do-all (or (setq tem (nthcdr 3 item)) (commandp symbol))) (indent-to 30 1) (if tem (princ (mapconcat 'key-description tem ", ")) (princ "(not bound to any keys)")))) (terpri) (cond ((setq tem (nth 1 item)) (princ " Function: ") (princ (if do-all (substitute-command-keys tem) tem)))) (or (bolp) (terpri)) (cond ((setq tem (nth 2 item)) (princ " Variable: ") (princ (if do-all (substitute-command-keys tem) tem)))) (or (bolp) (terpri))))) t) ;; Find key bindings for symbols that are cars in ALIST. Optionally, first ;; match the symbol name against REGEXP. Modifies ALIST in place. Each key ;; binding is added as a string to the end of the list in ALIST whose car is ;; the corresponding symbol. The pointer to ALIST is returned. (defun apropos-match-keys (alist &optional regexp) (let* ((current-local-map (current-local-map)) (maps (append (and current-local-map (accessible-keymaps current-local-map)) (accessible-keymaps (current-global-map)))) map ;map we are now inspecting sequence ;key sequence to reach map i ;index into vector map command ;what is bound to current keys key ;last key to reach command local ;local binding for sequence + key item) ;symbol data item in alist ;; examine all reachable keymaps (while (consp maps) (setq map (cdr (car maps)) sequence (car (car maps)) ;keys to reach this map maps (cdr maps)) ;; Skip the leading `keymap', doc string, etc. (if (eq (car map) 'keymap) (setq map (cdr map))) (while (stringp (car-safe map)) (setq map (cdr map))) (while (consp map) (cond ((consp (car map)) (setq command (cdr (car map)) key (car (car map))) ;; Skip any menu prompt in this key binding. (and (consp command) (symbolp (cdr command)) (setq command (cdr command))) ;; if is a symbol, and matches optional regexp, and is a car ;; in alist, and is not shadowed by a different local binding, ;; record it (and (symbolp command) (if regexp (string-match regexp (symbol-name command))) (setq item (assq command alist)) (if (or (vectorp sequence) (not (integerp key))) (setq key (vconcat sequence (vector key))) (setq key (concat sequence (char-to-string key)))) ;; checking if shadowed by local binding. ;; either no local map, no local binding, or runs off the ;; binding tree (number), or is the same binding (or (not current-local-map) (not (setq local (lookup-key current-local-map key))) (numberp local) (eq command local)) ;; add this key binding to the item in alist (nconc item (cons key nil)))) ((vectorp (car map)) (let ((i 0) (vec (car map)) (len (length (car map)))) (while (< i len) (setq command (aref vec i)) (setq key i) ;; Skip any menu prompt in this key binding. (and (consp command) (symbolp (cdr command)) (setq command (cdr command))) ;; This is the same as the code in the previous case. (and (symbolp command) (if regexp (string-match regexp (symbol-name command))) (setq item (assq command alist)) (if (or (vectorp sequence) (not (integerp key))) (setq key (vconcat sequence (vector key))) (setq key (concat sequence (char-to-string key)))) ;; checking if shadowed by local binding. ;; either no local map, no local binding, or runs off the ;; binding tree (number), or is the same binding (or (not current-local-map) (not (setq local (lookup-key current-local-map key))) (numberp local) (eq command local)) ;; add this key binding to the item in alist (nconc item (cons key nil))) (setq i (1+ i)))))) (setq map (cdr map))))) alist) ;; Get an alist item in alist apropos-accumulate whose car is SYMBOL. Creates ;; the item if not already present. Modifies apropos-accumulate in place. (defun apropos-get-accum-item (symbol) (or (assq symbol apropos-accumulate) (progn (setq apropos-accumulate (cons (list symbol nil nil) apropos-accumulate)) (assq symbol apropos-accumulate)))) (defun safe-documentation (function) "Like documentation, except it avoids calling `get_doc_string'. Will return nil instead." (while (symbolp function) (setq function (if (fboundp function) (symbol-function function) 0))) (if (eq (car-safe function) 'macro) (setq function (cdr function))) (if (not (consp function)) nil (if (not (memq (car function) '(lambda autoload))) nil (setq function (nth 2 function)) (if (stringp function) function nil)))) (defun safe-documentation-property (symbol) "Like documentation-property, except it avoids calling `get_doc_string'. Will return nil instead." (setq symbol (get symbol 'variable-documentation)) (if (numberp symbol) nil symbol)) ;;; apropos.el ends here emacs-19.22/lisp/array.el100444 74720 14 103236 5431620040 14151 0ustar eggertguest;;; 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") ;; Update mode-line. (progn (save-excursion (set-buffer (other-buffer))) (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)) (make-variable-buffer-local 'truncate-lines) (setq truncate-lines t) (setq overwrite-mode t) (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.22/lisp/asm-mode.el100444 12120 1 15701 5372042014 14115 0ustar rmsdaemon;;; asm-mode.el --- mode for editing assembler code ;; Copyright (C) 1991 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Last-Modified: 14 Jul 1992 ;; Keywords: tools, languages ;; @(#)asm-mode.el 1.7 ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; 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 ;; ; place or move comment ;; C-j, C-m newline and tab to tab stop ;; ;; Code is indented to the first tab stop level. ;; The ; key inserts copies of the value of asm-comment-char at an ;; appropriate spot. ;; This mode runs two hooks: ;; 1) An asm-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)) (define-key asm-mode-map ";" 'asm-comment) (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) ) (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-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) (use-local-map asm-mode-map) (setq mode-name "Assembler") (setq major-mode 'asm-mode) (setq local-abbrev-table asm-mode-abbrev-table) (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) (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) (auto-fill-mode 1) (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]+$" 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.22/lisp/assoc.el100444 13437 1 11544 5421163035 13662 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.22/lisp/autoinsert.el100444 74777 1 7074 5353347770 14767 0ustar ericdaemon;;; autoinsert.el --- automatic mode-dependent insertion of text into new files ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ;; Author: Charlie Martin ;; Created: 01 Jul 1988 ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; Abstract: ;;; ;;; The following defines an association list for files to be ;;; automatically inserted when a new file is created, and a function ;;; which automatically inserts these files; the idea is to insert ;;; default files much as the mode is automatically set using ;;; auto-mode-alist. ;;; ;;; The auto-insert-alist consists of dotted pairs of ;;; ( REGEXP . FILENAME ) where REGEXP is a regular expression, and ;;; FILENAME is the file name of a file which is to be inserted into ;;; all new files matching the regular expression with which it is ;;; paired. ;;; ;;; To use: ;;; load autoinsert.el ;;; setq auto-insert-directory to an appropriate value, which ;;; must end in "/" ;;; ;;; 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-alist '(("\\.tex$" . "tex-insert.tex") ("\\.c$" . "c-insert.c") ("\\.h$" . "h-insert.c") ("[Mm]akefile" . "makefile.inc") ("\\.bib$" . "tex-insert.tex")) "A list specifying text to insert by default into a new file. Elements look like (REGEXP . FILENAME); if the new file's name matches REGEXP, then the file FILENAME is inserted into the buffer. Only the first matching element is effective.") ;;; Establish a default value for auto-insert-directory (defvar auto-insert-directory "~/insert/" "*Directory from which auto-inserted files are taken.") (defun insert-auto-insert-files () "Insert default contents into a new file. Matches the visited file name against the elements of `auto-insert-alist'." (let ((alist auto-insert-alist) ;; remove backup suffixes from file name (name (file-name-sans-versions buffer-file-name)) (insert-file nil)) ;; find first matching alist entry (while (and (not insert-file) alist) (if (string-match (car (car alist)) name) (setq insert-file (cdr (car alist))) (setq alist (cdr alist)))) ;; Now, if we found an appropriate insert file, insert it (if insert-file (let ((file (concat auto-insert-directory insert-file))) (if (file-readable-p file) (progn (insert-file-contents file) (set-buffer-modified-p nil)) (message "Auto-insert: file %s not found" file) (sleep-for 1)))))) ;; Make this feature take effect when a nonexistent file is visited. (setq find-file-not-found-hooks (cons 'insert-auto-insert-files find-file-not-found-hooks)) ;;; autoinsert.el ends here emacs-19.22/lisp/autoload.el100444 12120 1 31052 5432111675 14227 0ustar rmsdaemon;;; autoload.el --- maintain autoloads in loaddefs.el. ;;; Copyright (C) 1991, 1992, 1993 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 autoload.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 or defmacro." (let ((car (car-safe form))) (if (memq car '(defun defmacro)) (let ((macrop (eq car 'defmacro)) name doc) (setq form (cdr form)) (setq name (car form)) ;; Ignore the arguments. (setq form (cdr (cdr form))) (setq doc (car form)) (if (stringp doc) (setq form (cdr form)) (setq doc nil)) (list 'autoload (list 'quote name) file doc (eq (car-safe (car form)) 'interactive) (if macrop (list 'quote 'macro) nil))) nil))) (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 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) (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)) (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) (princ (substring (prin1-to-string (car elt)) 1) outbuf) (if (null (cdr elt)) (princ ")" outbuf) (princ " " outbuf) (princ (substring (prin1-to-string (cdr elt)) 1) outbuf)) (terpri outbuf)) (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 file (nth 5 (file-attributes file))) outbuf) (terpri outbuf) (insert ";;; Generated autoloads from " file "\n") (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))) (done 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)) (while (search-forward generate-autoload-section-header nil t) (let ((form (condition-case () (read (current-buffer)) (end-of-file nil)))) (if (string= (nth 2 form) load-name) (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))))) (message "Autoload section for %s is up to date." file) (search-forward generate-autoload-section-trailer) (delete-region begin (point)) (generate-file-autoloads file)) (setq done t)))))) (if done ;; There was an existing section and we have updated it. () (if (save-excursion (set-buffer (find-file-noselect file)) (save-excursion (save-restriction (widen) (goto-char (point-min)) (search-forward generate-autoload-cookie nil t)))) ;; There are autoload cookies in FILE. ;; Have the user tell us where to put the new section. (progn (save-window-excursion (switch-to-buffer (current-buffer)) (with-output-to-temp-buffer "*Help*" (princ (substitute-command-keys (format "\ Move point to where the autoload section for %s should be inserted. Then do \\[exit-recursive-edit]." file)))) (recursive-edit) (beginning-of-line)) (generate-file-autoloads file))))) (if (interactive-p) (save-buffer)) (if (and (null existing-buffer) (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 "Library \"%s\" (load \ file \"%s\") doesn't exist. Remove its autoload section? " (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: ") (mapcar 'update-file-autoloads (directory-files dir nil "\\.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)) (while args (catch 'file (condition-case lossage (if (file-directory-p (expand-file-name (car args))) (update-directory-autoloads (car args)) (update-file-autoloads (car args))) (error (progn (message ">>Error processing %s: %s" (car args) lossage) (setq lost t) (throw 'file nil))))) (setq args (cdr args))) (save-some-buffers t) (message "Done") (kill-emacs (if lost 1 0)))) (provide 'autoload) ;;; autoload.el ends here emacs-19.22/lisp/avoid.el100444 12120 1 21420 5474521263 13523 0ustar rmsdaemon;;; avoid.el -- make mouse pointer stay out of the way of editing. ;;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: mouse ;; Version: 1.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: ;;; ;;; 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 this file on your load-path and put the ;;; following in your .emacs: ;;; ;;; (cond (window-system ;;; (require 'avoid) ;;; (mouse-avoidance-mode 'cat-and-mouse))) ;;; ;;; The 'animate can be 'jump or 'banish or 'protean if you prefer. ;;; ;;; For added silliness, make the animatee animate... ;;; put something similar to the following into your .emacs: ;;; ;;; (cond (window-system ;;; (setq x-pointer-shape ;;; (eval (nth (random 4) ;;; '(x-pointer-man x-pointer-spider ;;; x-pointer-gobbler x-pointer-gumby)))) ;;; (set-mouse-color (cdr (assoc 'mouse-color (frame-parameters)))))) ;;; ;;; For completely random pointer shape, replace the setq above with: ;;; (setq x-pointer-shape (mouse-avoidance-random-shape)) ;;; ;;; Bugs & Warnings: ;;; ;;; - THIS CODE IS FOR USE WITH FSF EMACS 19.21 or later. ;;; It can cause earlier versions of emacs to crash, due to a bug in the ;;; mouse code. ;;; ;;; - Using this code does slow emacs down. "banish" mode shouldn't ;;; ever be too bad though, and on my workstation even "animate" doesn't ;;; seem to have a noticable effect. ;;; ;;; - There are some situations where it doesn't do what you expect, ;;; notably when there are long wrapped lines in the buffer. Since ;;; there is no low-level command for finding point's position ;;; on the screen, it can fail to move the pointer when on such a line. ;;; 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 the function instead.") (defvar mouse-avoidance-nudge-dist 4 "*Average distance that mouse will be moved when approached by cursor. Only applies in mode-avoidance-modes `animate' and `jump'.") (defvar mouse-avoidance-nudge-var 3 "*Variability of mouse-avoidance-nudge-dist (which see).") (defvar mouse-avoidance-animation-delay .01 "Delay between animation steps, in seconds.") (defvar mouse-avoidance-threshhold 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 for mouse-avoidance-random-shape (defvar mouse-avoidance-pointer-shapes nil) (defvar mouse-avoidance-n-pointer-shapes 0) ;;; Functions: (defun mouse-avoidance-too-close-p () ;; Return t if mouse pointer and point cursor are too close. ;; Acceptable distance is defined by mouse-avoidance-threshhold. (let ((mouse (mouse-position))) (and (car (cdr mouse)) (< (abs (- (car (cdr mouse)) (current-column))) mouse-avoidance-threshhold) (< (abs (- (cdr (cdr mouse)) (+ (car (cdr (window-edges))) (count-lines (window-start) (point))))) mouse-avoidance-threshhold)))) (defun mouse-avoidance-banish-mouse () ;; Put the mouse pointer in the upper-right corner of the current frame. (set-mouse-position (selected-frame) (1- (frame-width)) 0)) (defun mouse-avoidance-nudge-mouse () ;; Push the mouse a little way away, possibly animating the move (let* ((cur (mouse-position)) (deltax (* (+ mouse-avoidance-nudge-dist (random mouse-avoidance-nudge-var)) (if (zerop (random 2)) 1 -1))) (deltay (* (+ mouse-avoidance-nudge-dist (random mouse-avoidance-nudge-var)) (if (zerop (random 2)) 1 -1)))) (if (or (eq mouse-avoidance-mode 'animate) (eq mouse-avoidance-mode 'proteus)) (let ((i 0.0) (color (cdr (assoc 'mouse-color (frame-parameters))))) (while (<= i 1) (set-mouse-position (car cur) (mod (+ (car (cdr cur)) (round (* i deltax))) (window-width)) (mod (+ (cdr (cdr cur)) (round (* i deltay))) (window-height))) (setq i (+ i (/ 1.0 mouse-avoidance-nudge-dist))) (if (eq mouse-avoidance-mode 'proteus) (progn (setq x-pointer-shape (mouse-avoidance-random-shape)) (set-mouse-color color))) (sit-for mouse-avoidance-animation-delay))) (set-mouse-position (car cur) (mod (+ (car (cdr cur)) deltax) (window-width)) (mod (+ (cdr (cdr cur)) deltay) (window-height)))))) (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-simple-hook () (if (and (mouse-avoidance-keyboard-command (this-command-keys))) (mouse-avoidance-banish-mouse))) (defun mouse-avoidance-fancy-hook () (if (and (mouse-avoidance-keyboard-command (this-command-keys)) (mouse-avoidance-too-close-p)) (mouse-avoidance-nudge-mouse))) (defun mouse-avoidance-keyboard-command (key) "Return t if the KEYSEQENCE is composed of keyboard events only. Returns 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)))) (defun mouse-avoidance-mode (&optional mode) "Set cursor avoidance mode to MODE. MODE should be one of the symbols `banish', `jump', `animate', `cat-and-mouse', or `none'. `Animate' is the same as `cat-and-mouse'. If MODE is nil, toggle mouse avoidance. Positive numbers and symbols other than the above are treated as equivalent to `banish'; negative numbers and `-' are equivalent to `none'." (interactive (list (intern (completing-read "Select cursor avoidance technique (SPACE for list): " '(("banish") ("jump") ("animate") ("cat-and-mouse") ("proteus") ("none")) nil t)))) (if (eq mode 'cat-and-mouse) (setq mode 'animate)) (setq post-command-hook (delete 'mouse-avoidance-simple-hook (append post-command-hook nil))) (setq post-command-hook (delete 'mouse-avoidance-fancy-hook (append post-command-hook nil))) (cond ((eq mode 'none) (setq mouse-avoidance-mode nil)) ((or (eq mode 'jump) (eq mode 'animate) (eq mode 'proteus)) (add-hook 'post-command-hook 'mouse-avoidance-fancy-hook) (setq mouse-avoidance-mode mode)) ((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-hook 'mouse-avoidance-simple-hook) (setq mouse-avoidance-mode 'banish)) (t (setq mouse-avoidance-mode nil)))) (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.22/lisp/awk-mode.el100444 74777 1 7052 5353347772 14274 0ustar ericdaemon;;; awk-mode.el --- AWK code editing commands for Emacs ;; Copyright (C) 1988 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 "> " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\f "> " emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\# "< " emacs-lisp-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) (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 'awk-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.22/lisp/backquote.el100444 12120 1 31523 5471630232 14376 0ustar rmsdaemon;;; backquote.el --- backquoting for Emacs Lisp macros ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Author: Dick King (king@kestrel). ;; 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 is a rudimentary backquote package written by D. King, ;;; king@kestrel, on 8/31/85. (` x) is a macro ;;; that expands to a form that produces x. (` (a b ..)) is ;;; a macro that expands into a form that produces a list of what a b ;;; etc. would have produced. Any element can be of the form ;;; (,
) in which case the resulting form evaluates ;;; before putting it into place, or (,@ ), in which ;;; case the evaluation of is arranged for and each element ;;; of the result (which must be a (possibly null) list) is inserted. ;;; As an example, the immediately following macro push (v l) could ;;; have been written ;;; (defmacro push (v l) ;;; (` (setq (, l) (cons (,@ (list v l)))))) ;;; although ;;; (defmacro push (v l) ;;; (` (setq (, l) (cons (, v) (, l))))) ;;; is far more natural. The magic atoms , ;;; and ,@ are user-settable and list-valued. We recommend that ;;; things never be removed from this list lest you break something ;;; someone else wrote in the dim past that comes to be recompiled in ;;; the distant future. ;;; LIMITATIONS: tail consing is not handled correctly. Do not say ;;; (` (a . (, b))) - say (` (a (,@ b))) ;;; which works even if b is not list-valued. ;;; No attempt is made to handle vectors. (` [a (, b) c]) doesn't work. ;;; Sorry, you must say things like ;;; (` (a (,@ 'b))) to get (a . b) and ;;; (` ((, ',) c)) to get (, c) - [(` (a , b)) will work but is a bad habit] ;;; I haven't taught it the joys of nconc. ;;; (` atom) dies. (` (, atom)) or anything else is okay. ;;; BEWARE BEWARE BEWARE ;;; inclusion of (,atom) rather than (, atom) or (,@atom) rather than ;;; (,@ atom) will result in errors that will show up very late. ;;; This is so crunchy that I am considering including a check for ;;; this or changing the syntax to ... ,(). RMS: opinion? ;;; Code: ;;; a raft of general-purpose macros follows. See the nearest ;;; Commonlisp manual. (defmacro bq-push (v l) "Pushes evaluated first form onto second unevaluated object a list-value atom" (list 'setq l (list 'cons v l))) (defmacro bq-caar (l) (list 'car (list 'car l))) (defmacro bq-cadr (l) (list 'car (list 'cdr l))) (defmacro bq-cdar (l) (list 'cdr (list 'car l))) ;;; These two advertised variables control what characters are used to ;;; unquote things. I have included , and ,@ as the unquote and ;;; splice operators, respectively, to give users of MIT CADR machine ;;; derivative machines a warm, cosy feeling. (defconst backquote-unquote '(,) "*A list of all objects that stimulate unquoting in `. Memq test.") (defconst backquote-splice '(,@) "*A list of all objects that stimulate splicing in `. Memq test.") ;;; This is the interface ;;;###autoload (defmacro ` (form) "(` FORM) is a macro that expands to code to construct FORM. Note that this is very slow in interpreted code, but fast if you compile. FORM is one or more nested lists, which are `almost quoted': They are copied recursively, with non-lists used unchanged in the copy. (` a b) == (list 'a 'b) constructs a new list with two elements, `a' and `b'. (` a (b c)) == (list 'a (list 'b 'c)) constructs two nested new lists. However, certain special lists are not copied. They specify substitution. Lists that look like (, EXP) are evaluated and the result is substituted. (` a (, (+ x 5))) == (list 'a (+ x 5)) Elements of the form (,@ EXP) are evaluated and then all the elements of the result are substituted. This result must be a list; it may be `nil'. As an example, a simple macro `push' could be written: (defmacro push (v l) (` (setq (, l) (cons (,@ (list v l)))))) or as (defmacro push (v l) (` (setq (, l) (cons (, v) (, l))))) LIMITATIONS: \"dotted lists\" are not allowed in FORM. The ultimate cdr of each list scanned by ` must be `nil'. \(This does not apply to constants inside expressions to be substituted.) Substitution elements are not allowed as the cdr of a cons cell. For example, (` (A . (, B))) does not work. Instead, write (` (A (,@ B))). You cannot construct vectors, only lists. Vectors are treated as constants. BEWARE BEWARE BEWARE Inclusion of (,ATOM) rather than (, ATOM) or of (,@ATOM) rather than (,@ ATOM) will result in errors that will show up very late." (bq-make-maker form)) ;;; We develop the method for building the desired list from ;;; the end towards the beginning. The contract is that there be a ;;; variable called state and a list called tailmaker, and that the form ;;; (cons state tailmaker) deliver the goods. Exception - if the ;;; state is quote the tailmaker is the form itself. ;;; This function takes a form and returns what I will call a maker in ;;; what follows. Evaluating the maker would produce the form, ;;; properly evaluated according to , and ,@ rules. ;;; I work backwards - it seemed a lot easier. The reason for this is ;;; if I'm in some sort of a routine building a maker and I switch ;;; gears, it seemed to me easier to jump into some other state and ;;; glue what I've already done to the end, than to to prepare that ;;; something and go back to put things together. (defun bq-make-maker (form) "Given argument FORM, a `mostly quoted' object, produces a maker. See backquote.el for details" (let ((tailmaker (quote nil)) (qc 0) (ec 0) (state nil)) (mapcar 'bq-iterative-list-builder (reverse form)) (and state (cond ((eq state 'quote) (list state (if (equal form tailmaker) form tailmaker))) ((= (length tailmaker) 1) (funcall (bq-cadr (assq state bq-singles)) tailmaker)) (t (cons state tailmaker)))))) ;;; There are exceptions - we wouldn't want to call append of one ;;; argument, for example. (defconst bq-singles '((quote bq-quotecar) (append car) (list bq-make-list) (cons bq-id))) (defun bq-id (x) x) (defun bq-quotecar (x) (list 'quote (car x))) (defun bq-make-list (x) (cons 'list x)) ;;; fr debugging use only ;(defun funcalll (a b) (funcall a b)) ;(defun funcalll (a b) (debug nil 'enter state tailmaker a b) ; (let ((ans (funcall a b))) (debug nil 'leave state tailmaker) ; ans)) ;;; Given a state/tailmaker pair that already knows how to make a ;;; partial tail of the desired form, this function knows how to add ;;; yet another element to the burgeoning list. There are four cases; ;;; the next item is an atom (which will certainly be quoted); a ;;; (, xxx), which will be evaluated and put into the list at the top ;;; level; a (,@ xxx), which will be evaluated and spliced in, or ;;; some other list, in which case we first compute the form's maker, ;;; and then we either launch into the quoted case if the maker's ;;; top level function is quote, or into the comma case if it isn't. ;;; The fourth case reduces to one of the other three, so here we have ;;; a choice of three ways to build tailmaker, and cit turns out we ;;; use five possible values of state (although someday I'll add ;;; nconcto the possible values of state). ;;; This maintains the invariant that (cons state tailmaker) is the ;;; maker for the elements of the tail we've eaten so far. (defun bq-iterative-list-builder (form) (cond ((atom form) (funcall (bq-cadr (assq state bq-quotefns)) form)) ((memq (car form) backquote-unquote) (funcall (bq-cadr (assq state bq-evalfns)) (bq-cadr form))) ((memq (car form) backquote-splice) (funcall (bq-cadr (assq state bq-splicefns)) (bq-cadr form))) (t (let ((newform (bq-make-maker form))) (if (and (listp newform) (eq (car newform) 'quote)) (funcall (bq-cadr (assq state bq-quotefns)) (bq-cadr newform)) (funcall (bq-cadr (assq state bq-evalfns)) newform)))) )) ;;; We do a 2-d branch on the form of splicing and the old state. ;;; Here's fifteen functions' names... (defconst bq-splicefns '((nil bq-splicenil) (append bq-spliceappend) (list bq-splicelist) (quote bq-splicequote) (cons bq-splicecons))) (defconst bq-evalfns '((nil bq-evalnil) (append bq-evalappend) (list bq-evallist) (quote bq-evalquote) (cons bq-evalcons))) (defconst bq-quotefns '((nil bq-quotenil) (append bq-quoteappend) (list bq-quotelist) (quote bq-quotequote) (cons bq-quotecons))) ;;; The name of each function is ;;; (concat 'bq- ) ;;; I'll comment the non-obvious ones before the definitions... ;;; In what follows, uppercase letters and form will always be ;;; metavariables that don't need commas in backquotes, and I will ;;; assume the existence of something like matches that takes a ;;; backquote-like form and a value, binds metavariables and returns ;;; t if the pattern match is successful, returns nil otherwise. I ;;; will write such a goodie someday. ;;; (setq tailmaker ;;; (if (matches ((quote X) Y) tailmaker) ;;; (` ((quote (form X)) Y)) ;;; (` ((list form (quote X)) Y)))) ;;; (setq state 'append) (defun bq-quotecons (form) (if (and (listp (car tailmaker)) (eq (bq-caar tailmaker) 'quote)) (setq tailmaker (list (list 'quote (list form (bq-cadr (car tailmaker)))) (bq-cadr tailmaker))) (setq tailmaker (list (list 'list (list 'quote form) (car tailmaker)) (bq-cadr tailmaker)))) (setq state 'append)) (defun bq-quotequote (form) (bq-push form tailmaker)) ;;; Could be improved to convert (list 'a 'b 'c .. 'w x) ;;; to (append '(a b c .. w) x) ;;; when there are enough elements (defun bq-quotelist (form) (bq-push (list 'quote form) tailmaker)) ;;; (setq tailmaker ;;; (if (matches ((quote X) (,@ Y))) ;;; (` ((quote (, (cons form X))) (,@ Y))))) (defun bq-quoteappend (form) (cond ((and (listp tailmaker) (listp (car tailmaker)) (eq (bq-caar tailmaker) 'quote)) (rplaca (bq-cdar tailmaker) (cons form (car (bq-cdar tailmaker))))) (t (bq-push (list 'quote (list form)) tailmaker)))) (defun bq-quotenil (form) (setq tailmaker (list form)) (setq state 'quote)) ;;; (if (matches (X Y) tailmaker) ; it must ;;; (` ((list form X) Y))) (defun bq-evalcons (form) (setq tailmaker (list (list 'list form (car tailmaker)) (bq-cadr tailmaker))) (setq state 'append)) ;;; (if (matches (X Y Z (,@ W))) ;;; (progn (setq state 'append) ;;; (` ((list form) (quote (X Y Z (,@ W)))))) ;;; (progn (setq state 'list) ;;; (list form 'X 'Y .. ))) ; quote each one there is (defun bq-evalquote (form) (cond ((< (length tailmaker) 3) (setq tailmaker (cons form (mapcar (function (lambda (x) (list 'quote x))) tailmaker))) (setq state 'list)) (t (setq tailmaker (list (list 'list form) (list 'quote tailmaker))) (setq state 'append)))) (defun bq-evallist (form) (bq-push form tailmaker)) ;;; (cond ((matches ((list (,@ X)) (,@ Y))) ;;; (` ((list form (,@ X)) (,@ Y)))) ;;; ((matches (X)) ;;; (` (form (,@ X))) (setq state 'cons)) ;;; ((matches ((,@ X))) ;;; (` (form (,@ X))))) (defun bq-evalappend (form) (cond ((and (listp tailmaker) (listp (car tailmaker)) (eq (bq-caar tailmaker) 'list)) (rplacd (car tailmaker) (cons form (bq-cdar tailmaker)))) ((= (length tailmaker) 1) (setq tailmaker (cons form tailmaker) state 'cons)) (t (bq-push (list 'list form) tailmaker)))) (defun bq-evalnil (form) (setq tailmaker (list form) state 'list)) ;;; (if (matches (X Y)) ; it must ;;; (progn (setq state 'append) ;;; (` (form (cons X Y))))) ; couldn't think of anything clever (defun bq-splicecons (form) (setq tailmaker (list form (list 'cons (car tailmaker) (bq-cadr tailmaker))) state 'append)) (defun bq-splicequote (form) (setq tailmaker (list form (list 'quote tailmaker)) state 'append)) (defun bq-splicelist (form) (setq tailmaker (list form (cons 'list tailmaker)) state 'append)) (defun bq-spliceappend (form) (bq-push form tailmaker)) (defun bq-splicenil (form) (setq state 'append tailmaker (list form))) (provide 'backquote) ;;; backquote.el ends here emacs-19.22/lisp/bib-mode.el100444 74777 1 16204 5353347773 14266 0ustar ericdaemon;;; 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.22/lisp/bibtex.el100444 12120 1 166570 5433056550 13733 0ustar rmsdaemon;;; bibtex.el --- BibTeX mode for GNU Emacs ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Bengt Martensson ;; Mark Shapiro ;; Mike Newton ;; Aaron Larson ;; Version: 1.3.1 ;; Maintainer:Aaron Larson ;; Adapted-By: ESR ;; Keywords: tex, 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. ;;; TODO distribute texinfo file. ;;; LCD Archive Entry: ;;; bibtex-mode|Bengt Martensson, Marc Shapiro, Aaron Larson| ;;; alarson@src.honeywell.com| ;;; Support for maintaining BibTeX format bibliography databases| ;;; 93-03-29|version 1.3|~/modes/bibtex-mode.el.Z| ;;; Commentary: ;;; BUGS: ;;; 1. using regular expressions to match the entire bibtex entry dies ;;; on long bibtex entires (e.g. those containing abstracts) since ;;; the length of regular expression matches is fairly limited. ;;; 2. When inserting a string (with \C-C\C-E\s) hitting a TAB 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] ;;; 3. Function string-equalp should be in a library file, not in this ;;; file. ;;; (current keeper: alarson@src.honeywell.com ;;; previous: shapiro@corto.inria.fr) ;;; Change Log: ;; Mon Mar 29 14:06:06 1993 Aaron Larson (alarson at gendibal) ;; ;; * bibtex.el: V1.3 released Mar 30, 1993 ;; (bibtex-field-name): Fix to match definition if latex manual, ;; specifically letters, digits, and punctuation other than comma. ;; Underscore is retained for historical reasons. ;; (bibtex-make-field): Fix to work around bug in Lucid prin1-to-string ;; function as reported by Martin Sjolin . ;; (bibtex-entry): minor code cleanup. ;; (bibtex-mode-map): Remove key binding (C-c n) for ;; narrow-to-bibtex-entry, previous binding violated emacs policy of ;; reserving C-c followed by a letter for user customization. ;; revise modification history to better conform to FSF changelog ;; standards. ;; (bibtex-refile-entry): Removed. Would need disclaimer papers to ;; incorporate it into official sources, and unable to contact author. ;; Fix minor "syntax" errors in documentation strings and such found ;; by new byte compiler. Funs bibtex-mode, bibtex-remove-double-quotes ;; ;; ;; Fri Jan 15 14:06:06 1993 Aaron Larson (alarson at gendibal) ;; ;; * bibtex.el: V1.2 released Feb 15 1993 ;; (find-bibtex-entry-location bibtex-make-field): Fixed placement of ;; "interactive specification". [Bug report from ;; mernst@theory.lcs.mit.edu] ;; Fixed problem where bibtex-entry would fail if user typed entry ;; name in wrong case. ;; (bibtex-inside-field) Position the cursor _before_ the last comma ;; on a line (the comma is not necessarily "inside" the field); this ;; does not seem to break any existing code. ref sct@dcs.edinburgh.ac.uk ;; (bibtex-enclosing-field, bibtex-enclosing-reference): leave ;; point unmoved if no enclosing field/reference is found. As a ;; result of changes (3) and (4) bibtex-next-field works properly, ;; even when called from the entry key position. ;; (bibtex-remove-OPT): realign the '=' after removing the 'opt'. ;; (bibtex-clean-entry): always remove any trailing comma from the ;; end of a bibtex entry (these commas get stripped automatically when ;; optional fields are killed by bibtex-kill-optional-field, but can be ;; left if optional fields are removed by other means). ;; (bibtex-x-help) Replace tab with spaces in X menu as noted by ;; khera@cs.duke.edu ;; (bibtex-refile-entry): Added (from brannon@jove.cs.caltech.edu) ;; (bibtex-sort-ignore-string-entries sort-bibtex-entries, ;; map-bibtex-entries): Added variable as requested by ;; gernot@cs.unsw.oz.au, required changes to funs. ;; (bibtex-current-entry-label): Added at request of ;; yasuro@maekawa.is.uec.ac.jp ;; (bibtex-DEAthesis:) Deleted along with corresponding entry from ;; bibtex-x-help per shapiro@corto.inria.fr ;; Moved narrow-to-bibtex-entry from C-c C-n to C-c n (the previous ;; binding was in conflict with the binding for bibtex-pop-next. ;; bug report from [shapiro@corto.inria.fr] ;; ;;; ;;; alarson@src.honeywell.com 92-Feb-13 ;;; 1. Made bibtex-entry user callable, now prompts for entry type (e.g. ;;; Article), with completion, and bound it to a key. This is now my ;;; preferred way to add most entries. ;;; 2. Made fields of a bibtex entry derived from the alist bibtex-entry- ;;; field-alist. ;;; 3. Fixed handling of escaped double quotes, e.g. "Schr{\"o}dinger". ;;; 4. Fixed bug where unhiding bibtex entries moved point. ;;; 5. Made "field name" specs permit (name . value) for defaulting. E.g. ;;; (setq bibtex-mode-user-optional-fields '(("library" . "alarson"))) ;;; will generate the field: ;;; library = "alarson", ;;; 6. Added binding for narrow-to-bibtex-entry ;;; 7. Adding a bibtex entry now runs hook: bibtex-add-entry-hook ;;; 8. Made bibtex-clean-entry fixup text alignment, and eliminated the ;;; dependency on bibtex-enclosing-reference which has a problem with ;;; long entries (e.g. those containing abstracts). ;;; ;;; alarson@src.honeywell.com 92-Jan-31 ;;; Added support for: ispell, beginning/end of entry movement, a simple ;;; outline like mode (hide the bodies of bibtex entries), support for ;;; sorting bibtex entries, and maintaining them in sorted order, and ;;; simple buffer validation. ;;; User visible functions added: ;;; ispell-{abstract,bibtex-entry}, {beginning,end}-of-bibtex-entry ;;; hide-bibtex-entry-bodies, sort-bibtex-entries, validate-bibtex- ;;; buffer, find-bibtex-duplicates ;;; user visible variables added: ;;; bibtex-maintain-sorted-entries ;;; new local keybindings: ;;; " tex-insert-quote ;;; C-c$ ispell-bibtex-entry ;;; M-C-a beginning-of-bibtex-entry ;;; M-C-e end-of-bibtex-entry ;;; Mike Newton (newton@gumby.cs.caltech.edu) 90.11.17 ;;; * Handle items like ;;; title = poft # "Fifth Tri-quarterly" # random-conf, ;;; and title = {This title is inside curlies} ;;; * added user settable, always present, optional fields ;;; * fixed 'bibtex-find-it's doc string's location ;;; * bibtex-field-text made more general (it wouldn't handle the # construct) ;;; and it now handles a small subset of the {} cases ;;; Bengt Martensson, March 6 ;;; Adapted to Bibtex 0.99 by updating the optional fields according ;;; to the document BibTeXing, Oren Patashnik, dated January 31, 1988. ;;; Updated documentation strings accordingly. Added (provide 'bibtex). ;;; If bibtex-include-OPT-crossref is non-nil, every entry will have ;;; an OPTcrossref field, analogously for bibtex-include-OPTkey and ;;; bibtex-include-OPTannote. Added bibtex-preamble, bound to ^C^EP, ;;; and also found in X- and sun-menus. Cleaned up the sun-menu ;;; stuff, and made it more uniform with the X-menu stuff. Marc: I ;;; strongly suspect that I broke your parsing... (Or, more ;;; correctly, BibTeX 0.99 broke it.) ;;; Added bibtex-clean-entry-zap-empty-opts, defvar'd to t. If it ;;; is nil, bibtex-clean-entry will leave empty optional fields alone. ;;; Marc Shapiro 1-feb-89: integrated changes by Bengt Martensson 88-05-06: ;;; Added Sun menu support. Locally bound to right mouse button in ;;; bibtex-mode. Emacs 18.49 allows local mouse bindings!! ;;; Commented out DEAthesis. ;;; Marc Shapiro 6-oct-88 ;;; * skip-whitespace replaced by skip-chars-forward ;;; * use indent-to-column instead of inserting tabs (changes to ;;; bibtex-entry, bibtex-make-entry, bibtex-make-OPT-entry, renamed to ;;; bibtex-make-optional-entry) ;;; * C-c C-k deletes the current OPT entry entirely ;;; * C-c C-d replaces text of field with "" ;;; * renamed bibtex-find-it to bibtex-find-text. With arg, now goes to ;;; start of text. Fixed bugs in it. ;;; Marc Shapiro 23-sep-88 ;;; * bibtex-clean-entry moves past end of entry. ;;; * bibtex-clean-entry signals mandatory fields left empty. ;;; Marc Shapiro 18-jul-88 ;;; * Fixed bug in bibtex-flash-entry ;;; * Moved all the entry type keystrokes to "C-c C-e something" (instead of ;;; "C-c something" previously) to make room for more. C-c C-e is ;;; supposed to stand for "entry" [idea taken from mail-mode]. Moved ;;; bibtex-pop-previous to C-c C-p and bibtex-pop-next to C-c C-n. ;;; * removed binding for "\e[25~" ;;; * replaced bibtex-clean-optionals by bibtex-clean-entry, bound to ;;; C-c C-c ;;; Marc Shapiro 13-jul-88 [based on ideas by Sacha Krakowiak of IMAG] ;;; * bibtex-pop-previous replaces current field with value of ;;; similar field in previous entry. May be called n times in a row ;;; (or with arg n) to pop similar field of n'th previous entry. ;;; There is also a bibtex-pop-next to get similar field of next ;;; entry. ;;; * C-c C-k now kills all empty optional fields of current entry, and ;;; removes "OPT" for those optional fields which have text. ;;; Marc Shapiro 14-dec-87 ;;; Cosmetic fixes. Fixed small bug in bibtex-move-outside-of-entry. ;;; Skip Montanaro 7-dec-87, Shapiro 10-dec-87 ;;; before inserting an entry, make sure we are outside of a bib entry ;;; Marc Shapiro 3-nov-87 ;;; addition for France: DEAthesis ;;; Marc Shapiro 19-oct-1987 ;;; add X window menu option; bug fixes. TAB, LFD, C-c " and C-c C-o now ;;; behave consistently; deletion never occurs blindly. ;;; Marc Shapiro 15-oct-1986 ;;; align long lines nicely; C-c C-o checks for the "OPT" string; ;;; TAB goes to the end of the string; use lower case; use ;;; run-hooks ;;; Bengt Martensson 87-06-28 ;;; Bengt Martensson 87-06-28 ;;; Original version ;;; Code: ;;; NOTE by Marc Shapiro, 14-dec-87: ;;; (bibtex-x-environment) binds an X menu for bibtex mode to x-button-c-right. ;;; Trouble is, in Emacs 18.44 you can't have a mode-specific mouse binding, ;;; so it will remain active in all windows. Yuck! (provide 'bibtex) ;;; these guys typically don't have autoloads...[alarson:19920131.1548CST] ;;; Check for fboundp first so that if user autoloads them from non standard ;;; places, the users bindings will take precedence. (if (not (fboundp 'tex-insert-quote)) (autoload 'tex-insert-quote "tex-mode")) (if (not (fboundp 'sort-subr)) (autoload 'sort-subr "sort")) ;;; These should be in a more generally accessible location. (defun string-equalp (s1 s2) "Like string= except differences in case are ignored." (let ((ss1 (if (symbolp s1) (symbol-name s1) s1)) (ss2 (if (symbolp s2) (symbol-name s2) s2))) (and (= (length ss1) (length ss2)) (string-equal (upcase ss1) (upcase ss2))))) ;;; This should be moved into simple.el, and the functions there modified ;;; to call it rather than doing it themselves. (defun put-string-on-kill-ring (string) "Make STRING be the first element of the kill ring." (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)) (defvar bibtex-clean-entry-zap-empty-opts t "*If non-nil, bibtex-clean-entry will delete all empty optional fields.") (defvar bibtex-include-OPTcrossref t "*If non-nil, all entries 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.") ;; note: the user should be allowed to have their own list of always ;; available optional fields. exs: "keywords" "categories" (defvar bibtex-mode-user-optional-fields nil ;no default value "*List of optional fields that user want to have as always present when making a bibtex entry. One possibility is for ``keywords''. Entries can be either strings or conses, in which case the car should be string and the cdr the value to be inserted.") (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-abbrev-table nil "") (define-abbrev-table 'bibtex-mode-abbrev-table ()) (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 "\C-c\"" 'bibtex-remove-double-quotes) (define-key km "\C-c\C-c" 'bibtex-clean-entry) (define-key km "\C-c?" 'describe-mode) (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) ;; [alarson:19920131.1543CST] (define-key km "\"" 'tex-insert-quote) (define-key km "\C-c$" 'ispell-bibtex-entry) (define-key km "\M-\C-a" 'beginning-of-bibtex-entry) (define-key km "\M-\C-e" 'end-of-bibtex-entry) (define-key km "\C-c\C-b" 'bibtex-entry) ; (define-key km "\C-cn" 'narrow-to-bibtex-entry) (define-key km "\C-c\C-e\C-a" 'bibtex-Article) (define-key km "\C-c\C-e\C-b" 'bibtex-Book) ; (define-key km "\C-c\C-e\C-d" 'bibtex-DEAthesis) (define-key km "\C-c\C-e\C-c" 'bibtex-InProceedings) (define-key km "\C-c\C-e\C-i" 'bibtex-InBook) (define-key km "\C-c\C-ei" 'bibtex-InCollection) (define-key km "\C-c\C-eI" 'bibtex-InProceedings) (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-o" 'bibtex-remove-OPT) (define-key km "\C-c\C-e\C-p" 'bibtex-PhdThesis) (define-key km "\C-c\C-ep" 'bibtex-Proceedings) (define-key km "\C-c\C-eP" 'bibtex-preamble) (define-key km "\C-c\C-e\C-t" 'bibtex-TechReport) (define-key km "\C-c\C-e\C-s" 'bibtex-string) (define-key km "\C-c\C-e\C-u" 'bibtex-Unpublished) km)) (defvar bibtex-pop-previous-search-point nil "Next point where bibtex-pop-previous should start looking for a similar entry.") (defvar bibtex-pop-next-search-point nil "Next point where bibtex-pop-next should start looking for a similar entry.") (defvar bibtex-entry-field-alist '( ("Article" . ((("author" "title" "journal" "year") ("volume" "number" "pages" "month" "note")) (("author" "title") ("journal" "year" "volume" "number" "pages" "month" "note")))) ("Book" . ((("author" "title" "publisher" "year") ("editor" "volume" "number" "series" "address" "edition" "month" "note")))) ("Booklet" . ((("title") ("author" "howpublished" "address" "month" "year" "note")))) ;; France: Dipl\^{o}me d'Etudes Approfondies (similar to Master's) ; ("DEAthesis" . ((("author" "title" "school" "year") ; ("address" "month" "note")))) ("InBook" . ((("author" "title" "chapter" "publisher" "year") ("editor" "pages" "volume" "number" "series" "address" "edition" "month" "type" "note")) (("author" "title" "chapter") ("publisher" "year" "editor" "pages" "volume" "number" "series" "address" "edition" "month" "type" "note")))) ("InCollection" . ((("author" "title" "booktitle" "publisher" "year") ("editor" "volume" "number" "series" "type" "chapter" "pages" "address" "edition" "month" "note")) (("author" "title") ("booktitle" "publisher" "year" "editor" "volume" "number" "series" "type" "chapter" "pages" "address" "edition" "month" "note")))) ("InProceedings" . ((("author" "title" "booktitle" "year") ("editor" "volume" "number" "series" "pages" "organization" "publisher" "address" "month" "note")) (("author" "title") ("editor" "volume" "number" "series" "pages" "booktitle" "year" "organization" "publisher" "address" "month" "note")))) ("Manual" . ((("title") ("author" "organization" "address" "edition" "year" "month" "note")))) ("MastersThesis" . ((("author" "title" "school" "year") ("address" "month" "note" "type")))) ("Misc" . ((() ("author" "title" "howpublished" "year" "month" "note")))) ("PhdThesis" . ((("author" "title" "school" "year") ("address" "month" "type" "note")))) ("Proceedings" . ((("title" "year") ("editor" "volume" "number" "series" "publisher" "organization" "address" "month" "note")))) ("TechReport" . ((("author" "title" "institution" "year") ("type" "number" "address" "month" "note")))) ("Unpublished" . ((("author" "title" "note") ("year" "month")))) ) "List of (entry-name (required optional) (crossref-required crossref-optional)) tripples. If the third element is nil, then the first pair can be used. Required and optional are lists of strings. All entry creation functions use this variable to generate entries, and bibtex-entry ensures the entry type is valid. This variable can be used for example to make bibtex manipulate a different set of entry types, e.g. a crossreference document of organization types.") ;;; A bibtex file is a sequence of entries, either string definitions ;;; or reference entries. A reference entry has a type part, a ;;; key part, and a comma-separated sequence of fields. A string ;;; entry has a single field. A field has a left and right part, ;;; separated by a '='. The left part is the name, the right part is ;;; the text. Here come the definitions allowing to create and/or parse ;;; entries and fields: ;;; fields (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.") ;;; KAWATA Yasuro reported bug that "/" ;;; was not premitted in field names. The old value of this var was: ;;; "[A-Za-z][---A-Za-z0-9:_+]*" ;;; According to the LaTeX manual, page 71, the legal values are letters, ;;; digits, and punctuation other than comma. Section 2.1 defines ;;; punctuation as: ;;; .:;,?!`'()[]-/*@ ;;; and says that += can be used in normal text. Specifically #$%&~_^\{} ;;; are called out as special chars. Some experimentation with LaTeX ;;; indicates that # and ~ definitely don't work, but that the following ;;; citation does! \cite{a0.:;?!`'()[]-/*@_&$^+=|<>}. I chose here to ;;; permit _ since it was previously allowed, but otherwise to only handle ;;; punc and += ;;; Amendment: I couldn't get a regexp with both "[]"'s and hyphen to ;;; work. It looks like you need them both to be the first entries in a ;;; regexp pattern. [alarson:19930315.0900CST] (defconst bibtex-field-name "[A-Za-z][---A-Za-z0-9.:;?!`'()/*@_+=]*" "Regexp defining the name part of a bibtex field.") ;; bibtex-field-text must be able to handle ;; title = "Proc. Fifteenth Annual" # STOC, ;; month = "10~" # jan, ;; year = "{\noopsort{1973c}}1981", ;; month = apr # "-" # may, ;; key = {Volume-2}, ;; note = "Volume~2 is listed under Knuth \cite{book-full}" ;; i have added a few of these, but not all! -- MON (defconst bibtex-field-const "[0-9A-Za-z][---A-Za-z0-9:_+]*" "Format of a bibtex field constant.") (defconst bibtex-field-string (concat "\"[^\"]*[^\\\\]\"\\|\"\"") "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-text ; "\"[^\"]*[^\\\\]\"\\|\"\"\\|[0-9A-Za-z][---A-Za-z0-9:_+]*" ; "Regexp defining the text part of a bibtex field: either a string, or an empty string, or a constant.") (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") ;;; references (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 1 "The regexp subexpression number of the type part in bibtex-reference-head") (defconst bibtex-key-in-head 2 "The regexp subexpression number of the key part in bibtex-reference-head") (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") ;;; strings (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.") (defun bibtex-current-entry-label (&optional include-cite kill) "Return the label of the bibtex entry containing, or preceding point. Optional argument INCLUDE-CITE, if true means put a '\\cite{}' around the returned value. Second optional argument KILL, if true, means place the returned value in the kill buffer. Interactively; providing prefix argument makes INCLUDE-CITE true, and kill is true by default. Rationale: The intention is that someone will write a function that can be bound to a mouse key so that people entering TeX can just mouse on the bibtex entry and have the citation key inserted at the current point (which will almost certainly be in some other buffer). In the interim this function is marginally useful for keyboard binding and is not bound by default. Suggested binding is ^C-k." (interactive (list current-prefix-arg t)) (save-excursion (beginning-of-bibtex-entry) (re-search-forward bibtex-reference-head (save-excursion (end-of-bibtex-entry) (point))) (let* ((key (buffer-substring (match-beginning bibtex-key-in-head) (match-end bibtex-key-in-head))) (val (if include-cite (format "\\cite{%s}" key) key))) (if kill (put-string-on-kill-ring val)) val))) ;;; bibtex mode: ;;;###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] removes the double-quotes around the text of the current field. \\[bibtex-empty-field] replaces the text of the current field with the default \"\". The command \\[bibtex-clean-entry] cleans the current entry, i.e. (i) removes double-quotes 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 dot 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: find-bibtex-duplicates find-bibtex-entry-location hide-bibtex-entry-bodies sort-bibtex-entries validate-bibtex-buffer Variables: bibtex-clean-entry-zap-empty-opts bibtex-entry-field-alist bibtex-include-OPTannote bibtex-include-OPTcrossref bibtex-include-OPTkey bibtex-maintain-sorted-entries bibtex-mode-user-optional-fields Fields: address Publisher's address annote Long annotation used for annotated bibliographies (begins sentence) author Name(s) of author(s), in BibTeX name format booktitle Book title when the thing being referenced isn't the whole book. For book entries, the title field should be used instead. chapter Chapter number crossref The database key of the entry being cross referenced. edition Edition of a book (e.g., \"second\") editor Name(s) of editor(s), in BibTeX name format. If there is also an author field, then the editor field should be for the book or collection that the work appears in howpublished How something strange has been published (begins sentence) institution Sponsoring institution journal Journal name (macros are provided for many) key Alphabetizing and labeling key (needed when no author or editor) month Month (macros are provided) note To help the reader find a reference (begins sentence) number Number of a journal or technical report organization Organization (sponsoring a conference) pages Page number or numbers (use `--' to separate a range) publisher Publisher name school School name (for theses) series The name of a series or set of books. An individual book will will also have it's own title title The title of the thing being referenced type Type of a technical report (e.g., \"Research Note\") to be used instead of the default \"Technical Report\" volume Volume of a journal or multivolume work year Year---should contain only numerals --------------------------------------------------------- Entry to this mode calls the value of bibtex-mode-hook if that value is non-nil." (interactive) (kill-all-local-variables) (set-syntax-table bibtex-mode-syntax-table) (use-local-map bibtex-mode-map) (setq major-mode 'bibtex-mode) (setq mode-name "BibTeX") (set-syntax-table bibtex-mode-syntax-table) (setq local-abbrev-table bibtex-mode-abbrev-table) (make-local-variable 'paragraph-start) (setq paragraph-start "^[ \f\n\t]*$") (auto-fill-mode 1) ; nice alignments (setq left-margin (+ bibtex-text-alignment 1)) (run-hooks 'bibtex-mode-hook)) (defun bibtex-move-outside-of-entry () "Make sure we are outside of a bib 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 ispell-abstract () (interactive) (beginning-of-bibtex-entry) (re-search-forward "^[ \t]*[OPT]*abstract[ \t]*=") (ispell-region (point) (save-excursion (forward-sexp) (point)))) (defun beginning-of-bibtex-entry () (interactive) (re-search-backward "^@" nil 'move)) (defun skip-whitespace-and-comments () ;; It might be a good idea to have forward-sexp with argument 0 do what ;; this function tries to do, namely skip whitespace and comments. ;; Maybe a better name for this would be skip-to-next-sexp. ;; alternative implementation: ;; (let ((parse-sexp-ignore-comments t)) ;; (forward-sexp 1) ;; (forward-sexp -1)) ;; but I've had problems with this not getting the parse of comments ;; right going backward if they contain unbalanced expressions or string ;; quotes. [alarson:19920217.1021CST] (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)))) ;;; [alarson:19920214.1007CST] (defun end-of-bibtex-entry () "If inside an entry, move to the end of it, otherwise move to the end of the next entry." (interactive) ;; if point was previously at the end of an entry, this puts us ;; inside the next entry, otherwise we remain in the current one. (progn (skip-whitespace-and-comments) ;;; (skip-chars-forward " \t\n") (end-of-line)) (beginning-of-bibtex-entry) (let ((parse-sexp-ignore-comments t)) (forward-sexp) ; skip entry type (forward-sexp) ; skip entry body )) ;(defun end-of-bibtex-entry () ; (interactive) ; (re-search-forward "}$" nil 'move)) (defun ispell-bibtex-entry () (interactive) (ispell-region (progn (beginning-of-bibtex-entry) (point)) (progn (end-of-bibtex-entry) (point)))) (defun narrow-to-bibtex-entry () (interactive) (save-excursion (narrow-to-region (progn (beginning-of-bibtex-entry) (point)) (progn (end-of-bibtex-entry) (point))))) (defun beginning-of-first-bibtex-entry () (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 hide-bibtex-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")))) (setq selective-display (not arg)) (set-buffer-modified-p modifiedp)))) (defvar bibtex-sort-ignore-string-entries nil "*If true, bibtex @STRING entries are ignored when determining ordering of the buffer (e.g. sorting, locating alphabetical position for new entries, etc.)") (defun sort-bibtex-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)) (beginning-of-bibtex-entry) (end-of-bibtex-entry) (point))) (sort-subr nil ; reversep ;; beginning of record function 'forward-line ;; end of record function (function (lambda () (and (re-search-forward "}\\s-*\n[\n \t]*@" nil 'move) (forward-char -2)))) ;; start of key function (if bibtex-sort-ignore-string-entries (function (lambda () (while (and (re-search-forward "^\\s-*\\([@a-zA-Z]*\\)\\s-*{\\s-*") (string-equalp "@string" (buffer-substring (match-beginning 1) (match-end 1))))) nil)) (function (lambda () (re-search-forward "{\\s-*") nil))) ;; end of key function (function (lambda () (search-forward ","))) ))) (defun map-bibtex-entries (fun) "Call FUN for each bibtex entry starting with the current, 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." (beginning-of-bibtex-entry) (while (re-search-forward "^@[^{]*{[ \t]*\\([^, ]*\\)" nil t) (if (and bibtex-sort-ignore-string-entries (string-equalp "@string{" (buffer-substring (match-beginning 0) (match-beginning 1)))) nil ; ignore the @string entry. (funcall fun (buffer-substring (match-beginning 1) (match-end 1)))))) (defun find-bibtex-entry-location (entry-name) "Searches from beginning of current buffer looking for place to put the bibtex entry named ENTRY-NAME. Buffer is assumed to be in sorted order, without duplicates (see \\[sort-bibtex-entries]), if it is not, an error will be signalled." (interactive "sBibtex entry key: ") (let ((previous nil) point) (beginning-of-first-bibtex-entry) (or (catch 'done (map-bibtex-entries (function (lambda (current) (cond ((string-equal entry-name current) (error "Entry duplicates existing!")) ((or (null previous) (string< previous current)) (setq previous current point (point)) (if (string< entry-name current) (progn (beginning-of-bibtex-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)) (progn (message "Warning: Entry %s may be a duplicate of %s!" entry-name current) (ding t)))) (throw 'done t)))) ((string-equal previous current) (error "Duplicate here with previous!")) (t (error "Entries out of order here!"))))))) (end-of-bibtex-entry)))) (defun validate-bibtex-buffer () "Find some typical errors in bibtex files. 1. At signs (@) not as first char of a line. 2. Double quotes (\") inside strings. 3. Closing braces (}) not the last character of a line." (interactive) (let ((point (point))) (while (re-search-forward ".@" nil t) (let* ((foo (parse-partial-sexp (save-excursion (beginning-of-bibtex-entry) (point)) (point))) (in-a-string (nth 3 foo))) (if (not in-a-string) (error "At sign (@) out of place!")))) (goto-char point) (while (search-forward "\"" nil t) (or (looking-at "[,}][ \t]*$") (char-equal (preceding-char) ?\") ;; some versions put closing brace on separate line. (looking-at "[ \t]*\n}") (save-excursion (save-restriction (narrow-to-region (point) (progn (beginning-of-line) (point))) (looking-at "^[ \t]*[a-zA-Z]+[ \t]*=[ \t]*\"$"))) (error "Quote out of place, or missing \",\" or \"}\"!"))) (goto-char point) ;; This is only approximate, should actually search for close braces, ;; then see if they are inside a string, or at the end of a line. ;; This just gets the typical case of whitespace after a closing brace. (while (search-forward "}[ \t]+$" nil t) (error "Brace not last char of line!")) (goto-char point) (message "Bibtex buffer appears o.k."))) (defun find-bibtex-duplicates () "Searches forward in current buffer looking for duplicate bibtex entries. Buffer is assumed to be sorted, see \\[sort-bibtex-entries]" (interactive) (let ((point (point))) ;; errors if things are not right... (find-bibtex-entry-location (make-string 10 255)) (goto-char point) (message "No duplicates found!"))) ;;; assoc doesn't ignore case, so we need an assoc that does... (defun assoc-string-equalp (thing alist) (or (assoc thing alist) (while (and alist (not (string-equalp thing (car (car alist))))) (setq alist (cdr alist))) (car alist))) (defvar bibtex-maintain-sorted-entries nil "*If true, bibtex-mode will attempt to maintain all bibtex entries in sorted order. Note that this is more a property of a file than a personal preference and as such should normally be set via a file local variable entry.") (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-string-equalp 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!")) (if (and 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 ((key (if bibtex-maintain-sorted-entries (read-string (format "%s key: " entry-type))))) (if key (find-bibtex-entry-location key)) (bibtex-move-outside-of-entry) (insert "@" entry-type "{") (if key (insert key)) (save-excursion (mapcar 'bibtex-make-field required) (if 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-entry (entry-type required optional) ;; (bibtex-move-outside-of-entry) ;; (insert (concat "@" entry-type "{,\n\n}\n\n")) ;; (previous-line 3) ;; (insert (mapconcat 'bibtex-make-entry required ",\n")) ;; (if required ;; (if optional ;; (insert ",\n"))) ;; (insert (mapconcat 'bibtex-make-OPT-entry optional ",\n")) ;; (if bibtex-mode-user-optional-fields ;MON... ;; (progn ;; (if optional ;; (insert ",\n")) ;; (insert (mapconcat 'bibtex-make-OPT-entry ;; bibtex-mode-user-optional-fields ;; ",\n")))) ;MON ;; (up-list -1) ;; (forward-char 1)) (defun bibtex-make-field (e-t) (interactive "sBibTeX entry type: ") (let ((name (if (consp e-t) (car e-t) e-t)) (value (if (consp e-t) (cdr e-t) ""))) (insert ",\n") (indent-to-column bibtex-name-alignment) (insert name " = ") (indent-to-column bibtex-text-alignment) ;; lucid emacs prin1-to-string breaks the undo chain. When they fix ;; that, the hack can be removed. [alarson:19930316.0805CST] ; (insert (prin1-to-string value)) ;; begin hack (insert (format (if (stringp value) "\"%s\"" "%s") value)) ;; end hack nil)) (defun bibtex-make-optional-field (e-t) (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)) ;; What to do about crossref? if present, journal and year are ;; both optional. Due to this, i move all of them into optional. -- MON (defun bibtex-Article () (interactive) (bibtex-entry "Article")) (defun bibtex-Book () (interactive) (bibtex-entry "Book")) (defun bibtex-Booklet () (interactive) (bibtex-entry "Booklet")) ;(defun bibtex-DEAthesis () ; (interactive) ; (bibtex-entry "DEAthesis")) (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 "@string{ = \"\"}\n") (previous-line 1) (forward-char 8)) (defun bibtex-preamble () (interactive) (bibtex-move-outside-of-entry) (insert "@Preamble{}\n") (previous-line 1) (forward-char 10)) (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-next-field () ;; "Finds end of text of next field." ;; (interactive) ;; (condition-case () ;; (progn ;; (bibtex-inside-field) ;; (re-search-forward ",[ \t\n]*" (point-max) 1) ;; (bibtex-enclosing-field) ;; (bibtex-inside-field)) ;; (error nil))) (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 (= (preceding-char) ?\") (forward-char -1)))) ;; (defun bibtex-find-text () ;; "Go to end of text of current field." ;; (interactive) ;; (condition-case () ;; (progn ;; (bibtex-inside-field) ;; (bibtex-enclosing-field) ;; (goto-char (match-end bibtex-text-in-field)) ;; (bibtex-inside-field)) ;; (error nil))) (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-inside-field () "Try to avoid point being at end of a bibtex field." (interactive) (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) ?\") (forward-char -1)))) ;MON - only go back if quote (defun bibtex-remove-double-quotes () "Removes \"\" 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 "\"\"") (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 (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 (match-beginning 0)) (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 (match-beginning bibtex-text-in-cfield) (match-end bibtex-text-in-cfield))) ; 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 (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 (match-beginning 0)) (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 (match-beginning bibtex-text-in-cfield) (match-end bibtex-text-in-cfield))) ; 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-flash-head () "Flash at BibTeX reference head before point, if exists. (Moves point)." (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-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 end of reference; also, use match-beginning and match-end to parse the reference." ;; sct@dcs.edinburgh.ac.uk (let ((old-point (point))) (condition-case errname (bibtex-enclosing-regexp bibtex-reference) (search-failed (goto-char old-point) (error "Can't find enclosing BibTeX reference."))))) (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?]" (interactive "sRegexp: ") ; 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-clean-entry () "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." (interactive) (beginning-of-bibtex-entry) (let ((start (point))) (save-restriction (narrow-to-region start (save-excursion (end-of-bibtex-entry) (point))) (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 "\"\"") ; empty: delete whole field (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 "\"[0-9]+\"") ; 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 "\"\"") ; if empty quotes, complain (forward-char 1) (if (not (or (equal (buffer-substring begin-name (+ begin-name 3)) "OPT") (equal (buffer-substring begin-name (+ begin-name 3)) "opt"))) (error "Mandatory field ``%s'' is empty" (buffer-substring begin-name end-name)))) (t (goto-char end-field)))))))) (goto-char start) (end-of-bibtex-entry) ;; sct@dcs.edinburgh.ac.uk (save-excursion (previous-line 1) (end-of-line) (if (eq (preceding-char) ?,) (backward-delete-char 1))) (skip-whitespace-and-comments))) ;;; Menus for bibtex mode (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-InProceedings] '(" article in conference Proceedings " . bibtex-InProceedings)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Article] '(" Article in journal " . bibtex-Article)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Book] '(" Book " . bibtex-Book)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-Booklet] '(" Booklet " . bibtex-Booklet)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-InProceedings] '(" Conference " . bibtex-InProceedings)) (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-DEAthesis] ;'((" DEA Thesis " . bibtex-DEAthesis)) (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-TechReport] '(" Technical Report " . bibtex-TechReport)) (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-Proceedings] '(" conference Proceedings " . bibtex-Proceedings)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-InBook] '(" a chapter in a Book " . bibtex-InBook)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-InCollection] '(" an article in a Collection " . bibtex-InCollection)) (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-string] '(" string " . bibtex-string)) (define-key bibtex-mode-map [menu-bar entry-types bibtex-preamble] '(" preamble " . bibtex-preamble)) (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-next-field] '(" next field " . bibtex-next-field)) (define-key bibtex-mode-map [menu-bar move/edit bibtex-find-text] '(" to 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] '(" remove quotes " . bibtex-remove-double-quotes)) (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 find-bibtex-duplicates] '(" find duplicates " . find-bibtex-duplicates)) (define-key bibtex-mode-map [menu-bar move/edit sort-bibtex-entries] '(" sort entries " . sort-bibtex-entries)) (define-key bibtex-mode-map [menu-bar move/edit validate-bibtex-buffer] '(" validate entries " . validate-bibtex-buffer)) ;; Please don't send anything to bug-gnu-emacs about these Sunwindows functions ;; since we aren't interested. See etc/SUN-SUPPORT for the reasons why ;; we consider this nothing but a distraction from our work. ;(defmacro eval-in-menu-window (&rest l) ; "Evaluates its argument in the window in which the mouse button was pressed." ; (list 'eval-in-window '*menu-window* l)) ;(defmenu bibtex-sun-entry-menu ; ("Article In Conf. Proc." eval-in-menu-window bibtex-InProceedings) ; ("Article In Journal" eval-in-menu-window bibtex-Article) ; ("Book" eval-in-menu-window bibtex-Book) ; ("Booklet" eval-in-menu-window bibtex-Booklet) ; ("Master's Thesis" eval-in-menu-window bibtex-MastersThesis) ; ("PhD. Thesis" eval-in-menu-window bibtex-PhdThesis) ; ("Technical Report" eval-in-menu-window bibtex-TechReport) ; ("Technical Manual" eval-in-menu-window bibtex-Manual) ; ("Conference Proceedings" eval-in-menu-window bibtex-Proceedings) ; ("In A Book" eval-in-menu-window bibtex-InBook) ; ("In A Collection" eval-in-menu-window bibtex-InCollection) ; ("Miscellaneous" eval-in-menu-window bibtex-Misc) ; ("Unpublished" eval-in-menu-window bibtex-Unpublished) ; ("string" eval-in-menu-window bibtex-string) ; ("preamble" eval-in-menu-window bibtex-preamble)) ; ;(defmenu bibtex-sun-menu ; ("BibTeX menu") ; ("add entry" . bibtex-sun-entry-menu) ; ("next field" eval-in-menu-window bibtex-next-field nil) ; ("to end of field" eval-in-menu-window bibtex-find-text nil) ; ("snatch similar preceding field" eval-in-menu-window bibtex-pop-previous 1) ; ("snatch similar following field" eval-in-menu-window bibtex-pop-next 1) ; ("remove OPT" eval-in-menu-window bibtex-remove-OPT) ; ("remove quotes" eval-in-menu-window bibtex-remove-double-quotes) ; ("clean entry" eval-in-menu-window bibtex-clean-entry) ; ("describe BibTeX mode" eval-in-menu-window describe-mode) ; ("Main Emacs menu" . emacs-menu)) ;(defun bibtex-sun-menu-eval (window x y) ; "Pop-up menu of BibTeX commands." ; (sun-menu-evaluate window (1+ x) (1- y) 'bibtex-sun-menu)) ; ;(defun bibtex-sun-environment () ; "Set up sun menus for BibTeX mode. Call it as bibtex-mode-hook, or ;interactively" ; (interactive) ; (local-set-mouse '(text right) 'bibtex-sun-menu-eval)) ; ;;; bibtex.el ends here emacs-19.22/lisp/blackbox.el100444 13437 1 34310 5427043443 14341 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.22/lisp/bookmark.el100444 12120 1 144712 5463114607 14256 0ustar rmsdaemon;;; bookmark.el --- set bookmarks, jump to them later. ;; Copyright (C) 1993 Free Software Foundation ;; Author: Karl Fogel ;; Maintainer: Karl Fogel ;; Created: July, 1993 ;; Version: 2.5 ;; 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. ;; 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 list-bookmarks ;; and the menu-bar). ;; And much thanks to David Hughes for many small ;; suggestions and the code to implement them (like ;; Bookmark-menu-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!) ;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad ;; . ;; LCD Archive Entry: ;; bookmark|Karl Fogel|kfogel@cs.oberlin.edu| ;; Setting bookmarks in files or directories, jumping to them later.| ;; 16-July-93|Version: 2.5|~/misc/bookmark.el.Z| ;; 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? ;;; Commentary on code: ;; bookmark alist format: ;; (... ;; (bookmark-name (filename ;; string-in-front ;; string-behind ;; point)) ;; ...) ;; ;; 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 the ;; bookmark is set at, string-behind is the same thing after the ;; point. 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. ;; ;; 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. ;;; Code: ;; Added for lucid emacs compatibility, db (or (fboundp 'defalias) (fset 'defalias 'fset)) ;; suggested for lucid compatibility by david hughes: (or (fboundp 'frame-height) (fset 'frame-height 'screen-height)) ;; 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" 'list-bookmarks))) ;; 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-locate) ; "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) (defvar bookmark-alist () "Association list of bookmarks. You probably don't want to change the value of this alist yourself; instead, let the various bookmark functions do it for you.") (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-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-file, which is `~/.emacs-bkmrks' by default.") (defvar bookmark-alist-modification-count 0 "Number of modifications to bookmark list since it was last saved.") (defvar bookmark-file "~/.emacs-bkmrks" "*File in which to save bookmarks by default.") (defvar bookmark-version-control 'nospecial "This variable controls whether or not to make numbered backups of the master 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-search-size 500 "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) ;;;###autoload (defun bookmark-set (&optional parg) "Set a bookmark named NAME inside a file. 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-v inserts the name of the current file being visited. 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 behaves like C-v and 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 "P") (if (not (bookmark-buffer-file-name)) (error "Buffer not visiting a file or directory.")) (bookmark-try-default-file) (setq bookmark-current-point (point)) (setq bookmark-yank-point (point)) (setq bookmark-current-buffer (current-buffer)) (let* ((default (or bookmark-current-bookmark (buffer-name (current-buffer)))) (str (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-v" 'bookmark-insert-current-file-name) (define-key now-map "\C-u" 'bookmark-insert-current-bookmark)) now-map)))) (and (string-equal str "") (setq str default)) (progn (bookmark-make parg str) (setq bookmark-current-bookmark str) (if (get-buffer "*Bookmark List*") ;rebuild the bookmark list (save-excursion (save-window-excursion (list-bookmarks)))) (goto-char bookmark-current-point)))) (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-current-file-name)))) (defun bookmark-insert-current-file-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-file-name)))) (insert (substring str (1+ (string-match "\\(/[^/]*\\)/*$" str)))))) (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 (point) (save-excursion (forward-word 1) (setq bookmark-yank-point (point))))))) (insert string))) (defun bookmark-make (parg str) (if (and (assoc str bookmark-alist) (not parg)) ;; already existing boookmark under that name and ;; no prefix arg means just overwrite old bookmark (setcdr (assoc str bookmark-alist) (list (bookmark-make-cell))) ;; 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 str (bookmark-make-cell)) bookmark-alist))) ;; Added by db (setq bookmark-current-bookmark str) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (if (bookmark-time-to-save-p) (bookmark-save))) (defun bookmark-make-cell () ;; make the cell that is the cdr of a bookmark alist element. It ;; looks like this: ;; (filename search-forward-str search-back-str point) (list (bookmark-buffer-file-name) (if (>= (- (point-max) (point)) bookmark-search-size) (buffer-substring (point) (+ (point) bookmark-search-size)) nil) (if (>= (- (point) (point-min)) bookmark-search-size) (buffer-substring (point) (- (point) bookmark-search-size)) nil) (point))) (defun bookmark-buffer-file-name () (or buffer-file-name (if (and (boundp 'dired-directory) dired-directory) (if (stringp dired-directory) dired-directory (car dired-directory))))) (defun bookmark-try-default-file () (and (not bookmarks-already-loaded) (null bookmark-alist) (file-readable-p (expand-file-name bookmark-file)) (progn (bookmark-load bookmark-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 (str) "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 (progn (bookmark-try-default-file) (let* ((completion-ignore-case bookmark-completion-ignore-case) (default (or (and (assoc bookmark-current-bookmark bookmark-alist) bookmark-current-bookmark) (and (assoc (buffer-name (current-buffer)) bookmark-alist) (buffer-name (current-buffer))))) (str (completing-read (if default (format "Jump to bookmark (%s): " default) "Jump to bookmark: ") bookmark-alist nil 0))) (and (string-equal "" str) (setq str default)) (list str)))) (let ((cell (bookmark-jump-noselect str))) (and cell (switch-to-buffer (car cell)) (goto-char (cdr cell))))) (defun bookmark-jump-noselect (str) ;; a leetle helper for bookmark-jump :-) ;; returns (BUFFER . POINT) (let ((whereto-list (car (cdr (assoc str bookmark-alist))))) (let* ((file (expand-file-name (car whereto-list))) (orig-file file) (forward-str (car (cdr whereto-list))) (behind-str (car (cdr (cdr whereto-list)))) (place (car (cdr (cdr (cdr whereto-list)))))) (if (or (file-exists-p file) ;; else try some common compression extensions ;; and Emacs better handle it right! (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 (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 bookmark-search-size))) (if behind-str (if (search-backward behind-str (point-min) t) (forward-char bookmark-search-size))) ;; 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, but deleting it would be a good idea.") nil)))))) ;;;###autoload (defun bookmark-relocate (str) "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 (let ((completion-ignore-case bookmark-completion-ignore-case)) (progn (bookmark-try-default-file) (list (completing-read "Bookmark to relocate: " bookmark-alist nil 0))))) (let* ((bmrk (assoc str bookmark-alist)) (bmrk-filename (car (car (cdr bmrk)))) (newloc (expand-file-name (read-file-name (format "Relocate %s to: " str) (file-name-directory bmrk-filename))))) (setcar (car (cdr bmrk)) newloc))) ;;;###autoload (defun bookmark-locate (str &optional no-insertion) "Insert the name of the file associated with BOOKMARK. Optional second arg NO-INSERTION means merely return the filename as a string." (interactive (let ((completion-ignore-case bookmark-completion-ignore-case)) (progn (bookmark-try-default-file) (list (completing-read "Insert bookmark location: " bookmark-alist nil 0))))) (let ((where (car (car (cdr (assoc str bookmark-alist)))))) (if no-insertion where (insert where)))) ;;;###autoload (defun bookmark-rename (old &optional new) "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, and C-v inserts the name of the file." (interactive (let ((completion-ignore-case bookmark-completion-ignore-case)) (progn (bookmark-try-default-file) (list (completing-read "Old bookmark name: " bookmark-alist nil 0))))) (progn (setq bookmark-current-point (point)) (setq bookmark-yank-point (point)) (setq bookmark-current-buffer (current-buffer)) (let ((cell (assoc old bookmark-alist)) (str (or new ; use second arg, if non-nil (read-from-minibuffer "New name: " nil (let ((now-map (copy-keymap minibuffer-local-map))) (progn (define-key now-map "\C-w" 'bookmark-yank-word) (define-key now-map "\C-v" 'bookmark-insert-current-file-name)) now-map))))) (progn (setcar cell str) (setq bookmark-current-bookmark str) (if (get-buffer "*Bookmark List*") (save-excursion (save-window-excursion (list-bookmarks)))) (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) (if (bookmark-time-to-save-p) (bookmark-save)))))) ;;;###autoload (defun bookmark-insert (str) "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 (let ((completion-ignore-case bookmark-completion-ignore-case)) (progn (bookmark-try-default-file) (list (completing-read "Insert bookmark contents: " bookmark-alist nil 0))))) (let ((orig-point (point)) (str-to-insert (save-excursion (set-buffer (car (bookmark-jump-noselect str))) (buffer-substring (point-min) (point-max))))) (insert str-to-insert) (push-mark) (goto-char orig-point))) ;;;###autoload (defun bookmark-delete (str) "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\)." (interactive (let ((completion-ignore-case bookmark-completion-ignore-case)) (progn (bookmark-try-default-file) (list (completing-read "Delete bookmark: " bookmark-alist nil 0 bookmark-current-bookmark))))) (let ((will-go (assoc str bookmark-alist))) (setq bookmark-alist (delq will-go bookmark-alist)) ;; Added by db, nil bookmark-current-bookmark if the last ;; occurence has been deleted (or (assoc bookmark-current-bookmark bookmark-alist) (setq bookmark-current-bookmark nil))) (if (get-buffer "*Bookmark List*") (save-excursion (save-window-excursion (list-bookmarks)))) (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-try-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-file'. With a prefix arg, save it in file FILE. 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-file'." (interactive "P") (bookmark-try-default-file) (cond ((and (null parg) (null file)) ;;whether interactive or not, write to default file (bookmark-write-file bookmark-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)) (print 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)))))) ;;;###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-bkmrks', is maintained automatically by Emacs; you shouldn't need to load it explicitly." (interactive (progn (bookmark-try-default-file) (list (read-file-name (format "Load bookmarks from: (%s) " bookmark-file) ;;Default might not be used often, ;;but there's no better default, and ;;I guess it's better than none at all. "~/" bookmark-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)) (let ((blist (car (read-from-string (buffer-substring (point-min) (point-max)))))) (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))) (if (get-buffer "*Bookmark List*") (save-excursion (list-bookmarks)))) (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)))) ;;;; bookmark-menu-mode stuff ;;;; (defvar Bookmark-menu-bookmark-column nil) (defvar Bookmark-menu-hidden-bookmarks ()) (defvar Bookmark-menu-file-column 30 "*Column at which to display filenames in a buffer listing bookmarks. You can toggle whether files are shown with \\\\[Bookmark-menu-toggle-filenames].") (defvar Bookmark-menu-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-menu-toggle-filenames nil\)") (defvar Bookmark-menu-mode-map nil) (if Bookmark-menu-mode-map nil (setq Bookmark-menu-mode-map (make-keymap)) (suppress-keymap Bookmark-menu-mode-map t) (define-key Bookmark-menu-mode-map "q" 'Bookmark-menu-quit) (define-key Bookmark-menu-mode-map "v" 'Bookmark-menu-select) (define-key Bookmark-menu-mode-map "w" 'Bookmark-menu-locate) (define-key Bookmark-menu-mode-map "2" 'Bookmark-menu-2-window) (define-key Bookmark-menu-mode-map "1" 'Bookmark-menu-1-window) (define-key Bookmark-menu-mode-map "j" 'Bookmark-menu-this-window) (define-key Bookmark-menu-mode-map "f" 'Bookmark-menu-this-window) (define-key Bookmark-menu-mode-map "o" 'Bookmark-menu-other-window) (define-key Bookmark-menu-mode-map "\C-o" 'Bookmark-menu-switch-other-window) (define-key Bookmark-menu-mode-map "s" 'Bookmark-menu-save) (define-key Bookmark-menu-mode-map "k" 'Bookmark-menu-delete) (define-key Bookmark-menu-mode-map "\C-d" 'Bookmark-menu-delete-backwards) (define-key Bookmark-menu-mode-map "x" 'Bookmark-menu-execute) (define-key Bookmark-menu-mode-map "\C-k" 'Bookmark-menu-delete) (define-key Bookmark-menu-mode-map "d" 'Bookmark-menu-delete) (define-key Bookmark-menu-mode-map " " 'next-line) (define-key Bookmark-menu-mode-map "n" 'next-line) (define-key Bookmark-menu-mode-map "p" 'previous-line) (define-key Bookmark-menu-mode-map "\177" 'Bookmark-menu-backup-unmark) (define-key Bookmark-menu-mode-map "?" 'describe-mode) (define-key Bookmark-menu-mode-map "u" 'Bookmark-menu-unmark) (define-key Bookmark-menu-mode-map "m" 'Bookmark-menu-mark) (define-key Bookmark-menu-mode-map "l" 'Bookmark-menu-load) (define-key Bookmark-menu-mode-map "r" 'Bookmark-menu-rename) (define-key Bookmark-menu-mode-map "t" 'Bookmark-menu-toggle-filenames)) ;; Bookmark Menu mode is suitable only for specially formatted data. (put 'Bookmark-menu-mode 'mode-class 'special) ;; need to display whether or not bookmark exists as a buffer in flag ;; column. ;; Format: ;; FLAGS BOOKMARK (/FILE/NAME/HERE/WHAT/REGEXP/TO/USE?) ;; goto bookmark-column and then search till "(/[^)]*)$" or "(/.*)$" ? ;;;###autoload (defalias 'edit-bookmarks 'list-bookmarks) ;;;###autoload (defun list-bookmarks () "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-try-default-file) (switch-to-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) (let ((lst bookmark-alist)) (while lst (insert (concat " " (car (car lst)) "\n")) (setq lst (cdr lst))))) (goto-char (point-min)) (forward-line 2) (bookmark-menu-mode) (if Bookmark-menu-toggle-filenames (Bookmark-menu-toggle-filenames t))) (defun bookmark-menu-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-menu-mark] -- mark bookmark to be displayed. \\[Bookmark-menu-select] -- select bookmark of line point is on. Also show bookmarks marked using m in other windows. \\[Bookmark-menu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). \\[Bookmark-menu-locate] -- display (in minibuffer) location of this bookmark. \\[Bookmark-menu-1-window] -- select this bookmark in full-frame window. \\[Bookmark-menu-2-window] -- select this bookmark in one window, together with bookmark selected before this one in another window. \\[Bookmark-menu-this-window] -- select this bookmark in place of the bookmark menu buffer. \\[Bookmark-menu-other-window] -- select this bookmark in another window, so the bookmark menu bookmark remains visible in its window. \\[Bookmark-menu-switch-other-window] -- switch the other window to this bookmark. \\[Bookmark-menu-rename] -- rename this bookmark \(prompts for new name\). \\[Bookmark-menu-delete] -- mark this bookmark to be deleted, and move down. \\[Bookmark-menu-delete-backwards] -- mark this bookmark to be deleted, and move up. \\[Bookmark-menu-execute] -- delete marked bookmarks. \\[Bookmark-menu-save] -- save the current bookmark list in the default file. With a prefix arg, prompts for a file to save in. \\[Bookmark-menu-load] -- load in a file of bookmarks (prompts for file.) \\[Bookmark-menu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \\[Bookmark-menu-backup-unmark] -- back up a line and remove marks." (kill-all-local-variables) (use-local-map Bookmark-menu-mode-map) (setq truncate-lines t) (setq buffer-read-only t) (setq major-mode 'bookmark-menu-mode) (setq mode-name "Bookmark Menu") (run-hooks 'bookmark-menu-mode-hook)) (defun Bookmark-menu-toggle-filenames (&optional parg) "Toggle whether filenames are shown in the bookmark list. Optional argument SHOW means show them unconditionally." (interactive) (cond (parg (setq Bookmark-menu-toggle-filenames nil) (Bookmark-menu-show-filenames) (setq Bookmark-menu-toggle-filenames t)) (Bookmark-menu-toggle-filenames (Bookmark-menu-hide-filenames) (setq Bookmark-menu-toggle-filenames nil)) (t (Bookmark-menu-show-filenames) (setq Bookmark-menu-toggle-filenames t)))) (defun Bookmark-menu-show-filenames (&optional force) (if (and (not force) Bookmark-menu-toggle-filenames) nil ;already shown, so do nothing (save-excursion (save-window-excursion (goto-char (point-min)) (forward-line 2) (setq Bookmark-menu-hidden-bookmarks ()) (let ((buffer-read-only nil)) (while (< (point) (point-max)) (let ((bmrk (Bookmark-menu-bookmark))) (setq Bookmark-menu-hidden-bookmarks (cons bmrk Bookmark-menu-hidden-bookmarks)) (move-to-column Bookmark-menu-file-column t) (delete-region (point) (progn (end-of-line) (point))) (insert " ") (bookmark-locate bmrk) (forward-line 1)))))))) (defun Bookmark-menu-hide-filenames (&optional force) (if (and (not force) Bookmark-menu-toggle-filenames) ;; nothing to hide if above is nil (save-excursion (save-window-excursion (goto-char (point-min)) (forward-line 2) (setq Bookmark-menu-hidden-bookmarks (nreverse Bookmark-menu-hidden-bookmarks)) (save-excursion (goto-char (point-min)) (search-forward "Bookmark") (backward-word 1) (setq Bookmark-menu-bookmark-column (current-column))) (save-excursion (let ((buffer-read-only nil)) (while Bookmark-menu-hidden-bookmarks (move-to-column Bookmark-menu-bookmark-column t) (kill-line) (insert (car Bookmark-menu-hidden-bookmarks)) (setq Bookmark-menu-hidden-bookmarks (cdr Bookmark-menu-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-menu-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-menu-bookmark () ;; return a string which is bookmark of this line. (if (Bookmark-menu-check-position) (save-excursion (save-window-excursion (goto-char (point-min)) (search-forward "Bookmark") (backward-word 1) (setq Bookmark-menu-bookmark-column (current-column))))) (if Bookmark-menu-toggle-filenames (Bookmark-menu-hide-filenames)) (save-excursion (save-window-excursion (beginning-of-line) (forward-char Bookmark-menu-bookmark-column) (prog1 (buffer-substring (point) (progn (end-of-line) (point))) ;; well, this is certainly crystal-clear: (if Bookmark-menu-toggle-filenames (Bookmark-menu-toggle-filenames t)))))) (defun Bookmark-menu-mark () "Mark bookmark on this line to be displayed by \\\\[Bookmark-menu-select] command." (interactive) (beginning-of-line) (if (Bookmark-menu-check-position) (let ((buffer-read-only nil)) (delete-char 1) (insert ?>) (forward-line 1)))) (defun Bookmark-menu-select () "Select this line's bookmark; also display bookmarks marked with `>'. You can mark bookmarks with the \\\\[Bookmark-menu-mark] command." (interactive) (if (Bookmark-menu-check-position) (let ((bmrk (Bookmark-menu-bookmark)) (menu (current-buffer)) (others ()) tem) (goto-char (point-min)) (while (re-search-forward "^>" nil t) (setq tem (Bookmark-menu-bookmark)) (let ((buffer-read-only nil)) (delete-char -1) (insert ?\ )) (or (string-equal tem bmrk) (memq 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 (equal (length others) 0) nil (while others (split-window nil tem) (other-window 1) (bookmark-jump (car others)) (setq others (cdr others))) (other-window 1))))) (defun Bookmark-menu-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-menu-load () "Load a bookmark file and rebuild list." (interactive) (if (Bookmark-menu-check-position) (save-excursion (save-window-excursion (call-interactively 'bookmark-load))))) (defun Bookmark-menu-1-window () "Select this line's bookmark, alone, in full frame." (interactive) (if (Bookmark-menu-check-position) (progn (bookmark-jump (Bookmark-menu-bookmark)) (bury-buffer (other-buffer)) (delete-other-windows)))) (defun Bookmark-menu-2-window () "Select this line's bookmark, with previous buffer in second window." (interactive) (if (Bookmark-menu-check-position) (let ((bmrk (Bookmark-menu-bookmark)) (menu (current-buffer)) (pop-up-windows t)) (delete-other-windows) (switch-to-buffer (other-buffer)) (let ((buff (car (bookmark-jump-noselect bmrk)))) (pop-to-buffer buff)) (bury-buffer menu)))) (defun Bookmark-menu-this-window () "Select this line's bookmark in this window." (interactive) (if (Bookmark-menu-check-position) (bookmark-jump (Bookmark-menu-bookmark)))) (defun Bookmark-menu-other-window () "Select this line's bookmark in other window, leaving bookmark menu visible." (interactive) (if (Bookmark-menu-check-position) (let ((buff (car (bookmark-jump-noselect (Bookmark-menu-bookmark))))) (switch-to-buffer-other-window buff)))) (defun Bookmark-menu-switch-other-window () "Make the other window select this line's bookmark. The current window remains selected." (interactive) (if (Bookmark-menu-check-position) (let ((buff (car (bookmark-jump-noselect (Bookmark-menu-bookmark))))) (display-buffer buff)))) (defun Bookmark-menu-quit () "Quit the bookmark menu." (interactive) (let ((buffer (current-buffer))) (switch-to-buffer (other-buffer)) (bury-buffer buffer))) (defun Bookmark-menu-unmark (&optional backup) "Cancel all requested operations on bookmark on this line and move down. Optional ARG means move up." (interactive "P") (beginning-of-line) (if (Bookmark-menu-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-menu-backup-unmark () "Move up and cancel all requested operations on bookmark on line above." (interactive) (forward-line -1) (if (Bookmark-menu-check-position) (progn (Bookmark-menu-unmark) (forward-line -1)))) (defun Bookmark-menu-delete () "Mark bookmark on this line to be deleted by \\\\[Bookmark-menu-execute] command." (interactive) (beginning-of-line) (if (Bookmark-menu-check-position) (let ((buffer-read-only nil)) (delete-char 1) (insert ?D) (forward-line 1)))) (defun Bookmark-menu-delete-backwards () "Mark bookmark on this line to be deleted by \\\\[Bookmark-menu-execute] command and then move up one line" (interactive) (Bookmark-menu-delete) (forward-line -2) (if (Bookmark-menu-check-position) (forward-line 1))) (defun Bookmark-menu-execute () "Delete bookmarks marked with \\\\[Buffer-menu-delete] commands." (interactive) (let ((hide-em Bookmark-menu-toggle-filenames)) (if hide-em (Bookmark-menu-hide-filenames)) (setq Bookmark-menu-toggle-filenames nil) (goto-char (point-min)) (forward-line 1) (let ((deaders ())) (while (re-search-forward "^D" (point-max) t) (setq deaders (cons (Bookmark-menu-bookmark) deaders))) (mapcar (lambda (str) (setq bookmark-alist (delq (assoc str bookmark-alist) bookmark-alist))) deaders)) (list-bookmarks) (goto-char (point-min)) (forward-line 2) (setq Bookmark-menu-toggle-filenames hide-em) (if Bookmark-menu-toggle-filenames (Bookmark-menu-toggle-filenames t)))) (defun Bookmark-menu-rename () "Rename bookmark on current line. Prompts for a new name." (interactive) (if (Bookmark-menu-check-position) (let ((bmrk (Bookmark-menu-bookmark)) (thispoint (point))) (bookmark-rename bmrk) (list-bookmarks) (goto-char thispoint)))) (defun Bookmark-menu-locate () "Display location of this bookmark. Displays in the minibuffer." (interactive) (if (Bookmark-menu-check-position) (let ((bmrk (Bookmark-menu-bookmark))) (message (bookmark-locate bmrk t))))) ;;;; bookmark menu bar stuff ;;;; (defvar bookmark-menu-bar-length 70 "*Maximum length of a bookmark name displayed on a popup menu.") (defun bookmark-make-menu-bar-alist () (bookmark-try-default-file) (bookmark-maybe-sort-alist) (if bookmark-alist (mapcar (lambda (cell) (let ((str (car cell))) (cons (if (> (length str) bookmark-menu-bar-length) (substring str 0 bookmark-menu-bar-length) str) str))) bookmark-alist) (error "No bookmarks currently set."))) (defun bookmark-make-menu-bar-with-function (func-sym menu-label menu-str event) ;; help function for making menus that need to apply a bookmark ;; function to a string. (let* ((menu (bookmark-make-menu-bar-alist)) (str (x-popup-menu event (list menu-label (cons menu-str menu))))) (if str (apply func-sym (list str))))) (defun bookmark-menu-bar-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." (interactive "e") (bookmark-make-menu-bar-with-function 'bookmark-insert "Bookmark Insert Menu" "--- Insert Contents ---" event)) (defun bookmark-menu-bar-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." (interactive "e") (bookmark-make-menu-bar-with-function 'bookmark-jump "Bookmark Jump Menu" "--- Jump to Bookmark ---" event)) (defun bookmark-menu-bar-locate (event) "Insert the name of the file associated with BOOKMARK. \(This is not the same as the contents of that file\)." (interactive "e") (bookmark-make-menu-bar-with-function 'bookmark-locate "Bookmark Locate Menu" "--- Insert Location ---" event)) (defun bookmark-menu-bar-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, and C-v inserts the name of the file." (interactive "e") (bookmark-make-menu-bar-with-function 'bookmark-rename "Bookmark Rename Menu" "--- Rename Bookmark ---" event)) (defun bookmark-menu-bar-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\)." (interactive "e") (bookmark-make-menu-bar-with-function 'bookmark-delete "Bookmark Delete Menu" "--- 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. (defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions.")) ;; make bookmarks appear toward the right side of the menu. (if (boundp 'menu-bar-final-items) (if menu-bar-final-items (setq menu-bar-final-items (cons 'bookmark menu-bar-final-items))) (setq menu-bar-final-items '(bookmark))) (define-key menu-bar-bookmark-map [load] '("Load a bookmark file" . bookmark-load)) (define-key menu-bar-bookmark-map [write] '("Write \(to another file\)" . bookmark-write)) (define-key menu-bar-bookmark-map [save] '("Save \(in default file\)" . bookmark-save)) (define-key menu-bar-bookmark-map [edit] '("Edit Bookmark List" . list-bookmarks)) (define-key menu-bar-bookmark-map [delete] '("Delete bookmark" . bookmark-menu-bar-delete)) (define-key menu-bar-bookmark-map [rename] '("Rename bookmark" . bookmark-menu-bar-rename)) (define-key menu-bar-bookmark-map [locate] '("Insert location" . bookmark-menu-bar-locate)) (define-key menu-bar-bookmark-map [insert] '("Insert contents" . bookmark-menu-bar-insert)) (define-key menu-bar-bookmark-map [set] '("Set bookmark" . bookmark-set)) (define-key menu-bar-bookmark-map [jump] '("Jump to bookmark" . bookmark-menu-bar-jump)) ;;;###autoload (autoload 'menu-bar-bookmark-map "bookmark" nil t 'keymap) (fset 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map)) ;;;; end bookmark menu-bar stuff ;;;; (provide 'bookmark) ;;; bookmark.el ends here emacs-19.22/lisp/buff-menu.el100444 12120 1 32246 5425672171 14316 0ustar rmsdaemon;;; buff-menu.el --- buffer menu main function and support functions. ;; Copyright (C) 1985, 1986, 1987, 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: ;; 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: ;;;Not needed, now that q is now just quit and Buffer-menu-select is v. ;;;(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-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 "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) ) ;; 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-mark] -- mark buffer to be displayed. \\[Buffer-menu-select] -- select buffer of line point is on. 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-this-window] -- select that buffer in place of the buffer menu buffer. \\[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] -- switch the other window to this buffer. \\[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 truncate-lines t) (setq buffer-read-only t) (setq major-mode 'Buffer-menu-mode) (setq mode-name "Buffer Menu") (run-hooks 'buffer-menu-mode-hook)) (defvar Buffer-menu-buffer-column nil) (defvar Buffer-menu-size-column nil) (defun Buffer-menu-buffer (error-if-non-existent-p) "Return buffer described by this line of buffer menu." (if (null Buffer-menu-buffer-column) (save-excursion (goto-char (point-min)) (search-forward "Buffer") (backward-word 1) (setq Buffer-menu-buffer-column (current-column)) (search-forward "Size") (backward-word 1) (setq Buffer-menu-size-column (current-column)))) (save-excursion (beginning-of-line) (forward-char Buffer-menu-buffer-column) (let ((start (point)) string) ;; End of buffer name marked by tab or two spaces. (re-search-forward "\t\\| ") (skip-chars-backward " \t") (setq string (buffer-substring start (point))) (or (get-buffer string) (if error-if-non-existent-p (error "No buffer named \"%s\"" string) 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 and to restore previous window configuration." (interactive "P") ;;; (setq Buffer-menu-window-config (current-window-configuration)) (list-buffers arg) (pop-to-buffer "*Buffer List*") (forward-line 2) (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))) ;; Restore previous window configuration before displaying ;; selected buffers. (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 () "Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command." (interactive) (beginning-of-line) (if (looking-at " [-M]") ;header lines (ding) (let ((buffer-read-only nil)) (delete-char 1) (insert ?D) (forward-line 1)))) (defun Buffer-menu-delete-backwards () "Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command and then move up one line" (interactive) (Buffer-menu-delete) (forward-line -2) (if (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) (forward-char 1) (if (looking-at " [-M]") ;header lines (ding) (let ((buffer-read-only nil)) (delete-char 1) (insert ?S) (forward-line 1)))) (defun Buffer-menu-not-modified () "Mark buffer on this line as unmodified (no changes to save)." (interactive) (save-excursion (set-buffer (Buffer-menu-buffer t)) (set-buffer-modified-p nil)) (save-excursion (beginning-of-line) (forward-char 1) (if (looking-at "\\*") (let ((buffer-read-only nil)) (delete-char 1) (insert ? ))))) (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." (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-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." (interactive) (let (char) (save-excursion (set-buffer (Buffer-menu-buffer t)) (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)))))) ;;; buff-menu.el ends here emacs-19.22/lisp/byte-opt.el100444 11732 1 176171 5446736146 14376 0ustar bfoxdaemon;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler. ;;; Copyright (c) 1991 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)) ;;; ;;; collapse common subexpressions ;;; ;;; 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 'inhibit-quit 'binding-is-magic t) ;;; (put 'quit-flag '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. ;;; ;;; 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.) ;;; ;;; Really the Right Thing is to make lexical scope the default across ;;; the board, in the interpreter and compiler, and just FIX all of ;;; the code that relies on dynamic scope of non-defvarred variables. ;;; 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) (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 is nonassociative, like - or /. (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-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))) (while (cdr (setq rest (cdr rest))) (if (numberp (car rest)) (let (constants) (setq form (copy-sequence form) rest (nthcdr (1- start) form)) (while (setq rest (cdr rest)) (cond ((numberp (car rest)) (setq constants (cons (car rest) constants)) (setcar rest nil)))) (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) (list '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) ;; Don't shrink to less than two arguments--would get an error. nil) ((= 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)) (delq -1 (copy-sequence 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 (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 (mapcar 'cdr (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 (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) (let ((count (nth 1 form))) (if (not (memq count '(0 1 2))) (byte-optimize-predicate form) (setq form (nth 2 form)) (while (natnump (setq count (1- count))) (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- < <= = > >= append aref ash assoc assq boundp buffer-file-name buffer-local-variables buffer-modified-p buffer-substring capitalize car cdr concat coordinates-in-window-p copy-marker count-lines documentation downcase elt 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 format get get-buffer get-buffer-window getenv get-file-buffer length logand logior lognot logxor lsh marker-buffer max member memq min mod next-window nth nthcdr previous-window rassq regexp-quote reverse string< string= string-lessp string-equal substring user-variable-p window-buffer window-edges window-height window-hscroll window-width zerop)) ;; could also add plusp, minusp, signum. If anyone ever defines ;; these, they will certainly be side-effect free. (side-effect-and-error-free-fns '(arrayp atom bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp char-or-string-p commandp cons consp current-buffer dot dot-marker eobp eolp eq eql equal get-largest-window identity integerp integer-or-marker-p interactive-p keymapp list listp make-marker mark mark-marker markerp minibuffer-window natnump nlistp not null numberp one-window-p point point-marker processp selected-window sequencep stringp subrp symbolp syntax-table-p vector vectorp 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. ;;; (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 the optional 3rd arg is true, then `return' opcodes are replaced ;; with `goto's destined for the end of the code. (defun byte-decompile-bytecode-1 (bytes constvec &optional make-splicable) (let ((length (length bytes)) (ptr 0) optr tag tags op offset lap tmp endtag (retcount 0)) (while (not (= ptr length)) (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-splicable (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 ((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 'cdr (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 check-protected-fields completion-auto-help completion-ignore-case cursor-in-echo-area debug-on-next-call debug-on-quit defining-kbd-macro delete-exited-processes enable-recursive-minibuffers indent-tabs-mode insert-default-directory inverse-video load-in-progress menu-prompting mode-line-inverse-video no-redraw-on-reenter noninteractive parse-sexp-ignore-comments pop-up-frames pop-up-windows print-escape-newlines print-escape-newlines truncate-partial-width-windows visible-bell vms-stmlf-recfm words-include-escapes x-save-under) "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:" (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]... %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.22/lisp/byte-run.el100444 74777 1 14000 5351637240 14332 0ustar ericdaemon;;; 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.22/lisp/bytecomp.el100444 12120 1 346670 5432111712 14270 0ustar rmsdaemon;;; bytecomp.el --- compilation of Lisp code into byte code. ;;; Copyright (C) 1985, 1986, 1987, 1992 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) ;;; This defaults to nil in -batch mode, which is ;;; slightly faster. ;;; 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.") (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 (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 "c"))))) ;; 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-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)) (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. 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 wil 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 (defconst byte-compile-current-form nil) (defconst byte-compile-current-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) (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)) (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))) (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) (aref def 0))))) (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) (aref old 0)))) (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-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) (defmacro displaying-byte-compile-warnings (&rest body) (list 'let '((byte-compile-warnings-point-max (if (boundp 'byte-compile-warnings-point-max) byte-compile-warnings-point-max (save-excursion (set-buffer (get-buffer-create "*Compile-Log*")) (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-recompile-directory (directory &optional arg) "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." (interactive "DByte recompile directory: \nP") (if arg (setq arg (prefix-numeric-value arg))) (if noninteractive nil (save-some-buffers) (set-buffer-modified-p (buffer-modified-p))) ;Update the mode line. (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)) (if (or (null arg) (eq 0 arg) (y-or-n-p (concat "Check " source "? "))) (setq directories (nconc directories (list source)))) (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-newer-than-file-p source dest) (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 (file-name-nondirectory filename)) target-file input-buffer output-buffer) (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)) (set-auto-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)) (if byte-compiler-error-flag nil (kill-buffer input-buffer) (save-excursion (set-buffer output-buffer) (goto-char (point-max)) (insert "\n") ; aaah, unix. (let ((vms-stmlf-recfm t)) (setq target-file (byte-compile-dest-file filename)) ;;; (or byte-compile-overwrite-file ;;; (condition-case () ;;; (delete-file target-file) ;;; (error nil))) (if (file-writable-p target-file) (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki (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))) ;;; (or byte-compile-overwrite-file ;;; (condition-case () ;;; (set-file-modes target-file (file-modes filename)) ;;; (error nil))) ) (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 t)) ;; (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 eval) ;; buffer --> output-buffer, or buffer --> eval form, return nil (let (outbuffer) (let (;; Prevent truncation of flonums and lists as we read and print them (float-output-format nil) (case-fold-search nil) (print-length 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) ;; 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) (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) (and (not eval) (byte-compile-insert-header)) (byte-compile-warn-about-unresolved-functions) ;; 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))) (save-excursion (set-buffer outbuffer) (goto-char (point-min))))) (if (not eval) outbuffer (while (condition-case nil (progn (setq form (read outbuffer)) t) (end-of-file nil)) (eval form)) (kill-buffer outbuffer) nil))) (defun byte-compile-insert-header () (save-excursion (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 " (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" "\t (string-lessp emacs-version \"19\")))\n" " (error \"This file was compiled for Emacs 19\"))\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 '("\n(" 3 ")") form) (let ((print-escape-newlines t) (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 (info form) ;; Print a form with a doc string. INFO is (prefix doc-index postfix). (set-buffer (prog1 (current-buffer) (set-buffer outbuffer) (insert (car info)) (let ((docl (nthcdr (nth 1 info) form)) (print-escape-newlines t) (print-readably t) ; print #[] for bytecode, 'x for (quote x) (print-gensym nil)) ; this is too dangerous for now (prin1 (car form) outbuffer) (while (setq form (cdr form)) (insert " ") (if (eq form docl) (let ((print-escape-newlines nil)) (goto-char (prog1 (1+ (point)) (prin1 (car form) outbuffer))) (insert "\\\n") (goto-char (point-max))) (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)))) (if (not (stringp (nth 3 form))) ;; No doc string to make-docfile; insert form in normal code. (byte-compile-keep-pending (list (if (byte-compile-version-cond byte-compile-compatibility) 'fset 'defalias) (list 'quote name) (cond ((not macrop) code) ((eq 'make-byte-code (car-safe code)) (list 'cons ''macro code)) ((list 'quote (if macrop (cons 'macro new-one) new-one)))))) ;; Output the form by hand, that's much simpler than having ;; b-c-output-file-form analyze the defalias. (byte-compile-flush-pending) (princ (if (byte-compile-version-cond byte-compile-compatibility) "\n(fset '" "\n(defalias '") outbuffer) (prin1 name outbuffer) (byte-compile-output-docform (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)) (princ ")" outbuffer) nil))))) ;;;###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'. (or (eq (car-safe (nth 1 int)) '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 -> a single atom. ;; 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 (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) (and (consp (car body)) (eq output-type 'lambda))) (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 (get var 'byte-obsolete-variable) (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. (defun byte-compile-associative (form) (if (cdr form) (let ((opcode (get (car form) 'byte-opcode))) ;; To compile all the args first may enable some optimizations. (mapcar 'byte-compile-form (setq form (cdr form))) (while (setq form (cdr form)) (byte-compile-out opcode 0))) (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 (list 'track-mouse (byte-compile-top-level (nth 1 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 (symbolp condition)) (byte-compile-warn "%s is not a symbol naming a condition (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) (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)))) (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")) ;;; 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))) (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; this is now a list of events.") (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.") (provide 'byte-compile) ;;; 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.22/lisp/c-mode.el100444 12120 1 144117 5474370726 13624 0ustar rmsdaemon;;; c-mode.el --- C code editing commands for Emacs ;; Copyright (C) 1985, 1986, 1987, 1992 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 curser 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 () "Keymap used in C mode.") (if c-mode-map () (setq c-mode-map (make-sparse-keymap)) (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 "\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 "\177" 'backward-delete-char-untabify) (define-key c-mode-map "\t" 'c-indent-command)) ;; cmacexp is lame because it uses no preprocessor symbols. ;; It isn't very extensible either -- hardcodes /lib/cpp. (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-label-offset . -2) (c-continued-statement-offset . 2)) ("K&R" (c-indent-level . 5) (c-argdecl-indent . 0) (c-brace-offset . -5) (c-label-offset . -5) (c-continued-statement-offset . 5)) ("BSD" (c-indent-level . 4) (c-argdecl-indent . 4) (c-brace-offset . -4) (c-label-offset . -4) (c-continued-statement-offset . 4)) ("C++" (c-indent-level . 4) (c-continued-statement-offset . 4) (c-brace-offset . -4) (c-argdecl-indent . 0) (c-label-offset . -4) (c-auto-newline . t)) ("Whitesmith" (c-indent-level . 4) (c-argdecl-indent . 4) (c-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\\(\\S_\\|'\\)") (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 '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 '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 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (run-hooks 'c-mode-hook)) ;; 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 (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) (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. (goto-char (point-max)) (forward-line -1) (search-forward "*/" nil 'move) (beginning-of-line) (if (looking-at "[ \t]*\\*/") (delete-indentation))))) ;; Outside of comments: do ordinary filling. (fill-paragraph arg)))) (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)))) ((looking-at "}[ \t]*else") (setq indent (save-excursion (forward-char) (backward-sexp) (c-backward-to-start-of-if) (current-indentation)))) ((and (looking-at "while\\b") (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))) (setq lim (point)) (condition-case nil (forward-sexp 1) (error)) (skip-chars-forward " \t\f") (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. (let ((found (point)) stop) (while (not stop) (cond ((save-excursion (end-of-line 0) (= (preceding-char) ?\\)) (end-of-line 0)) ;; This line is not preceded by a backslash. ;; So either it starts a preprocessor command ;; or any following continuation lines ;; should not be skipped. ((progn (beginning-of-line) (= (following-char) ?#)) (end-of-line 0) (setq found (point))) (t (setq stop t)))) (goto-char found)) ;; Now we get the answer. (if (and (not (memq (preceding-char) '(nil ?\, ?\; ?\} ?\{))) ;; 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. ;; 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 ((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 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 (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 this-point (point)) (setq at-else (looking-at "else\\W")) (setq at-brace (= (following-char) ?{)) (setq at-while (looking-at "while\\b")) (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. (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))))))) ;; Just started a new nesting level. ;; Compute the standard indent for this level. (let ((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 (setq this-indent val)))) ;; 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) (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)))) (progn (indent-for-comment) (beginning-of-line))))))))))) ;; 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 (eolp))) ;; Indent one line as with TAB. (let ((shift-amt (c-indent-line)) nextline sexpbeg sexpend) (save-excursion ;; Find beginning of following line. (save-excursion (forward-line 1) (setq nextline (point))) ;; Find first beginning-of-sexp for sexp extending past this line. (beginning-of-line) (while (< (point) nextline) (condition-case nil (progn (forward-sexp 1) (setq sexpend (point-marker))) (error (setq sexpend nil) (goto-char nextline))) (skip-chars-forward " \t\n")) (if 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 (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) (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))))))) (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.22/lisp/cal-dst.el100444 12120 1 33441 5471272323 13753 0ustar rmsdaemon;;; cal-dst.el --- calendar functions for daylight savings rules. ;; Copyright (C) 1993 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 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. ;;; 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 t2-time t1-time) (list t1-name t0-name t2-rules t1-rules t1-time t2-time) ))))))))))) ;;; The following six 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.") (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.") (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.") (provide 'cal-dst) ;;; cal-dst.el ends here emacs-19.22/lisp/cal-french.el100444 13437 1 23252 5411475777 14575 0ustar jimbdaemon;;; cal-french.el --- calendar functions for the French Revolutionary calendar. ;; Copyright (C) 1988, 1989, 1992 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 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. ;;; 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 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. ;; 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-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 Recompense" "de la Revolution"]) (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 654414)));; Days before start of calendar (September 22, 1792). (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 654415) (list 0 0 0);; pre-French Revolutionary date (let* ((approx (/ (- date 654414) 366));; Approximation from below. (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-print-french-date () "Show the French Revolutionary calendar equivalent of the selected date." (interactive) (let* ((french-date (calendar-french-from-absolute (calendar-absolute-from-gregorian (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))))) (y (extract-calendar-year french-date)) (m (extract-calendar-month french-date)) (d (extract-calendar-day french-date))) (if (< y 1) (message "Date is pre-French Revolution") (if (= m 13) (message "Jour %s de l'Anne'e %d de la Revolution" (aref french-calendar-special-days-array (1- d)) y) (message "Decade %s, %s de %s de l'Anne'e %d de la Revolution" (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-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 Revolution (>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) (cdr;; we don't want rev. day in a non-leap yr. (nreverse (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* ((french-date (calendar-french-from-absolute (calendar-absolute-from-gregorian date))) (y (extract-calendar-year french-date)) (m (extract-calendar-month french-date)) (d (extract-calendar-day french-date))) (if (> y 0) (if (= m 13) (format "Jour %s de l'Anne'e %d de la Revolution" (aref french-calendar-special-days-array (1- d)) y) (format "Decade %s, %s de %s de l'Anne'e %d de la Revolution" (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))))) (provide 'cal-french) ;;; cal-french.el ends here emacs-19.22/lisp/cal-mayan.el100444 74720 14 37202 5431620054 14661 0ustar eggertguest;;; cal-mayan.el --- calendar functions for the Mayan calendars. ;; Copyright (C) 1992 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 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. ;;; 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) (defun mayan-adjusted-mod (m n) "Non-negative remainder of M/N with N instead of 0." (1+ (mod (1- m) n))) (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 the correlation used by Spinden.") (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 ((datum (read-from-string str cc))) (if (not (integerp (car datum))) (signal 'invalid-read-syntax (car datum)) (setq rlc (cons (car datum) rlc)) (setq cc (cdr datum))))) (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 (mayan-adjusted-mod (+ long-count (car calendar-mayan-tzolkin-at-epoch)) 13)) (name (mayan-adjusted-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-print-mayan-date () "Show the Mayan long count, tzolkin, and haab equivalents of date." (interactive) (let* ((d (calendar-absolute-from-gregorian (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))) (tzolkin (calendar-mayan-tzolkin-from-absolute d)) (haab (calendar-mayan-haab-from-absolute d)) (long-count (calendar-mayan-long-count-from-absolute d))) (message "Mayan date: 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-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." (let* ((d (calendar-absolute-from-gregorian 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 "Mayan date: Long count = %s; tzolkin = %s; haab = %s" (calendar-mayan-long-count-to-string long-count) (calendar-mayan-tzolkin-to-string haab) (calendar-mayan-haab-to-string tzolkin)))) (provide 'cal-mayan) ;;; cal-mayan.el ends here emacs-19.22/lisp/calendar.el100444 12120 1 406442 5471533015 14220 0ustar rmsdaemon;;; calendar.el --- Calendar functions. ;;; Copyright (C) 1988, 1989, 1990, 1991, 1992 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; Human-Keywords: calendar, Gregorian calendar, Julian calendar, ;; Hebrew calendar, Islamic calendar, ISO calendar, Julian day number, ;; diary, holidays (defconst calendar-version "Version 5.2, released October 20, 1993") ;; 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. ;;; 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, 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. ;; The following files are part of the calendar/diary code: ;; diary.el, diary-ins.el Diary functions ;; holidays.el Holiday functions ;; cal-french.el French Revolutionary calendar ;; cal-mayan.el Mayan calendars ;; cal-dst.el Daylight savings time rules ;; solar.el Sunrise/sunset, equinoxes/solstices ;; lunar.el Phases of the moon ;; appt.el Appointment notification ;; 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 ;; GNU Emacs users too numerous to list pointed out a variety of problems ;; with earlier forms of the `infinite' sliding calendar and suggested some ;; of the features included in this package. Especially significant in this ;; regard was the suggestion of mark-diary-entries and view-diary-entries, ;; together ideas for their implementation, by ;; Michael S. Littman Cognitive Science Research Group ;; (201) 829-5155 Bell Communications Research ;; mlittman@wind.bellcore.com 445 South St. Box 1961 (2L-331) ;; Morristown, NJ 07960 ;; The algorithms for the Hebrew calendar are those of the Rambam (Rabbi Moses ;; Maimonides), from his Mishneh Torah, as implemented by ;; Nachum Dershowitz Department of Computer Science ;; (217) 333-4219 University of Illinois at Urbana-Champaign ;; nachum@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: ;;;###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 view-diary-entries-initially nil "*If t, the diary entries for the current date will be displayed 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 will cause no diary entries to be displayed on Sunday, the current date's and the next day's diary entries to be displayed Monday through Thursday, Friday through Monday's entries to be displayed on Friday, and only Saturday's entries to be displayed 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 "*If t, dates with diary entries will be marked in the calendar window. The marking symbol is specified by the variable `diary-entry-marker'.") ;;;###autoload (defvar diary-entry-marker "+" "*The symbol used to mark dates that have diary entries.") ;;;###autoload (defvar view-calendar-holidays-initially nil "*If t, holidays for current three month period will be displayed on entry. The holidays are displayed in another window when the calendar is first displayed.") ;;;###autoload (defvar mark-holidays-in-calendar nil "*If t, dates of holidays will be marked in the calendar window. The marking symbol is specified by the variable `calendar-holiday-marker'.") ;;;###autoload (defvar calendar-holiday-marker "*" "*The symbol used to mark notable dates in the calendar.") ;;;###autoload (defvar all-hebrew-calendar-holidays nil "*If nil, show only major holidays from the Hebrew calendar. If nil, the only holidays from the Hebrew calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Hebrew calendar.") ;;;###autoload (defvar all-christian-calendar-holidays nil "*If nil, show only major holidays from the Christian calendar. If nil, the only holidays from the Christian calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Christian calendar.") ;;;###autoload (defvar all-islamic-calendar-holidays nil "*If nil, show only major holidays from the Islamic calendar. If nil, the only holidays from the Islamic calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Islamic calendar.") ;;;###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 could also be used to mark the current date with `='; 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 a 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 will not be displayed in the diary window; only the continuation lines will be 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-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 the 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' will be 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 the 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 "*If t, the holidays will be indicated in the diary display. The holidays will be given in the mode line of the diary buffer, or in the fancy diary buffer next to the date. This slows down the diary functions somewhat; setting it to nil will make the diary display faster.") (defvar calendar-mark-ring nil) ;;;###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 (defvar local-holidays nil "*Local holidays. See the documentation for `calendar-holidays' for details.") ;;;###autoload (defvar other-holidays nil "*User defined holidays. See the documentation for `calendar-holidays' for details.") ;;;###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 (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 (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 (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 (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 (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 (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 (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)) date 'standard) "")))) (funcall 'holiday-sexp calendar-daylight-savings-ends '(format "Daylight Savings Time Ends %s" (if (fboundp 'atan) (solar-time-string (/ (- calendar-daylight-savings-ends-time calendar-daylight-time-offset) (float 60)) date 'daylight) "")))) "*Sun-related holidays. See the documentation for `calendar-holidays' for details.") (defvar calendar-holidays (append general-holidays local-holidays other-holidays christian-holidays hebrew-holidays islamic-holidays solar-holidays) "*List of notable days for the command M-x holidays. Additional holidays are easy to add to the list, just put them in the list `other-holidays' in your .emacs file. Similarly, by setting any of `general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays', `islamic-holidays', or `solar-holidays' to nil in your .emacs file, you can eliminate unwanted categories of holidays. The intention is that (in the US) `local-holidays' be set in site-init.el and `other-holidays' be set by the user. 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.") (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 macros are for speed; the code would be clearer if they ;; were functions, but 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. For clarity, the defun form of each is given ;; in comments after the defmacro form. (defmacro extract-calendar-month (date) "Extract the month part of DATE which has the form (month day year)." (` (car (, date)))) ;;(defun extract-calendar-month (date) ;; "Extract the month part of DATE which has the form (month day year)." ;; (car date)) (defmacro extract-calendar-day (date) "Extract the day part of DATE which has the form (month day year)." (` (car (cdr (, date))))) ;;(defun extract-calendar-day (date) ;; "Extract the day part of DATE which has the form (month day year)." ;; (car (cdr date))) (defmacro extract-calendar-year (date) "Extract the year part of DATE which has the form (month day year)." (` (car (cdr (cdr (, date)))))) ;;(defun extract-calendar-year (date) ;; "Extract the year part of DATE which has the form (month day year)." ;; (car (cdr (cdr date)))) (defmacro 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)))))) ;;(defun 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: ;; ;;(defmacro 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)))) ;;(defun 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))) (defmacro calendar-last-day-of-month (month year) "The last day in MONTH during YEAR." (` (if (and (= (, month) 2) (, (macroexpand (` (calendar-leap-year-p (, year)))))) 29 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- (, month)))))) ;;(defun 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)))) (defmacro 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." ;; ;; An explanation of the calculation can be found in PascAlgorithms by ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988. ;; (` (let* ((month (, (macroexpand (` (extract-calendar-month (, date)))))) (day (, (macroexpand (` (extract-calendar-day (, date)))))) (year (, (macroexpand (` (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 (, (macroexpand (` (calendar-leap-year-p year)))) (setq day-of-year (1+ day-of-year))))) day-of-year))) ;;(defun 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)) (defmacro 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- (, (macroexpand (` (extract-calendar-year (, date)))))))) (+ (, (macroexpand (` (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 ;;(defun 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 (defun calendar (&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 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) (setq calendar-window-configuration (current-window-configuration)) (let* ((completion-ignore-case t) (pop-up-windows t) (split-height-threshold 1000) (date (calendar-current-date)) (month (if arg (cdr (assoc (capitalize (completing-read "Month name: " (mapcar 'list (append calendar-month-name-array nil)) nil t)) (calendar-make-alist calendar-month-name-array))) (extract-calendar-month date))) (year (if arg (calendar-read "Year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year date))) (extract-calendar-year date)))) (pop-to-buffer calendar-buffer) (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" "Prepare and display a buffer with diary entries. Searches the file diary-file for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar." 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-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 'show-all-diary-entries "diary" "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" "Mark days in the calendar window that have diary entries. Each entry in diary-file visible in the calendar window is marked." t) (autoload 'insert-diary-entry "diary-ins" "Insert a diary entry for the date indicated by point." t) (autoload 'insert-weekly-diary-entry "diary-ins" "Insert a weekly diary entry for the day of the week indicated by point." t) (autoload 'insert-monthly-diary-entry "diary-ins" "Insert a monthly diary entry for the day of the month indicated by point." t) (autoload 'insert-yearly-diary-entry "diary-ins" "Insert an annual diary entry for the day of the year indicated by point." t) (autoload 'insert-anniversary-diary-entry "diary-ins" "Insert an anniversary diary entry for the date indicated by point." t) (autoload 'insert-block-diary-entry "diary-ins" "Insert a block diary entry for the dates indicated by point and mark." t) (autoload 'insert-cyclic-diary-entry "diary-ins" "Insert a cyclic diary entry starting at the date indicated by point." t) (autoload 'insert-hebrew-diary-entry "diary-ins" "Insert a diary entry for the Hebrew date corresponding to the date indicated by point." t) (autoload 'insert-monthly-hebrew-diary-entry "diary-ins" "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 "diary-ins" "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 "diary-ins" "Insert a diary entry for the Islamic date corresponding to the date indicated by point." t) (autoload 'insert-monthly-islamic-diary-entry "diary-ins" "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 "diary-ins" "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 '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 (calendar-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 (calendar-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)) (and (zerop (calendar-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)) (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 'kill-region 'copy-region-as-kill 'downcase-region 'upcase-region 'capitalize-region 'write-region))) (while (car l) (let ((k (where-is-internal (car l)))) (while (car k) (define-key calendar-mode-map (car k) 'calendar-not-implemented) (setq k (cdr k))) (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 "\C-x<" 'scroll-calendar-left) (define-key calendar-mode-map [next] '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-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-current-month) (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 "s" 'show-all-diary-entries) (define-key calendar-mode-map "pd" 'calendar-print-day-of-year) (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 "?" 'describe-calendar-mode)) (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}"))) (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 "\\\\[describe-calendar-mode] help/\\[calendar-other-month] other/\\[calendar-current-month] current") '(calendar-date-string (calendar-current-date) t) (substitute-command-keys "\\\\[scroll-calendar-right]")) "The mode line of the calendar buffer.") (defun calendar-mode () "A major mode for the calendar window. The commands for cursor movement are:\\ \\[calendar-forward-day] one day forward \\[calendar-backward-day] one day backward \\[calendar-forward-week] one week forward \\[calendar-backward-week] one week backward \\[calendar-forward-month] one month forward \\[calendar-backward-month] one month backward \\[calendar-forward-year] one year forward \\[calendar-backward-year] one year backward \\[calendar-beginning-of-week] beginning of week \\[calendar-end-of-week] end of week \\[calendar-beginning-of-month] beginning of month \\[calendar-end-of-month] end of month \\[calendar-beginning-of-year] beginning of year \\[calendar-end-of-year] end of year \\[calendar-goto-date] go to date \\[calendar-goto-julian-date] go to Julian date \\[calendar-goto-astro-day-number] go to astronomical (Julian) day number \\[calendar-goto-hebrew-date] go to Hebrew date \\[calendar-goto-islamic-date] go to Islamic date \\[calendar-goto-iso-date] go to ISO date \\[calendar-goto-french-date] go to French Revolutionary date \\[calendar-goto-mayan-long-count-date] go to Mayan Long Count date \\[calendar-next-haab-date] go to next occurrence of Mayan Haab date \\[calendar-previous-haab-date] go to previous occurrence of Mayan Haab date \\[calendar-next-tzolkin-date] go to next occurrence of Mayan Tzolkin date \\[calendar-previous-tzolkin-date] go to previous occurrence of Mayan Tzolkin date \\[calendar-next-calendar-round-date] go to next occurrence of Mayan Calendar Round date \\[calendar-previous-calendar-round-date] go to previous occurrence of Mayan Calendar Round date You can mark a date in the calendar and switch the point and mark: \\[calendar-set-mark] mark date \\[calendar-exchange-point-and-mark] exchange point and mark You can determine the number of days (inclusive) between the point and mark by \\[calendar-count-days-region] count days in the region The commands for calendar movement are: \\[scroll-calendar-right] scroll one month right \\[scroll-calendar-left] scroll one month left \\[scroll-calendar-right-three-months] scroll 3 months right \\[scroll-calendar-left-three-months] scroll 3 months left \\[calendar-current-month] display current month \\[calendar-other-month] display another month Whenever it makes sense, the above commands take prefix arguments that multiply their affect. For convenience, the digit keys and the minus sign are bound to digit-argument, so they need not be prefixed with ESC. If the calendar window somehow becomes corrupted, it can be regenerated with \\[redraw-calendar] redraw the calendar The following commands deal with holidays and other notable days: \\[calendar-cursor-holidays] give holidays for the date specified by the cursor \\[mark-calendar-holidays] mark notable days \\[calendar-unmark] unmark dates \\[list-calendar-holidays] display notable days The command M-x holidays causes the notable dates for the current month, and the preceding and succeeding months, to be displayed, independently of the calendar. The following commands control the diary: \\[mark-diary-entries] mark diary entries \\[calendar-unmark] unmark dates \\[view-diary-entries] display diary entries \\[show-all-diary-entries] show all diary entries \\[print-diary-entries] print diary entries Displaying the diary entries causes the diary entries from the diary-file \(for the date indicated by the cursor in the calendar window) to be displayed in another window. This function takes an integer argument that specifies the number of days of calendar entries to be displayed, starting with the date indicated by the cursor. The command \\[print-diary-entries] prints the diary buffer (as it appears) on the line printer. The command M-x diary causes the diary entries for the current date to be displayed, independently of the calendar. The number of days of entries is governed by number-of-diary-entries. The format of the entries in the diary file is described in the documentation string for the variable diary-file. When diary entries are in view in the window, they can be edited. It is important to keep in mind that the buffer displayed contains the entire diary file, but with portions of it concealed from view. This means, for instance, that the forward-char command can put the cursor at what appears to be the end of the line, but what is in reality the middle of some concealed line. BE CAREFUL WHEN EDITING THE DIARY ENTRIES! (Inserting additional lines or adding/deleting characters in the middle of a visible line will not cause problems; watch out for end-of-line, however--it may put you at the end of a concealed line far from where the cursor appears to be!) BEFORE EDITING THE DIARY IT IS BEST TO DISPLAY THE ENTIRE FILE WITH show-all-diary-entries. BE SURE TO WRITE THE FILE BEFORE EXITING FROM THE CALENDAR. The following commands assist in making diary entries: \\[insert-diary-entry] insert a diary entry for the selected date \\[insert-weekly-diary-entry] insert a diary entry for the selected day of the week \\[insert-monthly-diary-entry] insert a diary entry for the selected day of the month \\[insert-yearly-diary-entry] insert a diary entry for the selected day of the year \\[insert-block-diary-entry] insert a diary entry for the block days between point and mark \\[insert-anniversary-diary-entry] insert an anniversary diary entry for the selected date \\[insert-cyclic-diary-entry] insert a cyclic diary entry There are corresponding commands to assist in making Hebrew- or Islamic-date diary entries: \\[insert-hebrew-diary-entry] insert a diary entry for the Hebrew date corresponding to the selected date \\[insert-monthly-hebrew-diary-entry] insert a diary entry for the day of the Hebrew month corresponding to the selected day \\[insert-yearly-hebrew-diary-entry] insert a diary entry for the day of the Hebrew year corresponding to the selected day \\[insert-islamic-diary-entry] insert a diary entry for the Islamic date corresponding to the selected date \\[insert-monthly-islamic-diary-entry] insert a diary entry for the day of the Islamic month corresponding to the selected day \\[insert-yearly-islamic-diary-entry] insert a diary entry for the day of the Islamic year corresponding to the selected day All of the diary entry commands make nonmarking entries when given a prefix argument; with no prefix argument, the diary entries are marking. The day number in the year and the number of days remaining in the year can be determined by \\[calendar-print-day-of-year] show day number and the number of days remaining in the year Equivalent dates on the ISO commercial, Julian, Hebrew, Islamic, French Revolutionary, and Mayan calendars can be determined by \\[calendar-print-iso-date] show equivalent date on the ISO commercial calendar \\[calendar-print-julian-date] show equivalent date on the Julian calendar \\[calendar-print-hebrew-date] show equivalent date on the Hebrew calendar \\[calendar-print-islamic-date] show equivalent date on the Islamic calendar \\[calendar-print-french-date] show equivalent date on the French Revolutionary calendar \\[calendar-print-mayan-date] show equivalent date on the Mayan calendar The astronomical (Julian) day number of a date is found with \\[calendar-print-astro-day-number] show equivalent astronomical (Julian) day number To find the times of sunrise and sunset and lunar phases use \\[calendar-sunrise-sunset] show times of sunrise and sunset \\[calendar-phases-of-moon] show times of quarters of the moon The times given will be for location `calendar-location-name' at latitude `calendar-latitude', longitude `calendar-longitude'; set these variables for your location. The following variables are also consulted, and you must set them if your system does not initialize them properly: `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-starts-time', `calendar-daylight-savings-ends-time'. To exit from the calendar use \\[exit-calendar] exit from calendar The variable `view-diary-entries-initially', whose default is nil, can be set to to t cause diary entries for the current date will be displayed in another window when the calendar is first displayed, if the current date is visible. The variable `number-of-diary-entries' controls number of days of diary entries that will be displayed initially or with the command M-x diary. 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, both the current day's and the next day's entries will be displayed. The value can also be a vector: If the value is [0 2 2 2 2 4 1] then no diary entries will be displayed on Sunday, the current date's and the next day's diary entries will be displayed Monday through Thursday, Friday through Monday's entries will be displayed on Friday, while on Saturday only that day's entries will be displayed. The variable `view-calendar-holidays-initially' can be set to t to cause the holidays for the current three month period will be displayed on entry to the calendar. The holidays are displayed in another window. The variable `mark-diary-entries-in-calendar' can be set to t to cause any dates visible with calendar entries to be marked with the symbol specified by the variable `diary-entry-marker', normally a plus sign. The variable `calendar-load-hook', whose default value is nil, is list of functions to be called when the calendar is first loaded. The variable `initial-calendar-window-hook', whose default value is nil, is 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. The variable `today-visible-calendar-hook', whose default value is nil, is the list of functions called after the calendar buffer has been prepared with the calendar when the current date is visible in the window. 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 could also be used to mark the current date with `*'; a function is also provided for this: (setq today-visible-calendar-hook 'calendar-mark-today) The variable `today-invisible-calendar-hook', whose default value is nil, is the list of functions called after the calendar buffer has been prepared with the calendar when the current date is not visible in the window. The variable `diary-display-hook' is the list of functions called after the diary buffer is prepared. The default value simply displays the diary file using selective-display to conceal irrelevant diary entries. An alternative function `fancy-diary-display' is provided that, when used as the `diary-display-hook', causes a noneditable buffer to be prepared with a neatly organized day-by-day listing of relevant diary entries, together with any known holidays. The inclusion of the holidays slows this fancy display of the diary; to speed it up, set the variable `holidays-in-diary-buffer' to nil. The variable `print-diary-entries-hook' is the list of functions called after a temporary buffer is prepared with the diary entries currently visible in the diary buffer. The default value of this hook adds a heading (composed from the diary buffer's mode line), does the printing with the command lpr-buffer, and kills the temporary buffer. Other uses might include, for example, rearranging the lines into order by day and time. The Gregorian calendar is assumed." (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-window-configuration);; Windows on entry. (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 There must be at least 2 strings. 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 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 exit-calendar () "Get out of the calendar window and bury it and related buffers." (interactive) (let ((diary-buffer (get-file-buffer diary-file)) (d-buffer (get-buffer fancy-diary-buffer)) (h-buffer (get-buffer holiday-buffer))) (if (not diary-buffer) (progn (set-window-configuration calendar-window-configuration) (bury-buffer calendar-buffer) (if d-buffer (bury-buffer d-buffer)) (if h-buffer (bury-buffer h-buffer))) (if (or (not (buffer-modified-p diary-buffer)) (yes-or-no-p "Diary modified; do you really want to exit the calendar? ")) (progn (set-window-configuration calendar-window-configuration) (bury-buffer calendar-buffer) (if d-buffer (bury-buffer d-buffer)) (if h-buffer (bury-buffer h-buffer)) (set-buffer diary-buffer) (set-buffer-modified-p nil) (bury-buffer diary-buffer)))))) (defun calendar-current-month () "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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))) (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-current-date () "Returns the current date in a list (month day year). If in the calendar buffer, also sets the current date local variables." (let* ((date (current-time-string)) (garbage (string-match "^\\([A-Z][a-z]*\\) *\\([A-Z][a-z]*\\) *\\([0-9]*\\) .* \\([0-9]*\\)$" date)) (month (cdr (assoc (substring date (match-beginning 2) (match-end 2)) (calendar-make-alist calendar-month-name-array 1 '(lambda (x) (substring x 0 3)))))) (day (string-to-int (substring date (match-beginning 3) (match-end 3)))) (year (string-to-int (substring date (match-beginning 4) (match-end 4))))) (list month day year))) (defun calendar-cursor-to-date () "Returns a list of the month, day, and year of current cursor position. Returns nil if the cursor is not on a specific day." (if (and (looking-at "[*0-9]") (< 2 (count-lines (point-min) (point)))) (save-excursion (re-search-backward "[^0-9]") (forward-char 1) (let* ((day (string-to-int (buffer-substring (point) (+ 3 (point))))) (day (if (= 0 day) starred-day day)) (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)))) (list month day year))))) (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) (+ (calendar-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 (calendar-mod (1- calendar-week-start-day) 7)) (* 7 arg) (+ (- 6 (calendar-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)))))) ;; 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-mod (x y) "Returns X % Y; value is *always* non-negative." (let ((v (mod x y))) (if (> 0 v) (+ v y) v))) (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 (calendar-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 (calendar-mod (- (calendar-day-of-week date) calendar-week-start-day) 7)))))) (defun calendar-other-month (month year) "Display a three-month calendar centered around MONTH and YEAR." (interactive (let* ((completion-ignore-case t) (month (cdr (assoc (capitalize (completing-read "Month name: " (mapcar 'list (append calendar-month-name-array nil)) nil t)) (calendar-make-alist calendar-month-name-array)))) (year (calendar-read "Year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-current-date)))))) (list month year))) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))) (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 () "Prompt for Gregorian date. Returns a list (month day 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)) (day (calendar-read (format "Day (1-%d): " last) '(lambda (x) (and (< 0 x) (<= x last)))))) (list month day year))) (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)) (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 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 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 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 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 the diary and holiday marks from the calendar." (interactive) (setq mark-diary-entries-in-calendar nil) (setq mark-holidays-in-calendar nil) (save-excursion (goto-line 3) (beginning-of-line) (let ((buffer-read-only nil) (start (point)) (star-date (search-forward "**" nil t)) (star-point (point))) (if star-date (progn ;; Don't delete today as left by calendar-star-date (subst-char-in-region start (- star-point 2) (string-to-char diary-entry-marker) ? t) (subst-char-in-region start (- star-point 2) (string-to-char calendar-holiday-marker) ? t) (subst-char-in-region star-point (point-max) (string-to-char diary-entry-marker) ? t) (subst-char-in-region star-point (point-max) (string-to-char calendar-holiday-marker) ? t)) (subst-char-in-region start (point-max) (string-to-char diary-entry-marker) ? t) (subst-char-in-region start (point-max) (string-to-char calendar-holiday-marker) ? t)) (set-buffer-modified-p nil)))) (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) "Leave mark DATE with MARK. 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) (forward-char 1) (let ((buffer-read-only nil)) (delete-char 1) (insert (if mark mark diary-entry-marker)) (forward-char -2)) (set-buffer-modified-p nil)))) (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 'starred-day) (forward-char 1) (setq 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 with an equal sign. This function can be used with the today-visible-calendar-hook run after the calendar window has been prepared." (let ((buffer-read-only nil)) (forward-char 1) (delete-char 1) (insert "=") (backward-char 2) (set-buffer-modified-p nil))) (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-print-day-of-year () "Show the day number in the year and the number of days remaining in the year for the date under the cursor." (interactive) (let* ((date (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))) (year (extract-calendar-year date)) (day (calendar-day-number date)) (days-remaining (- (calendar-day-number (list 12 31 year)) day))) (message "Day %d of %d; %d day%s remaining in the year" day year days-remaining (if (= days-remaining 1) "" "s")))) (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-print-iso-date () "Show equivalent ISO date for the date under the cursor." (interactive) (let* ((greg-date (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))) (day (% (calendar-absolute-from-gregorian greg-date) 7)) (iso-date (calendar-iso-from-absolute (calendar-absolute-from-gregorian greg-date)))) (message "ISO date: Day %s of week %d of %d." (if (zerop day) 7 day) (extract-calendar-month iso-date) (extract-calendar-year iso-date)))) (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-print-julian-date () "Show the Julian calendar equivalent of the date under the cursor." (interactive) (message "Julian date: %s" (calendar-date-string (calendar-julian-from-absolute (calendar-absolute-from-gregorian (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))) nil t))) (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 227014))) ;; 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 227015) (list 0 0 0);; pre-Islamic date (let* ((approx (/ (- date 227014) 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)))) (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"]) (defun calendar-print-islamic-date () "Show the Islamic calendar equivalent of the date under the cursor." (interactive) (let ((calendar-month-name-array calendar-islamic-month-name-array) (islamic-date (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))))) (if (< (extract-calendar-year islamic-date) 1) (message "Date is pre-Islamic") (message "Islamic date (until sunset): %s" (calendar-date-string islamic-date nil t))))) (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-print-hebrew-date () "Show the Hebrew calendar equivalent of the date under the cursor." (interactive) (let* ((hebrew-date (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (or (calendar-cursor-to-date) (error "Cursor is not on a 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))) (message "Hebrew date (until sunset): %s" (calendar-date-string hebrew-date nil 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-set-mode-line (str) "Set mode line to STR, centered, surrounded by dashes." (setq mode-line-format (calendar-string-spread (list "" str "") ?- (frame-width)))) ;;;###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 calendar-print-astro-day-number () "Show astronomical (Julian) day number of afternoon on date shown by cursor." (interactive) (message "Astronomical (Julian) day number after noon UTC: %d" (+ 1721425 (calendar-absolute-from-gregorian (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))))) (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 (- daynumber 1721425))) (or noecho (calendar-print-astro-day-number))) (run-hooks 'calendar-load-hook) (provide 'calendar) ;;; calendar.el ends here emacs-19.22/lisp/case-table.el100444 12120 1 7405 5404711302 14374 0ustar rmsdaemon;;; case-table.el --- code to extend the character set and support case tables. ;; 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: ;; 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 ((vector (make-vector 256 nil)) (case-table (current-case-table)) (ch 0)) (while (< ch 256) (aset vector ch (cond ((/= ch (downcase ch)) (concat "uppercase, matches " (text-char-description (downcase ch)))) ((/= ch (upcase ch)) (concat "lowercase, matches " (text-char-description (upcase ch)))) (t "case-invariant"))) (setq ch (1+ ch))) (save-excursion (with-output-to-temp-buffer "*Help*" (set-buffer standard-output) (describe-vector vector))))) ;;;###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', and `text-mode-syntax-table' to indicate left and right delimiters." (aset table l l) (aset table r r) (modify-syntax-entry l (concat "(" (char-to-string r) " ") (standard-syntax-table)) (modify-syntax-entry l (concat "(" (char-to-string r) " ") text-mode-syntax-table) (modify-syntax-entry r (concat ")" (char-to-string l) " ") (standard-syntax-table)) (modify-syntax-entry r (concat ")" (char-to-string l) " ") text-mode-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' and `text-mode-syntax-table' to indicate an (uppercase, lowercase) pair of letters." (aset table uc lc) (aset table lc lc) (modify-syntax-entry lc "w " (standard-syntax-table)) (modify-syntax-entry lc "w " text-mode-syntax-table) (modify-syntax-entry uc "w " (standard-syntax-table)) (modify-syntax-entry uc "w " text-mode-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' and `text-mode-syntax-table'. SYNTAX should be \" \", \"w\", \".\" or \"_\"." (aset table c c) (modify-syntax-entry c syntax (standard-syntax-table)) (modify-syntax-entry c syntax text-mode-syntax-table)) (provide 'case-table) ;;; case-table.el ends here emacs-19.22/lisp/cdl.el100444 12120 1 3076 5461277043 13152 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.22/lisp/chistory.el100444 74777 1 15037 5357066233 14450 0ustar ericdaemon;;; 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 (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 (equal (setq pattern (substring pattern (or (string-match "[ \t]*[^ \t]" pattern) (length pattern)))) "") (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? " (setq temp (prin1-to-string 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. If `default-list-command-history-filter' 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 "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, should be a positive number which specifies the maximum length of the Command History 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.22/lisp/cl-compat.el100444 12120 1 13717 5426300515 14302 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Commentary: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains emulations of internal routines of the older ;; CL package which users may have called directly from their code. ;; Use (require 'cl-compat) to get these routines. ;; See cl.el for Change Log. ;; Code: ;; Require at load-time, but not when compiling cl-compat. (or (featurep 'cl) (require 'cl)) ;;; Keyword routines not supported by new package. (defmacro defkeyword (x &optional doc) (list* 'defconst x (list 'quote x) (and doc (list doc)))) (defun keywordp (sym) (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym))) (defun keyword-of (sym) (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) ;;; Multiple values. Note that the new package uses a different ;;; convention for multiple values. The following definitions ;;; emulate the old convention; all function names have been changed ;;; by capitalizing the first letter: Values, Multiple-value-*, ;;; to avoid conflict with the new-style definitions in cl-macs. (put 'Multiple-value-bind 'lisp-indent-function 2) (put 'Multiple-value-setq 'lisp-indent-function 2) (put 'Multiple-value-call 'lisp-indent-function 1) (put 'Multiple-value-prog1 'lisp-indent-function 1) (defvar *mvalues-values* nil) (defun Values (&rest val-forms) (setq *mvalues-values* val-forms) (car val-forms)) (defun Values-list (val-forms) (apply 'values val-forms)) (defmacro Multiple-value-list (form) (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form)) '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*) (list *mvalues-temp*)))) (defmacro Multiple-value-call (function &rest args) (list 'apply function (cons 'append (mapcar (function (lambda (x) (list 'Multiple-value-list x))) args)))) (defmacro Multiple-value-bind (vars form &rest body) (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) (defmacro Multiple-value-setq (vars form) (list 'multiple-value-setq vars (list 'Multiple-value-list form))) (defmacro Multiple-value-prog1 (form &rest body) (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) ;;; Routines for parsing keyword arguments. (defun build-klist (arglist keys &optional allow-others) (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist)))) (or allow-others (let ((bad (set-difference (mapcar 'car res) keys))) (if bad (error "Bad keywords: %s not in %s" bad keys)))) res)) (defun extract-from-klist (klist key &optional def) (let ((res (assq key klist))) (if res (cdr res) def))) (defun keyword-argument-supplied-p (klist key) (assq key klist)) (defun elt-satisfies-test-p (item elt klist) (let ((test-not (cdr (assq ':test-not klist))) (test (cdr (assq ':test klist))) (key (cdr (assq ':key klist)))) (if key (setq elt (funcall key elt))) (if test-not (not (funcall test-not item elt)) (funcall (or test 'eql) item elt)))) ;;; Rounding functions with old-style multiple value returns. (defun cl-floor (a &optional b) (Values-list (floor* a b))) (defun cl-ceiling (a &optional b) (Values-list (ceiling* a b))) (defun cl-round (a &optional b) (Values-list (round* a b))) (defun cl-truncate (a &optional b) (Values-list (truncate* a b))) (defun safe-idiv (a b) (let* ((q (/ (abs a) (abs b))) (s (* (signum a) (signum b)))) (Values q (- a (* s q b)) s))) ;; Internal routines. (defun pair-with-newsyms (oldforms) (let ((newsyms (mapcar (function (lambda (x) (gensym))) oldforms))) (Values (mapcar* 'list newsyms oldforms) newsyms))) (defun zip-lists (evens odds) (mapcan 'list evens odds)) (defun unzip-lists (list) (let ((e nil) (o nil)) (while list (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list))) (Values (nreverse e) (nreverse o)))) (defun reassemble-argslists (list) (let ((n (apply 'min (mapcar 'length list))) (res nil)) (while (>= (setq n (1- n)) 0) (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res))) res)) (defun duplicate-symbols-p (list) (let ((res nil)) (while list (if (memq (car list) (cdr list)) (setq res (cons (car list) res))) (setq list (cdr list))) res)) ;;; Setf internals. (defun setnth (n list x) (setcar (nthcdr n list) x)) (defun setnthcdr (n list x) (setcdr (nthcdr (1- n) list) x)) (defun setelt (seq n x) (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x))) ;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms, ;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms, ;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify, ;;; all names with embedded `$'. (provide 'cl-compat) ;;; cl-compat.el ends here emacs-19.22/lisp/cl-extra.el100444 74720 14 100315 5431620057 14555 0ustar eggertguest;; cl-extra.el --- Common Lisp extensions for GNU Emacs Lisp (part two) ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Version: 2.02 ;; Keywords: extensions ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Commentary: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains portions of the Common Lisp extensions ;; package which are autoloaded since they are relatively obscure. ;; See cl.el for Change Log. ;; Code: (or (memq 'cl-19 features) (error "Tried to load `cl-extra' before `cl'!")) ;;; We define these here so that this file can compile without having ;;; loaded the cl.el file already. (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) (defmacro cl-pop (place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) (defvar cl-emacs-type) ;;; Type coercion. (defun coerce (x type) "Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier." (cond ((eq type 'list) (if (listp x) x (append x nil))) ((eq type 'vector) (if (vectorp x) x (vconcat x))) ((eq type 'string) (if (stringp x) x (concat x))) ((eq type 'array) (if (arrayp x) x (vconcat x))) ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type)) ((eq type 'float) (float x)) ((typep x type) x) (t (error "Can't coerce %s to type %s" x type)))) ;;; Predicates. (defun equalp (x y) "T if two Lisp objects have similar structures and contents. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively." (cond ((eq x y) t) ((stringp x) (and (stringp y) (= (length x) (length y)) (or (equal x y) (equal (downcase x) (downcase y))))) ; lazy but simple! ((numberp x) (and (numberp y) (= x y))) ((consp x) (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y)))) (and (not (consp x)) (equalp x y))) ((vectorp x) (and (vectorp y) (= (length x) (length y)) (let ((i (length x))) (while (and (>= (setq i (1- i)) 0) (equalp (aref x i) (aref y i)))) (< i 0)))) (t (equal x y)))) ;;; Control structures. (defun cl-mapcar-many (cl-func cl-seqs) (if (cdr (cdr cl-seqs)) (let* ((cl-res nil) (cl-n (apply 'min (mapcar 'length cl-seqs))) (cl-i 0) (cl-args (copy-sequence cl-seqs)) cl-p1 cl-p2) (setq cl-seqs (copy-sequence cl-seqs)) (while (< cl-i cl-n) (setq cl-p1 cl-seqs cl-p2 cl-args) (while cl-p1 (setcar cl-p2 (if (consp (car cl-p1)) (prog1 (car (car cl-p1)) (setcar cl-p1 (cdr (car cl-p1)))) (aref (car cl-p1) cl-i))) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))) (cl-push (apply cl-func cl-args) cl-res) (setq cl-i (1+ cl-i))) (nreverse cl-res)) (let ((cl-res nil) (cl-x (car cl-seqs)) (cl-y (nth 1 cl-seqs))) (let ((cl-n (min (length cl-x) (length cl-y))) (cl-i -1)) (while (< (setq cl-i (1+ cl-i)) cl-n) (cl-push (funcall cl-func (if (consp cl-x) (cl-pop cl-x) (aref cl-x cl-i)) (if (consp cl-y) (cl-pop cl-y) (aref cl-y cl-i))) cl-res))) (nreverse cl-res)))) (defun map (cl-type cl-func cl-seq &rest cl-rest) "Map a function across one or more sequences, returning a sequence. TYPE is the sequence type to return, FUNC is the function, and SEQS are the argument sequences." (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) (and cl-type (coerce cl-res cl-type)))) (defun maplist (cl-func cl-list &rest cl-rest) "Map FUNC to each sublist of LIST or LISTS. Like `mapcar', except applies to lists and their cdr's rather than to the elements themselves." (if cl-rest (let ((cl-res nil) (cl-args (cons cl-list (copy-sequence cl-rest))) cl-p) (while (not (memq nil cl-args)) (cl-push (apply cl-func cl-args) cl-res) (setq cl-p cl-args) (while cl-p (setcar cl-p (cdr (cl-pop cl-p)) ))) (nreverse cl-res)) (let ((cl-res nil)) (while cl-list (cl-push (funcall cl-func cl-list) cl-res) (setq cl-list (cdr cl-list))) (nreverse cl-res)))) (defun mapc (cl-func cl-seq &rest cl-rest) "Like `mapcar', but does not accumulate values returned by the function." (if cl-rest (apply 'map nil cl-func cl-seq cl-rest) (mapcar cl-func cl-seq)) cl-seq) (defun mapl (cl-func cl-list &rest cl-rest) "Like `maplist', but does not accumulate values returned by the function." (if cl-rest (apply 'maplist cl-func cl-list cl-rest) (let ((cl-p cl-list)) (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p))))) cl-list) (defun mapcan (cl-func cl-seq &rest cl-rest) "Like `mapcar', but nconc's together the values returned by the function." (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) (defun mapcon (cl-func cl-list &rest cl-rest) "Like `maplist', but nconc's together the values returned by the function." (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) (defun some (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of any element of SEQ or SEQs. If so, return the true (non-nil) value returned by PREDICATE." (if (or cl-rest (nlistp cl-seq)) (catch 'cl-some (apply 'map nil (function (lambda (&rest cl-x) (let ((cl-res (apply cl-pred cl-x))) (if cl-res (throw 'cl-some cl-res))))) cl-seq cl-rest) nil) (let ((cl-x nil)) (while (and cl-seq (not (setq cl-x (funcall cl-pred (cl-pop cl-seq)))))) cl-x))) (defun every (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of every element of SEQ or SEQs." (if (or cl-rest (nlistp cl-seq)) (catch 'cl-every (apply 'map nil (function (lambda (&rest cl-x) (or (apply cl-pred cl-x) (throw 'cl-every nil)))) cl-seq cl-rest) t) (while (and cl-seq (funcall cl-pred (car cl-seq))) (setq cl-seq (cdr cl-seq))) (null cl-seq))) (defun notany (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of every element of SEQ or SEQs." (not (apply 'some cl-pred cl-seq cl-rest))) (defun notevery (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of some element of SEQ or SEQs." (not (apply 'every cl-pred cl-seq cl-rest))) ;;; Support for `loop'. (defun cl-map-keymap (cl-func cl-map) (while (symbolp cl-map) (setq cl-map (symbol-function cl-map))) (if (eq cl-emacs-type 'lucid) (funcall 'map-keymap cl-func cl-map) (if (listp cl-map) (let ((cl-p cl-map)) (while (consp (setq cl-p (cdr cl-p))) (cond ((consp (car cl-p)) (funcall cl-func (car (car cl-p)) (cdr (car cl-p)))) ((vectorp (car cl-p)) (cl-map-keymap cl-func (car cl-p))) ((eq (car cl-p) 'keymap) (setq cl-p nil))))) (let ((cl-i -1)) (while (< (setq cl-i (1+ cl-i)) (length cl-map)) (if (aref cl-map cl-i) (funcall cl-func cl-i (aref cl-map cl-i)))))))) (defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) (or cl-base (setq cl-base (copy-sequence (if (eq cl-emacs-type 18) "0" [0])))) (cl-map-keymap (function (lambda (cl-key cl-bind) (aset cl-base (1- (length cl-base)) cl-key) (if (keymapp cl-bind) (cl-map-keymap-recursively cl-func-rec cl-bind (funcall (if (eq cl-emacs-type 18) 'concat 'vconcat) cl-base (list 0))) (funcall cl-func-rec cl-base cl-bind)))) cl-map)) (defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end) (or cl-what (setq cl-what (current-buffer))) (if (bufferp cl-what) (let (cl-mark cl-mark2 (cl-next t) cl-next2) (save-excursion (set-buffer cl-what) (setq cl-mark (copy-marker (or cl-start (point-min)))) (setq cl-mark2 (and cl-end (copy-marker cl-end)))) (while (and cl-next (or (not cl-mark2) (< cl-mark cl-mark2))) (setq cl-next (and (fboundp 'next-property-change) (if cl-prop (next-single-property-change cl-mark cl-prop cl-what) (next-property-change cl-mark cl-what))) cl-next2 (or cl-next (save-excursion (set-buffer cl-what) (point-max)))) (funcall cl-func (prog1 (marker-position cl-mark) (set-marker cl-mark cl-next2)) (if cl-mark2 (min cl-next2 cl-mark2) cl-next2))) (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))) (or cl-start (setq cl-start 0)) (or cl-end (setq cl-end (length cl-what))) (while (< cl-start cl-end) (let ((cl-next (or (and (fboundp 'next-property-change) (if cl-prop (next-single-property-change cl-start cl-prop cl-what) (next-property-change cl-start cl-what))) cl-end))) (funcall cl-func cl-start (min cl-next cl-end)) (setq cl-start cl-next))))) (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) (or cl-buffer (setq cl-buffer (current-buffer))) (if (fboundp 'overlay-lists) ;; This is the preferred algorithm, though overlay-lists is undocumented. (let (cl-ovl) (save-excursion (set-buffer cl-buffer) (setq cl-ovl (overlay-lists)) (if cl-start (setq cl-start (copy-marker cl-start))) (if cl-end (setq cl-end (copy-marker cl-end)))) (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) (while (and cl-ovl (or (not (overlay-start (car cl-ovl))) (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) (not (funcall cl-func (car cl-ovl) cl-arg)))) (setq cl-ovl (cdr cl-ovl))) (if cl-start (set-marker cl-start nil)) (if cl-end (set-marker cl-end nil))) ;; This alternate algorithm fails to find zero-length overlays. (let ((cl-mark (save-excursion (set-buffer cl-buffer) (copy-marker (or cl-start (point-min))))) (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer) (copy-marker cl-end)))) cl-pos cl-ovl) (while (save-excursion (and (setq cl-pos (marker-position cl-mark)) (< cl-pos (or cl-mark2 (point-max))) (progn (set-buffer cl-buffer) (setq cl-ovl (overlays-at cl-pos)) (set-marker cl-mark (next-overlay-change cl-pos))))) (while (and cl-ovl (or (/= (overlay-start (car cl-ovl)) cl-pos) (not (and (funcall cl-func (car cl-ovl) cl-arg) (set-marker cl-mark nil))))) (setq cl-ovl (cdr cl-ovl)))) (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) ;;; Support for `setf'. (defun cl-set-frame-visible-p (frame val) (cond ((null val) (make-frame-invisible frame)) ((eq val 'icon) (iconify-frame frame)) (t (make-frame-visible frame))) val) ;;; Support for `progv'. (defvar cl-progv-save) (defun cl-progv-before (syms values) (while syms (cl-push (if (boundp (car syms)) (cons (car syms) (symbol-value (car syms))) (car syms)) cl-progv-save) (if values (set (cl-pop syms) (cl-pop values)) (makunbound (cl-pop syms))))) (defun cl-progv-after () (while cl-progv-save (if (consp (car cl-progv-save)) (set (car (car cl-progv-save)) (cdr (car cl-progv-save))) (makunbound (car cl-progv-save))) (cl-pop cl-progv-save))) ;;; Numbers. (defun gcd (&rest args) "Return the greatest common divisor of the arguments." (let ((a (abs (or (cl-pop args) 0)))) (while args (let ((b (abs (cl-pop args)))) (while (> b 0) (setq b (% a (setq a b)))))) a)) (defun lcm (&rest args) "Return the least common multiple of the arguments." (if (memq 0 args) 0 (let ((a (abs (or (cl-pop args) 1)))) (while args (let ((b (abs (cl-pop args)))) (setq a (* (/ a (gcd a b)) b)))) a))) (defun isqrt (a) "Return the integer square root of the argument." (if (and (integerp a) (> a 0)) (let ((g (cond ((>= a 1000000) 10000) ((>= a 10000) 1000) ((>= a 100) 100) (t 10))) g2) (while (< (setq g2 (/ (+ g (/ a g)) 2)) g) (setq g g2)) g) (if (eq a 0) 0 (signal 'arith-error nil)))) (defun cl-expt (x y) "Return X raised to the power of Y. Works only for integer arguments." (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) x 0)) (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2))))) (or (and (fboundp 'expt) (subrp (symbol-function 'expt))) (defalias 'expt 'cl-expt)) (defun floor* (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." (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.22/lisp/cl-indent.el100444 13437 1 46061 5405341124 14430 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.22/lisp/cl-macs.el100444 12120 1 305213 5426300513 13753 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Commentary: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains the portions of the Common Lisp extensions ;; package which should be autoloaded, but need only be present ;; if the compiler or interpreter is used---this file is not ;; necessary for executing compiled code. ;; See cl.el for Change Log. ;; Code: (or (memq 'cl-19 features) (error "Tried to load `cl-macs' before `cl'!")) ;;; We define these here so that this file can compile without having ;;; loaded the cl.el file already. (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) (defmacro cl-pop (place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) (defmacro cl-pop2 (place) (list 'prog1 (list 'car (list 'cdr place)) (list 'setq place (list 'cdr (list 'cdr place))))) (put 'cl-push 'edebug-form-spec 'edebug-sexps) (put 'cl-pop 'edebug-form-spec 'edebug-sexps) (put 'cl-pop2 'edebug-form-spec 'edebug-sexps) (defvar cl-emacs-type) (defvar cl-optimize-safety) (defvar cl-optimize-speed) ;;; This kludge allows macros which use cl-transform-function-property ;;; to be called at compile-time. (require (progn (or (fboundp 'defalias) (fset 'defalias 'fset)) (or (fboundp 'cl-transform-function-property) (defalias 'cl-transform-function-property (function (lambda (n p f) (list 'put (list 'quote n) (list 'quote p) (list 'function (cons 'lambda f))))))) (car (or features (setq features (list 'cl-kludge)))))) ;;; Initialization. (defvar cl-old-bc-file-form nil) ;; Patch broken Emacs 18 compiler (re top-level macros). ;; Emacs 19 compiler doesn't need this patch. ;; Also, undo broken definition of `eql' that uses same bytecode as `eq'. (defun cl-compile-time-init () (setq cl-old-bc-file-form (symbol-function 'byte-compile-file-form)) (or (fboundp 'byte-compile-flush-pending) ; Emacs 19 compiler? (defalias 'byte-compile-file-form (function (lambda (form) (setq form (macroexpand form byte-compile-macro-environment)) (if (eq (car-safe form) 'progn) (cons 'progn (mapcar 'byte-compile-file-form (cdr form))) (funcall cl-old-bc-file-form form)))))) (put 'eql 'byte-compile 'cl-byte-compile-compiler-macro) (run-hooks 'cl-hack-bytecomp-hook)) ;;; Symbols. (defvar *gensym-counter*) (defun gensym (&optional arg) "Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\"." (let ((prefix (if (stringp arg) arg "G")) (num (if (integerp arg) arg (prog1 *gensym-counter* (setq *gensym-counter* (1+ *gensym-counter*)))))) (make-symbol (format "%s%d" prefix num)))) (defun gentemp (&optional arg) "Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\"." (let ((prefix (if (stringp arg) arg "G")) name) (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) (setq *gensym-counter* (1+ *gensym-counter*))) (intern name))) ;;; Program structure. (defmacro defun* (name args &rest body) "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)." (let* ((res (cl-transform-lambda (cons args body) name)) (form (list* 'defun name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) (defmacro defmacro* (name args &rest body) "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)." (let* ((res (cl-transform-lambda (cons args body) name)) (form (list* 'defmacro name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) (defmacro function* (func) "(function* SYMBOL-OR-LAMBDA): introduce a function. Like normal `function', except that if argument is a lambda form, its ARGLIST allows full Common Lisp conventions." (if (eq (car-safe func) 'lambda) (let* ((res (cl-transform-lambda (cdr func) 'cl-none)) (form (list 'function (cons 'lambda (cdr res))))) (if (car res) (list 'progn (car res) form) form)) (list 'function func))) (defun cl-transform-function-property (func prop form) (let ((res (cl-transform-lambda form func))) (append '(progn) (cdr (cdr (car res))) (list (list 'put (list 'quote func) (list 'quote prop) (list 'function (cons 'lambda (cdr res)))))))) (defconst lambda-list-keywords '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) (defvar cl-macro-environment nil) (defvar bind-block) (defvar bind-defs) (defvar bind-enquote) (defvar bind-inits) (defvar bind-lets) (defvar bind-forms) (defun cl-transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (bind-defs nil) (bind-enquote nil) (bind-inits nil) (bind-lets nil) (bind-forms nil) (header nil) (simple-args nil)) (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) (cl-push (cl-pop body) header)) (setq args (if (listp args) (copy-list args) (list '&rest args))) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) (if (setq bind-defs (cadr (memq '&cl-defs args))) (setq args (delq '&cl-defs (delq bind-defs args)) bind-defs (cadr bind-defs))) (if (setq bind-enquote (memq '&cl-quote args)) (setq args (delq '&cl-quote args))) (if (memq '&whole args) (error "&whole not currently implemented")) (let* ((p (memq '&environment args)) (v (cadr p))) (if p (setq args (nconc (delq (car p) (delq v args)) (list '&aux (list v 'cl-macro-environment)))))) (while (and args (symbolp (car args)) (not (memq (car args) '(nil &rest &body &key &aux))) (not (and (eq (car args) '&optional) (or bind-defs (consp (cadr args)))))) (cl-push (cl-pop args) simple-args)) (or (eq bind-block 'cl-none) (setq body (list (list* 'block bind-block body)))) (if (null args) (list* nil (nreverse simple-args) (nconc (nreverse header) body)) (if (memq '&optional simple-args) (cl-push '&optional args)) (cl-do-arglist args nil (- (length simple-args) (if (memq '&optional simple-args) 1 0))) (setq bind-lets (nreverse bind-lets)) (list* (and bind-inits (list* 'eval-when '(compile load eval) (nreverse bind-inits))) (nconc (nreverse simple-args) (list '&rest (car (cl-pop bind-lets)))) (nconc (nreverse header) (list (nconc (list 'let* bind-lets) (nreverse bind-forms) body))))))) (defun cl-do-arglist (args expr &optional num) ; uses bind-* (if (nlistp args) (if (or (memq args lambda-list-keywords) (not (symbolp args))) (error "Invalid argument name: %s" args) (cl-push (list args expr) bind-lets)) (setq args (copy-list args)) (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) (let ((p (memq '&body args))) (if p (setcar p '&rest))) (if (memq '&environment args) (error "&environment used incorrectly")) (let ((save-args args) (restarg (memq '&rest args)) (safety (if (cl-compiling-file) cl-optimize-safety 3)) (keys nil) (laterarg nil) (exactarg nil) minarg) (or num (setq num 0)) (if (listp (cadr restarg)) (setq restarg (gensym "--rest--")) (setq restarg (cadr restarg))) (cl-push (list restarg expr) bind-lets) (if (eq (car args) '&whole) (cl-push (list (cl-pop2 args) restarg) bind-lets)) (let ((p args)) (setq minarg restarg) (while (and p (not (memq (car p) lambda-list-keywords))) (or (eq p args) (setq minarg (list 'cdr minarg))) (setq p (cdr p))) (if (memq (car p) '(nil &aux)) (setq minarg (list '= (list 'length restarg) (length (ldiff args p))) exactarg (not (eq args p))))) (while (and args (not (memq (car args) lambda-list-keywords))) (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car) restarg))) (cl-do-arglist (cl-pop args) (if (or laterarg (= safety 0)) poparg (list 'if minarg poparg (list 'signal '(quote wrong-number-of-arguments) (list 'list (and (not (eq bind-block 'cl-none)) (list 'quote bind-block)) (list 'length restarg))))))) (setq num (1+ num) laterarg t)) (while (and (eq (car args) '&optional) (cl-pop args)) (while (and args (not (memq (car args) lambda-list-keywords))) (let ((arg (cl-pop args))) (or (consp arg) (setq arg (list arg))) (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t))) (let ((def (if (cdr arg) (nth 1 arg) (or (car bind-defs) (nth 1 (assq (car arg) bind-defs))))) (poparg (list 'pop restarg))) (and def bind-enquote (setq def (list 'quote def))) (cl-do-arglist (car arg) (if def (list 'if restarg poparg def) poparg)) (setq num (1+ num)))))) (if (eq (car args) '&rest) (let ((arg (cl-pop2 args))) (if (consp arg) (cl-do-arglist arg restarg))) (or (eq (car args) '&key) (= safety 0) exactarg (cl-push (list 'if restarg (list 'signal '(quote wrong-number-of-arguments) (list 'list (and (not (eq bind-block 'cl-none)) (list 'quote bind-block)) (list '+ num (list 'length restarg))))) bind-forms))) (while (and (eq (car args) '&key) (cl-pop args)) (while (and args (not (memq (car args) lambda-list-keywords))) (let ((arg (cl-pop args))) (or (consp arg) (setq arg (list arg))) (let* ((karg (if (consp (car arg)) (caar arg) (intern (format ":%s" (car arg))))) (varg (if (consp (car arg)) (cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) (or (car bind-defs) (cadr (assq varg bind-defs))))) (look (list 'memq (list 'quote karg) restarg))) (and def bind-enquote (setq def (list 'quote def))) (if (cddr arg) (let* ((temp (or (nth 2 arg) (gensym))) (val (list 'car (list 'cdr temp)))) (cl-do-arglist temp look) (cl-do-arglist varg (list 'if temp (list 'prog1 val (list 'setq temp t)) def))) (cl-do-arglist varg (list 'car (list 'cdr (if (null def) look (list 'or look (if (eq (cl-const-expr-p def) t) (list 'quote (list nil (cl-const-expr-val def))) (list 'list nil def)))))))) (cl-push karg keys) (if (= (aref (symbol-name karg) 0) ?:) (progn (set karg karg) (cl-push (list 'setq karg (list 'quote karg)) bind-inits))))))) (setq keys (nreverse keys)) (or (and (eq (car args) '&allow-other-keys) (cl-pop args)) (null keys) (= safety 0) (let* ((var (gensym "--keys--")) (allow '(:allow-other-keys)) (check (list 'while var (list 'cond (list (list 'memq (list 'car var) (list 'quote (append keys allow))) (list 'setq var (list 'cdr (list 'cdr var)))) (list (list 'car (list 'cdr (list 'memq (cons 'quote allow) restarg))) (list 'setq var nil)) (list t (list 'error (format "Keyword argument %%s not one of %s" keys) (list 'car var))))))) (cl-push (list 'let (list (list var restarg)) check) bind-forms))) (while (and (eq (car args) '&aux) (cl-pop args)) (while (and args (not (memq (car args) lambda-list-keywords))) (if (consp (car args)) (if (and bind-enquote (cadar args)) (cl-do-arglist (caar args) (list 'quote (cadr (cl-pop args)))) (cl-do-arglist (caar args) (cadr (cl-pop args)))) (cl-do-arglist (cl-pop args) nil)))) (if args (error "Malformed argument list %s" save-args))))) (defun cl-arglist-args (args) (if (nlistp args) (list args) (let ((res nil) (kind nil) arg) (while (consp args) (setq arg (cl-pop args)) (if (memq arg lambda-list-keywords) (setq kind arg) (if (eq arg '&cl-defs) (cl-pop args) (and (consp arg) kind (setq arg (car arg))) (and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg))) (setq res (nconc res (cl-arglist-args arg)))))) (nconc res (and args (list args)))))) (defmacro destructuring-bind (args expr &rest body) (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) (bind-defs nil) (bind-block 'cl-none)) (cl-do-arglist (or args '(&aux)) expr) (append '(progn) bind-inits (list (nconc (list 'let* (nreverse bind-lets)) (nreverse bind-forms) body))))) ;;; The `eval-when' form. (defvar cl-not-toplevel nil) (defmacro eval-when (when &rest body) "(eval-when (WHEN...) BODY...): control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when))) (cl-not-toplevel t)) (if (or (memq 'load when) (memq ':load-toplevel when)) (if comp (cons 'progn (mapcar 'cl-compile-time-too body)) (list* 'if nil nil body)) (progn (if comp (eval (cons 'progn body))) nil))) (and (or (memq 'eval when) (memq ':execute when)) (cons 'progn body)))) (defun cl-compile-time-too (form) (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler)) (setq form (macroexpand form (cons '(eval-when) byte-compile-macro-environment)))) (cond ((eq (car-safe form) 'progn) (cons 'progn (mapcar 'cl-compile-time-too (cdr form)))) ((eq (car-safe form) 'eval-when) (let ((when (nth 1 form))) (if (or (memq 'eval when) (memq ':execute when)) (list* 'eval-when (cons 'compile when) (cddr form)) form))) (t (eval form) form))) (or (and (fboundp 'eval-when-compile) (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload))) (eval '(defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time. The result of the body appears to the compiler as a quoted constant." (list 'quote (eval (cons 'progn body)))))) (defmacro load-time-value (form &optional read-only) "Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant." (if (cl-compiling-file) (let* ((temp (gentemp "--cl-load-time--")) (set (list 'set (list 'quote temp) form))) (if (and (fboundp 'byte-compile-file-form-defmumble) (boundp 'this-kind) (boundp 'that-one)) (fset 'byte-compile-file-form (list 'lambda '(form) (list 'fset '(quote byte-compile-file-form) (list 'quote (symbol-function 'byte-compile-file-form))) (list 'byte-compile-file-form (list 'quote set)) '(byte-compile-file-form form))) (print set (symbol-value 'outbuffer))) (list 'symbol-value (list 'quote temp))) (list 'quote (eval form)))) ;;; Conditional control structures. (defmacro case (expr &rest clauses) "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared against each key in each KEYLIST; the corresponding BODY is evaluated. If no clause succeeds, case returns nil. A single atom may be used in place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match. Key values are compared by `eql'." (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) (head-list nil) (body (cons 'cond (mapcar (function (lambda (c) (cons (cond ((memq (car c) '(t otherwise)) t) ((eq (car c) 'ecase-error-flag) (list 'error "ecase failed: %s, %s" temp (list 'quote (reverse head-list)))) ((listp (car c)) (setq head-list (append (car c) head-list)) (list 'member* temp (list 'quote (car c)))) (t (if (memq (car c) head-list) (error "Duplicate key in case: %s" (car c))) (cl-push (car c) head-list) (list 'eql temp (list 'quote (car c))))) (or (cdr c) '(nil))))) clauses)))) (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) (defmacro ecase (expr &rest clauses) "(ecase EXPR CLAUSES...): like `case', but error if no case fits. `otherwise'-clauses are not allowed." (list* 'case expr (append clauses '((ecase-error-flag))))) (defmacro typecase (expr &rest clauses) "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the final clause, and matches if no other keys match." (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) (type-list nil) (body (cons 'cond (mapcar (function (lambda (c) (cons (cond ((eq (car c) 'otherwise) t) ((eq (car c) 'ecase-error-flag) (list 'error "etypecase failed: %s, %s" temp (list 'quote (reverse type-list)))) (t (cl-push (car c) type-list) (cl-make-type-test temp (car c)))) (or (cdr c) '(nil))))) clauses)))) (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) (defmacro etypecase (expr &rest clauses) "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. `otherwise'-clauses are not allowed." (list* 'typecase expr (append clauses '((ecase-error-flag))))) ;;; Blocks and exits. (defmacro block (name &rest body) "(block NAME BODY...): define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' to jump prematurely out of the block. This differs from `catch' and `throw' in two respects: First, the NAME is an unevaluated symbol rather than a quoted symbol or other form; and second, NAME is lexically rather than dynamically scoped: Only references to it within BODY will work. These references may appear inside macro expansions, but not inside functions called from BODY." (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body) (list 'cl-block-wrapper (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name))) body)))) (defvar cl-active-block-names nil) (put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block) (defun cl-byte-compile-block (cl-form) (if (fboundp 'byte-compile-form-do-effect) ; Check for optimizing compiler (progn (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil)) (cl-active-block-names (cons cl-entry cl-active-block-names)) (cl-body (byte-compile-top-level (cons 'progn (cddr (nth 1 cl-form)))))) (if (cdr cl-entry) (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) cl-body)) (byte-compile-form cl-body)))) (byte-compile-form (nth 1 cl-form)))) (put 'cl-block-throw 'byte-compile 'cl-byte-compile-throw) (defun cl-byte-compile-throw (cl-form) (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names))) (if cl-found (setcdr cl-found t))) (byte-compile-normal-call (cons 'throw (cdr cl-form)))) (defmacro return (&optional res) "(return [RESULT]): return from the block named nil. This is equivalent to `(return-from nil RESULT)'." (list 'return-from nil res)) (defmacro return-from (name &optional res) "(return-from NAME [RESULT]): return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp." (let ((name2 (intern (format "--cl-block-%s--" name)))) (list 'cl-block-throw (list 'quote name2) res))) ;;; The "loop" macro. (defvar args) (defvar loop-accum-var) (defvar loop-accum-vars) (defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps) (defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag) (defvar loop-initially) (defvar loop-map-form) (defvar loop-name) (defvar loop-result) (defvar loop-result-explicit) (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) (defmacro loop (&rest args) "(loop CLAUSE...): The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, always COND, never COND, thereis COND, collect EXPR into VAR, append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, finally return EXPR, named NAME." (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args)))))) (list 'block nil (list* 'while t args)) (let ((loop-name nil) (loop-bindings nil) (loop-body nil) (loop-steps nil) (loop-result nil) (loop-result-explicit nil) (loop-result-var nil) (loop-finish-flag nil) (loop-accum-var nil) (loop-accum-vars nil) (loop-initially nil) (loop-finally nil) (loop-map-form nil) (loop-first-flag nil) (loop-destr-temps nil) (loop-symbol-macs nil)) (setq args (append args '(cl-end-loop))) (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause)) (if loop-finish-flag (cl-push (list (list loop-finish-flag t)) loop-bindings)) (if loop-first-flag (progn (cl-push (list (list loop-first-flag t)) loop-bindings) (cl-push (list 'setq loop-first-flag nil) loop-steps))) (let* ((epilogue (nconc (nreverse loop-finally) (list (or loop-result-explicit loop-result)))) (ands (cl-loop-build-ands (nreverse loop-body))) (while-body (nconc (cadr ands) (nreverse loop-steps))) (body (append (nreverse loop-initially) (list (if loop-map-form (list 'block '--cl-finish-- (subst (if (eq (car ands) t) while-body (cons (list 'or (car ands) '(return-from --cl-finish-- nil)) while-body)) '--cl-map loop-map-form)) (list* 'while (car ands) while-body))) (if loop-finish-flag (if (equal epilogue '(nil)) (list loop-result-var) (list (list 'if loop-finish-flag (cons 'progn epilogue) loop-result-var))) epilogue)))) (if loop-result-var (cl-push (list loop-result-var) loop-bindings)) (while loop-bindings (if (cdar loop-bindings) (setq body (list (cl-loop-let (cl-pop loop-bindings) body t))) (let ((lets nil)) (while (and loop-bindings (not (cdar loop-bindings))) (cl-push (car (cl-pop loop-bindings)) lets)) (setq body (list (cl-loop-let lets body nil)))))) (if loop-symbol-macs (setq body (list (list* 'symbol-macrolet loop-symbol-macs body)))) (list* 'block loop-name body))))) (defun cl-parse-loop-clause () ; uses args, loop-* (let ((word (cl-pop args)) (hash-types '(hash-key hash-keys hash-value hash-values)) (key-types '(key-code key-codes key-seq key-seqs key-binding key-bindings))) (cond ((null args) (error "Malformed `loop' macro")) ((eq word 'named) (setq loop-name (cl-pop args))) ((eq word 'initially) (if (memq (car args) '(do doing)) (cl-pop args)) (or (consp (car args)) (error "Syntax error on `initially' clause")) (while (consp (car args)) (cl-push (cl-pop args) loop-initially))) ((eq word 'finally) (if (eq (car args) 'return) (setq loop-result-explicit (or (cl-pop2 args) '(quote nil))) (if (memq (car args) '(do doing)) (cl-pop args)) (or (consp (car args)) (error "Syntax error on `finally' clause")) (if (and (eq (caar args) 'return) (null loop-name)) (setq loop-result-explicit (or (nth 1 (cl-pop args)) '(quote nil))) (while (consp (car args)) (cl-push (cl-pop args) loop-finally))))) ((memq word '(for as)) (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil) (ands nil)) (while (let ((var (or (cl-pop args) (gensym)))) (setq word (cl-pop args)) (if (eq word 'being) (setq word (cl-pop args))) (if (memq word '(the each)) (setq word (cl-pop args))) (if (memq word '(buffer buffers)) (setq word 'in args (cons '(buffer-list) args))) (cond ((memq word '(from downfrom upfrom to downto upto above below by)) (cl-push word args) (if (memq (car args) '(downto above)) (error "Must specify `from' value for downward loop")) (let* ((down (or (eq (car args) 'downfrom) (memq (caddr args) '(downto above)))) (excl (or (memq (car args) '(above below)) (memq (caddr args) '(above below)))) (start (and (memq (car args) '(from upfrom downfrom)) (cl-pop2 args))) (end (and (memq (car args) '(to upto downto above below)) (cl-pop2 args))) (step (and (eq (car args) 'by) (cl-pop2 args))) (end-var (and (not (cl-const-expr-p end)) (gensym))) (step-var (and (not (cl-const-expr-p step)) (gensym)))) (and step (numberp step) (<= step 0) (error "Loop `by' value is not positive: %s" step)) (cl-push (list var (or start 0)) loop-for-bindings) (if end-var (cl-push (list end-var end) loop-for-bindings)) (if step-var (cl-push (list step-var step) loop-for-bindings)) (if end (cl-push (list (if down (if excl '> '>=) (if excl '< '<=)) var (or end-var end)) loop-body)) (cl-push (list var (list (if down '- '+) var (or step-var step 1))) loop-for-steps))) ((memq word '(in in-ref on)) (let* ((on (eq word 'on)) (temp (if (and on (symbolp var)) var (gensym)))) (cl-push (list temp (cl-pop args)) loop-for-bindings) (cl-push (list 'consp temp) loop-body) (if (eq word 'in-ref) (cl-push (list var (list 'car temp)) loop-symbol-macs) (or (eq temp var) (progn (cl-push (list var nil) loop-for-bindings) (cl-push (list var (if on temp (list 'car temp))) loop-for-sets)))) (cl-push (list temp (if (eq (car args) 'by) (let ((step (cl-pop2 args))) (if (and (memq (car-safe step) '(quote function function*)) (symbolp (nth 1 step))) (list (nth 1 step) temp) (list 'funcall step temp))) (list 'cdr temp))) loop-for-steps))) ((eq word '=) (let* ((start (cl-pop args)) (then (if (eq (car args) 'then) (cl-pop2 args) start))) (cl-push (list var nil) loop-for-bindings) (if (or ands (eq (car args) 'and)) (progn (cl-push (list var (list 'if (or loop-first-flag (setq loop-first-flag (gensym))) start var)) loop-for-sets) (cl-push (list var then) loop-for-steps)) (cl-push (list var (if (eq start then) start (list 'if (or loop-first-flag (setq loop-first-flag (gensym))) start then))) loop-for-sets)))) ((memq word '(across across-ref)) (let ((temp-vec (gensym)) (temp-idx (gensym))) (cl-push (list temp-vec (cl-pop args)) loop-for-bindings) (cl-push (list temp-idx -1) loop-for-bindings) (cl-push (list '< (list 'setq temp-idx (list '1+ temp-idx)) (list 'length temp-vec)) loop-body) (if (eq word 'across-ref) (cl-push (list var (list 'aref temp-vec temp-idx)) loop-symbol-macs) (cl-push (list var nil) loop-for-bindings) (cl-push (list var (list 'aref temp-vec temp-idx)) loop-for-sets)))) ((memq word '(element elements)) (let ((ref (or (memq (car args) '(in-ref of-ref)) (and (not (memq (car args) '(in of))) (error "Expected `of'")))) (seq (cl-pop2 args)) (temp-seq (gensym)) (temp-idx (if (eq (car args) 'using) (if (and (= (length (cadr args)) 2) (eq (caadr args) 'index)) (cadr (cl-pop2 args)) (error "Bad `using' clause")) (gensym)))) (cl-push (list temp-seq seq) loop-for-bindings) (cl-push (list temp-idx 0) loop-for-bindings) (if ref (let ((temp-len (gensym))) (cl-push (list temp-len (list 'length temp-seq)) loop-for-bindings) (cl-push (list var (list 'elt temp-seq temp-idx)) loop-symbol-macs) (cl-push (list '< temp-idx temp-len) loop-body)) (cl-push (list var nil) loop-for-bindings) (cl-push (list 'and temp-seq (list 'or (list 'consp temp-seq) (list '< temp-idx (list 'length temp-seq)))) loop-body) (cl-push (list var (list 'if (list 'consp temp-seq) (list 'pop temp-seq) (list 'aref temp-seq temp-idx))) loop-for-sets)) (cl-push (list temp-idx (list '1+ temp-idx)) loop-for-steps))) ((memq word hash-types) (or (memq (car args) '(in of)) (error "Expected `of'")) (let* ((table (cl-pop2 args)) (other (if (eq (car args) 'using) (if (and (= (length (cadr args)) 2) (memq (caadr args) hash-types) (not (eq (caadr args) word))) (cadr (cl-pop2 args)) (error "Bad `using' clause")) (gensym)))) (if (memq word '(hash-value hash-values)) (setq var (prog1 other (setq other var)))) (setq loop-map-form (list 'maphash (list 'function (list* 'lambda (list var other) '--cl-map)) table)))) ((memq word '(symbol present-symbol external-symbol symbols present-symbols external-symbols)) (let ((ob (and (memq (car args) '(in of)) (cl-pop2 args)))) (setq loop-map-form (list 'mapatoms (list 'function (list* 'lambda (list var) '--cl-map)) ob)))) ((memq word '(overlay overlays extent extents)) (let ((buf nil) (from nil) (to nil)) (while (memq (car args) '(in of from to)) (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) ((eq (car args) 'to) (setq to (cl-pop2 args))) (t (setq buf (cl-pop2 args))))) (setq loop-map-form (list 'cl-map-extents (list 'function (list 'lambda (list var (gensym)) '(progn . --cl-map) nil)) buf from to)))) ((memq word '(interval intervals)) (let ((buf nil) (prop nil) (from nil) (to nil) (var1 (gensym)) (var2 (gensym))) (while (memq (car args) '(in of property from to)) (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) ((eq (car args) 'to) (setq to (cl-pop2 args))) ((eq (car args) 'property) (setq prop (cl-pop2 args))) (t (setq buf (cl-pop2 args))))) (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) (setq var1 (car var) var2 (cdr var)) (cl-push (list var (list 'cons var1 var2)) loop-for-sets)) (setq loop-map-form (list 'cl-map-intervals (list 'function (list 'lambda (list var1 var2) '(progn . --cl-map))) buf prop from to)))) ((memq word key-types) (or (memq (car args) '(in of)) (error "Expected `of'")) (let ((map (cl-pop2 args)) (other (if (eq (car args) 'using) (if (and (= (length (cadr args)) 2) (memq (caadr args) key-types) (not (eq (caadr args) word))) (cadr (cl-pop2 args)) (error "Bad `using' clause")) (gensym)))) (if (memq word '(key-binding key-bindings)) (setq var (prog1 other (setq other var)))) (setq loop-map-form (list (if (memq word '(key-seq key-seqs)) 'cl-map-keymap-recursively 'cl-map-keymap) (list 'function (list* 'lambda (list var other) '--cl-map)) map)))) ((memq word '(frame frames screen screens)) (let ((temp (gensym))) (cl-push (list var (if (eq cl-emacs-type 'lucid) '(selected-screen) '(selected-frame))) loop-for-bindings) (cl-push (list temp nil) loop-for-bindings) (cl-push (list 'prog1 (list 'not (list 'eq var temp)) (list 'or temp (list 'setq temp var))) loop-body) (cl-push (list var (list (if (eq cl-emacs-type 'lucid) 'next-screen 'next-frame) var)) loop-for-steps))) ((memq word '(window windows)) (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) (temp (gensym))) (cl-push (list var (if scr (list (if (eq cl-emacs-type 'lucid) 'screen-selected-window 'frame-selected-window) scr) '(selected-window))) loop-for-bindings) (cl-push (list temp nil) loop-for-bindings) (cl-push (list 'prog1 (list 'not (list 'eq var temp)) (list 'or temp (list 'setq temp var))) loop-body) (cl-push (list var (list 'next-window var)) loop-for-steps))) (t (let ((handler (and (symbolp word) (get word 'cl-loop-for-handler)))) (if handler (funcall handler var) (error "Expected a `for' preposition, found %s" word))))) (eq (car args) 'and)) (setq ands t) (cl-pop args)) (if (and ands loop-for-bindings) (cl-push (nreverse loop-for-bindings) loop-bindings) (setq loop-bindings (nconc (mapcar 'list loop-for-bindings) loop-bindings))) (if loop-for-sets (cl-push (list 'progn (cl-loop-let (nreverse loop-for-sets) 'setq ands) t) loop-body)) (if loop-for-steps (cl-push (cons (if ands 'psetq 'setq) (apply 'append (nreverse loop-for-steps))) loop-steps)))) ((eq word 'repeat) (let ((temp (gensym))) (cl-push (list (list temp (cl-pop args))) loop-bindings) (cl-push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body))) ((eq word 'collect) (let ((what (cl-pop args)) (var (cl-loop-handle-accum nil 'nreverse))) (if (eq var loop-accum-var) (cl-push (list 'progn (list 'push what var) t) loop-body) (cl-push (list 'progn (list 'setq var (list 'nconc var (list 'list what))) t) loop-body)))) ((memq word '(nconc nconcing append appending)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum nil 'nreverse))) (cl-push (list 'progn (list 'setq var (if (eq var loop-accum-var) (list 'nconc (list (if (memq word '(nconc nconcing)) 'nreverse 'reverse) what) var) (list (if (memq word '(nconc nconcing)) 'nconc 'append) var what))) t) loop-body))) ((memq word '(concat concating)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum ""))) (cl-push (list 'progn (list 'callf 'concat var what) t) loop-body))) ((memq word '(vconcat vconcating)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum []))) (cl-push (list 'progn (list 'callf 'vconcat var what) t) loop-body))) ((memq word '(sum summing)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum 0))) (cl-push (list 'progn (list 'incf var what) t) loop-body))) ((memq word '(count counting)) (let ((what (cl-pop args)) (var (cl-loop-handle-accum 0))) (cl-push (list 'progn (list 'if what (list 'incf var)) t) loop-body))) ((memq word '(minimize minimizing maximize maximizing)) (let* ((what (cl-pop args)) (temp (if (cl-simple-expr-p what) what (gensym))) (var (cl-loop-handle-accum nil)) (func (intern (substring (symbol-name word) 0 3))) (set (list 'setq var (list 'if var (list func var temp) temp)))) (cl-push (list 'progn (if (eq temp what) set (list 'let (list (list temp what)) set)) t) loop-body))) ((eq word 'with) (let ((bindings nil)) (while (progn (cl-push (list (cl-pop args) (and (eq (car args) '=) (cl-pop2 args))) bindings) (eq (car args) 'and)) (cl-pop args)) (cl-push (nreverse bindings) loop-bindings))) ((eq word 'while) (cl-push (cl-pop args) loop-body)) ((eq word 'until) (cl-push (list 'not (cl-pop args)) loop-body)) ((eq word 'always) (or loop-finish-flag (setq loop-finish-flag (gensym))) (cl-push (list 'setq loop-finish-flag (cl-pop args)) loop-body) (setq loop-result t)) ((eq word 'never) (or loop-finish-flag (setq loop-finish-flag (gensym))) (cl-push (list 'setq loop-finish-flag (list 'not (cl-pop args))) loop-body) (setq loop-result t)) ((eq word 'thereis) (or loop-finish-flag (setq loop-finish-flag (gensym))) (or loop-result-var (setq loop-result-var (gensym))) (cl-push (list 'setq loop-finish-flag (list 'not (list 'setq loop-result-var (cl-pop args)))) loop-body)) ((memq word '(if when unless)) (let* ((cond (cl-pop args)) (then (let ((loop-body nil)) (cl-parse-loop-clause) (cl-loop-build-ands (nreverse loop-body)))) (else (let ((loop-body nil)) (if (eq (car args) 'else) (progn (cl-pop args) (cl-parse-loop-clause))) (cl-loop-build-ands (nreverse loop-body)))) (simple (and (eq (car then) t) (eq (car else) t)))) (if (eq (car args) 'end) (cl-pop args)) (if (eq word 'unless) (setq then (prog1 else (setq else then)))) (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then)) (if simple (nth 1 else) (list (nth 2 else)))))) (if (cl-expr-contains form 'it) (let ((temp (gensym))) (cl-push (list temp) loop-bindings) (setq form (list* 'if (list 'setq temp cond) (subst temp 'it form)))) (setq form (list* 'if cond form))) (cl-push (if simple (list 'progn form t) form) loop-body)))) ((memq word '(do doing)) (let ((body nil)) (or (consp (car args)) (error "Syntax error on `do' clause")) (while (consp (car args)) (cl-push (cl-pop args) body)) (cl-push (cons 'progn (nreverse (cons t body))) loop-body))) ((eq word 'return) (or loop-finish-flag (setq loop-finish-flag (gensym))) (or loop-result-var (setq loop-result-var (gensym))) (cl-push (list 'setq loop-result-var (cl-pop args) loop-finish-flag nil) loop-body)) (t (let ((handler (and (symbolp word) (get word 'cl-loop-handler)))) (or handler (error "Expected a loop keyword, found %s" word)) (funcall handler)))) (if (eq (car args) 'and) (progn (cl-pop args) (cl-parse-loop-clause))))) (defun cl-loop-let (specs body par) ; uses loop-* (let ((p specs) (temps nil) (new nil)) (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) (setq p (cdr p))) (and par p (progn (setq par nil p specs) (while p (or (cl-const-expr-p (cadar p)) (let ((temp (gensym))) (cl-push (list temp (cadar p)) temps) (setcar (cdar p) temp))) (setq p (cdr p))))) (while specs (if (and (consp (car specs)) (listp (caar specs))) (let* ((spec (caar specs)) (nspecs nil) (expr (cadr (cl-pop specs))) (temp (cdr (or (assq spec loop-destr-temps) (car (cl-push (cons spec (or (last spec 0) (gensym))) loop-destr-temps)))))) (cl-push (list temp expr) new) (while (consp spec) (cl-push (list (cl-pop spec) (and expr (list (if spec 'pop 'car) temp))) nspecs)) (setq specs (nconc (nreverse nspecs) specs))) (cl-push (cl-pop specs) new))) (if (eq body 'setq) (let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new))))) (if temps (list 'let* (nreverse temps) set) set)) (list* (if par 'let 'let*) (nconc (nreverse temps) (nreverse new)) body)))) (defun cl-loop-handle-accum (def &optional func) ; uses args, loop-* (if (eq (car args) 'into) (let ((var (cl-pop2 args))) (or (memq var loop-accum-vars) (progn (cl-push (list (list var def)) loop-bindings) (cl-push var loop-accum-vars))) var) (or loop-accum-var (progn (cl-push (list (list (setq loop-accum-var (gensym)) def)) loop-bindings) (setq loop-result (if func (list func loop-accum-var) loop-accum-var)) loop-accum-var)))) (defun cl-loop-build-ands (clauses) (let ((ands nil) (body nil)) (while clauses (if (and (eq (car-safe (car clauses)) 'progn) (eq (car (last (car clauses))) t)) (if (cdr clauses) (setq clauses (cons (nconc (butlast (car clauses)) (if (eq (car-safe (cadr clauses)) 'progn) (cdadr clauses) (list (cadr clauses)))) (cddr clauses))) (setq body (cdr (butlast (cl-pop clauses))))) (cl-push (cl-pop clauses) ands))) (setq ands (or (nreverse ands) (list t))) (list (if (cdr ands) (cons 'and ands) (car ands)) body (let ((full (if body (append ands (list (cons 'progn (append body '(t))))) ands))) (if (cdr full) (cons 'and full) (car full)))))) ;;; Other iteration control structures. (defmacro do (steps endtest &rest body) "The Common Lisp `do' loop. Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (cl-expand-do-loop steps endtest body nil)) (defmacro do* (steps endtest &rest body) "The Common Lisp `do*' loop. Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (cl-expand-do-loop steps endtest body t)) (defun cl-expand-do-loop (steps endtest body star) (list 'block nil (list* (if star 'let* 'let) (mapcar (function (lambda (c) (if (consp c) (list (car c) (nth 1 c)) c))) steps) (list* 'while (list 'not (car endtest)) (append body (let ((sets (mapcar (function (lambda (c) (and (consp c) (cdr (cdr c)) (list (car c) (nth 2 c))))) steps))) (setq sets (delq nil sets)) (and sets (list (cons (if (or star (not (cdr sets))) 'setq 'psetq) (apply 'append sets))))))) (or (cdr endtest) '(nil))))) (defmacro dolist (spec &rest body) "(dolist (VAR LIST [RESULT]) BODY...): loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil." (let ((temp (gensym "--dolist-temp--"))) (list 'block nil (list* 'let (list (list temp (nth 1 spec)) (car spec)) (list* 'while temp (list 'setq (car spec) (list 'car temp)) (append body (list (list 'setq temp (list 'cdr temp))))) (if (cdr (cdr spec)) (cons (list 'setq (car spec) nil) (cdr (cdr spec))) '(nil)))))) (defmacro dotimes (spec &rest body) "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default nil." (let ((temp (gensym "--dotimes-temp--"))) (list 'block nil (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) (list* 'while (list '< (car spec) temp) (append body (list (list 'incf (car spec))))) (or (cdr (cdr spec)) '(nil)))))) (defmacro do-symbols (spec &rest body) "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol from OBARRAY." ;; Apparently this doesn't have an implicit block. (list 'block nil (list 'let (list (car spec)) (list* 'mapatoms (list 'function (list* 'lambda (list (car spec)) body)) (and (cadr spec) (list (cadr spec)))) (caddr spec)))) (defmacro do-all-symbols (spec &rest body) (list* 'do-symbols (list (car spec) nil (cadr spec)) body)) ;;; Assignments. (defmacro psetq (&rest args) "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) before assigning any symbols SYM to the corresponding values." (cons 'psetf args)) ;;; Binding control structures. (defmacro progv (symbols values &rest body) "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. Each SYMBOL in the first list is bound to the corresponding VALUE in the second list (or made unbound if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time." (list 'let '((cl-progv-save nil)) (list 'unwind-protect (list* 'progn (list 'cl-progv-before symbols values) body) '(cl-progv-after)))) ;;; This should really have some way to shadow 'byte-compile properties, etc. (defmacro flet (bindings &rest body) "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. This is an analogue of `let' that operates on the function cell of FUNC rather than its value cell. The FORMs are evaluated with the specified function definitions in place, then the definitions are undone (the FUNCs go back to their previous definitions, or lack thereof)." (list* 'letf* (mapcar (function (lambda (x) (let ((func (list 'function* (list 'lambda (cadr x) (list* 'block (car x) (cddr x)))))) (if (and (cl-compiling-file) (boundp 'byte-compile-function-environment)) (cl-push (cons (car x) (eval func)) byte-compile-function-environment)) (list (list 'symbol-function (list 'quote (car x))) func)))) bindings) body)) (defmacro labels (&rest args) (cons 'flet args)) ;; The following ought to have a better definition for use with newer ;; byte compilers. (defmacro macrolet (bindings &rest body) "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. This is like `flet', but for macros instead of functions." (if (cdr bindings) (list 'macrolet (list (car bindings)) (list* 'macrolet (cdr bindings) body)) (if (null bindings) (cons 'progn body) (let* ((name (caar bindings)) (res (cl-transform-lambda (cdar bindings) name))) (eval (car res)) (cl-macroexpand-all (cons 'progn body) (cons (list* name 'lambda (cdr res)) cl-macro-environment)))))) (defmacro symbol-macrolet (bindings &rest body) "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." (if (cdr bindings) (list 'symbol-macrolet (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body)) (if (null bindings) (cons 'progn body) (cl-macroexpand-all (cons 'progn body) (cons (list (symbol-name (caar bindings)) (cadar bindings)) cl-macro-environment))))) (defvar cl-closure-vars nil) (defmacro lexical-let (bindings &rest body) "(lexical-let BINDINGS BODY...): like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp." (let* ((cl-closure-vars cl-closure-vars) (vars (mapcar (function (lambda (x) (or (consp x) (setq x (list x))) (cl-push (gensym (format "--%s--" (car x))) cl-closure-vars) (list (car x) (cadr x) (car cl-closure-vars)))) bindings)) (ebody (cl-macroexpand-all (cons 'progn body) (nconc (mapcar (function (lambda (x) (list (symbol-name (car x)) (list 'symbol-value (caddr x)) t))) vars) (list '(defun . cl-defun-expander)) cl-macro-environment)))) (if (not (get (car (last cl-closure-vars)) 'used)) (list 'let (mapcar (function (lambda (x) (list (caddr x) (cadr x)))) vars) (sublis (mapcar (function (lambda (x) (cons (caddr x) (list 'quote (caddr x))))) vars) ebody)) (list 'let (mapcar (function (lambda (x) (list (caddr x) (list 'make-symbol (format "--%s--" (car x)))))) vars) (apply 'append '(setf) (mapcar (function (lambda (x) (list (list 'symbol-value (caddr x)) (cadr x)))) vars)) ebody)))) (defmacro lexical-let* (bindings &rest body) "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp." (if (null bindings) (cons 'progn body) (setq bindings (reverse bindings)) (while bindings (setq body (list (list* 'lexical-let (list (cl-pop bindings)) body)))) (car body))) (defun cl-defun-expander (func &rest rest) (list 'progn (list 'defalias (list 'quote func) (list 'function (cons 'lambda rest))) (list 'quote func))) ;;; Multiple values. (defmacro multiple-value-bind (vars form &rest body) "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-bind' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C)." (let ((temp (gensym)) (n -1)) (list* 'let* (cons (list temp form) (mapcar (function (lambda (v) (list v (list 'nth (setq n (1+ n)) temp)))) vars)) body))) (defmacro multiple-value-setq (vars form) "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp `multiple-value-setq' macro, using lists to simulate true multiple return values. For compatibility, (values A B C) is a synonym for (list A B C)." (cond ((null vars) (list 'progn form nil)) ((null (cdr vars)) (list 'setq (car vars) (list 'car form))) (t (let* ((temp (gensym)) (n 0)) (list 'let (list (list temp form)) (list 'prog1 (list 'setq (cl-pop vars) (list 'car temp)) (cons 'setq (apply 'nconc (mapcar (function (lambda (v) (list v (list 'nth (setq n (1+ n)) temp)))) vars))))))))) ;;; Declarations. (defmacro locally (&rest body) (cons 'progn body)) (defmacro the (type form) form) (defvar cl-proclaim-history t) ; for future compilers (defvar cl-declare-stack t) ; for future compilers (defun cl-do-proclaim (spec hist) (and hist (listp cl-proclaim-history) (cl-push spec cl-proclaim-history)) (cond ((eq (car-safe spec) 'special) (if (boundp 'byte-compile-bound-variables) (setq byte-compile-bound-variables (append (cdr spec) byte-compile-bound-variables)))) ((eq (car-safe spec) 'inline) (while (setq spec (cdr spec)) (or (memq (get (car spec) 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "%s already has a byte-optimizer, can't make it inline" (car spec))) (put (car spec) 'byte-optimizer 'byte-compile-inline-expand))) ((eq (car-safe spec) 'notinline) (while (setq spec (cdr spec)) (if (eq (get (car spec) 'byte-optimizer) 'byte-compile-inline-expand) (put (car spec) 'byte-optimizer nil)))) ((eq (car-safe spec) 'optimize) (let ((speed (assq (nth 1 (assq 'speed (cdr spec))) '((0 nil) (1 t) (2 t) (3 t)))) (safety (assq (nth 1 (assq 'safety (cdr spec))) '((0 t) (1 t) (2 t) (3 nil))))) (if speed (setq cl-optimize-speed (car speed) byte-optimize (nth 1 speed))) (if safety (setq cl-optimize-safety (car safety) byte-compile-delete-errors (nth 1 safety))))) ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) (if (eq byte-compile-warnings t) (setq byte-compile-warnings byte-compile-warning-types)) (while (setq spec (cdr spec)) (if (consp (car spec)) (if (eq (cadar spec) 0) (setq byte-compile-warnings (delq (caar spec) byte-compile-warnings)) (setq byte-compile-warnings (adjoin (caar spec) byte-compile-warnings))))))) nil) ;;; Process any proclamations made before cl-macs was loaded. (defvar cl-proclaims-deferred) (let ((p (reverse cl-proclaims-deferred))) (while p (cl-do-proclaim (cl-pop p) t)) (setq cl-proclaims-deferred nil)) (defmacro declare (&rest specs) (if (cl-compiling-file) (while specs (if (listp cl-declare-stack) (cl-push (car specs) cl-declare-stack)) (cl-do-proclaim (cl-pop specs) nil))) nil) ;;; Generalized variables. (defmacro define-setf-method (func args &rest body) "(define-setf-method NAME ARGLIST BODY...): define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). The argument forms ARGS are bound according to ARGLIST, as if NAME were going to be expanded as a macro, then the BODY forms are executed and must return a list of five elements: a temporary-variables list, a value-forms list, a store-variables list (of length one), a store-form, and an access- form. See `defsetf' for a simpler way to define most setf-methods." (append '(eval-when (compile load eval)) (if (stringp (car body)) (list (list 'put (list 'quote func) '(quote setf-documentation) (cl-pop body)))) (list (cl-transform-function-property func 'setf-method (cons args body))))) (defmacro defsetf (func arg1 &rest args) "(defsetf NAME FUNC): define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of the form (setf (NAME ARGS...) VAL) are transformed to function or macro calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset). Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). Here, the above `setf' call is expanded by binding the argument forms ARGS according to ARGLIST, binding the value form VAL to STORE, then executing BODY, which must return a Lisp form that does the necessary `setf' operation. Actually, ARGLIST and STORE may be bound to temporary variables which are introduced automatically to preserve proper execution order of the arguments. Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))." (if (listp arg1) (let* ((largs nil) (largsr nil) (temps nil) (tempsr nil) (restarg nil) (rest-temps nil) (store-var (car (prog1 (car args) (setq args (cdr args))))) (store-temp (intern (format "--%s--temp--" store-var))) (lets1 nil) (lets2 nil) (docstr nil) (p arg1)) (if (stringp (car args)) (setq docstr (prog1 (car args) (setq args (cdr args))))) (while (and p (not (eq (car p) '&aux))) (if (eq (car p) '&rest) (setq p (cdr p) restarg (car p)) (or (memq (car p) '(&optional &key &allow-other-keys)) (setq largs (cons (if (consp (car p)) (car (car p)) (car p)) largs) temps (cons (intern (format "--%s--temp--" (car largs))) temps)))) (setq p (cdr p))) (setq largs (nreverse largs) temps (nreverse temps)) (if restarg (setq largsr (append largs (list restarg)) rest-temps (intern (format "--%s--temp--" restarg)) tempsr (append temps (list rest-temps))) (setq largsr largs tempsr temps)) (let ((p1 largs) (p2 temps)) (while p1 (setq lets1 (cons (list (car p2) (list 'gensym (format "--%s--" (car p1)))) lets1) lets2 (cons (list (car p1) (car p2)) lets2) p1 (cdr p1) p2 (cdr p2)))) (if restarg (setq lets2 (cons (list restarg rest-temps) lets2))) (append (list 'define-setf-method func arg1) (and docstr (list docstr)) (list (list 'let* (nreverse (cons (list store-temp (list 'gensym (format "--%s--" store-var))) (if restarg (append (list (list rest-temps (list 'mapcar '(quote gensym) restarg))) lets1) lets1))) (list 'list ; 'values (cons (if restarg 'list* 'list) tempsr) (cons (if restarg 'list* 'list) largsr) (list 'list store-temp) (cons 'let* (cons (nreverse (cons (list store-var store-temp) lets2)) args)) (cons (if restarg 'list* 'list) (cons (list 'quote func) tempsr))))))) (list 'defsetf func '(&rest args) '(store) (let ((call (list 'cons (list 'quote arg1) '(append args (list store))))) (if (car args) (list 'list '(quote progn) call 'store) call))))) ;;; Some standard place types from Common Lisp. (defsetf aref aset) (defsetf car setcar) (defsetf cdr setcdr) (defsetf elt (seq n) (store) (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store) (list 'aset seq n store))) (defsetf get put) (defsetf get* (x y &optional d) (store) (list 'put x y store)) (defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h)) (defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) (defsetf subseq (seq start &optional end) (new) (list 'progn (list 'replace seq new ':start1 start ':end1 end) new)) (defsetf symbol-function fset) (defsetf symbol-plist setplist) (defsetf symbol-value set) ;;; Various car/cdr aliases. Note that `cadr' is handled specially. (defsetf first setcar) (defsetf second (x) (store) (list 'setcar (list 'cdr x) store)) (defsetf third (x) (store) (list 'setcar (list 'cddr x) store)) (defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store)) (defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store)) (defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store)) (defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store)) (defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store)) (defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store)) (defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store)) (defsetf rest setcdr) ;;; Some more Emacs-related place types. (defsetf buffer-file-name set-visited-file-name t) (defsetf buffer-modified-p set-buffer-modified-p t) (defsetf buffer-name rename-buffer t) (defsetf buffer-string () (store) (list 'progn '(erase-buffer) (list 'insert store))) (defsetf buffer-substring cl-set-buffer-substring) (defsetf current-buffer set-buffer) (defsetf current-case-table set-case-table) (defsetf current-column move-to-column t) (defsetf current-global-map use-global-map t) (defsetf current-input-mode () (store) (list 'progn (list 'apply 'set-input-mode store) store)) (defsetf current-local-map use-local-map t) (defsetf current-window-configuration set-window-configuration t) (defsetf default-file-modes set-default-file-modes t) (defsetf default-value set-default) (defsetf documentation-property put) (defsetf extent-data set-extent-data) (defsetf extent-face set-extent-face) (defsetf extent-priority set-extent-priority) (defsetf extent-end-position (ext) (store) (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext) store) store)) (defsetf extent-start-position (ext) (store) (list 'progn (list 'set-extent-endpoints store (list 'extent-end-position ext)) store)) (defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) (defsetf face-background-pixmap (f &optional s) (x) (list 'set-face-background-pixmap f x s)) (defsetf face-font (f &optional s) (x) (list 'set-face-font f x s)) (defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s)) (defsetf face-underline-p (f &optional s) (x) (list 'set-face-underline-p f x s)) (defsetf file-modes set-file-modes t) (defsetf frame-height set-screen-height t) (defsetf frame-parameters modify-frame-parameters t) (defsetf frame-visible-p cl-set-frame-visible-p) (defsetf frame-width set-screen-width t) (defsetf getenv setenv t) (defsetf get-register set-register) (defsetf global-key-binding global-set-key) (defsetf keymap-parent set-keymap-parent) (defsetf local-key-binding local-set-key) (defsetf mark set-mark t) (defsetf mark-marker set-mark t) (defsetf marker-position set-marker t) (defsetf match-data store-match-data t) (defsetf mouse-position (scr) (store) (list 'set-mouse-position scr (list 'car store) (list 'cadr store) (list 'cddr store))) (defsetf overlay-get overlay-put) (defsetf overlay-start (ov) (store) (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store)) (defsetf overlay-end (ov) (store) (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store)) (defsetf point goto-char) (defsetf point-marker goto-char t) (defsetf point-max () (store) (list 'progn (list 'narrow-to-region '(point-min) store) store)) (defsetf point-min () (store) (list 'progn (list 'narrow-to-region store '(point-max)) store)) (defsetf process-buffer set-process-buffer) (defsetf process-filter set-process-filter) (defsetf process-sentinel set-process-sentinel) (defsetf read-mouse-position (scr) (store) (list 'set-mouse-position scr (list 'car store) (list 'cdr store))) (defsetf screen-height set-screen-height t) (defsetf screen-width set-screen-width t) (defsetf selected-window select-window) (defsetf selected-screen select-screen) (defsetf selected-frame select-frame) (defsetf standard-case-table set-standard-case-table) (defsetf syntax-table set-syntax-table) (defsetf visited-file-modtime set-visited-file-modtime t) (defsetf window-buffer set-window-buffer t) (defsetf window-display-table set-window-display-table t) (defsetf window-dedicated-p set-window-dedicated-p t) (defsetf window-height () (store) (list 'progn (list 'enlarge-window (list '- store '(window-height))) store)) (defsetf window-hscroll set-window-hscroll) (defsetf window-point set-window-point) (defsetf window-start set-window-start) (defsetf window-width () (store) (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store)) (defsetf x-get-cutbuffer x-store-cutbuffer t) (defsetf x-get-cut-buffer x-store-cut-buffer t) ; groan. (defsetf x-get-secondary-selection x-own-secondary-selection t) (defsetf x-get-selection x-own-selection t) ;;; More complex setf-methods. ;;; These should take &environment arguments, but since full arglists aren't ;;; available while compiling cl-macs, we fake it by referring to the global ;;; variable cl-macro-environment directly. (define-setf-method apply (func arg1 &rest rest) (or (and (memq (car-safe func) '(quote function function*)) (symbolp (car-safe (cdr-safe func)))) (error "First arg to apply in setf is not (function SYM): %s" func)) (let* ((form (cons (nth 1 func) (cons arg1 rest))) (method (get-setf-method form cl-macro-environment))) (list (car method) (nth 1 method) (nth 2 method) (cl-setf-make-apply (nth 3 method) (cadr func) (car method)) (cl-setf-make-apply (nth 4 method) (cadr func) (car method))))) (defun cl-setf-make-apply (form func temps) (if (eq (car form) 'progn) (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form)) (or (equal (last form) (last temps)) (error "%s is not suitable for use with setf-of-apply" func)) (list* 'apply (list 'quote (car form)) (cdr form)))) (define-setf-method nthcdr (n place) (let ((method (get-setf-method place cl-macro-environment)) (n-temp (gensym "--nthcdr-n--")) (store-temp (gensym "--nthcdr-store--"))) (list (cons n-temp (car method)) (cons n (nth 1 method)) (list store-temp) (list 'let (list (list (car (nth 2 method)) (list 'cl-set-nthcdr n-temp (nth 4 method) store-temp))) (nth 3 method) store-temp) (list 'nthcdr n-temp (nth 4 method))))) (define-setf-method getf (place tag &optional def) (let ((method (get-setf-method place cl-macro-environment)) (tag-temp (gensym "--getf-tag--")) (def-temp (gensym "--getf-def--")) (store-temp (gensym "--getf-store--"))) (list (append (car method) (list tag-temp def-temp)) (append (nth 1 method) (list tag def)) (list store-temp) (list 'let (list (list (car (nth 2 method)) (list 'cl-set-getf (nth 4 method) tag-temp store-temp))) (nth 3 method) store-temp) (list 'getf (nth 4 method) tag-temp def-temp)))) (define-setf-method substring (place from &optional to) (let ((method (get-setf-method place cl-macro-environment)) (from-temp (gensym "--substring-from--")) (to-temp (gensym "--substring-to--")) (store-temp (gensym "--substring-store--"))) (list (append (car method) (list from-temp to-temp)) (append (nth 1 method) (list from to)) (list store-temp) (list 'let (list (list (car (nth 2 method)) (list 'cl-set-substring (nth 4 method) from-temp to-temp store-temp))) (nth 3 method) store-temp) (list 'substring (nth 4 method) from-temp to-temp)))) ;;; Getting and optimizing setf-methods. (defun get-setf-method (place &optional env) "Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to a macro like `setf' or `incf'." (if (symbolp place) (let ((temp (gensym "--setf--"))) (list nil nil (list temp) (list 'setq place temp) place)) (or (and (symbolp (car place)) (let* ((func (car place)) (name (symbol-name func)) (method (get func 'setf-method)) (case-fold-search nil)) (or (and method (let ((cl-macro-environment env)) (setq method (apply method (cdr place)))) (if (and (consp method) (= (length method) 5)) method (error "Setf-method for %s returns malformed method" func))) (and (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name) (get-setf-method (compiler-macroexpand place))) (and (eq func 'edebug-after) (get-setf-method (nth (1- (length place)) place) env))))) (if (eq place (setq place (macroexpand place env))) (if (and (symbolp (car place)) (fboundp (car place)) (symbolp (symbol-function (car place)))) (get-setf-method (cons (symbol-function (car place)) (cdr place)) env) (error "No setf-method known for %s" (car place))) (get-setf-method place env))))) (defun cl-setf-do-modify (place opt-expr) (let* ((method (get-setf-method place cl-macro-environment)) (temps (car method)) (values (nth 1 method)) (lets nil) (subs nil) (optimize (and (not (eq opt-expr 'no-opt)) (or (and (not (eq opt-expr 'unsafe)) (cl-safe-expr-p opt-expr)) (cl-setf-simple-store-p (car (nth 2 method)) (nth 3 method))))) (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place))))) (while values (if (or simple (cl-const-expr-p (car values))) (cl-push (cons (cl-pop temps) (cl-pop values)) subs) (cl-push (list (cl-pop temps) (cl-pop values)) lets))) (list (nreverse lets) (cons (car (nth 2 method)) (sublis subs (nth 3 method))) (sublis subs (nth 4 method))))) (defun cl-setf-do-store (spec val) (let ((sym (car spec)) (form (cdr spec))) (if (or (cl-const-expr-p val) (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1)) (cl-setf-simple-store-p sym form)) (subst val sym form) (list 'let (list (list sym val)) form)))) (defun cl-setf-simple-store-p (sym form) (and (consp form) (eq (cl-expr-contains form sym) 1) (eq (nth (1- (length form)) form) sym) (symbolp (car form)) (fboundp (car form)) (not (eq (car-safe (symbol-function (car form))) 'macro)))) ;;; The standard modify macros. (defmacro setf (&rest args) "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic references such as (car x) or (aref x i), as well as plain symbols. For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). The return value is the last VAL in the list." (if (cdr (cdr args)) (let ((sets nil)) (while args (cl-push (list 'setf (cl-pop args) (cl-pop args)) sets)) (cons 'progn (nreverse sets))) (if (symbolp (car args)) (and args (cons 'setq args)) (let* ((method (cl-setf-do-modify (car args) (nth 1 args))) (store (cl-setf-do-store (nth 1 method) (nth 1 args)))) (if (car method) (list 'let* (car method) store) store))))) (defmacro psetf (&rest args) "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values." (let ((p args) (simple t) (vars nil)) (while p (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars)) (setq simple nil)) (if (memq (car p) vars) (error "Destination duplicated in psetf: %s" (car p))) (cl-push (cl-pop p) vars) (or p (error "Odd number of arguments to psetf")) (cl-pop p)) (if simple (list 'progn (cons 'setf args) nil) (setq args (reverse args)) (let ((expr (list 'setf (cadr args) (car args)))) (while (setq args (cddr args)) (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr)))) (list 'progn expr nil))))) (defun cl-do-pop (place) (if (cl-simple-expr-p place) (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))) (let* ((method (cl-setf-do-modify place t)) (temp (gensym "--pop--"))) (list 'let* (append (car method) (list (list temp (nth 2 method)))) (list 'prog1 (list 'car temp) (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) (defmacro remf (place tag) "(remf PLACE TAG): remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise." (let* ((method (cl-setf-do-modify place t)) (tag-temp (and (not (cl-const-expr-p tag)) (gensym "--remf-tag--"))) (val-temp (and (not (cl-simple-expr-p place)) (gensym "--remf-place--"))) (ttag (or tag-temp tag)) (tval (or val-temp (nth 2 method)))) (list 'let* (append (car method) (and val-temp (list (list val-temp (nth 2 method)))) (and tag-temp (list (list tag-temp tag)))) (list 'if (list 'eq ttag (list 'car tval)) (list 'progn (cl-setf-do-store (nth 1 method) (list 'cddr tval)) t) (list 'cl-do-remf tval ttag))))) (defmacro shiftf (place &rest args) "(shiftf PLACE PLACE... VAL): shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (not (memq nil (mapcar 'symbolp (butlast (cons place args))))) (list* 'prog1 place (let ((sets nil)) (while args (cl-push (list 'setq place (car args)) sets) (setq place (cl-pop args))) (nreverse sets))) (let* ((places (reverse (cons place args))) (form (cl-pop places))) (while places (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) (setq form (list 'let* (car method) (list 'prog1 (nth 2 method) (cl-setf-do-store (nth 1 method) form)))))) form))) (defmacro rotatef (&rest args) "(rotatef PLACE...): rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (not (memq nil (mapcar 'symbolp args))) (and (cdr args) (let ((sets nil) (first (car args))) (while (cdr args) (setq sets (nconc sets (list (cl-pop args) (car args))))) (nconc (list 'psetf) sets (list (car args) first)))) (let* ((places (reverse args)) (temp (gensym "--rotatef--")) (form temp)) (while (cdr places) (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) (setq form (list 'let* (car method) (list 'prog1 (nth 2 method) (cl-setf-do-store (nth 1 method) form)))))) (let ((method (cl-setf-do-modify (car places) 'unsafe))) (list 'let* (append (car method) (list (list temp (nth 2 method)))) (cl-setf-do-store (nth 1 method) form) nil))))) (defmacro letf (bindings &rest body) "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY." (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) (list* 'let bindings body) (let ((lets nil) (sets nil) (unsets nil) (rev (reverse bindings))) (while rev (let* ((place (if (symbolp (caar rev)) (list 'symbol-value (list 'quote (caar rev))) (caar rev))) (value (cadar rev)) (method (cl-setf-do-modify place 'no-opt)) (save (gensym "--letf-save--")) (bound (and (memq (car place) '(symbol-value symbol-function)) (gensym "--letf-bound--"))) (temp (and (not (cl-const-expr-p value)) (cdr bindings) (gensym "--letf-val--")))) (setq lets (nconc (car method) (if bound (list (list bound (list (if (eq (car place) 'symbol-value) 'boundp 'fboundp) (nth 1 (nth 2 method)))) (list save (list 'and bound (nth 2 method)))) (list (list save (nth 2 method)))) (and temp (list (list temp value))) lets) body (list (list 'unwind-protect (cons 'progn (if (cdr (car rev)) (cons (cl-setf-do-store (nth 1 method) (or temp value)) body) body)) (if bound (list 'if bound (cl-setf-do-store (nth 1 method) save) (list (if (eq (car place) 'symbol-value) 'makunbound 'fmakunbound) (nth 1 (nth 2 method)))) (cl-setf-do-store (nth 1 method) save)))) rev (cdr rev)))) (list* 'let* lets body)))) (defmacro letf* (bindings &rest body) "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY." (if (null bindings) (cons 'progn body) (setq bindings (reverse bindings)) (while bindings (setq body (list (list* 'letf (list (cl-pop bindings)) body)))) (car body))) (defmacro callf (func place &rest args) "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, or any generalized variable allowed by `setf'." (let* ((method (cl-setf-do-modify place (cons 'list args))) (rargs (cons (nth 2 method) args))) (list 'let* (car method) (cl-setf-do-store (nth 1 method) (if (symbolp func) (cons func rargs) (list* 'funcall (list 'function func) rargs)))))) (defmacro callf2 (func arg1 place &rest args) "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first." (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func)) (list 'setf place (list* func arg1 place args)) (let* ((method (cl-setf-do-modify place (cons 'list args))) (temp (and (not (cl-const-expr-p arg1)) (gensym "--arg1--"))) (rargs (list* (or temp arg1) (nth 2 method) args))) (list 'let* (append (and temp (list (list temp arg1))) (car method)) (cl-setf-do-store (nth 1 method) (if (symbolp func) (cons func rargs) (list* 'funcall (list 'function func) rargs))))))) (defmacro define-modify-macro (name arglist func &optional doc) "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) (let ((place (gensym "--place--"))) (list 'defmacro* name (cons place arglist) doc (list* (if (memq '&rest arglist) 'list* 'list) '(quote callf) (list 'quote func) place (cl-arglist-args arglist))))) ;;; Structures. (defmacro defstruct (struct &rest descs) "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type. This macro defines a new Lisp data type called NAME, which contains data stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." (let* ((name (if (consp struct) (car struct) struct)) (opts (cdr-safe struct)) (slots nil) (defaults nil) (conc-name (concat (symbol-name name) "-")) (constructor (intern (format "make-%s" name))) (constrs nil) (copier (intern (format "copy-%s" name))) (predicate (intern (format "%s-p" name))) (print-func nil) (print-auto nil) (safety (if (cl-compiling-file) cl-optimize-safety 3)) (include nil) (tag (intern (format "cl-struct-%s" name))) (tag-symbol (intern (format "cl-struct-%s-tags" name))) (include-descs nil) (include-tag-symbol nil) (side-eff nil) (type nil) (named nil) (forms nil) pred-form pred-check) (if (stringp (car descs)) (cl-push (list 'put (list 'quote name) '(quote structure-documentation) (cl-pop descs)) forms)) (setq descs (cons '(cl-tag-slot) (mapcar (function (lambda (x) (if (consp x) x (list x)))) descs))) (while opts (let ((opt (if (consp (car opts)) (caar opts) (car opts))) (args (cdr-safe (cl-pop opts)))) (cond ((eq opt ':conc-name) (if args (setq conc-name (if (car args) (symbol-name (car args)) "")))) ((eq opt ':constructor) (if (cdr args) (cl-push args constrs) (if args (setq constructor (car args))))) ((eq opt ':copier) (if args (setq copier (car args)))) ((eq opt ':predicate) (if args (setq predicate (car args)))) ((eq opt ':include) (setq include (car args) include-descs (mapcar (function (lambda (x) (if (consp x) x (list x)))) (cdr args)) include-tag-symbol (intern (format "cl-struct-%s-tags" include)))) ((eq opt ':print-function) (setq print-func (car args))) ((eq opt ':type) (setq type (car args))) ((eq opt ':named) (setq named t)) ((eq opt ':initial-offset) (setq descs (nconc (make-list (car args) '(cl-skip-slot)) descs))) (t (error "Slot option %s unrecognized" opt))))) (if print-func (setq print-func (list 'progn (list 'funcall (list 'function print-func) 'cl-x 'cl-s 'cl-n) t)) (or type (and include (not (get include 'cl-struct-print))) (setq print-auto t print-func (and (or (not (or include type)) (null print-func)) (list 'progn (list 'princ (format "#S(%s" name) 'cl-s)))))) (if include (let ((inc-type (get include 'cl-struct-type)) (old-descs (get include 'cl-struct-slots))) (or inc-type (error "%s is not a struct name" include)) (and type (not (eq (car inc-type) type)) (error ":type disagrees with :include for %s" name)) (while include-descs (setcar (memq (or (assq (caar include-descs) old-descs) (error "No slot %s in included struct %s" (caar include-descs) include)) old-descs) (cl-pop include-descs))) (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs)) type (car inc-type) named (assq 'cl-tag-slot descs)) (if (cadr inc-type) (setq tag name named t)) (cl-push (list 'pushnew (list 'quote tag) include-tag-symbol) forms)) (if type (progn (or (memq type '(vector list)) (error "Illegal :type specifier: %s" type)) (if named (setq tag name))) (setq type 'vector named 'true))) (or named (setq descs (delq (assq 'cl-tag-slot descs) descs))) (cl-push (list 'defvar tag-symbol) forms) (setq pred-form (and named (let ((pos (- (length descs) (length (memq (assq 'cl-tag-slot descs) descs))))) (if (eq type 'vector) (list 'and '(vectorp cl-x) (list '>= '(length cl-x) (length descs)) (list 'memq (list 'aref 'cl-x pos) tag-symbol)) (if (= pos 0) (list 'memq '(car-safe cl-x) tag-symbol) (list 'and '(consp cl-x) (list 'memq (list 'nth pos 'cl-x) tag-symbol)))))) pred-check (and pred-form (> safety 0) (if (and (eq (caadr pred-form) 'vectorp) (= safety 1)) (cons 'and (cdddr pred-form)) pred-form))) (let ((pos 0) (descp descs)) (while descp (let* ((desc (cl-pop descp)) (slot (car desc))) (if (memq slot '(cl-tag-slot cl-skip-slot)) (progn (cl-push nil slots) (cl-push (and (eq slot 'cl-tag-slot) (list 'quote tag)) defaults)) (if (assq slot descp) (error "Duplicate slots named %s in %s" slot name)) (let ((accessor (intern (format "%s%s" conc-name slot)))) (cl-push slot slots) (cl-push (nth 1 desc) defaults) (cl-push (list* 'defsubst* accessor '(cl-x) (append (and pred-check (list (list 'or pred-check (list 'error (format "%s accessing a non-%s" accessor name) 'cl-x)))) (list (if (eq type 'vector) (list 'aref 'cl-x pos) (if (= pos 0) '(car cl-x) (list 'nth pos 'cl-x)))))) forms) (cl-push (cons accessor t) side-eff) (cl-push (list 'define-setf-method accessor '(cl-x) (if (cadr (memq ':read-only (cddr desc))) (list 'error (format "%s is a read-only slot" accessor)) (list 'cl-struct-setf-expander 'cl-x (list 'quote name) (list 'quote accessor) (and pred-check (list 'quote pred-check)) pos))) forms) (if print-auto (nconc print-func (list (list 'princ (format " %s" slot) 'cl-s) (list 'prin1 (list accessor 'cl-x) 'cl-s))))))) (setq pos (1+ pos)))) (setq slots (nreverse slots) defaults (nreverse defaults)) (and predicate pred-form (progn (cl-push (list 'defsubst* predicate '(cl-x) (if (eq (car pred-form) 'and) (append pred-form '(t)) (list 'and pred-form t))) forms) (cl-push (cons predicate 'error-free) side-eff))) (and copier (progn (cl-push (list 'defun copier '(x) '(copy-sequence x)) forms) (cl-push (cons copier t) side-eff))) (if constructor (cl-push (list constructor (cons '&key (delq nil (copy-sequence slots)))) constrs)) (while constrs (let* ((name (caar constrs)) (args (cadr (cl-pop constrs))) (anames (cl-arglist-args args)) (make (mapcar* (function (lambda (s d) (if (memq s anames) s d))) slots defaults))) (cl-push (list 'defsubst* name (list* '&cl-defs (list 'quote (cons nil descs)) args) (cons type make)) forms) (if (cl-safe-expr-p (cons 'progn (mapcar 'second descs))) (cl-push (cons name t) side-eff)))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) (if print-func (cl-push (list 'push (list 'function (list 'lambda '(cl-x cl-s cl-n) (list 'and pred-form print-func))) 'custom-print-functions) forms)) (cl-push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms) (cl-push (list* 'eval-when '(compile load eval) (list 'put (list 'quote name) '(quote cl-struct-slots) (list 'quote descs)) (list 'put (list 'quote name) '(quote cl-struct-type) (list 'quote (list type (eq named t)))) (list 'put (list 'quote name) '(quote cl-struct-print) print-auto) (mapcar (function (lambda (x) (list 'put (list 'quote (car x)) '(quote side-effect-free) (list 'quote (cdr x))))) side-eff)) forms) (cons 'progn (nreverse (cons (list 'quote name) forms))))) (defun cl-struct-setf-expander (x name accessor pred-form pos) (let* ((temp (gensym "--x--")) (store (gensym "--store--"))) (list (list temp) (list x) (list store) (append '(progn) (and pred-form (list (list 'or (subst temp 'cl-x pred-form) (list 'error (format "%s storing a non-%s" accessor name) temp)))) (list (if (eq (car (get name 'cl-struct-type)) 'vector) (list 'aset temp pos store) (list 'setcar (if (<= pos 5) (let ((xx temp)) (while (>= (setq pos (1- pos)) 0) (setq xx (list 'cdr xx))) xx) (list 'nthcdr pos temp)) store)))) (list accessor temp)))) ;;; Types and assertions. (defmacro deftype (name args &rest body) "(deftype NAME ARGLIST BODY...): define NAME as a new data type. The type name can then be used in `typecase', `check-type', etc." (list 'eval-when '(compile load eval) (cl-transform-function-property name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) args) body)))) (defun cl-make-type-test (val type) (if (memq type '(character string-char)) (setq type '(integer 0 255))) (if (symbolp type) (cond ((get type 'cl-deftype-handler) (cl-make-type-test val (funcall (get type 'cl-deftype-handler)))) ((memq type '(nil t)) type) ((eq type 'null) (list 'null val)) ((eq type 'float) (list 'floatp-safe val)) ((eq type 'real) (list 'numberp val)) ((eq type 'fixnum) (list 'integerp val)) (t (let* ((name (symbol-name type)) (namep (intern (concat name "p")))) (if (fboundp namep) (list namep val) (list (intern (concat name "-p")) val))))) (cond ((get (car type) 'cl-deftype-handler) (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler) (cdr type)))) ((memq (car-safe type) '(integer float real number)) (delq t (list 'and (cl-make-type-test val (car type)) (if (memq (cadr type) '(* nil)) t (if (consp (cadr type)) (list '> val (caadr type)) (list '>= val (cadr type)))) (if (memq (caddr type) '(* nil)) t (if (consp (caddr type)) (list '< val (caaddr type)) (list '<= val (caddr type))))))) ((memq (car-safe type) '(and or not)) (cons (car type) (mapcar (function (lambda (x) (cl-make-type-test val x))) (cdr type)))) ((memq (car-safe type) '(member member*)) (list 'and (list 'member* val (list 'quote (cdr type))) t)) ((eq (car-safe type) 'satisfies) (list (cadr type) val)) (t (error "Bad type spec: %s" type))))) (defun typep (val type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." (eval (cl-make-type-test 'val type))) (defmacro check-type (form type &optional string) "Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type." (and (or (not (cl-compiling-file)) (< cl-optimize-speed 3) (= cl-optimize-safety 3)) (let* ((temp (if (cl-simple-expr-p form 3) form (gensym))) (body (list 'or (cl-make-type-test temp type) (list 'signal '(quote wrong-type-argument) (list 'list (or string (list 'quote type)) temp (list 'quote form)))))) (if (eq temp form) (list 'progn body nil) (list 'let (list (list temp form)) body nil))))) (defmacro assert (form &optional show-args string &rest args) "Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. Other args STRING and ARGS... are arguments to be passed to `error'. They are not evaluated unless the assertion fails. If STRING is omitted, a default message listing FORM itself is used." (and (or (not (cl-compiling-file)) (< cl-optimize-speed 3) (= cl-optimize-safety 3)) (let ((sargs (and show-args (delq nil (mapcar (function (lambda (x) (and (not (cl-const-expr-p x)) x))) (cdr form)))))) (list 'progn (list 'or form (if string (list* 'error string (append sargs args)) (list 'signal '(quote cl-assertion-failed) (list* 'list (list 'quote form) sargs)))) nil)))) (defmacro ignore-errors (&rest body) "Execute FORMS; if an error occurs, return nil. Otherwise, return result of last FORM." (let ((err (gensym))) (list 'condition-case err (cons 'progn body) '(error nil)))) ;;; Some predicates for analyzing Lisp forms. These are used by various ;;; macro expanders to optimize the results in certain common cases. (defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max car-safe cdr-safe progn prog1 prog2)) (defconst cl-safe-funcs '(* / % length memq list vector vectorp < > <= >= = error)) ;;; Check if no side effects, and executes quickly. (defun cl-simple-expr-p (x &optional size) (or size (setq size 10)) (if (and (consp x) (not (memq (car x) '(quote function function*)))) (and (symbolp (car x)) (or (memq (car x) cl-simple-funcs) (get (car x) 'side-effect-free)) (progn (setq size (1- size)) (while (and (setq x (cdr x)) (setq size (cl-simple-expr-p (car x) size)))) (and (null x) (>= size 0) size))) (and (> size 0) (1- size)))) (defun cl-simple-exprs-p (xs) (while (and xs (cl-simple-expr-p (car xs))) (setq xs (cdr xs))) (not xs)) ;;; Check if no side effects. (defun cl-safe-expr-p (x) (or (not (and (consp x) (not (memq (car x) '(quote function function*))))) (and (symbolp (car x)) (or (memq (car x) cl-simple-funcs) (memq (car x) cl-safe-funcs) (get (car x) 'side-effect-free)) (progn (while (and (setq x (cdr x)) (cl-safe-expr-p (car x)))) (null x))))) ;;; Check if constant (i.e., no side effects or dependencies). (defun cl-const-expr-p (x) (cond ((consp x) (or (eq (car x) 'quote) (and (memq (car x) '(function function*)) (or (symbolp (nth 1 x)) (and (eq (car-safe (nth 1 x)) 'lambda) 'func))))) ((symbolp x) (and (memq x '(nil t)) t)) (t t))) (defun cl-const-exprs-p (xs) (while (and xs (cl-const-expr-p (car xs))) (setq xs (cdr xs))) (not xs)) (defun cl-const-expr-val (x) (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) (defun cl-expr-access-order (x v) (if (cl-const-expr-p x) v (if (consp x) (progn (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v))) v) (if (eq x (car v)) (cdr v) '(t))))) ;;; Count number of times X refers to Y. Return NIL for 0 times. (defun cl-expr-contains (x y) (cond ((equal y x) 1) ((and (consp x) (not (memq (car-safe x) '(quote function function*)))) (let ((sum 0)) (while x (setq sum (+ sum (or (cl-expr-contains (cl-pop x) y) 0)))) (and (> sum 0) sum))) (t nil))) (defun cl-expr-contains-any (x y) (while (and y (not (cl-expr-contains x (car y)))) (cl-pop y)) y) ;;; Check whether X may depend on any of the symbols in Y. (defun cl-expr-depends-p (x y) (and (not (cl-const-expr-p x)) (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) ;;; Compiler macros. (defmacro define-compiler-macro (func args &rest body) "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to FUNC is compiled (i.e., not interpreted). Compiler macros should be used for optimizing the way calls to FUNC are compiled; the form returned by BODY should do the same thing as a call to the normal function called FUNC, though possibly more efficiently. Note that, like regular macros, compiler macros are expanded repeatedly until no further expansions are possible. Unlike regular macros, BODY can decide to \"punt\" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo." (let ((p (if (listp args) args (list '&rest args))) (res nil)) (while (consp p) (cl-push (cl-pop p) res)) (setq args (nreverse res)) (setcdr res (and p (list '&rest p)))) (list 'eval-when '(compile load eval) (cl-transform-function-property func 'cl-compiler-macro (cons (if (memq '&whole args) (delq '&whole args) (cons '--cl-whole-arg-- args)) body)) (list 'or (list 'get (list 'quote func) '(quote byte-compile)) (list 'put (list 'quote func) '(quote byte-compile) '(quote cl-byte-compile-compiler-macro))))) (defun compiler-macroexpand (form) (while (let ((func (car-safe form)) (handler nil)) (while (and (symbolp func) (not (setq handler (get func 'cl-compiler-macro))) (fboundp func) (or (not (eq (car-safe (symbol-function func)) 'autoload)) (load (nth 1 (symbol-function func))))) (setq func (symbol-function func))) (and handler (not (eq form (setq form (apply handler form (cdr form)))))))) form) (defun cl-byte-compile-compiler-macro (form) (if (eq form (setq form (compiler-macroexpand form))) (byte-compile-normal-call form) (byte-compile-form form))) (defmacro defsubst* (name args &rest body) "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. Like `defun', except the function is automatically declared `inline', ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...)." (let* ((argns (cl-arglist-args args)) (p argns) (pbody (cons 'progn body)) (unsafe (not (cl-safe-expr-p pbody)))) (while (and p (eq (cl-expr-contains args (car p)) 1)) (cl-pop p)) (list 'progn (if p nil ; give up if defaults refer to earlier args (list 'define-compiler-macro name (list* '&whole 'cl-whole '&cl-quote args) (list* 'cl-defsubst-expand (list 'quote argns) (list 'quote (list* 'block name body)) (not (or unsafe (cl-expr-access-order pbody argns))) (and (memq '&key args) 'cl-whole) unsafe argns))) (list* 'defun* name args body)))) (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole (if (cl-simple-exprs-p argvs) (setq simple t)) (let ((lets (delq nil (mapcar* (function (lambda (argn argv) (if (or simple (cl-const-expr-p argv)) (progn (setq body (subst argv argn body)) (and unsafe (list argn argv))) (list argn argv)))) argns argvs)))) (if lets (list 'let lets body) body)))) ;;; Compile-time optimizations for some functions defined in this package. ;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, ;;; mainly to make sure these macros will be present. (put 'eql 'byte-compile nil) (define-compiler-macro eql (&whole form a b) (cond ((eq (cl-const-expr-p a) t) (let ((val (cl-const-expr-val a))) (if (and (numberp val) (not (integerp val))) (list 'equal a b) (list 'eq a b)))) ((eq (cl-const-expr-p b) t) (let ((val (cl-const-expr-val b))) (if (and (numberp val) (not (integerp val))) (list 'equal a b) (list 'eq a b)))) ((cl-simple-expr-p a 5) (list 'if (list 'numberp a) (list 'equal a b) (list 'eq a b))) ((and (cl-safe-expr-p a) (cl-simple-expr-p b 5)) (list 'if (list 'numberp b) (list 'equal a b) (list 'eq a b))) (t form))) (define-compiler-macro member* (&whole form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) ':test) (cl-const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) (list 'memq a list)) ((eq test 'equal) (list 'member a list)) ((or (null keys) (eq test 'eql)) (if (eq (cl-const-expr-p a) t) (list (if (floatp-safe (cl-const-expr-val a)) 'member 'memq) a list) (if (eq (cl-const-expr-p list) t) (let ((p (cl-const-expr-val list)) (mb nil) (mq nil)) (if (not (cdr p)) (and p (list 'eql a (list 'quote (car p)))) (while p (if (floatp-safe (car p)) (setq mb t) (or (integerp (car p)) (symbolp (car p)) (setq mq t))) (setq p (cdr p))) (if (not mb) (list 'memq a list) (if (not mq) (list 'member a list) form)))) form))) (t form)))) (define-compiler-macro assoc* (&whole form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) ':test) (cl-const-expr-val (nth 1 keys))))) (cond ((eq test 'eq) (list 'assq a list)) ((eq test 'equal) (list 'assoc a list)) ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql))) (if (floatp-safe (cl-const-expr-val a)) (list 'assoc a list) (list 'assq a list))) (t form)))) (define-compiler-macro adjoin (&whole form a list &rest keys) (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) (not (memq ':key keys))) (list 'if (list* 'member* a list keys) list (list 'cons a list)) form)) (define-compiler-macro list* (arg &rest others) (let* ((args (reverse (cons arg others))) (form (car args))) (while (setq args (cdr args)) (setq form (list 'cons (car args) form))) form)) (define-compiler-macro get* (sym prop &optional def) (if def (list 'getf (list 'symbol-plist sym) prop def) (list 'get sym prop))) (define-compiler-macro typep (&whole form val type) (if (cl-const-expr-p type) (let ((res (cl-make-type-test val (cl-const-expr-val type)))) (if (or (memq (cl-expr-contains res val) '(nil 1)) (cl-simple-expr-p val)) res (let ((temp (gensym))) (list 'let (list (list temp val)) (subst temp val res))))) form)) (mapcar (function (lambda (y) (put (car y) 'side-effect-free t) (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) (put (car y) 'cl-compiler-macro (list 'lambda '(w x) (if (symbolp (cadr y)) (list 'list (list 'quote (cadr y)) (list 'list (list 'quote (caddr y)) 'x)) (cons 'list (cdr y))))))) '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) (caaar car caar) (caadr car cadr) (cadar car cdar) (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar) (caaadr car caadr) (caadar car cadar) (caaddr car caddr) (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar) (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) )) ;;; Things that are inline. (proclaim '(inline floatp-safe acons map concatenate notany notevery cl-set-elt revappend nreconc gethash)) ;;; Things that are side-effect-free. (mapcar (function (lambda (x) (put x 'side-effect-free t))) '(oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm isqrt floor* ceiling* truncate* round* mod* rem* subseq list-length get* getf gethash hash-table-count)) ;;; Things that are side-effect-and-error-free. (mapcar (function (lambda (x) (put x 'side-effect-free 'error-free))) '(eql floatp-safe list* subst acons equalp random-state-p copy-tree sublis hash-table-p)) (run-hooks 'cl-macs-load-hook) ;;; cl-macs.el ends here emacs-19.22/lisp/cl-seq.el100444 12120 1 111431 5426300442 13616 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Commentary: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains the Common Lisp sequence and list functions ;; which take keyword arguments. ;; See cl.el for Change Log. ;; Code: (or (memq 'cl-19 features) (error "Tried to load `cl-seq' before `cl'!")) ;;; We define these here so that this file can compile without having ;;; loaded the cl.el file already. (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) (defmacro cl-pop (place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) ;;; Keyword parsing. This is special-cased here so that we can compile ;;; this file independent from cl-macs. (defmacro cl-parsing-keywords (kwords other-keys &rest body) (cons 'let* (cons (mapcar (function (lambda (x) (let* ((var (if (consp x) (car x) x)) (mem (list 'car (list 'cdr (list 'memq (list 'quote var) 'cl-keys))))) (if (eq var ':test-not) (setq mem (list 'and mem (list 'setq 'cl-test mem) t))) (if (eq var ':if-not) (setq mem (list 'and mem (list 'setq 'cl-if mem) t))) (list (intern (format "cl-%s" (substring (symbol-name var) 1))) (if (consp x) (list 'or mem (car (cdr x))) mem))))) kwords) (append (and (not (eq other-keys t)) (list (list 'let '((cl-keys-temp cl-keys)) (list 'while 'cl-keys-temp (list 'or (list 'memq '(car cl-keys-temp) (list 'quote (mapcar (function (lambda (x) (if (consp x) (car x) x))) (append kwords other-keys)))) '(car (cdr (memq (quote :allow-other-keys) cl-keys))) '(error "Bad keyword argument %s" (car cl-keys-temp))) '(setq cl-keys-temp (cdr (cdr cl-keys-temp))))))) body)))) (put 'cl-parsing-keywords 'lisp-indent-function 2) (put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form)) (defmacro cl-check-key (x) (list 'if 'cl-key (list 'funcall 'cl-key x) x)) (defmacro cl-check-test-nokey (item x) (list 'cond (list 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test item x)) 'cl-test-not)) (list 'cl-if (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not)) (list 't (list 'if (list 'numberp item) (list 'equal item x) (list 'eq item x))))) (defmacro cl-check-test (item x) (list 'cl-check-test-nokey item (list 'cl-check-key x))) (defmacro cl-check-match (x y) (setq x (list 'cl-check-key x) y (list 'cl-check-key y)) (list 'if 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not) (list 'if (list 'numberp x) (list 'equal x y) (list 'eq x y)))) (put 'cl-check-key 'edebug-form-spec 'edebug-forms) (put 'cl-check-test 'edebug-form-spec 'edebug-forms) (put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms) (put 'cl-check-match 'edebug-form-spec 'edebug-forms) (defvar cl-test) (defvar cl-test-not) (defvar cl-if) (defvar cl-if-not) (defvar cl-key) (defun reduce (cl-func cl-seq &rest cl-keys) "Reduce two-argument FUNCTION across SEQUENCE. Keywords supported: :start :end :from-end :initial-value :key" (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) (setq cl-seq (subseq cl-seq cl-start cl-end)) (if cl-from-end (setq cl-seq (nreverse cl-seq))) (let ((cl-accum (cond ((memq ':initial-value cl-keys) cl-initial-value) (cl-seq (cl-check-key (cl-pop cl-seq))) (t (funcall cl-func))))) (if cl-from-end (while cl-seq (setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq)) cl-accum))) (while cl-seq (setq cl-accum (funcall cl-func cl-accum (cl-check-key (cl-pop cl-seq)))))) cl-accum))) (defun fill (seq item &rest cl-keys) "Fill the elements of SEQ with ITEM. Keywords supported: :start :end" (cl-parsing-keywords ((:start 0) :end) () (if (listp seq) (let ((p (nthcdr cl-start seq)) (n (if cl-end (- cl-end cl-start) 8000000))) (while (and p (>= (setq n (1- n)) 0)) (setcar p item) (setq p (cdr p)))) (or cl-end (setq cl-end (length seq))) (if (and (= cl-start 0) (= cl-end (length seq))) (fillarray seq item) (while (< cl-start cl-end) (aset seq cl-start item) (setq cl-start (1+ cl-start))))) seq)) (defun replace (cl-seq1 cl-seq2 &rest cl-keys) "Replace the elements of SEQ1 with the elements of SEQ2. SEQ1 is destructively modified, then returned. Keywords supported: :start1 :end1 :start2 :end2" (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) (or (= cl-start1 cl-start2) (let* ((cl-len (length cl-seq1)) (cl-n (min (- (or cl-end1 cl-len) cl-start1) (- (or cl-end2 cl-len) cl-start2)))) (while (>= (setq cl-n (1- cl-n)) 0) (cl-set-elt cl-seq1 (+ cl-start1 cl-n) (elt cl-seq2 (+ cl-start2 cl-n)))))) (if (listp cl-seq1) (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) (if (listp cl-seq2) (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) (cl-n (min cl-n1 (if cl-end2 (- cl-end2 cl-start2) 4000000)))) (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) (setcar cl-p1 (car cl-p2)) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) (setq cl-end2 (min (or cl-end2 (length cl-seq2)) (+ cl-start2 cl-n1))) (while (and cl-p1 (< cl-start2 cl-end2)) (setcar cl-p1 (aref cl-seq2 cl-start2)) (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) (setq cl-end1 (min (or cl-end1 (length cl-seq1)) (+ cl-start1 (- (or cl-end2 (length cl-seq2)) cl-start2)))) (if (listp cl-seq2) (let ((cl-p2 (nthcdr cl-start2 cl-seq2))) (while (< cl-start1 cl-end1) (aset cl-seq1 cl-start1 (car cl-p2)) (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1)))) (while (< cl-start1 cl-end1) (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2)) (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))) cl-seq1)) (defun remove* (cl-item cl-seq &rest cl-keys) "Remove all occurrences of ITEM in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () (if (<= (or cl-count (setq cl-count 8000000)) 0) cl-seq (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) (if cl-i (let ((cl-res (apply 'delete* cl-item (append cl-seq nil) (append (if cl-from-end (list ':end (1+ cl-i)) (list ':start cl-i)) cl-keys)))) (if (listp cl-seq) cl-res (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) cl-seq)) (setq cl-end (- (or cl-end 8000000) cl-start)) (if (= cl-start 0) (while (and cl-seq (> cl-end 0) (cl-check-test cl-item (car cl-seq)) (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) (> (setq cl-count (1- cl-count)) 0)))) (if (and (> cl-count 0) (> cl-end 0)) (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq) (setq cl-end (1- cl-end)) (cdr cl-seq)))) (while (and cl-p (> cl-end 0) (not (cl-check-test cl-item (car cl-p)))) (setq cl-p (cdr cl-p) cl-end (1- cl-end))) (if (and cl-p (> cl-end 0)) (nconc (ldiff cl-seq cl-p) (if (= cl-count 1) (cdr cl-p) (and (cdr cl-p) (apply 'delete* cl-item (copy-sequence (cdr cl-p)) ':start 0 ':end (1- cl-end) ':count (1- cl-count) cl-keys)))) cl-seq)) cl-seq))))) (defun remove-if (cl-pred cl-list &rest cl-keys) "Remove all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'remove* nil cl-list ':if cl-pred cl-keys)) (defun remove-if-not (cl-pred cl-list &rest cl-keys) "Remove all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'remove* nil cl-list ':if-not cl-pred cl-keys)) (defun delete* (cl-item cl-seq &rest cl-keys) "Remove all occurrences of ITEM in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end (:start 0) :end) () (if (<= (or cl-count (setq cl-count 8000000)) 0) cl-seq (if (listp cl-seq) (if (and cl-from-end (< cl-count 4000000)) (let (cl-i) (while (and (>= (setq cl-count (1- cl-count)) 0) (setq cl-i (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) (setcdr cl-tail (cdr (cdr cl-tail))))) (setq cl-end cl-i)) cl-seq) (setq cl-end (- (or cl-end 8000000) cl-start)) (if (= cl-start 0) (progn (while (and cl-seq (> cl-end 0) (cl-check-test cl-item (car cl-seq)) (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) (> (setq cl-count (1- cl-count)) 0))) (setq cl-end (1- cl-end))) (setq cl-start (1- cl-start))) (if (and (> cl-count 0) (> cl-end 0)) (let ((cl-p (nthcdr cl-start cl-seq))) (while (and (cdr cl-p) (> cl-end 0)) (if (cl-check-test cl-item (car (cdr cl-p))) (progn (setcdr cl-p (cdr (cdr cl-p))) (if (= (setq cl-count (1- cl-count)) 0) (setq cl-end 1))) (setq cl-p (cdr cl-p))) (setq cl-end (1- cl-end))))) cl-seq) (apply 'remove* cl-item cl-seq cl-keys))))) (defun delete-if (cl-pred cl-list &rest cl-keys) "Remove all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'delete* nil cl-list ':if cl-pred cl-keys)) (defun delete-if-not (cl-pred cl-list &rest cl-keys) "Remove all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'delete* nil cl-list ':if-not cl-pred cl-keys)) (or (and (fboundp 'delete) (subrp (symbol-function 'delete))) (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal))))) (defun remove (x y) (remove* x y ':test 'equal)) (defun remq (x y) (if (memq x y) (delq x (copy-list y)) y)) (defun remove-duplicates (cl-seq &rest cl-keys) "Return a copy of SEQ with all duplicate elements removed. Keywords supported: :test :test-not :key :start :end :from-end" (cl-delete-duplicates cl-seq cl-keys t)) (defun delete-duplicates (cl-seq &rest cl-keys) "Remove all duplicate elements from SEQ (destructively). Keywords supported: :test :test-not :key :start :end :from-end" (cl-delete-duplicates cl-seq cl-keys nil)) (defun cl-delete-duplicates (cl-seq cl-keys cl-copy) (if (listp cl-seq) (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) () (if cl-from-end (let ((cl-p (nthcdr cl-start cl-seq)) cl-i) (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) (while (> cl-end 1) (setq cl-i 0) (while (setq cl-i (cl-position (cl-check-key (car cl-p)) (cdr cl-p) cl-i (1- cl-end))) (if cl-copy (setq cl-seq (copy-sequence cl-seq) cl-p (nthcdr cl-start cl-seq) cl-copy nil)) (let ((cl-tail (nthcdr cl-i cl-p))) (setcdr cl-tail (cdr (cdr cl-tail)))) (setq cl-end (1- cl-end))) (setq cl-p (cdr cl-p) cl-end (1- cl-end) cl-start (1+ cl-start))) cl-seq) (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1) (cl-position (cl-check-key (car cl-seq)) (cdr cl-seq) 0 (1- cl-end))) (setq cl-seq (cdr cl-seq) cl-end (1- cl-end))) (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq) (setq cl-end (1- cl-end) cl-start 1) cl-seq))) (while (and (cdr (cdr cl-p)) (> cl-end 1)) (if (cl-position (cl-check-key (car (cdr cl-p))) (cdr (cdr cl-p)) 0 (1- cl-end)) (progn (if cl-copy (setq cl-seq (copy-sequence cl-seq) cl-p (nthcdr (1- cl-start) cl-seq) cl-copy nil)) (setcdr cl-p (cdr (cdr cl-p)))) (setq cl-p (cdr cl-p))) (setq cl-end (1- cl-end) cl-start (1+ cl-start))) cl-seq))) (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil))) (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))) (defun substitute (cl-new cl-old cl-seq &rest cl-keys) "Substitute NEW for OLD in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () (if (or (eq cl-old cl-new) (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) cl-seq (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end))) (if (not cl-i) cl-seq (setq cl-seq (copy-sequence cl-seq)) (or cl-from-end (progn (cl-set-elt cl-seq cl-i cl-new) (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) (apply 'nsubstitute cl-new cl-old cl-seq ':count cl-count ':start cl-i cl-keys)))))) (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'substitute cl-new nil cl-list ':if cl-pred cl-keys)) (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary to avoid corrupting the original SEQ. Keywords supported: :key :count :start :end :from-end" (apply 'substitute cl-new nil cl-list ':if-not cl-pred cl-keys)) (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) "Substitute NEW for OLD in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :test :test-not :key :count :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not :count (:start 0) :end :from-end) () (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) (let ((cl-p (nthcdr cl-start cl-seq))) (setq cl-end (- (or cl-end 8000000) cl-start)) (while (and cl-p (> cl-end 0) (> cl-count 0)) (if (cl-check-test cl-old (car cl-p)) (progn (setcar cl-p cl-new) (setq cl-count (1- cl-count)))) (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) (or cl-end (setq cl-end (length cl-seq))) (if cl-from-end (while (and (< cl-start cl-end) (> cl-count 0)) (setq cl-end (1- cl-end)) (if (cl-check-test cl-old (elt cl-seq cl-end)) (progn (cl-set-elt cl-seq cl-end cl-new) (setq cl-count (1- cl-count))))) (while (and (< cl-start cl-end) (> cl-count 0)) (if (cl-check-test cl-old (aref cl-seq cl-start)) (progn (aset cl-seq cl-start cl-new) (setq cl-count (1- cl-count)))) (setq cl-start (1+ cl-start)))))) cl-seq)) (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'nsubstitute cl-new nil cl-list ':if cl-pred cl-keys)) (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. Keywords supported: :key :count :start :end :from-end" (apply 'nsubstitute cl-new nil cl-list ':if-not cl-pred cl-keys)) (defun find (cl-item cl-seq &rest cl-keys) "Find the first occurrence of ITEM in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :test :test-not :key :start :end :from-end" (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) (and cl-pos (elt cl-seq cl-pos)))) (defun find-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'find nil cl-list ':if cl-pred cl-keys)) (defun find-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the matching ITEM, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'find nil cl-list ':if-not cl-pred cl-keys)) (defun position (cl-item cl-seq &rest cl-keys) "Find the first occurrence of ITEM in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :test :test-not :key :start :end :from-end" (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end :from-end) () (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end) (if (listp cl-seq) (let ((cl-p (nthcdr cl-start cl-seq))) (or cl-end (setq cl-end 8000000)) (let ((cl-res nil)) (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) (if (cl-check-test cl-item (car cl-p)) (setq cl-res cl-start)) (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) cl-res)) (or cl-end (setq cl-end (length cl-seq))) (if cl-from-end (progn (while (and (>= (setq cl-end (1- cl-end)) cl-start) (not (cl-check-test cl-item (aref cl-seq cl-end))))) (and (>= cl-end cl-start) cl-end)) (while (and (< cl-start cl-end) (not (cl-check-test cl-item (aref cl-seq cl-start)))) (setq cl-start (1+ cl-start))) (and (< cl-start cl-end) cl-start)))) (defun position-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'position nil cl-list ':if cl-pred cl-keys)) (defun position-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the index of the matching item, or nil if not found. Keywords supported: :key :start :end :from-end" (apply 'position nil cl-list ':if-not cl-pred cl-keys)) (defun count (cl-item cl-seq &rest cl-keys) "Count the number of occurrences of ITEM in LIST. Keywords supported: :test :test-not :key :start :end" (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () (let ((cl-count 0) cl-x) (or cl-end (setq cl-end (length cl-seq))) (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) (while (< cl-start cl-end) (setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start))) (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) (setq cl-start (1+ cl-start))) cl-count))) (defun count-if (cl-pred cl-list &rest cl-keys) "Count the number of items satisfying PREDICATE in LIST. Keywords supported: :key :start :end" (apply 'count nil cl-list ':if cl-pred cl-keys)) (defun count-if-not (cl-pred cl-list &rest cl-keys) "Count the number of items not satisfying PREDICATE in LIST. Keywords supported: :key :start :end" (apply 'count nil cl-list ':if-not cl-pred cl-keys)) (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) "Compare SEQ1 with SEQ2, return index of first mismatching element. Return nil if the sequences match. If one sequence is a prefix of the other, the return value indicates the end of the shorted sequence. Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" (cl-parsing-keywords (:test :test-not :key :from-end (:start1 0) :end1 (:start2 0) :end2) () (or cl-end1 (setq cl-end1 (length cl-seq1))) (or cl-end2 (setq cl-end2 (length cl-seq2))) (if cl-from-end (progn (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) (cl-check-match (elt cl-seq1 (1- cl-end1)) (elt cl-seq2 (1- cl-end2)))) (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) (1- cl-end1))) (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) (cl-check-match (if cl-p1 (car cl-p1) (aref cl-seq1 cl-start1)) (if cl-p2 (car cl-p2) (aref cl-seq2 cl-start2)))) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) cl-start1))))) (defun search (cl-seq1 cl-seq2 &rest cl-keys) "Search for SEQ1 as a subsequence of SEQ2. Return the index of the leftmost element of the first match found; return nil if there are no matches. Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" (cl-parsing-keywords (:test :test-not :key :from-end (:start1 0) :end1 (:start2 0) :end2) () (or cl-end1 (setq cl-end1 (length cl-seq1))) (or cl-end2 (setq cl-end2 (length cl-seq2))) (if (>= cl-start1 cl-end1) (if cl-from-end cl-end2 cl-start2) (let* ((cl-len (- cl-end1 cl-start1)) (cl-first (cl-check-key (elt cl-seq1 cl-start1))) (cl-if nil) cl-pos) (setq cl-end2 (- cl-end2 (1- cl-len))) (while (and (< cl-start2 cl-end2) (setq cl-pos (cl-position cl-first cl-seq2 cl-start2 cl-end2 cl-from-end)) (apply 'mismatch cl-seq1 cl-seq2 ':start1 (1+ cl-start1) ':end1 cl-end1 ':start2 (1+ cl-pos) ':end2 (+ cl-pos cl-len) ':from-end nil cl-keys)) (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) (and (< cl-start2 cl-end2) cl-pos))))) (defun sort* (cl-seq cl-pred &rest cl-keys) "Sort the argument SEQUENCE according to PREDICATE. This is a destructive function; it reuses the storage of SEQUENCE if possible. Keywords supported: :key" (if (nlistp cl-seq) (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) (cl-parsing-keywords (:key) () (if (memq cl-key '(nil identity)) (sort cl-seq cl-pred) (sort cl-seq (function (lambda (cl-x cl-y) (funcall cl-pred (funcall cl-key cl-x) (funcall cl-key cl-y))))))))) (defun stable-sort (cl-seq cl-pred &rest cl-keys) "Sort the argument SEQUENCE stably according to PREDICATE. This is a destructive function; it reuses the storage of SEQUENCE if possible. Keywords supported: :key" (apply 'sort* cl-seq cl-pred cl-keys)) (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) "Destructively merge the two sequences to produce a new sequence. TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument sequences, and PRED is a `less-than' predicate on the elements. Keywords supported: :key" (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) (cl-parsing-keywords (:key) () (let ((cl-res nil)) (while (and cl-seq1 cl-seq2) (if (funcall cl-pred (cl-check-key (car cl-seq2)) (cl-check-key (car cl-seq1))) (cl-push (cl-pop cl-seq2) cl-res) (cl-push (cl-pop cl-seq1) cl-res))) (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) ;;; See compiler macro in cl-macs.el (defun member* (cl-item cl-list &rest cl-keys) "Find the first occurrence of ITEM in LIST. Return the sublist of LIST whose car is ITEM. Keywords supported: :test :test-not :key" (if cl-keys (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) (setq cl-list (cdr cl-list))) cl-list) (if (and (numberp cl-item) (not (integerp cl-item))) (member cl-item cl-list) (memq cl-item cl-list)))) (defun member-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. Keywords supported: :key" (apply 'member* nil cl-list ':if cl-pred cl-keys)) (defun member-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. Keywords supported: :key" (apply 'member* nil cl-list ':if-not cl-pred cl-keys)) (defun cl-adjoin (cl-item cl-list &rest cl-keys) (if (cl-parsing-keywords (:key) t (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) cl-list (cons cl-item cl-list))) ;;; See compiler macro in cl-macs.el (defun assoc* (cl-item cl-alist &rest cl-keys) "Find the first item whose car matches ITEM in LIST. Keywords supported: :test :test-not :key" (if cl-keys (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-alist (or (not (consp (car cl-alist))) (not (cl-check-test cl-item (car (car cl-alist)))))) (setq cl-alist (cdr cl-alist))) (and cl-alist (car cl-alist))) (if (and (numberp cl-item) (not (integerp cl-item))) (assoc cl-item cl-alist) (assq cl-item cl-alist)))) (defun assoc-if (cl-pred cl-list &rest cl-keys) "Find the first item whose car satisfies PREDICATE in LIST. Keywords supported: :key" (apply 'assoc* nil cl-list ':if cl-pred cl-keys)) (defun assoc-if-not (cl-pred cl-list &rest cl-keys) "Find the first item whose car does not satisfy PREDICATE in LIST. Keywords supported: :key" (apply 'assoc* nil cl-list ':if-not cl-pred cl-keys)) (defun rassoc* (cl-item cl-alist &rest cl-keys) "Find the first item whose cdr matches ITEM in LIST. Keywords supported: :test :test-not :key" (if (or cl-keys (numberp cl-item)) (cl-parsing-keywords (:test :test-not :key :if :if-not) () (while (and cl-alist (or (not (consp (car cl-alist))) (not (cl-check-test cl-item (cdr (car cl-alist)))))) (setq cl-alist (cdr cl-alist))) (and cl-alist (car cl-alist))) (rassq cl-item cl-alist))) (defun rassoc (item alist) (rassoc* item alist ':test 'equal)) (defun rassoc-if (cl-pred cl-list &rest cl-keys) "Find the first item whose cdr satisfies PREDICATE in LIST. Keywords supported: :key" (apply 'rassoc* nil cl-list ':if cl-pred cl-keys)) (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) "Find the first item whose cdr does not satisfy PREDICATE in LIST. Keywords supported: :key" (apply 'rassoc* nil cl-list ':if-not cl-pred cl-keys)) (defun union (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) cl-list1) (t (or (>= (length cl-list1) (length cl-list2)) (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) (while cl-list2 (if (or cl-keys (numberp (car cl-list2))) (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys)) (or (memq (car cl-list2) cl-list1) (cl-push (car cl-list2) cl-list1))) (cl-pop cl-list2)) cl-list1))) (defun nunion (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (t (apply 'union cl-list1 cl-list2 cl-keys)))) (defun intersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (and cl-list1 cl-list2 (if (equal cl-list1 cl-list2) cl-list1 (cl-parsing-keywords (:key) (:test :test-not) (let ((cl-res nil)) (or (>= (length cl-list1) (length cl-list2)) (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) (while cl-list2 (if (if (or cl-keys (numberp (car cl-list2))) (apply 'member* (cl-check-key (car cl-list2)) cl-list1 cl-keys) (memq (car cl-list2) cl-list1)) (cl-push (car cl-list2) cl-res)) (cl-pop cl-list2)) cl-res))))) (defun nintersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) (defun set-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (if (or (null cl-list1) (null cl-list2)) cl-list1 (cl-parsing-keywords (:key) (:test :test-not) (let ((cl-res nil)) (while cl-list1 (or (if (or cl-keys (numberp (car cl-list1))) (apply 'member* (cl-check-key (car cl-list1)) cl-list2 cl-keys) (memq (car cl-list1) cl-list2)) (cl-push (car cl-list1) cl-res)) (cl-pop cl-list1)) cl-res)))) (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (if (or (null cl-list1) (null cl-list2)) cl-list1 (apply 'set-difference cl-list1 cl-list2 cl-keys))) (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) nil) (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) (apply 'set-difference cl-list2 cl-list1 cl-keys))))) (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. Keywords supported: :test :test-not :key" (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) ((equal cl-list1 cl-list2) nil) (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) (defun subsetp (cl-list1 cl-list2 &rest cl-keys) "True if LIST1 is a subset of LIST2. I.e., if every element of LIST1 also appears in LIST2. Keywords supported: :test :test-not :key" (cond ((null cl-list1) t) ((null cl-list2) nil) ((equal cl-list1 cl-list2) t) (t (cl-parsing-keywords (:key) (:test :test-not) (while (and cl-list1 (apply 'member* (cl-check-key (car cl-list1)) cl-list2 cl-keys)) (cl-pop cl-list1)) (null cl-list1))))) (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all matching elements replaced by NEW. Keywords supported: :key" (apply 'sublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all non-matching elements replaced by NEW. Keywords supported: :key" (apply 'sublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) "Substitute NEW for OLD everywhere in TREE (destructively). Any element of TREE which is `eql' to OLD is changed to NEW (via a call to `setcar'). Keywords supported: :test :test-not :key" (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). Keywords supported: :key" (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements not matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). Keywords supported: :key" (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) (defun sublis (cl-alist cl-tree &rest cl-keys) "Perform substitutions indicated by ALIST in TREE (non-destructively). Return a copy of TREE with all matching elements replaced. Keywords supported: :test :test-not :key" (cl-parsing-keywords (:test :test-not :key :if :if-not) () (cl-sublis-rec cl-tree))) (defvar cl-alist) (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if* (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist)) (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) (setq cl-p (cdr cl-p))) (if cl-p (cdr (car cl-p)) (if (consp cl-tree) (let ((cl-a (cl-sublis-rec (car cl-tree))) (cl-d (cl-sublis-rec (cdr cl-tree)))) (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree))) cl-tree (cons cl-a cl-d))) cl-tree)))) (defun nsublis (cl-alist cl-tree &rest cl-keys) "Perform substitutions indicated by ALIST in TREE (destructively). Any matching element of TREE is changed via a call to `setcar'. Keywords supported: :test :test-not :key" (cl-parsing-keywords (:test :test-not :key :if :if-not) () (let ((cl-hold (list cl-tree))) (cl-nsublis-rec cl-hold) (car cl-hold)))) (defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if* (while (consp cl-tree) (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist)) (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) (setq cl-p (cdr cl-p))) (if cl-p (setcar cl-tree (cdr (car cl-p))) (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree)))) (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist) (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) (setq cl-p (cdr cl-p))) (if cl-p (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil)) (setq cl-tree (cdr cl-tree)))))) (defun tree-equal (cl-x cl-y &rest cl-keys) "T if trees X and Y have `eql' leaves. Atoms are compared by `eql'; cons cells are compared recursively. Keywords supported: :test :test-not :key" (cl-parsing-keywords (:test :test-not :key) () (cl-tree-equal-rec cl-x cl-y))) (defun cl-tree-equal-rec (cl-x cl-y) (while (and (consp cl-x) (consp cl-y) (cl-tree-equal-rec (car cl-x) (car cl-y))) (setq cl-x (cdr cl-x) cl-y (cdr cl-y))) (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y))) (run-hooks 'cl-seq-load-hook) ;;; cl-seq.el ends here emacs-19.22/lisp/cl.el100444 12120 1 62316 5426300420 13013 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;; Commentary: ;; These are extensions to Emacs Lisp that provide a degree of ;; Common Lisp compatibility, beyond what is already built-in ;; in Emacs Lisp. ;; ;; This package was written by Dave Gillespie; it is a complete ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. ;; ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. ;; ;; Bug reports, comments, and suggestions are welcome! ;; This file contains the portions of the Common Lisp extensions ;; package which should always be present. ;; Future notes: ;; Once Emacs 19 becomes standard, many things in this package which are ;; messy for reasons of compatibility can be greatly simplified. For now, ;; I prefer to maintain one unified version. ;; Change Log: ;; Version 2.02 (30 Jul 93): ;; * Added "cl-compat.el" file, extra compatibility with old package. ;; * Added `lexical-let' and `lexical-let*'. ;; * Added `define-modify-macro', `callf', and `callf2'. ;; * Added `ignore-errors'. ;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero. ;; * Merged `*gentemp-counter*' into `*gensym-counter*'. ;; * Extended `subseq' to allow negative START and END like `substring'. ;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses. ;; * Added `concat', `vconcat' loop clauses. ;; * Cleaned up a number of compiler warnings. ;; Version 2.01 (7 Jul 93): ;; * Added support for FSF version of Emacs 19. ;; * Added `add-hook' for Emacs 18 users. ;; * Added `defsubst*' and `symbol-macrolet'. ;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'. ;; * Added `map', `concatenate', `reduce', `merge'. ;; * Added `revappend', `nreconc', `tailp', `tree-equal'. ;; * Added `assert', `check-type', `typecase', `typep', and `deftype'. ;; * Added destructuring and `&environment' support to `defmacro*'. ;; * Added destructuring to `loop', and added the following clauses: ;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'. ;; * Renamed `delete' to `delete*' and `remove' to `remove*'. ;; * Completed support for all keywords in `remove*', `substitute', etc. ;; * Added `most-positive-float' and company. ;; * Fixed hash tables to work with latest Lucid Emacs. ;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'. ;; * Syntax for `warn' declarations has changed. ;; * Improved implementation of `random*'. ;; * Moved most sequence functions to a new file, cl-seq.el. ;; * Moved `eval-when' into cl-macs.el. ;; * Moved `pushnew' and `adjoin' to cl.el for most common cases. ;; * Moved `provide' forms down to ends of files. ;; * Changed expansion of `pop' to something that compiles to better code. ;; * Changed so that no patch is required for Emacs 19 byte compiler. ;; * Made more things dependent on `optimize' declarations. ;; * Added a partial implementation of struct print functions. ;; * Miscellaneous minor changes. ;; Version 2.00: ;; * First public release of this package. ;; Code: (defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version) (symbol-value 'epoch::version)) (string-lessp emacs-version "19")) 18) ((string-match "Lucid" emacs-version) 'lucid) (t 19))) (or (fboundp 'defalias) (fset 'defalias 'fset)) (defvar cl-optimize-speed 1) (defvar cl-optimize-safety 1) ;;; Keywords used in this package. (defconst :test ':test) (defconst :test-not ':test-not) (defconst :key ':key) (defconst :start ':start) (defconst :start1 ':start1) (defconst :start2 ':start2) (defconst :end ':end) (defconst :end1 ':end1) (defconst :end2 ':end2) (defconst :count ':count) (defconst :initial-value ':initial-value) (defconst :size ':size) (defconst :from-end ':from-end) (defconst :rehash-size ':rehash-size) (defconst :rehash-threshold ':rehash-threshold) (defconst :allow-other-keys ':allow-other-keys) (defvar custom-print-functions nil "This is a list of functions that format user objects for printing. Each function is called in turn with three arguments: the object, the stream, and the print level (currently ignored). If it is able to print the object it returns true; otherwise it returns nil and the printer proceeds to the next function on the list. This variable is not used at present, but it is defined in hopes that a future Emacs interpreter will be able to use it.") ;;; Predicates. (defun eql (a b) ; See compiler macro in cl-macs.el "T if the two args are the same Lisp object. Floating-point numbers of equal value are `eql', but they may not be `eq'." (if (numberp a) (equal a b) (eq a b))) ;;; Generalized variables. These macros are defined here so that they ;;; can safely be used in .emacs files. (defmacro incf (place &optional x) "(incf PLACE [X]): increment PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the incremented value of PLACE." (if (symbolp place) (list 'setq place (if x (list '+ place x) (list '1+ place))) (list 'callf '+ place (or x 1)))) (defmacro decf (place &optional x) "(decf PLACE [X]): decrement PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the decremented value of PLACE." (if (symbolp place) (list 'setq place (if x (list '- place x) (list '1- place))) (list 'callf '- place (or x 1)))) (defmacro pop (place) "(pop PLACE): remove and return the head of the list stored in PLACE. Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more careful about evaluating each argument only once and in the right order. PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (symbolp place) (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))) (cl-do-pop place))) (defmacro push (x place) "(push X PLACE): insert X at the head of the list stored in PLACE. Analogous to (setf PLACE (cons X PLACE)), though more careful about evaluating each argument only once and in the right order. PLACE may be a symbol, or any generalized variable allowed by `setf'." (if (symbolp place) (list 'setq place (list 'cons x place)) (list 'callf2 'cons x place))) (defmacro pushnew (x place &rest keys) "(pushnew X PLACE): insert X at the head of the list if not already there. Like (push X PLACE), except that the list is unmodified if X is `eql' to an element already on the list. Keywords supported: :test :test-not :key" (if (symbolp place) (list 'setq place (list* 'adjoin x place keys)) (list* 'callf2 'adjoin x place keys))) (defun cl-set-elt (seq n val) (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) (defun cl-set-nthcdr (n list x) (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list)) (defun cl-set-buffer-substring (start end val) (save-excursion (delete-region start end) (goto-char start) (insert val) val)) (defun cl-set-substring (str start end val) (if end (if (< end 0) (incf end (length str))) (setq end (length str))) (if (< start 0) (incf start str)) (concat (and (> start 0) (substring str 0 start)) val (and (< end (length str)) (substring str end)))) ;;; Control structures. ;;; These macros are so simple and so often-used that it's better to have ;;; them all the time than to load them from cl-macs.el. (defmacro when (cond &rest body) "(when COND BODY...): if COND yields non-nil, do BODY, else return nil." (list 'if cond (cons 'progn body))) (defmacro unless (cond &rest body) "(unless COND BODY...): if COND yields nil, do BODY, else return nil." (cons 'if (cons cond (cons nil body)))) (defun cl-map-extents (&rest cl-args) (if (fboundp 'next-overlay-at) (apply 'cl-map-overlays cl-args) (if (fboundp 'map-extents) (apply 'map-extents cl-args)))) ;;; Blocks and exits. (defalias 'cl-block-wrapper 'identity) (defalias 'cl-block-throw 'throw) ;;; Multiple values. True multiple values are not supported, or even ;;; simulated. Instead, multiple-value-bind and friends simply expect ;;; the target form to return the values as a list. (defalias 'values 'list) (defalias 'values-list 'identity) (defalias 'multiple-value-list 'identity) (defalias 'multiple-value-call 'apply) ; only works for one arg (defalias 'nth-value 'nth) ;;; Macros. (defvar cl-macro-environment nil) (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand) (defalias 'macroexpand 'cl-macroexpand))) (defun cl-macroexpand (cl-macro &optional cl-env) (let ((cl-macro-environment cl-env)) (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) (and (symbolp cl-macro) (cdr (assq (symbol-name cl-macro) cl-env)))) (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))) cl-macro)) ;;; Declarations. (defvar cl-compiling-file nil) (defun cl-compiling-file () (or cl-compiling-file (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer)) (equal (buffer-name (symbol-value 'outbuffer)) " *Compiler Output*")))) (defvar cl-proclaims-deferred nil) (defun proclaim (spec) (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t) (push spec cl-proclaims-deferred)) nil) (defmacro declaim (&rest specs) (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x)))) specs))) (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body) (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when ;;; Symbols. (defun cl-random-time () (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) v)) (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) ;;; Numbers. (defun floatp-safe (x) "T if OBJECT is a floating point number. On Emacs versions that lack floating-point support, this function always returns nil." (and (numberp x) (not (integerp x)))) (defun plusp (x) "T if NUMBER is positive." (> x 0)) (defun minusp (x) "T if NUMBER is negative." (< x 0)) (defun oddp (x) "T if INTEGER is odd." (eq (logand x 1) 1)) (defun evenp (x) "T if INTEGER is even." (eq (logand x 1) 0)) (defun cl-abs (x) "Return the absolute value of ARG." (if (>= x 0) x (- x))) (or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) ;;; We use `eval' in case VALBITS differs from compile-time to load-time. (defconst most-positive-fixnum (eval '(lsh -1 -1))) (defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1)))) ;;; The following are actually set by cl-float-limits. (defconst most-positive-float nil) (defconst most-negative-float nil) (defconst least-positive-float nil) (defconst least-negative-float nil) (defconst least-positive-normalized-float nil) (defconst least-negative-normalized-float nil) (defconst float-epsilon nil) (defconst float-negative-epsilon nil) ;;; Sequence functions. (defalias 'copy-seq 'copy-sequence) (defun mapcar* (cl-func cl-x &rest cl-rest) "Apply FUNCTION to each element of SEQ, and make a list of the results. If there are several SEQs, FUNCTION is called with that many arguments, and mapping stops as soon as the shortest list runs out. With just one SEQ, this is like `mapcar'. With several, it is like the Common Lisp `mapcar' function extended to arbitrary sequence types." (if cl-rest (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) (cl-mapcar-many cl-func (cons cl-x cl-rest)) (let ((cl-res nil) (cl-y (car cl-rest))) (while (and cl-x cl-y) (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)) (nreverse cl-res))) (mapcar cl-func cl-x))) ;;; List functions. (defalias 'first 'car) (defalias 'rest 'cdr) (defalias 'endp 'null) (defun second (x) "Return the second element of the list LIST." (car (cdr x))) (defun third (x) "Return the third element of the list LIST." (car (cdr (cdr x)))) (defun fourth (x) "Return the fourth element of the list LIST." (nth 3 x)) (defun fifth (x) "Return the fifth element of the list LIST." (nth 4 x)) (defun sixth (x) "Return the sixth element of the list LIST." (nth 5 x)) (defun seventh (x) "Return the seventh element of the list LIST." (nth 6 x)) (defun eighth (x) "Return the eighth element of the list LIST." (nth 7 x)) (defun ninth (x) "Return the ninth element of the list LIST." (nth 8 x)) (defun tenth (x) "Return the tenth element of the list LIST." (nth 9 x)) (defun caar (x) "Return the `car' of the `car' of X." (car (car x))) (defun cadr (x) "Return the `car' of the `cdr' of X." (car (cdr x))) (defun cdar (x) "Return the `cdr' of the `car' of X." (cdr (car x))) (defun cddr (x) "Return the `cdr' of the `cdr' of X." (cdr (cdr x))) (defun caaar (x) "Return the `car' of the `car' of the `car' of X." (car (car (car x)))) (defun caadr (x) "Return the `car' of the `car' of the `cdr' of X." (car (car (cdr x)))) (defun cadar (x) "Return the `car' of the `cdr' of the `car' of X." (car (cdr (car x)))) (defun caddr (x) "Return the `car' of the `cdr' of the `cdr' of X." (car (cdr (cdr x)))) (defun cdaar (x) "Return the `cdr' of the `car' of the `car' of X." (cdr (car (car x)))) (defun cdadr (x) "Return the `cdr' of the `car' of the `cdr' of X." (cdr (car (cdr x)))) (defun cddar (x) "Return the `cdr' of the `cdr' of the `car' of X." (cdr (cdr (car x)))) (defun cdddr (x) "Return the `cdr' of the `cdr' of the `cdr' of X." (cdr (cdr (cdr x)))) (defun caaaar (x) "Return the `car' of the `car' of the `car' of the `car' of X." (car (car (car (car x))))) (defun caaadr (x) "Return the `car' of the `car' of the `car' of the `cdr' of X." (car (car (car (cdr x))))) (defun caadar (x) "Return the `car' of the `car' of the `cdr' of the `car' of X." (car (car (cdr (car x))))) (defun caaddr (x) "Return the `car' of the `car' of the `cdr' of the `cdr' of X." (car (car (cdr (cdr x))))) (defun cadaar (x) "Return the `car' of the `cdr' of the `car' of the `car' of X." (car (cdr (car (car x))))) (defun cadadr (x) "Return the `car' of the `cdr' of the `car' of the `cdr' of X." (car (cdr (car (cdr x))))) (defun caddar (x) "Return the `car' of the `cdr' of the `cdr' of the `car' of X." (car (cdr (cdr (car x))))) (defun cadddr (x) "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." (car (cdr (cdr (cdr x))))) (defun cdaaar (x) "Return the `cdr' of the `car' of the `car' of the `car' of X." (cdr (car (car (car x))))) (defun cdaadr (x) "Return the `cdr' of the `car' of the `car' of the `cdr' of X." (cdr (car (car (cdr x))))) (defun cdadar (x) "Return the `cdr' of the `car' of the `cdr' of the `car' of X." (cdr (car (cdr (car x))))) (defun cdaddr (x) "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." (cdr (car (cdr (cdr x))))) (defun cddaar (x) "Return the `cdr' of the `cdr' of the `car' of the `car' of X." (cdr (cdr (car (car x))))) (defun cddadr (x) "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." (cdr (cdr (car (cdr x))))) (defun cdddar (x) "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." (cdr (cdr (cdr (car x))))) (defun cddddr (x) "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." (cdr (cdr (cdr (cdr x))))) (defun last (x &optional n) "Returns the last link in the list LIST. With optional argument N, returns Nth-to-last link (default 1)." (if n (let ((m 0) (p x)) (while (consp p) (incf m) (pop p)) (if (<= n 0) p (if (< n m) (nthcdr (- m n) x) x))) (while (consp (cdr x)) (pop x)) x)) (defun butlast (x &optional n) "Returns a copy of LIST with the last N elements removed." (if (and n (<= n 0)) x (nbutlast (copy-sequence x) n))) (defun nbutlast (x &optional n) "Modifies LIST to remove the last N elements." (let ((m (length x))) (or n (setq n 1)) (and (< n m) (progn (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) x)))) (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el "Return a new list with specified args as elements, cons'd to last arg. Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to `(cons A (cons B (cons C D)))'." (cond ((not rest) arg) ((not (cdr rest)) (cons arg (car rest))) (t (let* ((n (length rest)) (copy (copy-sequence rest)) (last (nthcdr (- n 2) copy))) (setcdr last (car (cdr last))) (cons arg copy))))) (defun ldiff (list sublist) "Return a copy of LIST with the tail SUBLIST removed." (let ((res nil)) (while (and (consp list) (not (eq list sublist))) (push (pop list) res)) (nreverse res))) (defun copy-list (list) "Return a copy of a list, which may be a dotted list. The elements of the list are not copied, just the list structure itself." (if (consp list) (let ((res nil)) (while (consp list) (push (pop list) res)) (prog1 (nreverse res) (setcdr res list))) (car list))) (defun cl-maclisp-member (item list) (while (and list (not (equal item (car list)))) (setq list (cdr list))) list) ;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users. (or (and (fboundp 'member) (subrp (symbol-function 'member))) (defalias 'member 'cl-maclisp-member)) (defalias 'cl-member 'memq) ; for compatibility with old CL package (defalias 'cl-floor 'floor*) (defalias 'cl-ceiling 'ceiling*) (defalias 'cl-truncate 'truncate*) (defalias 'cl-round 'round*) (defalias 'cl-mod 'mod*) (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs "Return ITEM consed onto the front of LIST only if it's not already there. Otherwise, return LIST unmodified. Keywords supported: :test :test-not :key" (cond ((or (equal cl-keys '(:test eq)) (and (null cl-keys) (not (numberp cl-item)))) (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) ((or (equal cl-keys '(:test equal)) (null cl-keys)) (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) (t (apply 'cl-adjoin cl-item cl-list cl-keys)))) (defun subst (cl-new cl-old cl-tree &rest cl-keys) "Substitute NEW for OLD everywhere in TREE (non-destructively). Return a copy of TREE with all elements `eql' to OLD replaced by NEW. Keywords supported: :test :test-not :key" (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) (cl-do-subst cl-new cl-old cl-tree))) (defun cl-do-subst (cl-new cl-old cl-tree) (cond ((eq cl-tree cl-old) cl-new) ((consp cl-tree) (let ((a (cl-do-subst cl-new cl-old (car cl-tree))) (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) cl-tree (cons a d)))) (t cl-tree))) (defun acons (a b c) (cons (cons a b) c)) (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) ;;; Miscellaneous. (put 'cl-assertion-failed 'error-conditions '(error)) (put 'cl-assertion-failed 'error-message "Assertion failed") ;;; This is defined in Emacs 19; define it here for Emacs 18 users. (defun cl-add-hook (hook func &optional append) "Add to hook variable HOOK the function FUNC. FUNC is not added if it already appears on the list stored in HOOK." (let ((old (and (boundp hook) (symbol-value hook)))) (and (listp old) (not (eq (car old) 'lambda)) (setq old (list old))) (and (not (member func old)) (set hook (if append (nconc old (list func)) (cons func old)))))) (or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook)) ;;; Autoload the other portions of the package. (mapcar (function (lambda (set) (mapcar (function (lambda (func) (autoload func (car set) nil nil (nth 1 set)))) (cddr set)))) '(("cl-extra" nil coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon cl-map-keymap cl-map-keymap-recursively cl-map-intervals cl-map-overlays cl-set-frame-visible-p cl-float-limits gcd lcm isqrt expt floor* ceiling* truncate* round* mod* rem* signum random* make-random-state random-state-p subseq concatenate cl-mapcar-many map some every notany notevery revappend nreconc list-length tailp copy-tree get* getf cl-set-getf cl-do-remf remprop make-hash-table cl-hash-lookup gethash cl-puthash remhash clrhash maphash hash-table-p hash-table-count cl-progv-before cl-prettyexpand cl-macroexpand-all) ("cl-seq" nil reduce fill replace remq remove remove* remove-if remove-if-not delete delete* delete-if delete-if-not remove-duplicates delete-duplicates substitute substitute-if substitute-if-not nsubstitute nsubstitute-if nsubstitute-if-not find find-if find-if-not position position-if position-if-not count count-if count-if-not mismatch search sort* stable-sort merge member* member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not rassoc* rassoc rassoc-if rassoc-if-not union nunion intersection nintersection set-difference nset-difference set-exclusive-or nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis tree-equal) ("cl-macs" nil gensym gentemp typep cl-do-pop get-setf-method cl-struct-setf-expander compiler-macroexpand cl-compile-time-init) ("cl-macs" t defun* defmacro* function* destructuring-bind eval-when eval-when-compile load-time-value case ecase typecase etypecase block return return-from loop do do* dolist dotimes do-symbols do-all-symbols psetq progv flet labels macrolet symbol-macrolet lexical-let lexical-let* multiple-value-bind multiple-value-setq locally the declare define-setf-method defsetf define-modify-macro setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct check-type assert ignore-errors define-compiler-macro))) ;;; Define data for indentation and edebug. (mapcar (function (lambda (entry) (mapcar (function (lambda (func) (put func 'lisp-indent-function (nth 1 entry)) (put func 'lisp-indent-hook (nth 1 entry)) (or (get func 'edebug-form-spec) (put func 'edebug-form-spec (nth 2 entry))))) (car entry)))) '(((defun* defmacro*) 2) ((function*) nil (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form))) ((eval-when) 1 (sexp &rest form)) ((when unless) 1 (&rest form)) ((declare) nil (&rest sexp)) ((the) 1 (sexp &rest form)) ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) ((block return-from) 1 (sexp &rest form)) ((return) nil (&optional form)) ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) (form &rest form) &rest form)) ((dolist dotimes) 1 ((symbolp form &rest form) &rest form)) ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) ((psetq setf psetf) nil edebug-setq-form) ((progv) 2 (&rest form)) ((flet labels macrolet) 1 ((&rest (sexp sexp &rest form)) &rest form)) ((symbol-macrolet lexical-let lexical-let*) 1 ((&rest &or symbolp (symbolp form)) &rest form)) ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form)) ((letf letf*) 1 ((&rest (&rest form)) &rest form)) ((callf destructuring-bind) 2 (sexp form &rest form)) ((callf2) 3 (sexp form form &rest form)) ((loop) nil (&rest &or symbolp form)) ((ignore-errors) 0 (&rest form)))) ;;; This goes here so that cl-macs can find it if it loads right now. (provide 'cl-19) ; usage: (require 'cl-19 "cl") ;;; Things to do after byte-compiler is loaded. ;;; As a side effect, we cause cl-macs to be loaded when compiling, so ;;; that the compiler-macros defined there will be present. (defvar cl-hacked-flag nil) (defun cl-hack-byte-compiler () (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)) (progn (cl-compile-time-init) ; in cl-macs.el (setq cl-hacked-flag t)))) ;;; Try it now in case the compiler has already been loaded. (cl-hack-byte-compiler) ;;; Also make a hook in case compiler is loaded after this file. ;;; The compiler doesn't call any hooks when it loads or runs, but ;;; we can take advantage of the fact that emacs-lisp-mode will be ;;; called when the compiler reads in the file to be compiled. ;;; BUG: If the first compilation is `byte-compile' rather than ;;; `byte-compile-file', we lose. Oh, well. (add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler) ;;; The following ensures that packages which expect the old-style cl.el ;;; will be happy with this one. (provide 'cl) (provide 'mini-cl) ; for Epoch (run-hooks 'cl-load-hook) ;;; cl.el ends here emacs-19.22/lisp/cmacexp.el100644 74777 13 41331 5367013663 13760 0ustar ericuser;;; cmacexp.el --- expand C macros in a region ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Francesco Potorti` ;; Version: $Id: cmacexp.el 1.2 1992/09/15 11:34:56 pot 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. ;;; Commentary: ;; In C mode C-M-x is bound to c-macro-expand. The result of the ;; expansion is put in a separate buffer. The buffer is put in ;; view-mode if the Inge Frick's view.el is installed. 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. With two C-u's the user is offered to ;; change the flags to the preprocessor (while the results of the ;; expansion go to a separate buffer). Preprocessor arguments default ;; to the last ones entered. Both the preprocessor name and the ;; initial flag defaults can be set by the user. Setting ;; c-macro-always-prompt to a non-nil value allows one to be always ;; prompted for the flags, regardless of the prefix used. ;; A c-macro-expansion function is provided for non-interactive use. ;; A still experimental function c-macro-eval is provided. It aims at ;; evaluating the contents of a region by using calc (by Dave ;; Gillespie). Select a region and type C-x C-e (if you followed the ;; suggestions in the INSTALLATION section) or type M-x c-ma RET v ;; RET. If you have calc installed, the computed value of the ;; expression will appear in the message area. If you give an ;; interactive C-u prefix the computed value will be shown in signed, ;; unsigned, hex and boolean representations. Two C-u's allow to ;; change the preprocessor flags via prompt. c-macro-eval works well ;; for constant expressions, but see the BUG section. ;; A patch to calc 2.02 has been written by Dave Gillespie. It can ;; be downloaded via anonymous ftp at fly.cnuce.cnr.it:pub/calc.diff. ;; INSTALLATION ====================================================== ;; Put this file on your load-path, byte compile it for increased ;; speed and put part or all of the following in your ~/.emacs file. ;; To make a directory ~/emacs be in front of your load-path: ;;(setq load-path (cons (expand-file-name "~/emacs") load-path)) ;; ;; Suggested keybindings (work only in c-mode): ;;(define-key c-mode-map "\C-\M-x" 'c-macro-expand) ;;(define-key c-mode-map "\C-x\C-e" 'c-macro-eval) ;; ;; If you want the *Macroexpansion* window to be not higher than ;; necessary: ;;(setq c-macro-shrink-window-p 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, and want them to be ;; the default: ;;(setq c-macro-default-cppflags "-I /usr/include/local -DDEBUG" ;; ;; If you always want the "Preprocessor arguments: " prompt, ;; regardless of the arguments provided: ;;(setq c-macro-always-prompt-p t) ;; ;; If you want to experiment with the C constant expressions ;; evaluation feature: ;;(autoload 'c-macro-eval "cmacexp" ;; "C constant expressions evaluation. Requires calc. Experimental." 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 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. ;; - The /lib/cpp process is run synchronously. This fixes an ;; infinite loop bug on Motorola Delta (cpp waiting forever for ;; end-of-file, don't know why). Fixes a similar intermittent ;; problem on SunOS 4.1. ;; ACKNOWLEDGEMENTS ================================================== ;; A lot of thanks to Don Maszle who did a great work of testing, bug ;; reporting and suggestion of new features, to Inge Fricks for her ;; help with view.el and to Dave Gillespie for his suggestions on ;; calc's use. This work has been partially inspired by Don Maszle ;; and Jonathan Segal's. ;; By the way, I recommend you Inge Frick's view.el. It works like ;; the standard view, but *it is not recursive* and has some more ;; commands. Moreover it is a minor mode, so you preserve all your ;; major mode keybindings (well, not always :). Mail me to obtain a ;; copy, or get it by anonymous ftp in fly.cnuce.cnr.it:pub/view.el. ;; BUGS ============================================================== ;; calc 2.02 does not handle the C operators "->", ".", "*" (as a ;; prefix), the composite assignement operators "+=" etc. It cannot ;; handle the "," operator and will be confused by ";". Almost all ;; these can be defined as no-ops using the Calc's Syntax Tables ;; feature. The built-in calc functions will cause problems in ;; certain circumstances. c-macro-eval behaves correctly only on ;; expressions not containing such operators. Does not distinguish ;; among integer and real division. ;; If the start point of the region is inside a macro definition the ;; macro expansion is often inaccurate. ;;; Code: (defvar c-macro-shrink-window-p nil "*Non-nil means shrink the *Macroexpansion* window to fit its contents.") (defvar c-macro-always-prompt-p nil "*Non-nil means always 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-default-cppflags "" "Default cpp flags used by c-macro-expand.") (defconst c-macro-buffer-name "*Macroexpansion*") (defun c-macro-expand (start end &optional flag) "\ Expand all C macros occurring in the region using c-macro-preprocessor. Normally display output in temp buffer. Prefix arg means replace the region with it. Prompt for a string of arguments to the preprocessor, (e.g. -DDEBUG -I ./include) when prefixed with two C-u's. It is intended for interactive use only. For non interactive use, see the c-macro-expansion function." (interactive "r\nP") (let* ((subst (and flag (not (equal flag '(16))))) (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 (or c-macro-always-prompt-p (equal flag '(16))) (setq c-macro-default-cppflags (read-string "Preprocessor arguments: " c-macro-default-cppflags))) ;; Decide where to display output. (if (and subst buffer-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. (if (interactive-p) (message (c-macro-default-message))) (setq expansion (c-macro-expansion start end (concat c-macro-preprocessor " " c-macro-default-cppflags))) (message (concat (c-macro-default-message) "done")) (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-flush-undo displaybuf) (erase-buffer) (insert expansion) (set-buffer-modified-p nil) (if (string= "" expansion) (message "Null expansion") (c-macro-display-buffer inbuf)) (setq buffer-read-only t) (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. Put the current buffer in view-mode ;; if the Inge Frick's view-mode is installed, with buffer to return ;; to set to RETBUF (if sensible). 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-p is nil the window size is *never* ;; changed. (defun c-macro-display-buffer (retbuf) (goto-char (point-min)) (c-mode) (require 'view) ;load view.el (let ((oldwinheight (window-height)) (alreadythere ;the window was already there (get-buffer-window (current-buffer))) (popped nil) ;the window popped changing the layout (niceview ;is this Inge Fricks's view.el? (boundp 'view-kill-when-finished))) (or alreadythere (progn (display-buffer (current-buffer) t) (setq popped (/= oldwinheight (window-height))))) (if niceview (view-mode 1)) ;set view mode (if (and c-macro-shrink-window-p ;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 1000000)))) (window-height))) (goto-char (point-min)) (select-window oldwin)))))) (defun c-macro-expansion (start end cppcommand) "\ Expands 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. Returns the output as a string." ;; 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))) (linenum 0) (linelist ())) (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 " ") ;; Now we insert the #line directives after all #endif or ;; #else following START. ;(switch-to-buffer outbuf) (debug) ;debugging instructions (while (re-search-backward "\n#\\(endif\\|else\\)\\>" start 'move) (if (equal (nthcdr 3 (parse-partial-sexp 1 (point))) '(nil nil nil 0)) ;neither in string nor in ;comment nor after quote (progn (goto-char (match-end 0)) (setq linenum (count-lines 1 (point))) (setq linelist (cons (format "\n# %d \"%s\"\n" linenum filename) linelist)) (insert (car linelist)) (skip-chars-backward "^#") (insert "line") (goto-char (match-beginning 0))))) ;; We are at START. Insert the first #line directive. This ;; must work even inside a string or comment, or after a ;; quote. (setq linenum (+ (count-lines 1 (point)) (if (bolp) 1 0))) (setq linelist (cons (let* ((startstat (parse-partial-sexp 1 start)) (startinstring (nth 3 startstat)) (startincomment (nth 4 startstat)) (startafterquote (nth 5 startstat))) (concat (if startafterquote " ") (cond (startinstring "\"") (startincomment "*/")) (format "\n# %d \"%s\"\n" linenum filename) (cond (startinstring "\"") (startincomment "/*")) (if startafterquote "\\"))) linelist)) (insert (car linelist)) (skip-chars-backward "^#") (insert "line") ;; Call the preprocessor. (call-process-region 1 (point-max) "sh" t t nil "-c" (concat cppcommand " 2>/dev/null")) ;; Look for the `# nn "file.c"' lines from the last to the first ;; and delete them. (setq linelist (reverse linelist)) (while (progn (if (search-backward (car linelist) nil t) (replace-match "")) (setq linelist (cdr linelist)))) ;; Compute the return value, keeping in account the space ;; inserted at the end of the buffer. (buffer-substring (point) (max (point) (- (point-max) 1)))) ;; Cleanup. (kill-buffer outbuf)))) ;; Experimental. With an argument, print signed, unsigned, hex and ;; boolean representations. (defun c-macro-eval (start end &optional flag) "\ Expand region using cpp and evaluate it using calc. Interactively print value in minibuffer and push it on the kill ring. With a C-u argument shows the evaluation in a variety of formats. With two C-u's prompts the user for a string of flags to the preprocessor. Non interactively returns value of region between START and END as a string. Several formats are used if optional FLAG is non-nil." (interactive "r\nP") (or (fboundp 'calc-eval) (require 'calc)) (if (or c-macro-always-prompt-p (equal flag '(16))) (setq c-macro-default-cppflags (read-string "Preprocessor arguments: " c-macro-default-cppflags))) ;; Expand the region. (if (interactive-p) (message (c-macro-default-message))) (let ((evaluation (c-macro-expansion start end (concat c-macro-preprocessor " " c-macro-default-cppflags))) (evalbuf (get-buffer-create " *Macro Evaluation*"))) (unwind-protect (save-excursion (set-buffer evalbuf) (setq buffer-read-only nil) (erase-buffer) (insert evaluation) ;; Evaluate expression(s). (if (interactive-p) (message "Invoking calc...")) (setq evaluation (let ((calc-eval-error t)) (calc-eval (list (buffer-string) 'calc-language 'c)))) (erase-buffer) (cond (flag (insert (calc-eval (list evaluation 'calc-language 'c 'calc-simplify-mode 'binary)) "(u)" " == " (calc-eval (list evaluation 'calc-language 'c 'calc-word-size (- calc-word-size) 'calc-simplify-mode 'binary)) "(d)" " == " (calc-eval (list evaluation 'calc-language 'c 'calc-number-radix 16 'calc-simplify-mode 'binary)) "(x)") (save-excursion (insert " == " (calc-eval (list evaluation 'calc-language 'c 'calc-number-radix 16 'calc-simplify-mode 'binary)))) (while (re-search-forward "0x\\([^,]+\\)\\(, \\|\\'\\)" nil t) (if (string= "0" (buffer-substring (match-beginning 1) (match-end 1))) (replace-match "FALSE\\2") (replace-match "TRUE\\2")))) (t (insert evaluation))) ;; Output the evaluation. (if (interactive-p) (progn (copy-region-as-kill 1 (point-max)) (message (buffer-string))) (buffer-string))) (kill-buffer evalbuf)))) (defun c-macro-default-message () (format "Invoking %s%s%s on region..." c-macro-preprocessor (if (string= "" c-macro-default-cppflags) "" " ") c-macro-default-cppflags)) (provide 'cmacexp) ;;; cmacexp.el ends here. emacs-19.22/lisp/cmuscheme.el100444 13437 1 44554 5405343662 14542 0ustar jimbdaemon;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el. ;; Copyright (C) 1988 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: ;;; 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... ;; YOUR .EMACS FILE ;;============================================================================= ;; Some suggestions for your .emacs file. ;; ;; ; If cmuscheme lives in some non-standard directory, you must tell emacs ;; ; where to get it. This may or may not be necessary. ;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path)) ;; ;; ; Autoload run-scheme from file cmuscheme.el ;; (autoload 'run-scheme "cmuscheme" ;; "Run an inferior Scheme process." ;; t) ;; ;; ; Files ending in ".scm" are Scheme source, ;; ; so put their buffers in scheme-mode. ;; (setq auto-mode-alist ;; (cons '("\\.scm$" . scheme-mode) ;; auto-mode-alist)) ;; ;; ; Define C-c t to run my favorite command in inferior scheme mode: ;; (setq cmuscheme-load-hook ;; '((lambda () (define-key inferior-scheme-mode-map "\C-ct" ;; 'favorite-cmd)))) ;;; ;;; Unfortunately, scheme.el defines run-scheme to autoload from xscheme.el. ;;; This will womp your declaration to autoload run-scheme from cmuscheme.el ;;; if you haven't loaded cmuscheme in before scheme. Three fixes: ;;; - Put the autoload on your scheme mode hook and in your .emacs toplevel: ;;; (setq scheme-mode-hook ;;; '((lambda () (autoload 'run-scheme "cmuscheme" ;;; "Run an inferior Scheme" t)))) ;;; (autoload 'run-scheme "cmuscheme" "Run an inferior Scheme" t) ;;; Now when scheme.el autoloads, it will restore the run-scheme autoload. ;;; - Load cmuscheme.el in your .emacs: (load-library 'cmuscheme) ;;; - Change autoload declaration in scheme.el to point to cmuscheme.el: ;;; (autoload 'run-scheme "cmuscheme" "Run an inferior Scheme" t) ;;; *or* just delete the autoload declaration from scheme.el altogether, ;;; which will allow the autoload in your .emacs to have its say. ;;; 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 (full-copy-sparse-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 "^[^>]*>+ *") ; 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-input-sentinel (function ignore)) (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") ;;; Obsolete (defun scheme (&rest foo) "Use run-scheme" (interactive) (message "Use run-scheme") (ding)) (defun run-scheme (cmd) "Run an inferior Scheme process, input and output via buffer *scheme*. If there is a process already running in *scheme*, just switch to that buffer. With argument, allows you to edit the command line (default is value of scheme-program-name). Runs the hooks from 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-buffer "*scheme*") (switch-to-buffer "*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.22/lisp/comint.el100444 12120 1 261744 5475030335 13745 0ustar rmsdaemon;;; comint.el --- general command interpreter in a window stuff ;; Copyright (C) 1988, 1990, 1992, 1993 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 (s.marshall@dcs.hull.ac.uk) ;;; 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-r comint-previous-input-matching Search backwards in input history ;;; return comint-send-input ;;; c-a comint-bol Beginning of line; skip prompt ;;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff ;;; 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 ;;; ;;; Not bound by default in comint-mode (some are in shell 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-get-old-input - function Hooks for specific ;;; comint-get-current-command - function process-in-a-buffer ;;; comint-dynamic-complete-command-command - function modes. ;;; comint-after-partial-filename-command - ;;; comint-input-sentinel - function ... ;;; comint-input-filter - function ... ;;; comint-input-send - 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 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: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp) Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" kcl: \"^>+ *\" shell: \"^[^#$%>]*[#$%>] *\" 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. Good choices: shell: \(\"|\" \"&\" \"<\" \">\" \"\(\" \")\" \";\") This is a good thing to set in mode hooks.") (defvar comint-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 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-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.") ;;; 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-after-partial-filename-command 'comint-after-partial-filename "Function that returns non-nil if point is after a file name. By default this is `comint-after-partial-filename'. This is a good thing to set in mode hooks.") (defvar comint-dynamic-complete-filename-command 'comint-dynamic-complete-filename "Function that dynamically completes the file name at point. By default this is `comint-dynamic-complete-filename', though an alternative is `comint-replace-by-expanded-filename'. This is a good thing to set in mode hooks.") (defvar comint-dynamic-complete-command-command 'comint-dynamic-complete-filename "Function that dynamically completes the command at point. By default this is `comint-dynamic-complete-filename'. This is a good thing to set in mode hooks.") (defvar comint-get-current-command 'comint-get-old-input-default "Function that returns the current command including arguments. By default this is `comint-get-old-input-default', meaning the whole line. This is a good thing to set in mode hooks.") (defvar comint-input-sentinel (function ignore) "Called on each input submitted to comint mode process by `comint-send-input'. Thus it can, for instance, track cd/pushd/popd commands issued to a shell.") (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-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-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-input-ring 'permanent-local t) (put 'comint-input-ring-index 'permanent-local t) (put 'comint-input-autoexpand '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-sentinel', `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-list-dynamic-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)) (make-local-variable 'comint-last-input-end) (setq comint-last-input-end (make-marker)) (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-variable 'comint-after-partial-filename-command) (make-local-variable 'comint-dynamic-complete-filename-command) (make-local-variable 'comint-dynamic-complete-command-command) (make-local-variable 'comint-get-current-command) (make-local-variable 'comint-get-old-input) (make-local-variable 'comint-input-sentinel) (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-variable 'comint-output-filter-functions) (make-local-variable 'comint-ptyp) (make-local-variable 'comint-exec-hook) (make-local-variable 'comint-process-echoes) (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 "\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 "\C-m" 'comint-send-input) (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof) (define-key comint-mode-map "\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) ;; " ; Stops emacs-19.19's hilit getting confused. (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-h" '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-variable] '("Complete Variable Name" . comint-dynamic-complete-variable)) (define-key comint-mode-map [menu-bar completion complete-command] '("Complete Command Name" . (lambda () (interactive) (funcall comint-dynamic-complete-command-command)))) (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 input] (cons "In/Out" (make-sparse-keymap "In/Out"))) (define-key comint-mode-map [menu-bar input kill-output] '("Kill Current Output Group" . comint-kill-output)) (define-key comint-mode-map [menu-bar input next-prompt] '("Forward Output Group" . comint-next-prompt)) (define-key comint-mode-map [menu-bar input previous-prompt] '("Backward Output Group" . comint-previous-prompt)) (define-key comint-mode-map [menu-bar input show-maximum-output] '("Show Maximum Output" . comint-show-maximum-output)) (define-key comint-mode-map [menu-bar input show-output] '("Show Current Output Group" . comint-show-output)) (define-key comint-mode-map [menu-bar input kill-input] '("Kill Current Input" . comint-kill-input)) (define-key comint-mode-map [menu-bar input copy-input] '("Copy Old Input" . comint-copy-old-input)) (define-key comint-mode-map [menu-bar input forward-matching-history] '("Forward Matching Input..." . comint-forward-matching-input)) (define-key comint-mode-map [menu-bar input backward-matching-history] '("Backward Matching Input..." . comint-backward-matching-input)) (define-key comint-mode-map [menu-bar input next-matching-history] '("Next Matching Input..." . comint-next-matching-input)) (define-key comint-mode-map [menu-bar input previous-matching-history] '("Previous Matching Input..." . comint-previous-matching-input)) (define-key comint-mode-map [menu-bar input next-matching-history-from-input] '("Next Matching Current Input" . comint-next-matching-input-from-input)) (define-key comint-mode-map [menu-bar input previous-matching-history-from-input] '("Previous Matching Current Input" . comint-previous-matching-input-from-input)) (define-key comint-mode-map [menu-bar input next-history] '("Next Input" . comint-next-input)) (define-key comint-mode-map [menu-bar input previous-history] '("Previous Input" . comint-previous-input)) (define-key comint-mode-map [menu-bar input list-history] '("List Input History" . comint-dynamic-list-input-ring)) (define-key comint-mode-map [menu-bar input 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 input output signals) menu-bar-final-items)) ) ;;; This function is used to make a full copy of the comint mode map, ;;; so that client modes won't interfere with each other. This function ;;; isn't necessary in emacs 18.5x, but we keep it around for 18.4x versions. (defun full-copy-sparse-keymap (km) "Recursively copy the sparse keymap KM." (cond ((consp km) (cons (full-copy-sparse-keymap (car km)) (full-copy-sparse-keymap (cdr km)))) (t km))) (defun comint-check-proc (buffer) "Return t if there is a living process associated w/buffer BUFFER. Living means the status is `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-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. 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 ;; 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)) (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 (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 process-environment)) (setenv "TERMCAP" (format "emacs:co#%d:tc=unknown" (frame-width))) (setenv "TERM" "emacs") (setenv "EMACS" "t") (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. ;;; ;;; Two functions: ;;; comint-read-input-ring Read into comint-input-ring... ;;; comint-write-input-ring Write to comint-input-ring-file-name. (defun comint-read-input-ring () "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. Useful within mode or mode hooks. The structure of the history file should be one input command per line, and 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)) (message "Cannot read history file %s" comint-input-ring-file-name)) (t (let ((history-buf (get-file-buffer comint-input-ring-file-name)) (ring (make-ring comint-input-ring-size))) (save-excursion (set-buffer (or history-buf (find-file-noselect comint-input-ring-file-name))) ;; Save restriction in case file is already visited... ;; Watch for those date stamps in history files! (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward "^\\s *\\([^#].*\\)\\s *$" 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 ring history))))) ;; Kill buffer unless already visited. (if (null history-buf) (kill-buffer nil)))) (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, find the next or Nth next 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. \(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 "p") (comint-previous-matching-input-from-input (- arg))) (defun comint-replace-by-expanded-history () "Expand input command history references before point. 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. See also `comint-magic-space'." (interactive) (save-excursion (let ((toend (- (save-excursion (end-of-line nil) (point)) (point))) (start (progn (comint-bol nil) (point)))) (while (re-search-forward "[!^]" (save-excursion (end-of-line nil) (- (point) toend)) t) ;; 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) (goto-char (match-beginning 0)) (cond ((or (= (preceding-char) ?\\) (comint-within-quotes start (point))) ;; The history is quoted, or we're in quotes. (goto-char (match-end 0))) ((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)) ((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 (message "Not found") (goto-char (match-end 0)) (ding)) (setq comint-input-ring-index pos) (message "History item: %d" (1+ pos)) (replace-match (comint-args (ring-ref comint-input-ring pos) (match-beginning 4) (match-end 4)) t t)))) ((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 (search-forward old pos t) (replace-match new t t) (message "Not found") (ding)))) (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))))) (defun comint-delim-arg (arg) ;; Return a list of arguments from ARG. If there's a quote in there, just ;; a list of the arg, otherwise try and break up using characters in ;; comint-delimiter-argument-list. Returned list is backwards. (if (or (null comint-delimiter-argument-list) (string-match "[\"\'\`]" arg)) (list arg) (let ((not-delim (concat (format "\\([^%s]" (mapconcat (function (lambda (d) (regexp-quote d))) comint-delimiter-argument-list "")) "\\|" (mapconcat (function (lambda (d) (concat "\\\\" (regexp-quote d)))) comint-delimiter-argument-list "\\|") "\\)+")) (delim-str (mapconcat (function (lambda (d) (concat (regexp-quote d) "+"))) comint-delimiter-argument-list "\\|")) (args ()) (pos 0)) (while (or (eq pos (string-match not-delim arg pos)) (eq pos (string-match delim-str arg pos))) (setq pos (match-end 0) args (cons (substring arg (match-beginning 0) 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. Arguments are assumed to be delimited by whitespace. Strings comprising characters in the variable `comint-delimiter-argument-list' are treated as delimiters and arguments. Argument 0 is the command name." (let ((arg "\\(\\S \\|\\(\"[^\"]*\"\\|\'[^\']*\'\\|\`[^\`]*\`\\)\\)+") (args ()) (pos 0) (str nil)) ;; We build a list of all the args. Unnecessary, but more efficient, when ;; ranges of args are required, than picking out one by one and recursing. (while (string-match arg string pos) (setq pos (match-end 0) str (substring string (match-beginning 0) pos) args (nconc (comint-delim-arg str) args))) (let ((n (or nth (1- (length args)))) (m (if mth (1- (- (length args) 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 value of variable `comint-input-sentinel' 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. `comint-get-old-input', `comint-input-sentinel', 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-sentinel 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-sentinel 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) (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) (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)) (funcall comint-input-sentinel input) (funcall comint-input-sender proc input) (setq comint-input-ring-index nil) (set-marker comint-last-input-start pmark) (set-marker comint-last-input-end (point)) (set-marker (process-mark proc) (point)) ;; A kludge to prevent the delay between insert and process output ;; affecting the display. A case for a comint-send-input-hook? (if (eq (process-filter proc) 'comint-output-filter) (let ((functions comint-output-filter-functions)) (while functions (funcall (car functions) (concat input "\n")) (setq functions (cdr functions))))))))) ;; 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) (let ((functions comint-output-filter-functions)) (while functions (funcall (car functions) string) (setq functions (cdr functions)))) (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', `mouse-yank-at-click', 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 mouse-yank-at-click 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)) scroll (not (window-minibuffer-p selected))) (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) (and (eq scroll 'this) (eq selected window)))) (progn (select-window window) (goto-char (point-max)) (select-window selected))))) 'not-minibuf 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)) (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)))) (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. If you don't like this command, bind C-a to `beginning-of-line' in your hook, `comint-mode-hook'." (interactive "P") (beginning-of-line) (if (null arg) (comint-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 send-invisible and type in your line. (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) (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 is 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")))) ;;; Low-level process communication (defvar comint-input-chunk-size 512 "*Long inputs are sent to comint processes in chunks of this size. If your process is choking on big inputs, try lowering the value.") (defun comint-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 `comint-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 comint-input-chunk-size))) (process-send-string proc (substring str 0 i)) (while (< i len) (let ((next-i (+ i comint-input-chunk-size))) (accept-process-output) (sit-for 0) (process-send-string proc (substring str i (min len next-i))) (setq i next-i))))) (defun comint-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 `comint-send-string'." (comint-send-string proc (buffer-substring start end))) ;;; Random input hackage (defun comint-kill-output () "Kill all output from interpreter since last input. Does not delete the prompt." (interactive) (let ((pmark (progn (goto-char (process-mark (get-buffer-process (current-buffer)))) (beginning-of-line nil) (point-marker)))) (kill-region comint-last-input-end pmark) (insert "*** output flushed ***\n") (comint-skip-prompt) (set-marker pmark (point)))) (defun comint-show-output () "Display start of this batch of interpreter output at top of window. Also put cursor there if the current position is not visible." (interactive) (let ((pos (point))) (goto-char comint-last-input-end) (beginning-of-line 0) (set-window-start (selected-window) (point)) (if (pos-visible-in-window-p pos) (goto-char pos) (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 functions: ;;; comint-dynamic-complete Complete or expand command, filename, ;;; history at point. ;;; comint-dynamic-complete-filename Complete filename at point. ;;; comint-dynamic-complete-variable Complete variable 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. ;;; Four hooks (defined above): ;;; comint-dynamic-complete-filename-command Complete file name at point. ;;; comint-dynamic-complete-command-command Complete command at point. ;;; comint-get-current-command Return command at point. ;;; comint-after-partial-filename-command Return non-nil if after file. ;;; 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. 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-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.") (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-match-partial-filename () "Return the filename at point, or signal an error. Environment variables are substituted." (save-excursion (if (re-search-backward "[^~/A-Za-z0-9+@:_.$#,={}-]" nil 'move) (forward-char 1)) ;; Anchor the search forwards. (if (not (looking-at "[~/A-Za-z0-9+@:_.$#,={}-]")) (error "")) (re-search-forward "[~/A-Za-z0-9+@:_.$#,={}-]+") (substitute-in-file-name (buffer-substring (match-beginning 0) (match-end 0))))) (defun comint-match-partial-variable () "Return the variable at point, or signal an error." (save-excursion (if (re-search-backward "[^A-Za-z0-9_${}]" nil 'move) (forward-char 1)) ;; Anchor the search forwards. (if (not (looking-at "\\$")) (error "")) (re-search-forward "\\${?[A-Za-z0-9_]+}?") (buffer-substring (match-beginning 0) (match-end 0)))) (defun comint-after-partial-filename () "Returns t if point is after a file name. File names are assumed to contain `/'s or not be the first item in the input. See also `comint-bol'." (let ((filename (comint-match-partial-filename))) (or (save-match-data (string-match "/" filename)) (not (eq (match-beginning 0) (save-excursion (comint-bol nil) (point))))))) (defun comint-dynamic-complete () "Dynamically complete/expand the command/filename/history at point. If the text contains (a non-absolute line reference) `!' or `^' and `comint-input-autoexpand' is non-nil, then an attempt is made to complete the history. The value of the variable `comint-after-partial-filename-command' is used to match file names. Otherwise, an attempt is made to complete the command. See also the variables `comint-after-partial-filename-command', `comint-dynamic-complete-filename-command', and `comint-dynamic-complete-command-command', and functions `comint-replace-by-expanded-history' and `comint-magic-space'." (interactive) (let ((previous-modified-tick (buffer-modified-tick))) (if (and comint-input-autoexpand (string-match "[!^]" (funcall comint-get-current-command))) ;; Looks like there might be history references in the command. (comint-replace-by-expanded-history)) (if (= previous-modified-tick (buffer-modified-tick)) ;; No references were expanded, so maybe they were none after all. (cond ((funcall comint-after-partial-filename-command) ;; It's a file name. (funcall comint-dynamic-complete-filename-command)) (t ;; Assume it's a command. (funcall comint-dynamic-complete-command-command)))))) (defun comint-dynamic-complete-filename () "Dynamically complete the filename at point. 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' and `comint-completion-recexact', and the timing of completions listing is dependent on the value of `comint-completion-autolist'." (interactive) (let* ((completion-ignore-case nil) (filename (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) (ding)) ((eq completion t) ; Means already completed "file". (if comint-completion-addsuffix (insert " ")) (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))) (goto-char (match-end 0)) (insert (substring (directory-file-name completion) (length pathnondir))) (cond ((symbolp (file-name-completion completion directory)) ;; We inserted a unique completion. (if comint-completion-addsuffix (insert (if (file-directory-p file) "/" " "))) (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) "/" " ")) (message "Completed shortest")) ((or comint-completion-autolist (string-equal pathnondir completion)) ;; It's not unique, list possible completions. (comint-dynamic-list-filename-completions)) (t (message "Partially completed")))))))) (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-complete-variable () "Dynamically complete the environment variable at point. 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 `comint-dynamic-complete-process-environment-variable'. See also `comint-dynamic-complete-filename'." (interactive) (let* ((completion-ignore-case nil) (variable (comint-match-partial-variable)) (varname (substring variable (string-match "[^$({]" variable))) (protection (cond ((string-match "{" variable) "}") ((string-match "(" variable) ")") (t ""))) (variables (mapcar (function (lambda (x) (list (substring x 0 (string-match "=" x))))) process-environment)) (var-directory-p (function (lambda (var) (file-directory-p (comint-directory (substitute-in-file-name (concat "$" var))))))) (completions (all-completions varname variables))) ;; Complete variable as if its value were a filename (which it might be). (cond ((null completions) (message "No completions of %s" varname) (ding)) ((= 1 (length completions)) ; Gotcha! (let ((completion (car completions))) (if (string-equal completion varname) (message "Sole completion") (insert (substring (directory-file-name completion) (length varname))) (message "Completed")) (insert protection) (if comint-completion-addsuffix (insert (if (funcall var-directory-p completion) "/" " "))))) (t ; There's no unique completion. (let ((completion (try-completion varname variables))) ;; Insert the longest substring. (insert (substring (directory-file-name completion) (length varname))) (cond ((and comint-completion-recexact comint-completion-addsuffix (string-equal varname completion) (member completion completions)) ;; It's not unique, but user wants shortest match. (insert protection (if (funcall var-directory-p completion) "/" " ")) (message "Completed shortest")) ((or comint-completion-autolist (string-equal varname completion)) ;; It's not unique, list possible completions. (comint-dynamic-list-completions completions)) (t (message "Partially completed")))))))) (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. See also `comint-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) (ding)) ((= 1 (length completions)) ; Gotcha! (let ((completion (car completions))) (if (string-equal completion stub) (message "Sole completion") (insert (substring completion (length stub))) (message "Completed")) (if comint-completion-addsuffix (insert " ")))) (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 " ") (message "Completed shortest")) ((or comint-completion-autolist (string-equal stub completion)) ;; It's not unique, list possible completions. (comint-dynamic-list-completions completions)) (t (message "Partially completed")))))))) (defun comint-dynamic-list-filename-completions () "List in help buffer possible completions of the filename at point." (interactive) (let* ((completion-ignore-case nil) (filename (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 completions (comint-dynamic-list-completions completions) (message "No completions of %s" filename) (ding)))) (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))) (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)))))) ;;; 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-sentinel. ;;; 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, comint-input-filter, comint-input-sentinel, ;;; comint-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 (full-copy-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))) ;;; ;;; (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) ;;; (setq comint-input-sentinel '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-after-partial-filename-command ;;; should be set to a function that returns t if the stub before point is to ;;; be treated as a filename. By default, if the stub contains a `/', or does ;;; not follow the prompt, comint-dynamic-complete-filename-command is called. ;;; Otherwise, comint-dynamic-complete-command-command is called. This should ;;; also be set to a function that completes whatever the mode calls commands. ;;; You could use comint-dynamic-simple-complete to do the bulk of the ;;; completion job. ;;; Do the user's customisation... ;;; ;;; Isn't this what eval-after-load is for? ;;;(defvar comint-load-hook nil ;;; "This hook is run when comint is loaded in. ;;;This is a good place to put keybindings.") ;;; ;;;(run-hooks 'comint-load-hook) (provide 'comint) ;;; comint.el ends here emacs-19.22/lisp/compare-w.el100444 12120 1 13027 5471317101 14306 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. 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) (setq maxp2 (point-max))) (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)) (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.22/lisp/compile.el100444 21641 1 125742 5447775411 15107 0ustar friedmandaemon;;; compile.el --- run compiler as inferior of Emacs, parse error messages. ;; Copyright (C) 1985, 86, 87, 93 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 (defconst 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, that cons's car is a cons \(DIRECTORY . FILE\), specifying the file the message is about, and its cdr is the number of the line the message is about. Or its cdr may be nil if that error is not interesting. The value may be t instead of a list; this means that the buffer of 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 erros. 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! This first one is repeated in 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 ;; ;; 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]" 1 2) ;; 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: ;; Error on line 3 of t.f: Execution error unclassifiable statement ;; Unknown who does this: ;; Line 45 of "foo.c": bloofel undefined ("\n\\(Error on \\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ of[ \t]+\"?\\([^\"\n]+\\)\"?:" 3 2) ;; Apollo cc, 4.3BSD fc: ;; "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 ("\"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[:.,-]" 1 2) ;; MIPS RISC CC - the one distributed with Ultrix: ;; ccom: Error: foo.c, line 2: syntax error ("rror: \\([^,\" \n\t]+\\), line \\([0-9]+\\):" 1 2) ;; 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. ) "Alist that specifies how to match errors in compiler output. Each element has the form (REGEXP FILE-IDX LINE-IDX). If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th subexpression gives the line number.") (defvar grep-regexp-alist '(("^\\([^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2)) "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") ;;;###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))))))") (defconst 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.") (defconst 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.") ;; History of compile commands. (defvar compile-history nil) ;; History of grep commands. (defvar grep-history nil) ;;;###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. 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 (list (read-from-minibuffer "Compile command: " compile-command nil nil '(compile-history . 1)))) (setq compile-command command) (save-some-buffers nil nil) (compile-internal compile-command "No more errors")) ;;;###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 -n " nil nil 'grep-history))) (compile-internal (concat command-args " /dev/null") "No more grep hits" "grep" ;; Give it a simpler regexp to match. nil grep-regexp-alist)) (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) (erase-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) (buffer-disable-undo (current-buffer)) ;; (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))) (and compilation-window-height (= (window-width outwin) (frame-width)) (let ((w (selected-window))) (unwind-protect (progn (select-window outwin) (enlarge-window (- compilation-window-height (window-height)))) (select-window w)))) ;; Start the compilation. (let ((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))))) ;; Make it so the next C-x ` will use this buffer. (setq compilation-last-buffer outbuf))) (defvar compilation-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" '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) 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) (fundamental-mode) (use-local-map compilation-mode-map) (setq major-mode 'compilation-mode mode-name "Compilation") (compilation-setup) (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)) (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 " " msg) (forward-char -1) (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 redisplay soon. (set-buffer-modified-p (buffer-modified-p))) (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'." (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)) (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 (argp &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) (consp argp)) (progn (compilation-forget-errors) (setq compilation-parsing-end 1))) (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 (switch-to-buffer compilation-last-buffer) (set-buffer-modified-p nil) (if (< compilation-parsing-end (point-max)) (let ((at-start (= compilation-parsing-end 1))) (funcall compilation-parse-errors-function limit-search find-at-least) ;; Remember the entire list for compilation-forget-errors. ;; If this is an incremental parse, append to previous list. (if at-start (setq compilation-old-error-list compilation-error-list) (setq compilation-old-error-list (nconc compilation-old-error-list compilation-error-list))) ))))) (defun compile-goto-error (&optional argp) "Visit the source for the error message point is on. Use this command in a compilation log buffer. \\[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 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))) (next-error 1)) (defsubst compilation-buffer-p (buffer) (assq 'compilation-error-list (buffer-local-variables buffer))) ;; 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)) (compile-reinitialize-errors argp nil ;; We want to pass a number here only if ;; we got a numeric prefix arg, not just C-u. (and (not (consp argp)) (if (< (prefix-numeric-value argp) 1) 0 (1- (prefix-numeric-value argp))))) ;; Make ARGP nil if the prefix arg was just C-u, ;; since that means to reparse the errors, which the ;; compile-reinitialize-errors call just did. ;; Now we are only interested in a numeric prefix arg. (if (consp argp) (setq argp nil)) (let (next-errors next-error) (save-excursion (set-buffer compilation-last-buffer) ;; compilation-error-list points to the "current" error. (setq next-errors (if (> (prefix-numeric-value argp) 0) (nthcdr (1- (prefix-numeric-value argp)) compilation-error-list) ;; Zero or negative arg; we need to move back in the list. (let ((n (1- (prefix-numeric-value argp))) (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 (progn (if (null next-error) (progn (if argp (if (> (prefix-numeric-value argp) 0) (error "Moved past last error") (error "Moved back past first error"))) (compilation-forget-errors) (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 (compilation-find-file (cdr fileinfo) (car fileinfo) (car next-error)))) (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 (cdr (cdr next-error)))) (set-buffer buffer) (save-excursion (save-restriction (widen) (goto-line last-line) (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 (cdr (cdr (car errors)))) (lines (- (cdr (cdr (car errors))) last-line))) (if (eq selective-display t) (if (< lines 0) (re-search-backward "[\n\C-m]" nil 'end (- lines)) (re-search-forward "[\n\C-m]" nil 'end lines)) (forward-line lines)) (setq last-line this) (setcdr (car errors) (point-marker)))) (setq errors (cdr errors))))))))) ;; If we didn't get a marker for this error, ;; go on to the next one. (not (markerp (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. (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) (w (display-buffer (marker-buffer (car next-error))))) (set-window-point w (car next-error)) (set-window-start w (car next-error))))) ;;;###autoload (define-key ctl-x-map "`" 'next-error) ;; 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 (filename dir marker) (let ((dirs compilation-search-path) result name) (while (and dirs (null result)) (setq name (expand-file-name filename (or (car dirs) dir)) result (and (file-exists-p name) (find-file-noselect name)) dirs (cdr dirs))) (or result ;; 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. (progn (let* ((pop-up-windows t) (w (display-buffer (marker-buffer marker)))) (set-window-point w marker) (set-window-start w marker)) (setq 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 (concat (file-name-as-directory name) filename))) (if (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)) (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), where IDX is the number of the ;; subexpression for an entire error-regexp, and FILE and LINE are the ;; numbers for the subexpressions giving the file name and line 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)))) error-regexp-groups)) (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist))))) (setq alist (cdr alist))) (setq orig default-directory) (setq orig-expanded (file-truename orig)) (setq parent-expanded (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)))) ((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 "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)) (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)) )) ((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 (cons default-directory (buffer-substring (match-beginning (nth 1 alist)) (match-end (nth 1 alist))))) (linenum (save-restriction (narrow-to-region (match-beginning (nth 2 alist)) (match-end (nth 2 alist))) (goto-char (point-min)) (if (looking-at "[0-9]") (read (current-buffer)))))) ;; 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 (beginning-of-line 1) (let ((this (cons (point-marker) (cons filename linenum)))) ;; 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 find-at-least (>= compilation-num-errors-found find-at-least) ;; We have found as many new errors as the user wants. ;; 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 (%d%% of buffer)" compilation-num-errors-found (/ (* 100 (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) (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.22/lisp/complete.el100444 13437 1 70175 5407110745 14373 0ustar jimbdaemon;; complete.el -- partial completion mechanism plus other goodies. ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Author: Dave Gillespie ;; Version: 2.02 ;; Special thanks to Hallvard Furuseth for his many ideas and contributions. ;; 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. ;; 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) (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 ;; 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))) (if p (progn (if (null mode) (PC-temp-minibuffer-message " (Complete, but not unique)")) 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)) (insert (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))) (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 (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.22/lisp/completion.el100444 12120 1 270275 5427375644 14640 0ustar rmsdaemon;;; completion.el --- dynamic word-completion code ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: abbrev ;; Author: Jim Salem and Brewster Kahle ;; of Thinking Machines Inc. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;;; ;;; What to put in .emacs ;;;----------------------- ;;; (load "completion") ;;; (initialize-completions) ;;;--------------------------------------------------------------------------- ;;; 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)) (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) ;; Need this file around too (require 'cl) ;;;--------------------------------------------------------------------------- ;;; 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.") ;;;--------------------------------------------------------------------------- ;;; 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-vector 256 0)) ;; default syntax is whitespace ) ;; alpha chars (dotimes (i 26) (modify-syntax-entry (+ ?a i) "_" table) (modify-syntax-entry (+ ?A i) "_" table)) ;; digit chars. (dotimes (i 10) (modify-syntax-entry (+ ?0 i) "_" table)) ;; Other ones (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%)) (symbol-chars-ignore '(?_ ?- ?: ?.)) ) (dolist (char symbol-chars) (modify-syntax-entry char "_" table)) (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 '(?! ?& ?? ?= ?^)) ) (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 '(?+ ?* ?/ ?: ?%)) ) (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 '(?+ ?- ?* ?/ ?:)) ) (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) ;;; 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))) ) (when 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 (when 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)) ) (defun list-all-completions () "Returns a list of all the known completion entries." (let ((return-completions nil)) (mapatoms 'list-all-completions-1 cmpl-prefix-obarray) return-completions)) (defun list-all-completions-1 (prefix-symbol) (if (boundp prefix-symbol) (setq return-completions (append (cmpl-prefix-entry-head (symbol-value prefix-symbol)) return-completions)))) (defun list-all-completions-by-hash-bucket () "Return list of lists of known completion entries, organized by hash bucket." (let ((return-completions nil)) (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray) return-completions)) (defun list-all-completions-by-hash-bucket-1 (prefix-symbol) (if (boundp prefix-symbol) (setq return-completions (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol)) return-completions)))) ;;;----------------------------------------------- ;;; 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" 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 (string) "If STRING is not in the database, add it to prefix list. STRING is added to the head of the appropriate prefix list. Otherwise it is moved to the head of the list. 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 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 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 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 (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 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. Couldn't delete it." 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)) (when (and completion-on-separator-character (zerop (completion-num-uses entry))) (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)) ((minusp index) (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) (minusp (setq index (1+ index)))) (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 (minusp (setq index (1- index))))) (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, the 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) ) (when (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) ) (when (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 "Do not know how to 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) ))) )) (pushnew 'cmpl-find-file-hook find-file-hooks) ;;;----------------------------------------------- ;;; 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-vector 256 0)) (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) ;; unfortunately the ?( causes the parens to appear unbalanced (separator-chars '(?, ?* ?= ?\( ?\; )) ) ;; default syntax is whitespace (dotimes (i 256) (modify-syntax-entry i "w" table)) (dolist (char whitespace-chars) (modify-syntax-entry char "_" table)) (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 (second e) "Containing expression ends prematurely") (string-equal (second e) "Unbalanced parentheses")) ;; unbalanced paren., keep going ;;(ding) (forward-line 1) (message "Error parsing C buffer for completions. Please 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 () (when (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))) (when (file-writable-p filename) (if (not cmpl-initialized-p) (initialize-completions));; make sure everything's loaded (message "Saving completions to file %s" filename) (let* ((trim-versions-without-asking 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) (when (not (verify-visited-file-modtime (current-buffer))) ;; 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)) (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 (plusp (completion-num-uses completion)) ;; 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))) (when file-exists-p ;; 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} (unless (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) (when 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 () ;;; (when (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) ;;; )) ;;;(pushnew 'autosave-completions cmpl-emacs-idle-time-hooks) (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)) ) (when backup-readable-p (setq filename backup-filename)) (when (file-readable-p filename) (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 (when insert-okay-p (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 (> (current-column) fill-column) 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 (get this-command 'completion-function) 'use-completion-under-or-before-point))) (add-hook 'before-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. (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) ;;; 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.22/lisp/cookie1.el100444 12241 1 13561 5446403414 14440 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.22/lisp/cplus-md.el100444 12120 1 103650 5425256747 14203 0ustar rmsdaemon;;; cplus-md.el --- C++ code editing commands for Emacs ;;; Copyright (C) 1985, 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. ;; 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 class". ;; ;; 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)) (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 class 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.") ;;;###autoload (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 class 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) nil) (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 ?:) (not (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]class[ \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 (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 (not (memq (preceding-char) '(nil ?\, ?\; ?} ?: ?\{))) ;; 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) (while (progn (skip-chars-forward " \t\n") (looking-at (concat "#\\|/\\*\\|//" "\\|case[ \t]" "\\|[a-zA-Z0-9_$]*:[^:]" "\\|friend[ \t]class[ \t]"))) ;; Skip over comments and labels following openbrace. (cond ((= (following-char) ?\#) (forward-line 1)) ((looking-at "/\\*") (search-forward "*/" nil 'move)) ((looking-at "//\\|friend[ \t]class[ \t]") (forward-line 1)) (t (re-search-forward ":[^:]" nil 'move)))) ;; 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 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)))) (t (beginning-of-line) (skip-chars-forward " \t") (if (looking-at "#") (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. (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)))))) ;; Just started a new nesting level. ;; Compute the standard indent for this level. (let ((val (calculate-c++-indent (if (car indent-stack) (- (car indent-stack)))))) (setcar indent-stack (setq this-indent val)))) ;; 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]class[ \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.22/lisp/cplus-md1.el100444 12120 1 323725 5474462232 14263 0ustar rmsdaemon;;; cplus-md1.el --- major mode for editing C++ (and C) code ;; Author: 1992 Barry A. Warsaw, Century Computing Inc. ;; 1987 Dave Detlefs and Stewart Clamen ;; 1985 Richard M. Stallman ;; Maintainer: c++-mode-help@anthem.nlm.nih.gov ;; Created: a long, long, time ago. adapted from the original c-mode.el ;; Version: 2.353 ;; Last Modified: 1993/06/23 13:58:52 ;; Keywords: languages ;; 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. ;; Introduction ;; ============ ;; Do a "C-h m" in a c++-mode buffer for more information on ;; customizing c++-mode. To submit bug reports hit "C-c C-b" in a ;; c++-mode buffer. This runs the command c++-submit-bug-report and ;; automatically sets up the mail buffer with all the necessary ;; information. If you have other questions contact me at the ;; following address: c++-mode-help@anthem.nlm.nih.gov. Please don't ;; send bug reports to my personal account, I may not get it for a ;; long time. ;; Notes for Novice Users ;; ====================== ;; c++-mode facilitates editing of C++ code by automatically handling ;; the indentation of lines of code in a manner very similar to c-mode ;; as distributed with GNU Emacs. Refer to the GNU Emacs manual, ;; chapter 21 for more information on "Editing Programs". In fact, ;; c++-mode (through its companion mode entry point c++-c-mode) can ;; also be used to edit both K&R and ANSI C code! ;; ;; To use c++-mode, add the following to your .emacs file. This ;; assumes you will use .cc or .C extensions for your C++ source: ;; ;; (autoload 'c++-mode "c++-mode" "C++ Editing Mode" t) ;; (autoload 'c++-c-mode "c++-mode" "C Editing Mode" t) ;; (setq auto-mode-alist ;; (append '(("\\.C$" . c++-mode) ;; ("\\.cc$" . c++-mode) ;; ("\\.c$" . c++-c-mode) ; to edit C code ;; ("\\.h$" . c++-c-mode) ; to edit C code ;; ) auto-mode-alist)) ;; ;; If you want to use the default c-mode for editing C code, then just ;; omit the lines marked "to edit C code". ;; ;; Finally, you may want to customize certain c++-mode variables. The ;; best place to do this is in the mode hook variable called ;; c++-mode-hook. Again, see the Emacs manual, chapter 21 for more ;; information. ;; Important Note about Escapes in Comments, and Performance ;; ========================================================= ;; You may notice that certain characters, when typed in comment ;; regions, get escaped with a backslash. This is a workaround for ;; bugs in Emacs' syntax parsing algorithms. In brief, syntax parsing ;; in Emacs 18 and derivatives is broken because syntax tables are not ;; rich enough to support more than 1 comment style per mode (as C++ ;; requires). The result is that Emacs will sometimes choke on ;; unbalanced parentheses and single quotes in comments. Please do a ;; "C-h v c++-untame-characters" for more information. ;; ;; This problem affect both the accuracy and performance of c++-mode ;; because some parsing must be performed in Emacs lisp instead of ;; relying on the C primitives. In general, I've chosen accuracy over ;; performance, but have worked hard to give moderately acceptable ;; speed in all but the most uncommon situations. You will most likely ;; notice c++-mode slowing when you're editing a file of preprocessor ;; commands, or inside long functions or class definitions. ;; Optimization is an ongoing concern, but the real solution is to fix ;; Emacs. ;; ;; As of release 19.4, Lucid Emacs is distributed with the fixes in ;; place, and c++-mode will automatically take advantage of them so ;; none of the above applies to you. Similar patches will be part of ;; FSF GNU Emacs 19. Some patches for GNU Emacs 18 have been released ;; on the beta site, but they are unsupported. Email for more ;; information. ;; Beta Testers Mailing List ;; ========================= ;; Want to be a c++-mode victim, er, beta-tester? Send add/drop ;; requests to c++-mode-victims-request@anthem.nlm.nih.gov. ;; Discussions go to c++-mode-victims@anthem.nlm.nih.gov, but bug ;; reports and such should still be sent to c++-mode-help only. ;; ;; Many, many thanks go out to all the folks on the beta test list. ;; Without their patience, testing, insight, and code contribution, ;; c++-mode.el would be a far inferior package. ;; Getting c++-mode.el ;; =================== ;; The latest public release version of this file should always be ;; available for anonymous ftp on the Emacs lisp archive machine. The ;; path to the file is: ;; ;; archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/modes/c++-mode.el.Z ;; ;; For those of you without anon-ftp access, you can use the DEC's ;; ftpmail'er at the address ftpmail@decwrl.dec.com. Send the ;; following message in the body of your mail to that address to get ;; c++-mode: ;; ;; reply ;; connect archive.cis.ohio-state.edu ;; binary ;; uuencode ;; chdir pub/gnu/emacs/elisp-archive/modes ;; get c++-mode.el.Z ;; ;; or just send the message "help" for more information on ftpmail. ;; Response times will vary with the number of requests in the queue. ;; LCD Archive Entry: ;; c++-mode|Barry A. Warsaw|c++-mode-help@anthem.nlm.nih.gov ;; |Mode for editing C++, and ANSI/K&R C code (was Detlefs' c++-mode.el) ;; |1993/06/23 13:58:52|2.353| ;;; Code: ;; some people may not have c-mode loaded in by default. c++-mode.el ;; unfortunately still depends on distrib c-mode. c-mode doesn't ;; provide itself so this hack is best known way to ensure its loaded (or (fboundp 'c-mode) (load "c-mode" nil t)) ;; ====================================================================== ;; user definable variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv (defconst c++-emacs-features (let ((mse-spec 'no-dual-comments) (scanner 'v18)) ;; vanilla GNU18/Epoch 4 uses default values (if (= 8 (length (parse-partial-sexp (point) (point)))) ;; we know we're using v19 style dual-comment specifications. ;; All Lemacsen use 8-bit modify-syntax-entry flags, as do all ;; patched FSF19, GNU18, Epoch4's. Only vanilla FSF19 uses ;; 1-bit flag. Lets be as smart as we can about figuring this ;; out. (let ((table (copy-syntax-table))) (modify-syntax-entry ?a ". 12345678" table) (if (= (logand (lsh (aref table ?a) -16) 255) 255) (setq mse-spec '8-bit) (setq mse-spec '1-bit)) ;; we also know we're using a quicker, built-in comment ;; scanner, but we don't know if its old-style or new. ;; Fortunately we can ask emacs directly (if (fboundp 'forward-comment) (setq scanner 'v19) (setq scanner 'old-v19)))) ;; now cobble up the necessary list (list mse-spec scanner)) "A list of needed features extant in the Emacs you are using. There are many flavors of Emacs out on the net, each with different features supporting those needed by c++-mode. Here's the current known list, along with the values for this variable: Vanilla GNU 18/Epoch 4: (no-dual-comments v18) GNU 18/Epoch 4 (patch1): (8-bit old-v19) GNU 18/Epoch 4 (patch2): (8-bit v19) Lemacs 19.4 - 19.7: (8-bit old-v19) Lemacs 19.8 and over: (8-bit v19) FSF 19: (1-bit v19) FSF 19 (patched): (8-bit v19)") (defvar c++-mode-abbrev-table nil "Abbrev table in use in c++-mode buffers.") (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 "{" 'c++-electric-brace) (define-key c++-mode-map "}" 'c++-electric-brace) (define-key c++-mode-map ";" 'c++-electric-semi) (define-key c++-mode-map "#" 'c++-electric-pound) (define-key c++-mode-map "\e\C-h" 'mark-c-function) (define-key c++-mode-map "\e\C-q" 'c++-indent-exp) (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++-macroize-region) (define-key c++-mode-map "\C-c\C-c" 'c++-comment-region) (define-key c++-mode-map "\C-c\C-u" 'c++-uncomment-region) (define-key c++-mode-map "\C-c\C-x" 'c++-match-paren) (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) (define-key c++-mode-map "/" 'c++-electric-slash) (define-key c++-mode-map "*" 'c++-electric-star) (define-key c++-mode-map ":" 'c++-electric-colon) (define-key c++-mode-map "\177" 'c++-electric-delete) (define-key c++-mode-map "\C-c\C-t" 'c++-toggle-auto-hungry-state) (define-key c++-mode-map "\C-c\C-h" 'c++-toggle-hungry-state) (define-key c++-mode-map "\C-c\C-a" 'c++-toggle-auto-state) (if (memq 'v18 c++-emacs-features) (progn (define-key c++-mode-map "\C-c'" 'c++-tame-comments) (define-key c++-mode-map "'" 'c++-tame-insert) (define-key c++-mode-map "[" 'c++-tame-insert) (define-key c++-mode-map "]" 'c++-tame-insert) (define-key c++-mode-map "(" 'c++-tame-insert) (define-key c++-mode-map ")" 'c++-tame-insert))) (define-key c++-mode-map "\C-c\C-b" 'c++-submit-bug-report) (define-key c++-mode-map "\C-c\C-v" 'c++-version) ;; these are necessary because default forward-sexp and ;; backward-sexp don't automatically let-bind ;; parse-sexp-ignore-comments, which is needed for them to work ;; properly in a C++ buffer. (define-key c++-mode-map "\e\C-f" 'c++-forward-sexp) (define-key c++-mode-map "\e\C-b" 'c++-backward-sexp) ) (defvar c++-mode-syntax-table nil "Syntax table used in c++-mode buffers.") (defvar c++-c-mode-syntax-table nil "Syntax table used in c++-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 ?+ "." 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) ;; comment syntax (cond ((memq '8-bit c++-emacs-features) ;; Lucid emacs has the best implementation (modify-syntax-entry ?/ ". 1456" c++-mode-syntax-table) (modify-syntax-entry ?* ". 23" c++-mode-syntax-table) (modify-syntax-entry ?\n "> b" c++-mode-syntax-table)) ((memq '1-bit c++-emacs-features) ;; FSF19 has sub-optimal, but workable implementation ;; Some strange behavior may be encountered. LOBBY FSF! (modify-syntax-entry ?/ ". 124" c++-mode-syntax-table) (modify-syntax-entry ?* ". 23b" c++-mode-syntax-table) (modify-syntax-entry ?\n ">" c++-mode-syntax-table)) (t ;; Vanilla GNU18 is just plain busted. We'll do the best we can, ;; but some strange behavior may be encountered. PATCH or UPGRADE! (modify-syntax-entry ?/ ". 124" c++-mode-syntax-table) (modify-syntax-entry ?* ". 23" c++-mode-syntax-table) (modify-syntax-entry ?\n ">" c++-mode-syntax-table)) )) (if c++-c-mode-syntax-table () (setq c++-c-mode-syntax-table (make-syntax-table)) (modify-syntax-entry ?\\ "\\" c++-c-mode-syntax-table) (modify-syntax-entry ?+ "." c++-c-mode-syntax-table) (modify-syntax-entry ?- "." c++-c-mode-syntax-table) (modify-syntax-entry ?= "." c++-c-mode-syntax-table) (modify-syntax-entry ?% "." c++-c-mode-syntax-table) (modify-syntax-entry ?< "." c++-c-mode-syntax-table) (modify-syntax-entry ?> "." c++-c-mode-syntax-table) (modify-syntax-entry ?& "." c++-c-mode-syntax-table) (modify-syntax-entry ?| "." c++-c-mode-syntax-table) (modify-syntax-entry ?\' "\"" c++-c-mode-syntax-table) (modify-syntax-entry ?/ ". 14" c++-c-mode-syntax-table) (modify-syntax-entry ?* ". 23" c++-c-mode-syntax-table) ) (defvar c++-tab-always-indent (if (boundp 'c-tab-always-indent) c-tab-always-indent t) "*Controls the operation of the TAB key. If t (the default), 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 not-nil-or-t, then tab is inserted only within literals (comments and strings) and inside preprocessor directives, but line is always reindented.") (defvar c++-always-arglist-indent-p nil "*Control indentation of continued arglists. When non-nil, arglists continued on subsequent lines will always indent `c++-empty-arglist-indent' spaces, otherwise, they will indent to just under previous line's argument indentation.") (defvar c++-block-close-brace-offset 0 "*Extra indentation given to close braces which close a block. This variable can be either an integer or a list. If an integer, it describes the extra offset given a block closing brace (and a closing paren if `c++-paren-as-block-close-p' is non-nil), treating all closing parens the same. If a list of the form (OTHERS . TOPLEVEL), OTHERS is an integer describing the offset given to all but top-level (e.g. function) closing braces, while TOPLEVEL is an integer describing offset given only to braces which close top-level constructs.") (defvar c++-paren-as-block-close-p nil "*Treat a parenthesis which is the first non-whitespace on a line as a paren which closes a block. When non-nil, `c-indent-level' is subtracted, and `c++-block-close-brace-offset' is added to the line's offset.") (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 class declarations relative to member declarations.") (defvar c++-access-specifier-offset c-label-offset "*Extra indentation given to public, protected, and private labels.") (defvar c++-empty-arglist-indent nil "*Indicates how far to indent a line following an empty argument list. Nil means indent to just after the paren.") (defvar c++-comment-only-line-offset 0 "*Indentation offset for line which contains only C or C++ style comments. This variable can take either a single integer or a list of integers. If a single integer this is the extra indentation offset to apply to all comment-only lines, except those which start in column zero. If a list is used, the first integer is for all non-column-zero comment-only lines and the second integer is for all column-zero lines. You can also use a list containing only 1 integer, in which case, this value is used for all comment-only lines. For example: value meaning ===== ======= 0 comment-only lines do not indent 4 non-col0 lines indent 4 spaces, col0 lines don't indent '(4) all comment-only lines indent 4 spaces '(4 1) non-col0 lines indent 4 spaces, col0 lines indent 1 space") (defvar c++-C-block-comments-indent-p nil "*4 styles of C block comments are supported. If this variable is nil, then styles 1-3 are supported. If this variable is non-nil, style 4 is supported. style 1: style 2: style 3: style 4: /* /* /* /* blah * blah ** blah blah blah * blah ** blah blah */ */ */ */ ") (defvar c++-cleanup-list nil "*List of various C++ constructs to \"clean up\". These cleanups only take place when the auto-newline feature is turned on, as evidenced by the `/a' or `/ah' appearing next to the mode name. Current legal values are: `brace-else-brace' -- clean up `} else {' constructs by placing entire construct on a single line. This cleanup only takes place when there is nothing but white space between the braces and the else. `empty-defun-braces' -- cleans up empty C++ function braces by placing them on the same line. `defun-close-semi' -- cleans up the terminating semi-colon on class definitions and functions by placing the semi on the same line as the closing brace.") (defvar c++-hanging-braces t "*Controls the insertion of newlines before open (left) braces. This variable only has effect when auto-newline is on, as evidenced by the `/a' or `/ah' appearing next to the mode name. If nil, open braces do not hang (i.e. a newline is inserted before all open braces). If t, all open braces hang -- no newline is inserted before open braces. If not nil or t, newlines are only inserted before top-level open braces; all other braces hang.") (defvar c++-hanging-member-init-colon 'before "*Defines how colons which introduce member initializations are formatted. Legal values are: t -- no newlines inserted before or after colon nil -- newlines inserted before and after colon `after' -- newlines inserted only after colon `before` -- newlines inserted only before colon") (defvar c++-auto-hungry-initial-state 'none "*Initial state of auto/hungry features when buffer is first visited. Legal values are: `none' -- no auto-newline and no hungry-delete-key. `auto-only' -- auto-newline, but no hungry-delete-key. `hungry-only' -- no auto-newline, but hungry-delete-key. `auto-hungry' -- both auto-newline and hungry-delete-key enabled. Nil is synonymous for `none' and t is synonymous for `auto-hungry'.") (defvar c++-auto-hungry-toggle t "*Enable/disable toggling of auto/hungry features. Legal values are: `none' -- auto-newline and hungry-delete-key cannot be enabled. `auto-only' -- only auto-newline feature can be toggled. `hungry-only' -- only hungry-delete-key feature can be toggled. `auto-hungry' -- both auto-newline and hungry-delete-key can be toggled. Nil is synonymous for `none' and t is synonymous for `auto-hungry'.") (defvar c++-relative-offset-p t "*Control the calculation for indentation. When non-nil (the default), indentation is calculated relative to the first statement in the block. When nil, the indentation is calculated without regard to how the first statement is indented.") (defvar c++-untame-characters (and (memq 'v18 c++-emacs-features) '(?\')) "*Utilize a backslashing workaround of an Emacs syntax parsing bug. If non-nil, this variable should contain a list of characters which will be prepended by a backslash in comment regions. By default, the list contains only the most troublesome character, the single quote. To be completely safe, set this variable to: '(?\( ?\) ?\' ?\{ ?\} ?\[ ?\]) This is the full list of characters which can potentially cause problems if they exist unbalanced within comments. Setting this variable to nil will defeat this feature, but be forewarned! Such un-escaped characters in comment regions can potentially break many things such as some indenting and blinking of parenthesis. Note further that only the default set of characters will be escaped automatically as they are typed. But, executing `c++-tame-comments' (\\[c++-tame-comments]) will escape all characters which are members of this set, and which are found in comments throughout the file. Finally, c++-mode can tell if you're running a patched Emacs. If so, taming characters isn't necessary and this variable is automatically set to nil.") (defvar c++-default-macroize-column 78 "*Column to insert backslashes.") (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. By supplying a hook, you can make adjustments to the line's standard indentation. If you do use this hook, you will likely need to also set `c++-relative-offset-p' to nil. The call to this hook is wrapped in a `save-excursion' so you don't need to worry about restoring point and mark inside the hook function.") (defvar c++-delete-function 'backward-delete-char-untabify "*Function called by `c++-electric-delete' when deleting a single char.") (defvar c++-electric-pound-behavior nil "*List of behaviors for electric pound insertion. Only currently supported behavior is `alignleft'.") (defvar c++-backscan-limit 2000 "*Limit in characters for looking back while skipping syntactic ws. If you typically write really big methods, and start noticing incorrect indentations, try cranking this value up. The larger this value is, though, the slower parts of c++-mode can become. Setting this variable to nil defeats backscan limits.") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT ;; (defvar c++-hungry-delete-key nil "Internal state of hungry delete key feature.") (defvar c++-auto-newline nil "Internal state of auto newline feature.") (make-variable-buffer-local 'c++-auto-newline) (make-variable-buffer-local 'c++-hungry-delete-key) (defconst c++-access-key "\\<\\(public\\|protected\\|private\\)\\>:" "Regexp which describes access specification keywords.") (defconst c++-class-key (concat "\\(\\(extern\\|typedef\\)\\s +\\)?" "\\(template\\s *<[^>]*>\\s *\\)?" "\\<\\(class\\|struct\\|union\\)\\>") "Regexp which describes a class declaration, including templates.") (defconst c++-inher-key (concat "\\(\\\\s +\\)?" c++-class-key "[ \t]+\\(\\(\\w\\|_\\)+[ \t]*:[ \t]*\\)?") "Regexp which describes a class inheritance declaration.") ;; ====================================================================== ;; c++-mode main entry point ;; ====================================================================== (defun c++-mode () "Major mode for editing C++ code. 2.353 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 and send the message. 1. Very much like editing C code, 2. Expression and list commands understand all C++ brackets, 3. Tab at left margin indents for C++ code, 4. Both C++ and C style block comments are recognized, 5. Paragraphs are separated by blank lines only, 6. Hungry delete key and auto newline features are optional. IMPORTANT NOTE: You may notice that some characters (by default, only single quote) will get escaped with a backslash when typed in a comment region. This is a necessary workaround of a bug present in GNU Emacs 18 and derivatives. Enter `\\[describe-variable] c++-untame-characters RET' for more information. If you are running a patched Emacs, no characters will be escaped in comment regions, and many functions will run much faster. Key bindings: \\{c++-mode-map} These variables control indentation style. Those with names like c- are inherited from c-mode. Those with names like c++- are unique for this mode, or have extended functionality from their c-mode cousins. c-argdecl-indent Indentation level of declarations of C function arguments. 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-brace-offset Extra indentation for line if it starts with an open brace. c-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `c-continued-statement-offset'. c-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. 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-label-offset Extra indentation for line that is a label, or case or `default:'. c++-C-block-comments-indent-p Style of C block comments to support. c++-access-specifier-offset Extra indentation given to public, protected, and private keyword lines. c++-always-arglist-indent-p Control indentation of continued arglists. When non-nil, arglists continued on subsequent lines will always indent `c++-empty-arglist-indent' spaces, otherwise, they will indent to just under previous line's argument indentation. c++-auto-hungry-initial-state Initial state of auto/hungry feature when a C++ buffer is first visited. c++-auto-hungry-toggle Enable/disable toggling of auto/hungry features. c++-backscan-limit Limit in characters for looking back while skipping syntactic whitespace. This variable is only used in an un-patched Emacs to help improve performance at the expense of some accuracy. Patched Emacses are both fast and accurate. c++-block-close-brace-offset Extra indentation give to braces which close a block. c++-cleanup-list A list of construct \"clean ups\" which c++-mode will perform when auto-newline feature is on. Current legal values are: `brace-else-brace', `empty-defun-braces', `defun-close-semi'. c++-comment-only-line-offset Extra indentation for a line containing only a C or C++ style comment. Can be an integer or list, specifying the various styles of comment-only line special indentations. 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. c++-default-macroize-column Column to insert backslashes when macroizing a region. c++-delete-function Function called by `c++-electric-delete' when deleting a single char. c++-electric-pound-behavior List of behaviors for electric pound insertion. c++-empty-arglist-indent Extra indentation to apply to a line following an empty argument list. nil means to line it up with the left paren. c++-friend-offset Offset of C++ friend class declarations relative to member declarations. c++-hanging-braces Controls open brace hanging behavior when using auto-newline feature. nil says no braces hang, t says all open braces hang. non-nil-or-t means top-level open braces don't hang, all others do. c++-hanging-member-init-colon Defines how colons which introduce member initialization lists are formatted. t means no newlines are inserted either before or after the colon. nil means newlines are inserted both before and after the colon. `before' inserts newlines only before the colon, and `after' inserts newlines only after colon. c++-member-init-indent Indentation level of member initializations in function declarations, if they are on a separate line beginning with a colon. c++-paren-as-block-close-p If non-nil, treat a parenthesis which is the first non-whitespace on a line as a paren which closes a block (i.e. treat it similar to right curly brace). c++-relative-offset-p Control the calculation for indentation. When non-nil (the default), indentation is calculated relative to the first statement in the block. When nil, the indentation is calculated without regard to how the first statement is indented. Useful when using a `c++-special-indent-hook'. c++-special-indent-hook Hook for user defined special indentation adjustments. You can use this hook, which gets called after a line is indented by the mode, to customize indentations of the line. c++-tab-always-indent Controls the operation of the TAB key. t means always just indent the current line. nil means indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. Any other value means insert tab only within literals (comments and strings) and inside preprocessor directives, but always reindent the line. The default is value for `c-tab-always-indent'. c++-untame-characters When non-nil, inserts backslash escapes before certain untamed characters in comment regions. It is recommended that you keep the default setting to workaround a nasty Emacs bug, unless you are running a patched Emacs. Auto-newlining is no longer an all or nothing proposition. In my opinion, I don't believe it is possible to implement a perfect auto-newline algorithm. Sometimes you want it and sometimes you don't. So now auto-newline (and its companion feature, hungry-delete-key) can be toggled on and off on the fly. Hungry-delete-key is the optional behavior of the delete key so that, when enabled, hitting the delete key once consumes all preceding whitespace, unless point is within a literal (defined as a C or C++ comment, or string). Inside literals, and with hungry-delete-key disabled, the delete key just calls the function in variable `c++-delete-function'. Selection and toggling of these features is controlled by the variables `c++-auto-hungry-initial-state' and `c++-auto-hungry-toggle'. Legal values for both variables are: `none' (or nil) -- no auto-newline or hungry-delete-key. `auto-only' -- function affects only auto-newline feature. `hungry-only' -- function affects only hungry-delete-key feature. `auto-hungry' (or t) -- function affects both features. Thus if `c++-auto-hungry-initial-state' is `hungry-only', then only hungry-delete-key feature is turned on when the buffer is first visited. If `c++-auto-hungry-toggle' is `auto-hungry', and both auto-newline and hungry-delete-key features are on, then hitting `\\[c++-toggle-auto-hungry-state]' will toggle both features. Hitting `\\[c++-toggle-hungry-state]' will always toggle hungry-delete-key feature and hitting `\\[c++-toggle-auto-state]' will always toggle auto-newline feature, regardless of the value of `c++-auto-hungry-toggle'. 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++-access-specifier-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++" local-abbrev-table c++-mode-abbrev-table) (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) nil) ;; (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-column) 32) (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|// *") (set (make-local-variable 'comment-indent-hook) 'c++-comment-indent) ;; hack auto-hungry designators into mode-line-format (if (listp mode-line-format) (setq mode-line-format (let ((modeline nil)) (mapcar (function (lambda (element) (setq modeline (append modeline (if (eq element 'mode-name) '(mode-name (c++-hungry-delete-key (c++-auto-newline "/ah" "/h") (c++-auto-newline "/a"))) (list element)))))) mode-line-format) modeline))) (run-hooks 'c++-mode-hook) (c++-set-auto-hungry-state (memq c++-auto-hungry-initial-state '(auto-only auto-hungry t)) (memq c++-auto-hungry-initial-state '(hungry-only auto-hungry t)))) (defun c++-c-mode () "Major mode for editing K&R and ANSI C code. 2.353 This mode is based on c++-mode. Documentation for this mode is available by doing a `\\[describe-function] c++-mode'." (interactive) (c++-mode) (setq major-mode 'c++-c-mode mode-name "C" local-abbrev-table c-mode-abbrev-table) (setq comment-start "/* " comment-end " */") ;; some syntax differences are necessary for C vs. C++ (set-syntax-table c++-c-mode-syntax-table) (run-hooks 'c++-c-mode-hook)) (defun c++-comment-indent () "Used by `indent-for-comment' to decide how much to indent a comment in C++ code based on its context." (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))) ;; use comment-column if previous line is comment only line ;; indented to the left of comment-column (save-excursion (beginning-of-line) (if (not (bobp)) (forward-line -1)) (skip-chars-forward " \t") (if (looking-at "/\\*\\|//") (if (< (current-column) comment-column) comment-column (current-column)) 0)) (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. ;; ====================================================================== ;; most command level (interactive) and related ;; ====================================================================== (defun c++-set-auto-hungry-state (auto-p hungry-p) "Set auto/hungry to state indicated by AUTO-P and HUNGRY-P. Update mode line to indicate state to user." (setq c++-auto-newline auto-p c++-hungry-delete-key hungry-p) (set-buffer-modified-p (buffer-modified-p))) (defun c++-toggle-auto-state (arg) "Toggle auto-newline feature. This function ignores `c++-auto-hungry-toggle' variable. Optional numeric ARG, if supplied turns on auto-newline when positive, turns off auto-newline when negative and toggles when zero." (interactive "P") (let ((auto (cond ((not arg) (not c++-auto-newline)) ((zerop (setq arg (prefix-numeric-value arg))) (not c++-auto-newline)) ((< arg 0) nil) (t t)))) (c++-set-auto-hungry-state auto c++-hungry-delete-key))) (defun c++-toggle-hungry-state (arg) "Toggle hungry-delete-key feature. This function ignores `c++-auto-hungry-toggle' variable. Optional numeric ARG, if supplied turns on hungry-delete-key when positive, turns off hungry-delete-key when negative and toggles when zero." (interactive "P") (let ((hungry (cond ((not arg) (not c++-hungry-delete-key)) ((zerop (setq arg (prefix-numeric-value arg))) (not c++-hungry-delete-key)) ((< arg 0) nil) (t t)))) (c++-set-auto-hungry-state c++-auto-newline hungry))) (defun c++-toggle-auto-hungry-state (arg) "Toggle auto-newline and hungry-delete-key features. Actual toggling of these features is controlled by `c++-auto-hungry-toggle' variable. Optional argument has the following meanings when supplied: Universal argument \\[universal-argument] resets features to c++-auto-hungry-initial-state. negative number turn off both auto-newline and hungry-delete-key features. positive number turn on both auto-newline and hungry-delete-key features. zero toggle both features regardless of `c++-auto-hungry-toggle-p'." (interactive "P") (let* ((numarg (prefix-numeric-value arg)) (apl (list 'auto-only 'auto-hungry t)) (hpl (list 'hungry-only 'auto-hungry t)) (auto (cond ((not arg) (if (memq c++-auto-hungry-toggle apl) (not c++-auto-newline) c++-auto-newline)) ((listp arg) (memq c++-auto-hungry-initial-state apl)) ((zerop numarg) (not c++-auto-newline)) ((< arg 0) nil) (t t))) (hungry (cond ((not arg) (if (memq c++-auto-hungry-toggle hpl) (not c++-hungry-delete-key) c++-hungry-delete-key)) ((listp arg) (memq c++-auto-hungry-initial-state hpl)) ((zerop numarg) (not c++-hungry-delete-key)) ((< arg 0) nil) (t t)))) (c++-set-auto-hungry-state auto hungry))) (defun c++-tame-insert (arg) "Safely inserts certain troublesome characters in comment regions. Because of syntax bugs in Emacs, characters with string or parenthesis syntax must be escaped with a backslash or lots of things get messed up. Unfortunately, setting `parse-sexp-ignore-comments' to non-nil does not fix the problem, but this function is unnecessary if you are running a patched Emacs. See also the variable `c++-untame-characters'." (interactive "p") (if (and (memq last-command-char c++-untame-characters) (memq (c++-in-literal) '(c c++))) (insert "\\")) (self-insert-command arg)) (defun c++-electric-delete (arg) "If `c++-hungry-delete-key' is non-nil, consumes all preceding whitespace unless ARG is supplied, or point is inside a C or C++ style comment or string. If ARG is supplied, this just calls `backward-delete-char-untabify' passing along ARG. If `c++-hungry-delete-key' is nil, just call `backward-delete-char-untabify'." (interactive "P") (cond ((or (not c++-hungry-delete-key) arg) (funcall c++-delete-function (prefix-numeric-value arg))) ((let ((bod (c++-point 'bod))) (not (or (memq (c++-in-literal bod) '(c c++ string)) (save-excursion (skip-chars-backward " \t") (= (preceding-char) ?#))))) (let ((here (point))) (skip-chars-backward " \t\n") (if (/= (point) here) (delete-region (point) here) (funcall c++-delete-function 1)))) (t (funcall c++-delete-function 1)))) (defun c++-electric-pound (arg) "Electric pound command." (interactive "p") (if (memq (c++-in-literal) '(c c++ string)) (self-insert-command arg) (let ((here (point-marker)) (bobp (bobp)) (bolp (bolp))) (if (memq 'alignleft c++-electric-pound-behavior) (progn (beginning-of-line) (delete-horizontal-space))) (if bobp (insert (make-string arg last-command-char)) (insert-before-markers (make-string arg last-command-char))) (if (not bolp) (goto-char here)) (set-marker here nil)))) (defun c++-electric-brace (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos (last-command-char last-command-char) (bod (c++-point 'bod))) (if (and (not arg) (save-excursion (skip-chars-forward " \t") (eolp)) (or (save-excursion (skip-chars-backward " \t") (bolp)) (let ((c++-auto-newline c++-auto-newline) (open-brace-p (= last-command-char ?{))) (if (and open-brace-p (or (eq c++-hanging-braces t) (and c++-hanging-braces (not (c++-at-top-level-p t bod))))) (setq c++-auto-newline nil)) (if (c++-auto-newline) ;; this may have auto-filled so we need to ;; indent the previous line. we also need to ;; indent the currently line, or ;; c++-beginning-of-defun will not be able to ;; correctly find the bod when ;; c++-match-headers-strongly is nil. (progn (c++-indent-line) (save-excursion (forward-line -1) (c++-indent-line)))) t))) (progn (if (and (memq last-command-char c++-untame-characters) (memq (c++-in-literal bod) '(c c++))) (insert "\\")) ;; we need to work around a bogus feature of Emacs where an ;; open brace at bolp means a beginning-of-defun. but it ;; really might not. (and (= last-command-char ?{) (bolp) (c++-indent-line)) (insert last-command-char) ;; try to clean up empty defun braces if conditions apply (let ((here (point-marker))) (and (memq 'empty-defun-braces c++-cleanup-list) (c++-at-top-level-p t bod) c++-auto-newline (= last-command-char ?\}) (progn (forward-char -1) (skip-chars-backward " \t\n") (= (preceding-char) ?\{)) (not (memq (c++-in-literal) '(c c++ string))) (delete-region (point) (1- here))) (goto-char here) (set-marker here nil)) (let ((here (point-marker)) mbeg mend) (if (and (memq 'brace-else-brace c++-cleanup-list) (= last-command-char ?\{) (let ((status (re-search-backward "}[ \t\n]*else[ \t\n]*{" nil t))) (setq mbeg (match-beginning 0) mend (match-end 0)) status) (= mend here) (not (memq (c++-in-literal bod) '(c c++ string)))) (progn ;; we should clean up brace-else-brace syntax (delete-region mbeg mend) (insert-before-markers "} else {") (goto-char here) (set-marker here nil)) (goto-char here) (set-marker here nil))) (c++-indent-line) (if (c++-auto-newline) (progn ;; c++-auto-newline may have done an auto-fill (save-excursion (let ((here (point-marker))) (goto-char (- (point) 2)) (c++-indent-line) (setq insertpos (- (goto-char here) 2)) (set-marker here nil))) (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++-electric-slash (arg) "Insert slash, and if slash is second of a double-slash comment introducing construct, indent line as comment. This only indents if we're on a comment-only line, otherwise use `indent-for-comment' (\\[indent-for-comment])." (interactive "P") (let ((here (point)) char) (self-insert-command (prefix-numeric-value arg)) (and (setq char (char-after (1- here))) (= char ?/) (save-excursion (goto-char here) (c++-indent-line))))) (defun c++-electric-star (arg) "Works with `c++-electric-slash' to auto indent C style comment lines." (interactive "P") (let ((here (point)) char) (self-insert-command (prefix-numeric-value arg)) (if (and (setq char (char-after (1- here))) (memq (c++-in-literal) '(c)) (memq char '(?/ ?* ?\t 32 ?\n)) (save-excursion (skip-chars-backward "* \t") (if (= (preceding-char) ?/) (progn (forward-char -1) (skip-chars-backward " \t"))) (bolp))) (save-excursion (goto-char here) (c++-indent-line))))) (defun c++-electric-semi (arg) "Insert character and correct line's indentation." (interactive "P") (if (c++-in-literal) (self-insert-command (prefix-numeric-value arg)) (let ((here (point-marker))) (if (and (memq 'defun-close-semi c++-cleanup-list) c++-auto-newline (progn (skip-chars-backward " \t\n") (= (preceding-char) ?}))) (delete-region here (point))) (goto-char here) (set-marker here nil)) (c++-electric-terminator arg))) (defun c++-electric-colon (arg) "Electrify colon. De-auto-newline double colons. No auto-new-lines for member initialization list." (interactive "P") (if (c++-in-literal) (self-insert-command (prefix-numeric-value arg)) (let ((c++-auto-newline c++-auto-newline) (insertion-point (point)) (bod (c++-point 'bod))) (save-excursion (cond ;; check for double-colon where the first colon is not in a ;; comment or literal region ((progn (skip-chars-backward " \t\n") (and (= (preceding-char) ?:) (not (memq (c++-in-literal bod) '(c c++ string))))) (progn (delete-region insertion-point (point)) (setq c++-auto-newline nil insertion-point (point)))) ;; check for ?: construct which may be at any level ((progn (goto-char insertion-point) (condition-case premature-end (backward-sexp 1) (error nil)) ;; is possible that the sexp we just skipped was a ;; negative number. in that case the minus won't be ;; gobbled (skip-chars-backward "-") (c++-backward-syntactic-ws bod) (= (preceding-char) ?\?)) (setq c++-auto-newline nil)) ;; check for being at top level or top with respect to the ;; class. if not, process as normal ((progn (goto-char insertion-point) (not (c++-at-top-level-p t bod)))) ;; if at top level, check to see if we are introducing a member ;; init list. if not, continue ((progn (c++-backward-syntactic-ws bod) (= (preceding-char) ?\))) (goto-char insertion-point) ;; at a member init list, figure out about auto newlining. if ;; nil or before then put a newline before the colon and ;; adjust the insertion point, but *only* if there is no ;; newline already before the insertion point (if (and (memq c++-hanging-member-init-colon '(nil before)) c++-auto-newline) (if (not (save-excursion (skip-chars-backward " \t") (bolp))) (let ((c++-auto-newline t)) (c++-auto-newline) (setq insertion-point (point))))) ;; if hanging colon is after or nil, then newline is inserted ;; after colon. set up variable so c++-electric-terminator ;; places the newline correctly (setq c++-auto-newline (and c++-auto-newline (memq c++-hanging-member-init-colon '(nil after))))) ;; last condition is always put newline after colon (t (setq c++-auto-newline nil)) )) ; end-cond, end-save-excursion (goto-char insertion-point) (c++-electric-terminator arg)))) (defun c++-electric-terminator (arg) "Insert character and correct line's indentation." (interactive "P") (let (insertpos (end (point))) (if (and (not arg) (save-excursion (skip-chars-forward " \t") (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 ?:) (not (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 (c++-beginning-of-defun) (let* ((parse-sexp-ignore-comments t) (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++-in-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 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 not-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 bod)) 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 "#"))) (cond ;; CASE 1: indent when at column zero or in lines indentation, ;; otherwise insert a tab ((not c++-tab-always-indent) (if (and (save-excursion (skip-chars-backward " \t") (bolp)) (or (looking-at "[ \t]*$") (/= (point) (c++-point 'boi)) (bolp))) (c++-indent-line bod) (insert-tab))) ;; CASE 2: just indent the line ((eq c++-tab-always-indent t) (c++-indent-line bod)) ;; CASE 3: if in a literal, insert a tab, but always indent the line ((or (memq (c++-in-literal bod) '(c c++ string)) (save-excursion (skip-chars-backward " \t") (= (preceding-char) ?#))) (let ((here (point)) (boi (save-excursion (back-to-indentation) (point))) (indent-p nil)) (c++-indent-line bod) (save-excursion (back-to-indentation) (setq indent-p (and (> here boi) (= (point) boi)))) (if indent-p (insert-tab)))) ;; CASE 4: bogus, just indent the line (t (c++-indent-line bod)))))) (defun c++-indent-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 (parse-sexp-ignore-comments t) (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) ;; fix by reed@adapt.net.com ;; must pass in the return past the end of line, so that ;; parse-partial-sexp finds it, and recognizes that a "//" ;; comment is over. otherwise, state is set that we're in a ;; comment, and never gets unset, causing outer-loop to only ;; terminate in (eobp). old: ;;(setq state (parse-partial-sexp (point) ;;(progn (end-of-line) (point)) ;;nil nil state)) (let ((start (point)) (line-end (progn (end-of-line) (while (eq (c++-in-literal) 'c) (forward-line 1) (c++-indent-line) (end-of-line)) (skip-chars-backward " \t") (end-of-line) (point))) (end (progn (if (not (eobp)) (forward-char)) (point)))) (setq state (parse-partial-sexp start end nil nil state)) (goto-char line-end)) (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") ;; check for C comment block (if (memq (c++-in-literal) '(c)) (let ((eoc (save-excursion (re-search-forward "\\*/" (point-max) 'move) (point)))) (while (< (point) eoc) (c++-indent-line) (forward-line 1)))) (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 (or (/= (char-after (car contain-stack)) ?{) ;;(c++-at-top-level-p t)) ;; baw hack for continued statement offsets ;; repercussions??? t) (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-syntactic-ws 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) (back-to-indentation) (skip-chars-forward "{ \t") (setq this-indent (current-column))) (setq this-indent (car indent-stack)))))) ;; Just started a new nesting level. ;; Compute the standard indent for this level. (let ((val (c++-calculate-indent (if (car indent-stack) (- (car indent-stack)))))) (setcar indent-stack (setq this-indent val)))) ;; Adjust line indentation according to its contents (cond ;; looking at public, protected, private line ((looking-at c++-access-key) (setq this-indent (+ this-indent c++-access-specifier-offset))) ;; looking at a case, default, or other label ((or (looking-at "\\(case[ \t]+.*\\|default[ \t]*\\):") (and (looking-at "[A-Za-z]") (save-excursion (forward-sexp 1) (looking-at ":[^:]")))) (setq this-indent (max 0 (+ this-indent c-label-offset)))) ;; looking at a comment only line? ((looking-at comment-start-skip) ;; different indentation base on whether this is a col0 ;; comment only line or not. also, if comment is in, or ;; to the right of comment-column, the comment doesn't ;; move (progn (skip-chars-forward " \t") (setq this-indent (if (>= (current-column) comment-column) (current-column) (c++-comment-offset (bolp) (+ this-indent (if (save-excursion (c++-backward-syntactic-ws (car contain-stack)) (memq (preceding-char) '(nil ?\, ?\; ?} ?: ?{))) 0 c-continued-statement-offset)) ))))) ;; looking at a friend declaration ((looking-at "friend[ \t]") (setq this-indent (+ this-indent c++-friend-offset))) ;; looking at a close brace ((= (following-char) ?}) (setq this-indent (- this-indent c-indent-level))) ;; looking at an open brace ((= (following-char) ?{) (setq this-indent (+ this-indent c-brace-offset (if (c++-at-top-level-p t (car contain-stack)) 0 c-indent-level)))) ;; check for continued statements ((save-excursion (c++-backward-syntactic-ws (car contain-stack)) (and (not (c++-in-parens-p)) (not (memq (preceding-char) '(nil ?\000 ?\; ?\} ?\: ?\{))) (progn (beginning-of-line) (skip-chars-forward " \t") (not (looking-at c++-class-key))))) (setq this-indent (+ this-indent c-continued-statement-offset ;; are we in a member init list? (if (not (looking-at "[ \t]*:")) (save-excursion (let ((lim (car contain-stack))) (c++-backward-syntactic-ws lim) (while (and (< lim (point)) (= (preceding-char) ?,)) (beginning-of-line) (c++-backward-syntactic-ws)) (forward-line 1) (beginning-of-line) (if (looking-at "[ \t]*:") (- (save-excursion (skip-chars-forward " \t") (point)) (point)) 0))) 0) ))) ;; check for stream operator ((looking-at "\\(<<\\|>>\\)") (setq this-indent (c++-calculate-indent))) ) ;; end-cond ;; 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 (c++-point 'eol) t) (progn (indent-for-comment) (beginning-of-line)))) )))))) (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++-tame-comments () "Backslashifies all untamed in comment regions found in the buffer. This is a workaround for Emacs syntax bugs. This function is unnecessary (and un-used automatically) if you are running a patched Emacs. Untamed characters to escape are defined in the variable `c++-untame-characters'." (interactive) ;; make the list into a valid charset, escaping where necessary (let ((charset (concat "^" (mapconcat (function (lambda (char) (if (memq char '(?\\ ?^ ?-)) (concat "\\" (char-to-string char)) (char-to-string char)))) c++-untame-characters "")))) (save-excursion (beginning-of-buffer) (while (not (eobp)) (skip-chars-forward charset) (if (and (not (zerop (following-char))) (memq (c++-in-literal) '(c c++)) (/= (preceding-char) ?\\ )) (insert "\\")) (if (not (eobp)) (forward-char 1)))))) ;; taken from match-paren.el. Author: unknown (defun c++-match-paren () "Jumps to the paren matching the one under point, if there is one." (interactive) (let ((parse-sexp-ignore-comments (memq 'v19 c++-emacs-features))) (cond ((looking-at "[\(\[{]") (forward-sexp 1) (backward-char)) ((looking-at "[])}]") (forward-char) (backward-sexp 1)) (t (message "Could not find matching paren."))))) (defun c++-forward-sexp (&optional arg) "Safe forward-sexp call." (interactive "p") (let ((parse-sexp-ignore-comments (memq 'v19 c++-emacs-features))) (forward-sexp arg))) (defun c++-backward-sexp (&optional arg) "Safe backward-sexp call." (interactive "p") (let ((parse-sexp-ignore-comments (memq 'v19 c++-emacs-features))) (backward-sexp arg))) ;; ====================================================================== ;; compatibility between emacsen ;; ====================================================================== ;; This is the best we can do in vanilla GNU 18 emacsen. Note that the ;; following problems exist: ;; 1. We only look back to LIM, and that could place us inside a ;; literal if we are scanning backwards over lots of comments ;; 2. This can potentially get slower the larger LIM is ;; If anybody has a better solution, I'll all ears (defun c++-backward-syntactic-ws (&optional lim) "Skip backwards over syntactic whitespace. Syntactic whitespace is defined as lexical whitespace, C and C++ style comments, and preprocessor directives. Search no farther back than optional LIM. If LIM is omitted, `beginning-of-defun' is used." (let ((lim (or lim (c++-point 'bod))) literal stop) (if (and c++-backscan-limit (> (- (point) lim) c++-backscan-limit)) (setq lim (- (point) c++-backscan-limit))) (while (not stop) (skip-chars-backward " \t\n\r\f" lim) ;; c++ comment (if (eq (setq literal (c++-in-literal lim)) 'c++) (progn (skip-chars-backward "^/" lim) (skip-chars-backward "/" lim) (while (not (or (and (= (following-char) ?/) (= (char-after (1+ (point))) ?/)) (<= (point) lim))) (skip-chars-backward "^/" lim) (skip-chars-backward "/" lim))) ;; c comment (if (eq literal 'c) (progn (skip-chars-backward "^*" lim) (skip-chars-backward "*" lim) (while (not (or (and (= (following-char) ?*) (= (preceding-char) ?/)) (<= (point) lim))) (skip-chars-backward "^*" lim) (skip-chars-backward "*" lim)) (or (bobp) (forward-char -1))) ;; preprocessor directive (if (eq literal 'pound) (progn (beginning-of-line) (setq stop (<= (point) lim))) ;; just outside of c block (if (and (= (preceding-char) ?/) (= (char-after (- (point) 2)) ?*)) (progn (skip-chars-backward "^*" lim) (skip-chars-backward "*" lim) (while (not (or (and (= (following-char) ?*) (= (preceding-char) ?/)) (<= (point) lim))) (skip-chars-backward "^*" lim) (skip-chars-backward "*" lim)) (or (bobp) (forward-char -1))) ;; none of the above (setq stop t)))))))) ;; This defun works well for Lemacs 19.4-7, which implemented a first ;; shot at doing this via a C built-in backward-syntactic-ws. This ;; has been obsoleted in future Lemacsen and in FSF19 (defun c++-fast-backward-syntactic-ws-1 (&optional lim) "Skip backwards over syntactic whitespace. Syntactic whitespace is defined as lexical whitespace, C and C++ style comments, and preprocessor directives. Search no farther back than optional LIM. If LIM is omitted, `beginning-of-defun' is used." (save-restriction (let ((parse-sexp-ignore-comments t) donep boi char (lim (or lim (c++-point 'bod)))) (if (< lim (point)) (unwind-protect (progn (narrow-to-region lim (point)) ;; cpp statements are comments for our purposes here (if (eq major-mode 'c++-mode) (modify-syntax-entry ?# "< b" c++-mode-syntax-table) (modify-syntax-entry ?\n "> b" c++-c-mode-syntax-table) (modify-syntax-entry ?# "< b" c++-c-mode-syntax-table)) (while (not donep) ;; if you're not running a patched lemacs, the new byte ;; compiler will complain about this function. ignore that (backward-syntactic-ws) (if (not (looking-at "#\\|/\\*\\|//\\|\n")) (forward-char 1)) (setq boi (c++-point 'boi) char (char-after boi)) (if (and char (= char ?#)) (progn (goto-char boi) (setq donep (<= (point) lim))) (setq donep t)) )) ;; cpp statements are not comments anywhere else. (if (eq major-mode 'c++-mode) (modify-syntax-entry ?# "." c++-mode-syntax-table) (modify-syntax-entry ?\n " " c++-c-mode-syntax-table) (modify-syntax-entry ?# "." c++-c-mode-syntax-table)))) ))) ;; This is the way it should be done for all post 19.7 Lemacsen and ;; for all FSF19 implementations (defun c++-fast-backward-syntactic-ws-2 (&optional lim) "Skip backwards over syntactic whitespace. Syntactic whitespace is defined as lexical whitespace, C and C++ style comments, and preprocessor directives. Search no farther back than optional LIM. If LIM is omitted, `beginning-of-defun' is used." (save-restriction (let* ((lim (or lim (c++-point 'bod))) (here lim)) (if (< lim (point)) (unwind-protect (progn (narrow-to-region lim (point)) ;; cpp statements are comments for our purposes here (if (eq major-mode 'c++-mode) (modify-syntax-entry ?# "< b" c++-mode-syntax-table) (modify-syntax-entry ?\n "> b" c++-c-mode-syntax-table) (modify-syntax-entry ?# "< b" c++-c-mode-syntax-table)) (while (/= here (point)) (setq here (point)) (forward-comment -1))) ;; cpp statements are not comments everywhere else (if (eq major-mode 'c++-mode) (modify-syntax-entry ?# "." c++-mode-syntax-table) (modify-syntax-entry ?\n " " c++-c-mode-syntax-table) (modify-syntax-entry ?# "." c++-c-mode-syntax-table)))) ))) ;; This is the slow and ugly way, but its the best we can do in ;; vanilla GNU18 emacsen (defun c++-in-literal (&optional lim) "Determine if point is in a C++ \"literal\". 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, `c++-beginning-of-defun' is used." (save-excursion (let* ((here (point)) (state nil) (match nil) (backlim (or lim (c++-point 'bod)))) (goto-char backlim) (while (< (point) here) (setq match (and (re-search-forward "\\(/[/*]\\)\\|[\"']\\|\\(^[ \t]*#\\)" here 'move) (buffer-substring (match-beginning 0) (match-end 0)))) (setq state (cond ;; no match ((null match) nil) ;; looking at the opening of a C++ style comment ((string= "//" match) (if (<= here (progn (end-of-line) (point))) 'c++)) ;; looking at the opening of a C block comment ((string= "/*" match) (if (not (re-search-forward "*/" here 'move)) 'c)) ;; looking at the opening of a double quote string ((string= "\"" match) (if (not (save-restriction ;; this seems to be necessary since the ;; re-search-forward will not work without it (narrow-to-region (point) here) (re-search-forward ;; this regexp matches a double quote ;; which is preceded by an even number ;; of backslashes, including zero "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) 'string)) ;; looking at the opening of a single quote string ((string= "'" match) (if (not (save-restriction ;; see comments from above (narrow-to-region (point) here) (re-search-forward ;; this matches a single quote which is ;; preceded by zero or two backslashes. "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" here 'move))) 'string)) ((string-match "[ \t]*#" match) (if (<= here (progn (end-of-line) (point))) 'pound)) (t nil))) ) ; end-while state))) ;; This is for all 8-bit emacsen (Lucid 19, patched GNU18) (defun c++-in-literal-8-bit (&optional lim) "Determine if point is in a C++ \"literal\". 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, `c++-beginning-of-defun' is used." (save-excursion (let* ((backlim (or lim (c++-point 'bod))) (here (point)) (parse-sexp-ignore-comments t) ; may not be necessary (state (parse-partial-sexp backlim (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))))) ;; This is for all 1-bit emacsen (FSF19) (defun c++-in-literal-1-bit (&optional lim) "Determine if point is in a C++ \"literal\". 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, `c++-beginning-of-defun' is used." (save-excursion (let* ((backlim (or lim (c++-point 'bod))) (here (point)) (parse-sexp-ignore-comments t) ; may not be necessary (state (parse-partial-sexp backlim (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))))) (cond ((memq 'old-v19 c++-emacs-features) (fset 'c++-backward-syntactic-ws 'c++-fast-backward-syntactic-ws-1)) ((memq 'v19 c++-emacs-features) (fset 'c++-backward-syntactic-ws 'c++-fast-backward-syntactic-ws-2)) ) (cond ((memq '8-bit c++-emacs-features) (fset 'c++-in-literal 'c++-in-literal-8-bit)) ((memq '1-bit c++-emacs-features) (fset 'c++-in-literal 'c++-in-literal-1-bit)) ) ;; ====================================================================== ;; defuns for parsing syntactic elements ;; ====================================================================== (defun c++-parse-state (&optional limit) "Determinate the syntactic state of the code at point. Iteratively uses `parse-partial-sexp' from point to LIMIT and returns the result of `parse-partial-sexp' at point. LIMIT is optional and defaults to `point-max'." (let ((limit (or limit (point-max))) (parse-sexp-ignore-comments t) state) (while (< (point) limit) (setq state (parse-partial-sexp (point) limit 0))) state)) (defun c++-at-top-level-p (wrt &optional bod) "Return t if point is not inside a containing C++ expression, nil if it is embedded in an expression. When WRT is non-nil, returns nil if not at the top level with respect to an enclosing class, or the depth of class nesting at point. With WRT nil, returns nil if not at the \"real\" top level. Optional BOD is the beginning of defun." (save-excursion (let ((indent-point (point)) (case-fold-search nil) state containing-sexp paren-depth (bod (or bod (c++-point 'bod))) foundp) (goto-char bod) (setq state (c++-parse-state indent-point) containing-sexp (nth 1 state) paren-depth (nth 0 state)) (cond ((eq major-mode 'c++-c-mode) (and (null containing-sexp) 0)) ((not wrt) (null containing-sexp)) ((null containing-sexp) 0) ((c++-in-parens-p) nil) (t ;; calculate depth wrt containing (possibly nested) classes (goto-char containing-sexp) (while (and (setq foundp (re-search-backward (concat "[;}]\\|" c++-class-key) (point-min) t)) (let ((bod (c++-point 'bod))) (or (c++-in-literal bod) (c++-in-parens-p bod) ;; see if class key is inside a template spec (and (looking-at c++-class-key) (progn (skip-chars-backward " \t\n") (memq (preceding-char) '(?, ?<)))))))) (if (memq (following-char) '(?} ?\;)) nil (setq state (c++-parse-state containing-sexp)) (and foundp (not (nth 1 state)) (nth 2 state) paren-depth)) ))))) (defun c++-in-parens-p (&optional lim) "Return t if inside a paren expression. Optional LIM is used as the backward limit of the search." (let ((lim (or lim (c++-point 'bod)))) (condition-case var (save-excursion (save-restriction (narrow-to-region (point) lim) (goto-char (point-max)) (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\())) (error nil) ))) (defun c++-in-function-p (&optional containing) "Return t if inside a C++ function definition. Optional CONTAINING is position of containing s-exp open brace. If not supplied, point is used as search start." (save-excursion (let ((here (if (not containing) (point) (goto-char containing) (c++-backward-syntactic-ws) (point)))) (if (and (= (preceding-char) ?t) (forward-word -1) (looking-at "\\")) (c++-backward-syntactic-ws) (goto-char here)) (= (preceding-char) ?\))))) ;; ====================================================================== ;; defuns for calculating indentation ;; ====================================================================== (defun c++-indent-line (&optional bod) "Indent current line as C++ code. Return the amount the indentation changed by. Optional BOD is the point of the beginning of the C++ definition." (let* ((bod (or bod (c++-point 'bod))) (indent (c++-calculate-indent nil bod)) beg shift-amt close-paren top-close-paren (case-fold-search nil) (pos (- (point-max) (point)))) ;; calculate block close paren offset (if (listp c++-block-close-brace-offset) (setq close-paren (car c++-block-close-brace-offset) top-close-paren (cdr c++-block-close-brace-offset)) (setq close-paren c++-block-close-brace-offset top-close-paren c++-block-close-brace-offset)) ;; now start cleanup (beginning-of-line) (setq beg (point)) (cond ((eq indent nil) (setq indent (current-indentation))) ((eq indent t) (setq indent (c++-calculate-c-indent-within-comment))) ((looking-at "[ \t]*#") (setq indent 0)) ((save-excursion (back-to-indentation) (looking-at "//\\|/\\*")) ;; we've found a comment-only line. we now must try to determine ;; if the line is a continuation from a comment on the previous ;; line. we check to see if the comment starts in or to the ;; right of comment-column and if so, we don't change its ;; indentation. (skip-chars-forward " \t") (if (>= (current-column) comment-column) (setq indent (current-column)) (setq indent (c++-comment-offset (bolp) indent)))) (t (skip-chars-forward " \t") (if (listp indent) (setq indent (car indent))) (cond ((looking-at c++-access-key) (setq indent (+ indent c++-access-specifier-offset))) ((looking-at "default[ \t]*:") (setq indent (+ indent c-label-offset))) ((or (looking-at "case[ \t]+.*:") (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) (back-to-indentation) (skip-chars-forward "{ \t") (current-column)))) ((looking-at "\\") (setq indent (+ indent c++-friend-offset))) ((and (= (following-char) ?\)) c++-paren-as-block-close-p) (setq indent (+ (- indent c-indent-level) (if (save-excursion (forward-char 1) (c++-at-top-level-p nil bod)) top-close-paren close-paren)))) ((= (following-char) ?}) (setq indent (+ (- indent c-indent-level) (if (save-excursion (forward-char 1) (c++-at-top-level-p nil bod)) top-close-paren close-paren)))) ((= (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)))) ;; save-excursion is necessary because things break if the hook ;; changes point or mark (save-excursion (run-hooks 'c++-special-indent-hook)) shift-amt)) (defun c++-cont-indent (ipnt char lim) "Calculate the indentation for a continued statement. IPNT is the indentation point; CHAR is the character before the indentation point, excluding any intervening whitespace; LIM is the minimum point to search backwards to." (let ((charlist '(nil ?\000 ?\, ?\; ?\} ?\: ?\{)) streamop-pos here) (goto-char ipnt) (c++-backward-syntactic-ws lim) (if (not (memq char charlist)) ;; This line is continuation of preceding line's statement (progn (c-backward-to-start-of-continued-exp lim) ;; take care of << and >> while in streams (setq here (point)) (if (save-excursion (and (progn (goto-char ipnt) (looking-at "[ \t]*\\(<<\\|>>\\)")) (progn (goto-char here) (skip-chars-forward "^><\n") (setq streamop-pos (current-column)) (looking-at "\\(<<\\|>>\\)")))) streamop-pos (+ (current-column) ;; prevent repeated continued indentation (if (save-excursion (beginning-of-line 1) (c++-backward-syntactic-ws lim) (memq (preceding-char) charlist)) c-continued-statement-offset ;; the following statements *do* indent even ;; for single statements (are there others?) (if (looking-at "\\(do\\|else\\|for\\|if\\|while\\)\\b") c-continued-statement-offset ;; else may be a continued statement inside ;; a simple for/else/while/if/do loop (beginning-of-line 1) (forward-char -1) (c++-backward-syntactic-ws lim) (c-backward-to-start-of-continued-exp lim) (if (looking-at "\\(do\\|else\\|for\\|if\\|while\\)\\b") c-continued-statement-offset 0))) (save-excursion (goto-char ipnt) (skip-chars-forward " \t") (cond ((= (following-char) ?\{) c-continued-brace-offset) ((and (= (following-char) ?\}) (progn (forward-char 1) (c++-at-top-level-p nil lim))) (- c-continued-statement-offset)) (t 0)))))) nil))) (defun c++-calculate-indent (&optional parse-start bod) "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. Optional PARSE-START is the location to start parsing, and optional BOD is the beginning of the C++ definition." (save-excursion (beginning-of-line) (let ((indent-point (point)) (case-fold-search nil) state do-indentation literal in-meminit-p containing-sexp streamop-pos char-before-ip (inclass-shift 0) inclass-depth inclass-unshift (bod (or bod (c++-point 'bod)))) (if parse-start (goto-char parse-start) (goto-char bod)) (setq parse-start (point) state (c++-parse-state indent-point) containing-sexp (nth 1 state)) ;; it is possible that c++-defun-header-weak could not find the ;; beginning of the C++ definition. The following code attempts ;; to work around this. It is probably better to just use ;; c++-match-header-strongly, but there are performance questions (if (null state) (let* ((c++-match-header-strongly t) (bod (c++-point 'bod))) (goto-char bod) (setq state (c++-parse-state indent-point) containing-sexp (nth 1 state) parse-start (point)))) (setq literal (c++-in-literal bod)) ;; cache char before indent point (save-excursion (goto-char indent-point) (c++-backward-syntactic-ws bod) (setq char-before-ip (preceding-char))) (cond ;; CASE 1: in a string. ((memq literal '(string)) nil) ;; CASE 2: in a C or C++ style comment. ((memq literal '(c c++)) t) ;; CASE 3: Line is at top level. May be comment-only line, ;; 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 ends with a closeparen ;; (closebrace), optional spaces, and a semicolon, in ;; which case this line follows a multiline function ;; declaration (class definition), or ;; ;; 3. 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. ;; ((setq inclass-depth (c++-at-top-level-p t bod)) (+ ;; add an offset if we are inside a class defun body, i.e. we ;; are at the top level, but only wrt a containing class (let ((shift/level (+ c-indent-level c-brace-imaginary-offset))) (setq inclass-shift (* shift/level inclass-depth) inclass-unshift (* shift/level (max 0 (1- inclass-depth)))) inclass-shift) (progn (goto-char indent-point) (skip-chars-forward " \t") (cond ;; ((or (= (following-char) ?{) (progn (c++-backward-syntactic-ws parse-start) (bobp))) 0) ;; first arg decl or member init ((c++-in-function-p) (goto-char indent-point) (skip-chars-forward " \t") (if (= (following-char) ?:) c++-member-init-indent c-argdecl-indent)) ;; ((progn (if (= (preceding-char) ?\;) (progn (backward-char 1) (skip-chars-backward " \t"))) ;; may be first line after a hanging member init colon. ;; check to be sure its not a scope operator meaning we ;; are inside a member def (or (= (preceding-char) ?:) (save-excursion (forward-line 1) (skip-chars-forward " \t") (or (eobp) (forward-char 1)) (and (= (preceding-char) ?:) (/= (following-char) ?:))) (save-excursion (and (= (preceding-char) ?,) (let ((bol (c++-point 'bol))) (skip-chars-backward "^:" bol) (= (preceding-char) ?:)) (not (c++-in-parens-p)) (progn (forward-char -1) (skip-chars-backward " \t") (not (bolp))) ;; make sure its not a multiple inheritance ;; continuation line (progn (beginning-of-line) (not (looking-at c++-inher-key))) )))) ;; check to see if we're looking at a member init, or ;; access specifier (if (progn (beginning-of-line) (skip-chars-forward " \t") (looking-at c++-access-key)) ;; access specifier. class defun opening brace may ;; not be in col zero, and derived classes could be ;; on a separate line than class intro (progn (goto-char (or containing-sexp bod)) (beginning-of-line) (skip-chars-forward " \t") (if (looking-at ":[ \t]*\\<\\(public\\|protected\\|private\\)\\>") (forward-line -1)) (- (current-indentation) ;; remove some nested inclass indentation inclass-unshift)) ;; member init, so add offset. add additional offset if ;; looking at line with just a member init colon (+ c++-member-init-indent (if (looking-at ":[ \t]*$") (or c++-continued-member-init-offset 0) 0)))) ((or (= (preceding-char) ?}) (= (preceding-char) ?\)) (save-excursion (beginning-of-line) (looking-at "[ \t]*\\"))) ;; indentation of class defun opening brace may not be ;; zero (goto-char (or containing-sexp bod)) (- (current-indentation) ;; remove some nested inclass indentation inclass-unshift)) ;; cont arg decls or member inits. we might be inside a ;; K&R C arg decl ((save-excursion (while (and (< bod (point)) (memq (preceding-char) '(?\, ?\;))) (beginning-of-line) (c++-backward-syntactic-ws bod)) (and (eq major-mode 'c++-c-mode) (= (preceding-char) ?\)))) (+ c-argdecl-indent (progn (goto-char indent-point) (c++-backward-syntactic-ws bod) (if (= (preceding-char) ?,) c-continued-statement-offset 0)))) ((progn (beginning-of-line) (skip-chars-forward " \t") (or (memq (c++-in-literal bod) '(c c++)) (looking-at "/[/*]"))) 0) ;; are we looking at the first member init? ((and (= (following-char) ?:) (save-excursion (c++-backward-syntactic-ws bod) (= (preceding-char) ?\)))) (if c++-continued-member-init-offset (+ (current-indentation) c++-continued-member-init-offset) (progn (forward-char 1) (skip-chars-forward " \t") (- (current-column) inclass-shift)))) ;; else first check to see if its a multiple inheritance ;; continuation line, but not a K&R C arg decl ((and (not (eq major-mode 'c++-c-mode)) (looking-at c++-inher-key)) (if (= char-before-ip ?,) (progn (goto-char (match-end 0)) (current-column)) ;; nope, its probably a nested class 0)) ;; we might be looking at the opening brace of a class ;; defun ((= (following-char) ?\{) ;; indentation of opening brace may not be zero (- (current-indentation) ;; remove some nested inclass indentation inclass-unshift)) ((eolp) ;; looking at a blank line, indent next line to zero 0) ;; at beginning of buffer, if nothing else, indent to zero ((save-excursion (goto-char indent-point) (beginning-of-line) (bobp)) 0) ;; this could be a compound statement, but make sure its ;; not a member init list ((save-excursion (goto-char indent-point) (c++-backward-syntactic-ws bod) (and (= (preceding-char) ?,) (save-excursion (while (and (< bod (point)) (= (preceding-char) ?,)) (beginning-of-line) (c++-backward-syntactic-ws bod)) (forward-line 1) (not (setq in-meminit-p (looking-at "[ \t]*:")))))) c-continued-statement-offset) (t (if (c++-in-parens-p) ;; we are perhaps inside a member init call (while (and (c++-in-parens-p) (< bod (point))) (forward-line -1) (skip-chars-forward " \t"))) ;; check to be sure that we're not on the first line of ;; the member init list (if (and (= (following-char) ?:) (save-excursion (c++-backward-syntactic-ws bod) (= (preceding-char) ?\)))) (progn (forward-char 1) (skip-chars-forward " \t"))) ;; skip to start of compound statement, but only if we're ;; not in a member initialization list (if (not in-meminit-p) (let ((ipnt (point))) (c++-backward-syntactic-ws bod) (while (and (= (preceding-char) ?,) (< bod (point))) (beginning-of-line) (skip-chars-forward " \t") (setq ipnt (point)) (c++-backward-syntactic-ws bod)) (goto-char ipnt))) ;; subtract inclass-shift since its already incorporated ;; by default in current-column (- (current-column) inclass-shift) ))))) ;; CASE 4: 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. ((/= (char-after containing-sexp) ?{) (if (and c++-empty-arglist-indent (or c++-always-arglist-indent-p (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)) (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)) ;; We want to skip any whitespace b/w open paren and ;; first argument. this handles while (thing) style ;; and while( thing ) style (skip-chars-forward " \t") (current-column))) ;; CASE 5: Statement. Find previous non-comment character. (t (or (c++-cont-indent indent-point char-before-ip containing-sexp) ;; This line may start a new statement, or it could ;; represent the while closure of a do/while construct (if (save-excursion (and (progn (goto-char indent-point) (skip-chars-forward " \t\n") (looking-at "while\\b")) (progn (c++-backward-to-start-of-do containing-sexp) (looking-at "do\\b")) (setq do-indentation (current-column)))) do-indentation ;; this could be a case statement. if so we want to ;; indent it like the first case statement after a switch (if (save-excursion (goto-char indent-point) (skip-chars-forward " \t\n") (looking-at "\\(case[ \t]+.*\\|default[ \t]*\\):")) (progn (goto-char containing-sexp) (back-to-indentation) (+ (current-column) c-indent-level)) ;; else, this is the start of a new statement ;; Position following last unclosed open. (goto-char containing-sexp) ;; Is line first statement after an open-brace? (or (and c++-relative-offset-p ;; If no, find that first statement and ;; indent like it. (save-excursion (forward-char 1) (while (progn (skip-chars-forward " \t\n") (looking-at (concat "#\\|/\\*\\|//" "\\|\\(case[ \t]+.*\\|default[ \t]*\\):" "\\|[a-zA-Z0-9_$]*:[^:]" "\\|friend[ \t]" c++-class-key "[ \t]"))) ;; Skip over comments and labels ;; following openbrace. (cond ((= (following-char) ?\#) (forward-line 1)) ((looking-at "/\\*") (search-forward "*/" nil 'move)) ((looking-at (concat "//\\|friend[ \t]" c++-class-key "[ \t]")) (forward-line 1)) ((looking-at "\\(case[ \t]+.*\\|default[ \t]*\\):") (forward-line 1)) (t (re-search-forward ":[^:]" nil 'move)))) ;; The first following code counts ;; if it is before the line we want to indent. (and (< (point) indent-point) (+ (current-column) (c++-compound-offset char-before-ip containing-sexp bod))))) ;; 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)))))))) ; end t outer cond )))) (defun c++-calculate-c-indent-within-comment () "Return the indentation amount for line, assuming that the current line is to be regarded as part of a block comment." (let (end stars indent) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (setq stars (if (looking-at "\\*\\*?") (- (match-end 0) (match-beginning 0)) 0)) (skip-chars-backward " \t\n") (setq end (point)) (beginning-of-line) (skip-chars-forward " \t") (if (re-search-forward "/\\*[ \t]*" end t) (goto-char (+ (match-beginning 0) (cond (c++-C-block-comments-indent-p 0) ((= stars 1) 1) ((= stars 2) 0) (t (- (match-end 0) (match-beginning 0))))))) (current-column)))) (defun c++-comment-offset (col0-line-p indent) "Calculates and returns the comment-only line offset. Offset is based on the value of `c++-comment-only-line-offset', the argument COL0-LINE-P, and the current indentation INDENT." (let ((offset 0)) (if col0-line-p ;; col0 means we need to look at the second member of the var's ;; list value. if value is not a list, then zero is used (if (listp c++-comment-only-line-offset) ;; it is a list, so second element must be nil or a number (setq offset (+ indent (or (car (cdr c++-comment-only-line-offset)) (car c++-comment-only-line-offset))))) ;; not in column zero so indentation is car or value of variable (setq offset (+ indent (if (listp c++-comment-only-line-offset) (car c++-comment-only-line-offset) c++-comment-only-line-offset)))) offset)) (defun c++-compound-offset (char-before-ip containing-sexp bod) "Calculates any addition offset due a comma separated compound statement. CHAR-BEFORE-IP is the character before the indentation point and CONTAINING-SEXP is the buffer position of the open brace or paren. BOD is the `beginning-of-defun' point." (cond ;; not a compound statement ((/= char-before-ip ?,) 0) ;; open brace could be at column zero == bod ((and (= containing-sexp bod) (or (let ((lim (progn (goto-char containing-sexp) (forward-line -1) (point)))) (end-of-line) (c++-backward-syntactic-ws lim) (= (preceding-char) ?=)) (progn (beginning-of-line) (looking-at "\\(^\\|[ \t]*\\)enum[ \t]")) )) 0) ;; check for inside an enum ((let ((parse-sexp-ignore-comments t) in-enum-p) (goto-char containing-sexp) (while (< bod (point)) (c++-backward-syntactic-ws) (if (memq (preceding-char) '(?\) ?\" ?\; ?\})) (goto-char bod) (forward-sexp -1) (if (looking-at "\\(enum[ \t\n]\\|\\[.*\\]\\)") (progn (goto-char bod) (setq in-enum-p t))))) in-enum-p) 0) ;; assume we're not in a list of enums or static array elems (t c-continued-statement-offset) )) ;; ====================================================================== ;; defuns to look backwards for things ;; ====================================================================== (defun c++-backward-to-start-of-do (&optional limit) "Move to the start of the last \"unbalanced\" do." (let ((do-level 1) (case-fold-search nil) (limit (or limit (c++-point 'bod)))) (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 err (progn (backward-sexp 1) (cond ((memq (c++-in-literal limit) '(c c++))) ((looking-at "while\\b") (setq do-level (1+ do-level))) ((looking-at "do\\b") (setq do-level (1- do-level))) ((< (point) limit) (setq do-level 0) (goto-char limit)))) (error (goto-char limit) (setq do-level 0)))))) (defun c++-backward-to-start-of-if (&optional limit) "Move to the start of the last \"unbalanced\" if." (let ((if-level 1) (case-fold-search nil) (limit (or limit (c++-point 'bod)))) (while (and (not (bobp)) (not (zerop if-level))) (c++-backward-syntactic-ws) (c++-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 c++-auto-newline () "Insert a newline iff we're not in a literal. Literals are defined as being inside a C or C++ style comment or open string according to mode's syntax." (let ((bod (c++-point 'bod))) (and c++-auto-newline (not (c++-in-literal bod)) (not (newline))))) (defun 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 This function does not modify point or mark." (let ((here (point)) bufpos) (cond ((eq position 'bol) (beginning-of-line)) ((eq position 'eol) (end-of-line)) ((eq position 'bod) (c++-beginning-of-defun)) ((eq position 'boi) (back-to-indentation)) ) (setq bufpos (point)) (goto-char here) bufpos)) ;; ====================================================================== ;; defuns for "macroizations" -- making C++ parameterized types via macros ;; ====================================================================== (defun c++-macroize-region (from to arg) "Insert backslashes at end of every line in region. Useful for defining cpp macros. If called with a prefix argument, it will remove trailing backslashes." (interactive "r\nP") (save-excursion (goto-char from) (beginning-of-line 1) (let ((line (count-lines (point-min) (point))) (to-line (save-excursion (goto-char to) (count-lines (point-min) (point))))) (while (< line to-line) (c++-backslashify-current-line (null arg)) (forward-line 1) (setq line (1+ line)))))) (defun c++-backslashify-current-line (doit) "Backslashifies current line." (end-of-line 1) (cond (doit ;; Note that "\\\\" is needed to get one backslash. (if (not (save-excursion (forward-char -1) (looking-at "\\\\"))) (progn (if (>= (current-column) c++-default-macroize-column) (insert " \\") (while (<= (current-column) c++-default-macroize-column) (insert "\t") (end-of-line)) (delete-char -1) (while (< (current-column) c++-default-macroize-column) (insert " ") (end-of-line)) (insert "\\"))))) (t (forward-char -1) (if (looking-at "\\\\") (progn (skip-chars-backward " \t") (kill-line)))))) ;; ====================================================================== ;; defuns for commenting out multiple lines. ;; ====================================================================== (defun c++-comment-region (beg end) "Comment out all lines in a region between mark and current point by inserting `comment-start' in front of each line." (interactive "*r") (save-excursion (save-restriction (narrow-to-region (progn (goto-char beg) (beginning-of-line) (point)) (progn (goto-char end) (or (bolp) (forward-line 1)) (point))) (goto-char (point-min)) (while (not (eobp)) (insert comment-start) (forward-line 1)) (if (eq major-mode 'c++-c-mode) (insert comment-end))))) (defun c++-uncomment-region (beg end) "Uncomment all lines in region between mark and current point by deleting the leading `// ' from each line, if any." (interactive "*r") (save-excursion (save-restriction (narrow-to-region (progn (goto-char beg) (beginning-of-line) (point)) (progn (goto-char end) (forward-line 1) (point))) (goto-char (point-min)) (let ((comment-regexp (if (eq major-mode 'c++-c-mode) (concat "\\s *\\(" (regexp-quote comment-start) "\\|" (regexp-quote comment-end) "\\)") (concat "\\s *" (regexp-quote comment-start))))) (while (not (eobp)) (if (looking-at comment-regexp) (delete-region (match-beginning 0) (match-end 0))) (forward-line 1)))))) ;; ====================================================================== ;; grammar parsing ;; ====================================================================== ;;; 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\\|union\\|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\\|protected\\|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 definition.") ;; 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 definition.") (defun c++-beginning-of-defun (&optional arg) "Find the beginning of the C++ function or class." (interactive "p") (if (not arg) (setq arg 1)) (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) "Find the end of the C++ function or class." (interactive "p") (let ((c++-defun-header (if c++-match-header-strongly c++-defun-header-strong c++-defun-header-weak)) (parse-sexp-ignore-comments t)) (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 def, struct or class declaration." (interactive) (let ((restore (point))) (c++-end-of-defun 1) (beginning-of-line 1) (let ((end (point-marker))) (c++-beginning-of-defun) (while (and (< (point) end)) (c++-indent-line) (forward-line 1) (beginning-of-line 1)) (set-marker end nil)) (goto-char restore))) ;; ====================================================================== ;; defuns for submitting bug reports ;; ====================================================================== (defconst c++-version "2.353" "c++-mode version number.") (defconst c++-mode-help-address "c++-mode-help@anthem.nlm.nih.gov" "Address accepting submission of bug reports.") (defun c++-version () "Echo the current version of c++-mode." (interactive) (message "Using c++-mode.el %s" c++-version)) (defun c++-submit-bug-report () "Submit via mail a bug report on c++-mode." (interactive) (require 'reporter) (and (y-or-n-p "Do you want to submit a report on c++-mode? ") (reporter-submit-bug-report c++-mode-help-address (concat "c++-mode.el " c++-version " (editing " (if (eq major-mode 'c++-mode) "C++" "C") " code)") (list 'c++-emacs-features 'c++-C-block-comments-indent-p 'c++-access-specifier-offset 'c++-always-arglist-indent-p 'c++-auto-hungry-initial-state 'c++-auto-hungry-toggle 'c++-auto-newline 'c++-backscan-limit 'c++-block-close-brace-offset 'c++-cleanup-list 'c++-comment-only-line-offset 'c++-continued-member-init-offset 'c++-default-macroize-column 'c++-defun-header-strong-struct-equivs 'c++-delete-function 'c++-electric-pound-behavior 'c++-empty-arglist-indent 'c++-friend-offset 'c++-hanging-braces 'c++-hanging-member-init-colon 'c++-hungry-delete-key 'c++-match-header-strongly 'c++-member-init-indent 'c++-paren-as-block-close-p 'c++-relative-offset-p 'c++-tab-always-indent 'c++-untame-characters 'c-argdecl-indent 'c-brace-imaginary-offset 'c-brace-offset 'c-continued-brace-offset 'c-continued-statement-offset 'c-indent-level 'c-label-offset 'tab-width ) (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") ))) ))) ;; this is sometimes useful (provide 'c++-mode) ;;; cplus-md1.el ends here emacs-19.22/lisp/cust-print.el100444 13437 1 46434 5405343711 14673 0ustar jimbdaemon;;; cust-print.el --- handles print-level and print-circle. ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte ;; Version: 1.0 ;; 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: ;; 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 untrappable error in Emacs version 18. Version ;; 19 will support print-level, but it is often useful to get a better ;; print representation of circular structures; the print-circle ;; option may be used to print more concise representations. ;; There are two main ways to use this package. First, you may ;; replace prin1, princ, and some subroutines that use them by calling ;; install-custom-print-funcs so that any use of these functions in ;; lisp code will be affected. Second, 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, evaluating (aref circ-list 0), which calls error ;; directly (because circ-list is not an array), will jump to the top ;; level instead of printing the circular list. ;; Obviously the right way to implement this custom-print facility ;; is in C. Please volunteer since I don't have the time or need. ;; 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. ;;========================================================= ;; export list: ;; print-level ;; print-circle ;; custom-print-list ;; custom-print-vector ;; add-custom-print-list ;; add-custom-print-vector ;; install-custom-print-funcs ;; uninstall-custom-print-funcs ;; custom-prin1 ;; custom-princ ;; custom-prin1-to-string ;; custom-print ;; custom-format ;; custom-message ;; custom-error ;;; Code: (provide 'custom-print) ;;(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 untrappable 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 untrappable 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. Currently, there is no way to read this representation in Emacs.") (defconst custom-print-list nil ;; e.g. '((floatp . float-to-string)) "An alist for custom printing of lists. Pairs are of the form (PRED . CONVERTER). If PREDICATE is true for an object, then CONVERTER is called with the object and should return a string to be printed with `princ'. Also see `custom-print-vector'.") (defconst custom-print-vector nil "An alist for custom printing of vectors. Pairs are of the form (PRED . CONVERTER). If PREDICATE is true for an object, then CONVERTER is called with the object and should return a string to be printed with `princ'. Also see `custom-print-list'.") (defun add-custom-print-list (pred converter) "Add a pair of PREDICATE and CONVERTER to `custom-print-list'. Any pair that has the same PREDICATE is first removed." (setq custom-print-list (cons (cons pred converter) (delq (assq pred custom-print-list) custom-print-list)))) ;; e.g. (add-custom-print-list 'floatp 'float-to-string) (defun add-custom-print-vector (pred converter) "Add a pair of PREDICATE and CONVERTER to `custom-print-vector'. Any pair that has the same PREDICATE is first removed." (setq custom-print-vector (cons (cons pred converter) (delq (assq pred custom-print-vector) custom-print-vector)))) ;;==================================================== ;; Saving and restoring internal printing routines. (defun cust-print-set-function-cell (symbol-pair) (defalias (car symbol-pair) (symbol-function (car (cdr symbol-pair))))) (if (not (fboundp 'cust-print-internal-prin1)) (mapcar 'cust-print-set-function-cell '((cust-print-internal-prin1 prin1) (cust-print-internal-princ princ) (cust-print-internal-print print) (cust-print-internal-prin1-to-string prin1-to-string) (cust-print-internal-format format) (cust-print-internal-message message) (cust-print-internal-error error)))) (defun install-custom-print-funcs () "Replace print functions with general, customizable, Lisp versions. The internal subroutines are saved away, and you can reinstall them by running `uninstall-custom-print-funcs'." (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) ))) (defun uninstall-custom-print-funcs () "Reset print functions to their internal subroutines." (interactive) (mapcar 'cust-print-set-function-cell '((prin1 cust-print-internal-prin1) (princ cust-print-internal-princ) (print cust-print-internal-print) (prin1-to-string cust-print-internal-prin1-to-string) (format cust-print-internal-format) (message cust-print-internal-message) (error cust-print-internal-error) ))) ;;=============================================================== ;; Lisp replacements for prin1 and princ and for subrs that use prin1 ;; (or princ) -- so far only the printing and formatting subrs. (defun custom-prin1 (object &optional stream) "Replacement for standard `prin1'. Uses the appropriate printer depending on the values of `print-level' and `print-circle' (which see). 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)." (cust-print-top-level object stream 'cust-print-internal-prin1)) (defun custom-princ (object &optional stream) "Same as `custom-prin1' except no quoting." (cust-print-top-level object stream 'cust-print-internal-princ)) (defvar custom-prin1-chars) (defun custom-prin1-to-string-func (c) "Stream function for `custom-prin1-to-string'." (setq custom-prin1-chars (cons c custom-prin1-chars))) (defun custom-prin1-to-string (object) "Replacement for standard `prin1-to-string'." (let ((custom-prin1-chars nil)) (custom-prin1 object 'custom-prin1-to-string-func) (concat (nreverse custom-prin1-chars)))) (defun custom-print (object &optional stream) "Replacement for standard `print'." (cust-print-internal-princ "\n") (custom-prin1 object stream) (cust-print-internal-princ "\n")) (defun custom-format (fmt &rest args) "Replacement for standard `format'. Calls format after first making strings for list or vector 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-internal-format fmt (mapcar (function (lambda (arg) (if (or (listp arg) (vectorp arg)) (custom-prin1-to-string arg) arg))) args))) (defun custom-message (fmt &rest args) "Replacement for standard `message' that works like `custom-format'." ;; It doesn't work to princ the result of custom-format ;; because the echo area requires special handling ;; to avoid duplicating the output. cust-print-internal-message does it right. ;; (cust-print-internal-princ (apply 'custom-format fmt args)) (apply 'cust-print-internal-message fmt (mapcar (function (lambda (arg) (if (or (listp arg) (vectorp arg)) (custom-prin1-to-string arg) arg))) args))) (defun custom-error (fmt &rest args) "Replacement for standard `error' that uses `custom-format'" (signal 'error (list (apply 'custom-format fmt args)))) ;;========================================= ;; Support for custom prin1 and princ (defvar circle-table) (defvar circle-tree) (defvar circle-level) (defun cust-print-top-level (object stream internal-printer) "Set up for printing." (let ((standard-output (or stream standard-output)) (circle-table (and print-circle (cust-print-preprocess-circle-tree object))) (circle-level (or print-level -1)) ) (defalias 'cust-print-internal-printer internal-printer) (defalias 'cust-print-low-level-prin (cond ((or custom-print-list custom-print-vector print-level ; comment out for version 19 ) 'cust-print-custom-object) (circle-table 'cust-print-object) (t 'cust-print-internal-printer))) (defalias 'cust-print-prin (if circle-table 'cust-print-circular 'cust-print-low-level-prin)) (cust-print-prin object) object)) ;; Test object type and print accordingly. (defun cust-print-object (object) ;; Could be called as either cust-print-low-level-prin or cust-print-prin. (cond ((null object) (cust-print-internal-printer object)) ((consp object) (cust-print-list object)) ((vectorp object) (cust-print-vector object)) ;; All other types, just print. (t (cust-print-internal-printer object)))) ;; Test object type and print accordingly. (defun cust-print-custom-object (object) ;; Could be called as either cust-print-low-level-prin or cust-print-prin. (cond ((null object) (cust-print-internal-printer object)) ((consp object) (or (and custom-print-list (cust-print-custom-object1 object custom-print-list)) (cust-print-list object))) ((vectorp object) (or (and custom-print-vector (cust-print-custom-object1 object custom-print-vector)) (cust-print-vector object))) ;; All other types, just print. (t (cust-print-internal-printer object)))) ;; Helper for cust-print-custom-object. ;; Print the custom OBJECT using the custom type ALIST. ;; For the first predicate that matches the object, the corresponding ;; converter is evaluated with the object and the string that results is ;; printed with princ. Return nil if no predicate matches the object. (defun cust-print-custom-object1 (object alist) (while (and alist (not (funcall (car (car alist)) object))) (setq alist (cdr alist))) ;; If alist is not null, then something matched. (if alist (cust-print-internal-princ (funcall (cdr (car alist)) object) ; returns string ))) (defun cust-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-internal-princ "#") (cust-print-internal-princ id) (cust-print-internal-princ "#")) ;; Not printed yet, so label with id and print object. (setcdr tag (- id)) ; mark it as printed (cust-print-internal-princ "#") (cust-print-internal-princ (- id)) (cust-print-internal-princ "=") (cust-print-low-level-prin object) )) ;; Not repeated in structure. (cust-print-low-level-prin object)))) ;;================================================ ;; List and vector processing for print functions. ;; Print a list using print-length, print-level, and print-circle. (defun cust-print-list (list) (if (= circle-level 0) (cust-print-internal-princ "#") (let ((circle-level (1- circle-level))) (cust-print-internal-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-internal-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-internal-princ ". ") (cust-print-prin list) (setq list nil)) (setq length (1- length)) (if list (cust-print-internal-princ " "))) (if (and list (= length 0)) (cust-print-internal-princ "...")) (cust-print-internal-princ ")")))) list) ;; Print a vector according to print-length, print-level, and print-circle. (defun cust-print-vector (vector) (if (= circle-level 0) (cust-print-internal-princ "#") (let ((circle-level (1- circle-level)) (i 0) (len (length vector))) (cust-print-internal-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-internal-princ " "))) (if (< i (length vector)) (cust-print-internal-princ "...")) (cust-print-internal-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) (symbolp 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. ;;;; 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)) ;;(install-custom-print-funcs) ;;;; (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"))) ;;;; There's no special handling of uninterned symbols in custom-print. ;;(let ((print-circle nil)) ;; (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-funcs) ;;; cust-print.el ends here emacs-19.22/lisp/dabbrev.el100444 12120 1 24542 5407144542 14033 0ustar rmsdaemon;;; dabbrev.el --- dynamic abbreviation package for GNU Emacs. ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. ;; Last-Modified: 16 Mar 1992 ;; Copyright (C) 1985, 1986 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: ; DABBREVS - "Dynamic abbreviations" hack, originally written by Don Morrison ; for Twenex Emacs. Converted to mlisp by Russ Fish. Supports the table ; feature to avoid hitting the same expansion on re-expand, and the search ; size limit variable. Bugs fixed from the Twenex version are flagged by ; comments starting with ;;; . ; ; converted to Emacs Lisp by Spencer Thomas. ; Thoroughly cleaned up by Richard Stallman. ; ; If anyone feels like hacking at it, Bob Keller (Keller@Utah-20) first ; suggested the beast, and has some good ideas for its improvement, but ; doesn't know TECO (the lucky devil...). One thing that should definitely ; be done is adding the ability to search some other buffer(s) if you can?t ; find the expansion you want in the current one. ;;; Code: ;; (defun dabbrevs-help () ;; "Give help about dabbrevs." ;; (interactive) ;; (&info "emacs" "dabbrevs") ; Select the specific info node. ;; ) (defvar dabbrevs-limit nil "*Limits region searched by `dabbrevs-expand' to this many chars away.") (make-variable-buffer-local 'dabbrevs-limit) (defvar dabbrevs-backward-only nil "*If non-NIL, `dabbrevs-expand' only looks backwards.") ; State vars for dabbrevs-re-expand. (defvar last-dabbrevs-table nil "Table of expansions seen so far (local)") (make-variable-buffer-local 'last-dabbrevs-table) (defvar last-dabbrevs-abbreviation "" "Last string we tried to expand (local).") (make-variable-buffer-local 'last-dabbrevs-abbreviation) (defvar last-dabbrevs-direction 0 "Direction of last dabbrevs search (local)") (make-variable-buffer-local 'last-dabbrevs-direction) (defvar last-dabbrevs-abbrev-location nil "Location last abbreviation began (local).") (make-variable-buffer-local 'last-dabbrevs-abbrev-location) (defvar last-dabbrevs-expansion nil "Last expansion of an abbreviation. (local)") (make-variable-buffer-local 'last-dabbrevs-expansion) (defvar last-dabbrevs-expansion-location nil "Location the last expansion was found. (local)") (make-variable-buffer-local 'last-dabbrevs-expansion-location) ;;;###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 `case-fold-search' and `case-replace' are non-nil (usually true) then the substituted word may be case-adjusted to match the abbreviation that you had typed. This takes place if the substituted word, as found, is all lower case, or if it is at the beginning of a sentence and only its first letter was upper case. A positive prefix arg N says to take the Nth backward DISTINCT possibility. A negative argument says search forward. The variable `dabbrev-backward-only' may be used to limit the direction of search to backward if set non-nil. 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." (interactive "*P") (let (abbrev expansion old which loc n pattern (do-case (and case-fold-search case-replace))) ;; 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) ;; loc -- place where expansion is found ;; (to start search there for next expansion if requested later) ;; do-case -- non-nil if should transform case when substituting. (save-excursion (if (and (null arg) (eq last-command this-command) last-dabbrevs-abbrev-location) (progn (setq abbrev last-dabbrevs-abbreviation) (setq old last-dabbrevs-expansion) (setq which last-dabbrevs-direction)) (setq which (if (null arg) (if dabbrevs-backward-only 1 0) (prefix-numeric-value arg))) (setq loc (point)) (forward-word -1) (setq last-dabbrevs-abbrev-location (point)) ; Original location. (setq abbrev (buffer-substring (point) loc)) (setq old abbrev) (setq last-dabbrevs-expansion-location nil) (setq last-dabbrev-table nil)) ; Clear table of things seen. (setq pattern (concat "\\b" (regexp-quote abbrev) "\\(\\sw\\|\\s_\\)+")) ;; Try looking backward unless inhibited. (if (>= which 0) (progn (setq n (max 1 which)) (if last-dabbrevs-expansion-location (goto-char last-dabbrevs-expansion-location)) (while (and (> n 0) (setq expansion (dabbrevs-search pattern t do-case))) (setq loc (point-marker)) (setq last-dabbrev-table (cons expansion last-dabbrev-table)) (setq n (1- n))) (or expansion (setq last-dabbrevs-expansion-location nil)) (setq last-dabbrevs-direction (min 1 which)))) (if (and (<= which 0) (not expansion)) ; Then look forward. (progn (setq n (max 1 (- which))) (if last-dabbrevs-expansion-location (goto-char last-dabbrevs-expansion-location)) (while (and (> n 0) (setq expansion (dabbrevs-search pattern nil do-case))) (setq loc (point-marker)) (setq last-dabbrev-table (cons expansion last-dabbrev-table)) (setq n (1- n))) (setq last-dabbrevs-direction -1)))) (if (not expansion) (let ((first (string= abbrev old))) (setq last-dabbrevs-abbrev-location nil) (if (not first) (progn (undo-boundary) (search-backward old) (if (eq major-mode 'picture-mode) (picture-replace-match abbrev t 'literal) (replace-match abbrev t 'literal)))) (error (if first "No dynamic expansion for \"%s\" found." "No further dynamic expansions for \"%s\" found.") abbrev)) ;; Success: stick it in and return. (undo-boundary) (search-backward old) ;; 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. ;; First put back the original abbreviation with its original ;; case pattern. (save-excursion (if (eq major-mode 'picture-mode) (picture-replace-match abbrev t 'literal) (replace-match abbrev t 'literal))) (search-forward abbrev) (let ((do-case (and do-case (string= (substring expansion 1) (downcase (substring expansion 1)))))) ;; First put back the original abbreviation with its original ;; case pattern. (save-excursion (replace-match abbrev t 'literal)) ;;; This used to be necessary, but no longer, ;;; because now point is preserved correctly above. ;;; (search-forward abbrev) (if (eq major-mode 'picture-mode) (picture-replace-match (if do-case (downcase expansion) expansion) (not do-case) 'literal) (replace-match (if do-case (downcase expansion) expansion) (not do-case) 'literal))) ;; Save state for re-expand. (setq last-dabbrevs-abbreviation abbrev) (setq last-dabbrevs-expansion expansion) (setq last-dabbrevs-expansion-location loc)))) ;;;###autoload (define-key esc-map "/" 'dabbrev-expand) ;; Search function used by dabbrevs library. ;; First arg is string to find as prefix of word. Second arg is ;; t for reverse search, nil for forward. Variable dabbrevs-limit ;; controls the maximum search region size. ;; Table of expansions already seen is examined in buffer last-dabbrev-table, ;; so that only distinct possibilities are found by dabbrevs-re-expand. ;; Note that to prevent finding the abbrev itself it must have been ;; entered in the table. ;; 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. ;; Value is the expansion, or nil if not found. After a successful ;; search, point is left right after the expansion found. (defun dabbrevs-search (pattern reverse ignore-case) (let (missing result (case-fold-search ignore-case)) (save-restriction ; Uses restriction for limited searches. (if dabbrevs-limit (narrow-to-region last-dabbrevs-abbrev-location (+ (point) (* dabbrevs-limit (if reverse -1 1))))) ;; Keep looking for a distinct expansion. (setq result nil) (setq missing nil) (while (and (not result) (not missing)) ; Look for it, leave loop if search fails. (setq missing (not (if reverse (re-search-backward pattern nil t) (re-search-forward pattern nil t)))) (if (not missing) (progn (setq result (buffer-substring (match-beginning 0) (match-end 0))) (let* ((test last-dabbrev-table)) (while (and test (not (if ignore-case (string= (downcase (car test)) (downcase result)) (string= (car test) result)))) (setq test (cdr test))) (if test (setq result nil)))))) ; if already in table, ignore (if result (save-excursion (let ((beg (match-beginning 0))) (goto-char beg) (and ignore-case (string= (substring result 1) (downcase (substring result 1))) (if (string= paragraph-start (concat "^$\\|" page-delimiter)) (and (re-search-backward sentence-end nil t) (= (match-end 0) beg)) (forward-char 1) (backward-sentence) (= (point) beg)) (setq result (downcase result)))))) result))) (provide 'dabbrev) ;;; dabbrev.el ends here emacs-19.22/lisp/debug.el100444 74777 1 30401 5353350016 13651 0ustar ericdaemon;;; debug.el --- debuggers and related commands for Emacs ;; Copyright (C) 1985, 1986 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.") ;;;###autoload (setq debugger 'debug) ;;;###autoload (defun debug (&rest debugger-args) "Enter debugger. Returns if user says \"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." (message "Entering debugger...") (let (debugger-value (debugger-match-data (match-data)) (debug-on-error nil) (debug-on-quit nil) (debugger-buffer (let ((default-major-mode 'fundamental-mode)) (generate-new-buffer "*Backtrace*"))) (debugger-old-buffer (current-buffer)) (debugger-step-after-exit nil) ;; Don't keep reading from an executing kbd macro! (executing-macro nil) (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) (cond ((memq (car debugger-args) '(lambda debug)) (insert "Entering:\n") (if (eq (car debugger-args) 'debug) (progn (backtrace-debug 4 t) (delete-char 1) (insert ?*) (beginning-of-line)))) ((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)) ((eq (car debugger-args) 'error) (insert "Signalling: ") (prin1 (nth 1 debugger-args) (current-buffer)) (insert ?\n)) ((eq (car debugger-args) t) (insert "Beginning evaluation of function call form:\n")) (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)))) ;; So that users do not try to execute debugger commands ;; in an invalid context (kill-buffer debugger-buffer) (store-match-data debugger-match-data)) (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) (interactive "xEval: ") (save-excursion (if (null (buffer-name debugger-old-buffer)) ;; old buffer deleted (setq debugger-old-buffer (current-buffer))) (set-buffer debugger-old-buffer) (eval-expression exp))) (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 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." (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) (setq body (cons (nth 4 contents) 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.")))) ;;; debug.el ends here emacs-19.22/lisp/COPYING100666 12120 24 43070 5475722562 13056 0ustar rmsother 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.22/lisp/delsel.el100444 12120 1 7420 5376707530 13661 0ustar rmsdaemon;;; 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 '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 'yank 'delete-selection t) (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))) (set-buffer-modified-p (buffer-modified-p))) ;No-op, but updates mode line. ;; 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.22/lisp/desktop.el100444 12120 1 30172 5455044244 14074 0ustar rmsdaemon;;; desktop.el --- save partial status of Emacs when killed ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Morten Welinder ;; Version: 2.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. ;;; 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 ;; - truncate-lines ;; - case-fold-search ;; - case-replace ;; - fill-column ;; 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) ;; ;; 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. ;; ;; 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. ;; --------------------------------------------------------------------------- ;; TODO: ;; ;; Save window configuration. ;; Recognize more minor modes. ;; Save mark rings. ;; Start-up with buffer-menu??? ;;; Code: ;; USER OPTIONS -- settings you might want to play with. ;; ---------------------------------------------------------------------------- (defconst desktop-basefilename (if (equal system-type 'ms-dos) "emacs.dsk" ; Ms-Dos does not support multiple dots in file name ".emacs.desktop") "File for Emacs desktop. A directory name will be prepended to this name.") (defvar desktop-missing-file-warning t "*If non-nil then issue warning if a file no longer exists. Otherwise simply ignore the 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 ;; 'desktop-globals-to-save ; Itself! ) "List of global variables to save when killing Emacs.") ;; 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 "\\(\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" "Regexp identifying buffers that are to be excluded from saving.") (defvar desktop-buffer-handlers '(desktop-buffer-dired desktop-buffer-rmail 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-dirname nil "The directory in which the current desktop file resides.") (defconst desktop-header ";; -------------------------------------------------------------------------- ;; Desktop File for Emacs ;; -------------------------------------------------------------------------- " "*Header to place in Desktop file.") ;; ---------------------------------------------------------------------------- (defconst postv18 (string-lessp "19" emacs-version) "t if Emacs version 19 or later.") (defun desktop-clear () "Empty the Desktop." (interactive) (setq kill-ring nil) (setq kill-ring-yank-pointer nil) (mapcar (function kill-buffer) (buffer-list))) ;; ---------------------------------------------------------------------------- ;; This is a bit dirty for version 18 because that version of Emacs was not ;; toilet-trained considering hooks. (if (not (boundp 'desktop-kill)) (if postv18 (add-hook 'kill-emacs-hook 'desktop-kill) (setq old-kill-emacs kill-emacs-hook) (setq kill-emacs-hook (function (lambda () (progn (desktop-kill) (if (or (null old-kill-emacs) (symbolp old-kill-emacs)) (run-hooks old-kill-emacs) (funcall old-kill-emacs)))))))) ;; ---------------------------------------------------------------------------- (defun desktop-kill () (if desktop-dirname (progn (desktop-save desktop-dirname)))) ;; ---------------------------------------------------------------------------- (defun desktop-outvar (VAR) "Output a setq statement for VAR to the desktop file." (if (boundp VAR) (progn (insert "(setq ") (prin1 VAR (current-buffer)) (insert " '") (prin1 (symbol-value VAR) (current-buffer)) (insert ")\n")))) ;; ---------------------------------------------------------------------------- (defun desktop-save-buffer-p (filename bufname mode) "Return t if 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." (or (and filename (not (string-match desktop-buffers-not-to-save bufname))) (and (null filename) (memq mode '(Info-mode dired-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: ") (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) (list 'quote major-mode) (list 'quote (list overwrite-mode (not (null (if postv18 auto-fill-function auto-fill-hook))))) (point) (if postv18 (list 'quote (mark t) mark-active) (mark)) buffer-read-only truncate-lines fill-column case-fold-search case-replace (list 'quote (cond ((equal major-mode 'Info-mode) (list Info-current-file Info-current-node)) ((equal major-mode 'dired-mode) (if postv18 (nreverse (mapcar (function car) dired-subdir-alist)) (list default-directory))) )) ))) (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 (desktop-save-buffer-p (car l) (nth 1 l) (nth 1 (nth 2 l))) (progn (insert "(desktop-buffer") (mapcar (function (lambda (e) (insert "\n ") (prin1 e (current-buffer)))) 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))) (if (file-exists-p filename) (delete-file filename)) (setq desktop-dirname nil)))) ;; ---------------------------------------------------------------------------- (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) (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. ;; The byte compiler may therefore complain of undeclared variables. ;; (defun desktop-buffer-info () "Load an info file." (if (equal 'Info-mode mam) (progn (require 'info) (Info-find-node (nth 0 misc) (nth 1 misc)) t))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-rmail () "Load a RMAIL file." (if (equal 'rmail-mode mam) (progn (rmail-input fn) t))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-dired () "Load a directory using dired." (if (equal 'dired-mode mam) (progn (dired (car misc)) (mapcar (function dired-maybe-insert-subdir) (cdr misc)) t))) ;; ---------------------------------------------------------------------------- (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-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc) (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 (equal result t) (progn (if (not (equal (buffer-name) bn)) (rename-buffer bn)) (if (nth 0 mim) (overwrite-mode 1) (overwrite-mode 0)) (if (nth 1 mim) (auto-fill-mode 1) (overwrite-mode 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)) (setq truncate-lines tl) (setq fill-column fc) (setq case-fold-search cfs) (setq case-replace cr) )))) ;; ---------------------------------------------------------------------------- (provide 'desktop) ;; desktop.el ends here. emacs-19.22/lisp/diary-ins.el100444 13437 1 23045 5410367741 14460 0ustar jimbdaemon;;; diary-ins.el --- calendar functions for adding diary entries. ;; Copyright (C) 1990 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: diary, calendar ;; 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. ;;; Commentary: ;; This collection of functions implements the diary insertion 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 'diary) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")) nil t)) arg))) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))))) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))))) arg))) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))))) 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")))))) arg))) (provide 'diary-ins) ;;; diary-ins.el ends here emacs-19.22/lisp/diary.el100444 12120 1 261537 5461150227 13562 0ustar rmsdaemon;;; diary.el --- diary functions. ;; Copyright (C) 1989, 1990, 1992 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; 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. ;;; 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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!")) arg) (error "Your diary file is not readable!")) (error "You don't have a diary file!")))) (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-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'." (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;; 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))) (save-excursion;; Prepare the fancy diary buffer. (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) (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 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)) (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))) (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\\)" sexp-mark "(")) (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) (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 ))) (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 "^ *\\([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 "^ *\\([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 "^ *\\([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-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 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-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-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-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." (let* ((year (extract-calendar-year date)) (day (calendar-day-number date)) (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 diary-iso-date () "ISO calendar equivalent of date diary entry." (let ((day (% (calendar-absolute-from-gregorian date) 7)) (iso-date (calendar-iso-from-absolute (calendar-absolute-from-gregorian date)))) (format "ISO date: Day %s of week %d of %d." (if (zerop day) 7 day) (extract-calendar-month iso-date) (extract-calendar-year iso-date)))) (defun diary-islamic-date () "Islamic calendar equivalent of date diary entry." (let* ((i-date (calendar-islamic-from-absolute (calendar-absolute-from-gregorian date))) (calendar-month-name-array calendar-islamic-month-name-array)) (if (>= (extract-calendar-year i-date) 1) (format "Islamic date: %s" (calendar-date-string i-date nil t))))) (defun diary-hebrew-date () "Hebrew calendar equivalent of date diary entry." (let* ((h-date (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian date))) (calendar-month-name-array (if (hebrew-calendar-leap-year-p (extract-calendar-year h-date)) calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year))) (format "Hebrew date: %s" (calendar-date-string h-date nil t)))) (defun diary-julian-date () "Julian calendar equivalent of date diary entry." (format "Julian date: %s" (calendar-date-string (calendar-julian-from-absolute (calendar-absolute-from-gregorian date))) nil t)) (defun diary-astro-day-number () "Astronomical (Julian) day number diary entry." (format "Astronomical (Julian) day number %d" (+ 1721425 (calendar-absolute-from-gregorian 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)))))))) (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)))))) (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))) (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))))))))) (provide 'diary) ;;; diary.el ends here emacs-19.22/lisp/diff.el100444 11732 1 22551 5446736217 13512 0ustar bfoxdaemon;;; diff.el --- Run `diff' in compilation-mode. ;; Copyright (C) 1992 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-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 '("diff") ;; 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 (or old-alt old)) (list (or new-alt new))) " "))) (setq buf (compile-internal command "No more differences" "Diff" 'diff-parse-differences)) (save-excursion (set-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." ;; 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 (expand-file-name fn)) (or (let ((bak (make-backup-file-name fn))) (if (file-exists-p bak) bak)) (let* ((dir (file-name-directory fn)) (base-versions (concat (file-name-nondirectory fn) ".~")) (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.22/lisp/dired-aux.el100444 12120 1 213104 5474511031 14315 0ustar rmsdaemon;;; dired-aux.el --- all of dired except what people usually use ;; Copyright (C) 1985, 1986, 1992 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" "chmod" 'chmod arg)) ;;;###autoload (defun dired-do-chgrp (&optional arg) "Change the group of the marked (or next ARG) files." (interactive "P") (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") (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: " (apply 'concat lpr-command " " 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) ;; "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)))) ;; 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))) (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))) (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 (if (eq system-type 'vax-vms) (concat (substring filename 0 (string-match ";" filename)) "c") (concat filename "c"))) buffer-read-only failure) (condition-case err (save-excursion (byte-compile-file filename)) (error (setq failure err))) (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-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 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)) (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)) (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"))) ;; found and point is at The Right Place: (let (buffer-read-only) (beginning-of-line) (dired-add-entry-do-indentation marker-char) ;; don't expand `.' ! (insert-directory (dired-make-absolute filename directory) (concat dired-actual-switches "d")) (forward-line -1) ;; We want to have the non-directory part, only: (let* ((beg (dired-move-to-filename t)) ; error for strange output (end (dired-move-to-end-of-filename))) (setq filename (buffer-substring beg end)) (delete-region beg end) (insert (file-name-nondirectory filename))) (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))) (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))))))) (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)))) (defun dired-copy-file (from to ok-flag) (dired-handle-overwrite to) (copy-file from to ok-flag dired-copy-preserve-time)) (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 ((blist (buffer-list))) (while blist (save-excursion (set-buffer (car blist)) (if (and buffer-file-name (dired-in-this-tree buffer-file-name 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 ((alist dired-subdir-alist) (elt nil)) (while alist (setq elt (car alist) alist (cdr alist)) (if (dired-in-this-tree (car elt) 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))))))) ;; Cloning replace-match to work on strings instead of in buffer: ;; The FIXEDCASE parameter of replace-match is not implemented. ;;;###autoload (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 ((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) (if literal newtext (dired-expand-newtext string newtext))) start me)) (if mb ; matched at least once (concat result (substring string start)) nil)) ;; not GLOBAL (if (not (string-match regexp string 0)) nil (concat (substring string 0 (match-beginning 0)) (if literal newtext (dired-expand-newtext string newtext)) (substring string (match-end 0)))))) (defun dired-expand-newtext (string newtext) ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT, using match data. ;; Note that in Emacs 18 match data are clipped to current buffer ;; size...so the buffer should better not be smaller than STRING. (let ((pos 0) (len (length newtext)) (expanded-newtext "")) (while (< pos len) (setq expanded-newtext (concat expanded-newtext (let ((c (aref newtext pos))) (if (= ?\\ c) (cond ((= ?\& (setq c (aref newtext (setq pos (1+ pos))))) (substring string (match-beginning 0) (match-end 0))) ((and (>= c ?1) (<= c ?9)) ;; return empty string if N'th ;; sub-regexp did not match: (let ((n (- c ?0))) (if (match-beginning n) (substring string (match-beginning n) (match-end n)) ""))) (t (char-to-string c))) (char-to-string c))))) (setq pos (1+ pos))) expanded-newtext)) ;; 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 symbolic links 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 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: ") (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) (insert-directory dirname dired-actual-switches nil t))) (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 "P") (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 ;;; dired-aux.el ends here emacs-19.22/lisp/dired.el100444 12120 1 256776 5474252460 13560 0ustar rmsdaemon;;; dired.el --- directory-browsing commands ;; Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. ;; Author: Sebastian Kremer . ;; Version: 6 ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; 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'.") ; 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)) "chown" "/etc/chown") "Name of chown command (usually `chown' or `/etc/chown').") ;;;###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.)") ;;; 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-dot "^.* \\.\\.?$") (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 (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) ;; 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. (let* ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list)) (buffer (dired-find-buffer-nocreate dir-or-list)) ;; 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 ... (if switches ; ... but new switches (dired-sort-other switches)) ; this calls dired-revert ;; Else a new buffer (setq default-directory (abbreviate-file-name (if (file-directory-p dirname) dirname (file-name-directory dirname)))) (or switches (setq switches dired-listing-switches)) (dired-mode dirname switches) ;; 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)) ;; This differs from dired-buffers-for-dir in that it does not consider ;; subdirs of default-directory and searches for the first match only (defun dired-find-buffer-nocreate (dirname) (let (found (blist (buffer-list))) (while blist (save-excursion (set-buffer (car blist)) (if (and (eq major-mode 'dired-mode) (equal dired-directory dirname)) (setq found (car blist) blist nil) (setq blist (cdr blist))))) 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) (set-buffer-modified-p nil) ;; 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)))) ;; 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. (if (consp dir-or-list) (progn (mapcar (function (lambda (x) (insert-directory x switches wildcard full-p))) (cdr dir-or-list))) (insert-directory dir-or-list switches wildcard full-p)) (setq dired-directory dir-or-list)) (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))) (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 ;; Force `f' rather than `e' in the mode doc: (defalias 'dired-advertised-find-file 'dired-find-file) ;; This looks ugly when substitute-command-keys uses C-d instead d: ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion) (setq dired-mode-map (make-keymap)) (suppress-keymap dired-mode-map) ;; Commands to mark or flag certain categories of files (define-key dired-mode-map "#" 'dired-flag-auto-save-files) (define-key dired-mode-map "*" 'dired-mark-executables) (define-key dired-mode-map "." 'dired-clean-directory) (define-key dired-mode-map "/" 'dired-mark-directories) (define-key dired-mode-map "@" 'dired-mark-symlinks) (define-key dired-mode-map "~" 'dired-flag-backup-files) ;; Upper case keys (except !) for operating on the marked files (define-key dired-mode-map "C" 'dired-do-copy) (define-key dired-mode-map "B" 'dired-do-byte-compile) (define-key dired-mode-map "D" 'dired-do-delete) (define-key dired-mode-map "G" 'dired-do-chgrp) (define-key dired-mode-map "H" 'dired-do-hardlink) (define-key dired-mode-map "L" 'dired-do-load) (define-key dired-mode-map "M" 'dired-do-chmod) (define-key dired-mode-map "O" 'dired-do-chown) (define-key dired-mode-map "P" 'dired-do-print) (define-key dired-mode-map "R" 'dired-do-rename) (define-key dired-mode-map "S" 'dired-do-symlink) (define-key dired-mode-map "X" 'dired-do-shell-command) (define-key dired-mode-map "Z" 'dired-do-compress) (define-key dired-mode-map "!" 'dired-do-shell-command) ;; Comparison commands (define-key dired-mode-map "=" 'dired-diff) (define-key dired-mode-map "\M-=" 'dired-backup-diff) ;; Tree Dired commands (define-key dired-mode-map "\M-\C-?" 'dired-unmark-all-files) (define-key dired-mode-map "\M-\C-d" 'dired-tree-down) (define-key dired-mode-map "\M-\C-u" 'dired-tree-up) (define-key dired-mode-map "\M-\C-n" 'dired-next-subdir) (define-key dired-mode-map "\M-\C-p" 'dired-prev-subdir) ;; move to marked files (define-key dired-mode-map "\M-{" 'dired-prev-marked-file) (define-key dired-mode-map "\M-}" 'dired-next-marked-file) ;; Make all regexp commands share a `%' prefix: (defalias 'dired-regexp-prefix (make-sparse-keymap)) (define-key dired-mode-map "%" 'dired-regexp-prefix) (define-key dired-mode-map "%u" 'dired-upcase) (define-key dired-mode-map "%l" 'dired-downcase) (define-key dired-mode-map "%d" 'dired-flag-files-regexp) (define-key dired-mode-map "%m" 'dired-mark-files-regexp) (define-key dired-mode-map "%r" 'dired-do-rename-regexp) (define-key dired-mode-map "%C" 'dired-do-copy-regexp) (define-key dired-mode-map "%H" 'dired-do-hardlink-regexp) (define-key dired-mode-map "%R" 'dired-do-rename-regexp) (define-key dired-mode-map "%S" 'dired-do-symlink-regexp) ;; Lower keys for commands not operating on all the marked files (define-key dired-mode-map "c" 'dired-change-marks) (define-key dired-mode-map "d" 'dired-flag-file-deletion) (define-key dired-mode-map "e" 'dired-find-file) (define-key dired-mode-map "f" 'dired-advertised-find-file) (define-key dired-mode-map "g" 'revert-buffer) (define-key dired-mode-map "h" 'describe-mode) (define-key dired-mode-map "i" 'dired-maybe-insert-subdir) (define-key dired-mode-map "k" 'dired-do-kill-lines) (define-key dired-mode-map "l" 'dired-do-redisplay) (define-key dired-mode-map "m" 'dired-mark) (define-key dired-mode-map "n" 'dired-next-line) (define-key dired-mode-map "o" 'dired-find-file-other-window) (define-key dired-mode-map "\C-o" 'dired-display-file) (define-key dired-mode-map "p" 'dired-previous-line) (define-key dired-mode-map "q" 'dired-quit) (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit) (define-key dired-mode-map "u" 'dired-unmark) (define-key dired-mode-map "v" 'dired-view-file) (define-key dired-mode-map "x" 'dired-do-flagged-delete) (define-key dired-mode-map "+" 'dired-create-directory) ;; moving (define-key dired-mode-map "<" 'dired-prev-dirline) (define-key dired-mode-map ">" 'dired-next-dirline) (define-key dired-mode-map "^" 'dired-up-directory) (define-key dired-mode-map " " 'dired-next-line) (define-key dired-mode-map "\C-n" 'dired-next-line) (define-key dired-mode-map "\C-p" 'dired-previous-line) ;; hiding (define-key dired-mode-map "$" 'dired-hide-subdir) (define-key dired-mode-map "\M-$" 'dired-hide-all) ;; misc (define-key dired-mode-map "?" 'dired-summary) (define-key dired-mode-map "\177" 'dired-unmark-backward) (define-key dired-mode-map "\C-_" 'dired-undo) (define-key dired-mode-map "\C-xu" 'dired-undo) ) ;; Make menu bar items. ;; Get rid of the Edit menu bar item to save space. (define-key dired-mode-map [menu-bar edit] 'undefined) (define-key dired-mode-map [menu-bar subdir] (cons "Subdir" (make-sparse-keymap "Subdir"))) (define-key dired-mode-map [menu-bar subdir hide-all] '("Hide All" . dired-hide-all)) (define-key dired-mode-map [menu-bar subdir hide-subdir] '("Hide Subdir" . dired-hide-subdir)) (define-key dired-mode-map [menu-bar subdir tree-down] '("Tree Down" . dired-tree-down)) (define-key dired-mode-map [menu-bar subdir tree-up] '("Tree Up" . dired-tree-up)) (define-key dired-mode-map [menu-bar subdir up] '("Up Directory" . dired-up-directory)) (define-key dired-mode-map [menu-bar subdir prev-subdir] '("Prev Subdir" . dired-prev-subdir)) (define-key dired-mode-map [menu-bar subdir next-subdir] '("Next Subdir" . dired-next-subdir)) (define-key dired-mode-map [menu-bar subdir prev-dirline] '("Prev Dirline" . dired-prev-dirline)) (define-key dired-mode-map [menu-bar subdir next-dirline] '("Next Dirline" . dired-next-dirline)) (define-key dired-mode-map [menu-bar subdir insert] '("Insert This Subdir" . dired-maybe-insert-subdir)) (define-key dired-mode-map [menu-bar immediate] (cons "Immediate" (make-sparse-keymap "Immediate"))) (define-key dired-mode-map [menu-bar immediate backup-diff] '("Compare with Backup" . dired-backup-diff)) (define-key dired-mode-map [menu-bar immediate diff] '("Diff" . dired-diff)) (define-key dired-mode-map [menu-bar immediate view] '("View This File" . dired-view-file)) (define-key dired-mode-map [menu-bar immediate display] '("Display in Other Window" . dired-display-file)) (define-key dired-mode-map [menu-bar immediate find-file-other-window] '("Find in Other Window" . dired-find-file-other-window)) (define-key dired-mode-map [menu-bar immediate find-file] '("Find This File" . dired-find-file)) (define-key dired-mode-map [menu-bar immediate create-directory] '("Create Directory..." . dired-create-directory)) (define-key dired-mode-map [menu-bar regexp] (cons "Regexp" (make-sparse-keymap "Regexp"))) (define-key dired-mode-map [menu-bar regexp downcase] '("Downcase" . dired-downcase)) (define-key dired-mode-map [menu-bar regexp upcase] '("Upcase" . dired-upcase)) (define-key dired-mode-map [menu-bar regexp hardlink] '("Hardlink..." . dired-do-hardlink-regexp)) (define-key dired-mode-map [menu-bar regexp symlink] '("Symlink..." . dired-do-symlink-regexp)) (define-key dired-mode-map [menu-bar regexp rename] '("Rename..." . dired-do-rename-regexp)) (define-key dired-mode-map [menu-bar regexp copy] '("Copy..." . dired-do-copy-regexp)) (define-key dired-mode-map [menu-bar regexp flag] '("Flag..." . dired-flag-files-regexp)) (define-key dired-mode-map [menu-bar regexp mark] '("Mark..." . dired-mark-files-regexp)) (define-key dired-mode-map [menu-bar mark] (cons "Mark" (make-sparse-keymap "Mark"))) (define-key dired-mode-map [menu-bar mark prev] '("Previous Marked" . dired-prev-marked-file)) (define-key dired-mode-map [menu-bar mark next] '("Next Marked" . dired-next-marked-file)) (define-key dired-mode-map [menu-bar mark marks] '("Change Marks..." . dired-change-marks)) (define-key dired-mode-map [menu-bar mark unmark-all] '("Unmark All" . dired-unmark-all-files-no-query)) (define-key dired-mode-map [menu-bar mark symlinks] '("Mark Symlinks" . dired-mark-symlinks)) (define-key dired-mode-map [menu-bar mark directories] '("Mark Directories" . dired-mark-directories)) (define-key dired-mode-map [menu-bar mark directory] '("Mark Old Backups" . dired-clean-directory)) (define-key dired-mode-map [menu-bar mark executables] '("Mark Executables" . dired-mark-executables)) (define-key dired-mode-map [menu-bar mark backup-files] '("Flag Backup Files" . dired-flag-backup-files)) (define-key dired-mode-map [menu-bar mark auto-save-files] '("Flag Auto-save Files" . dired-flag-auto-save-files)) (define-key dired-mode-map [menu-bar mark deletion] '("Flag" . dired-flag-file-deletion)) (define-key dired-mode-map [menu-bar mark unmark] '("Unmark" . dired-unmark)) (define-key dired-mode-map [menu-bar mark mark] '("Mark" . dired-mark)) (define-key dired-mode-map [menu-bar operate] (cons "Operate" (make-sparse-keymap "Operate"))) (define-key dired-mode-map [menu-bar operate chown] '("Change Owner..." . dired-do-chown)) (define-key dired-mode-map [menu-bar operate chgrp] '("Change Group..." . dired-do-chgrp)) (define-key dired-mode-map [menu-bar operate chmod] '("Change Mode..." . dired-do-chmod)) (define-key dired-mode-map [menu-bar operate load] '("Load" . dired-do-load)) (define-key dired-mode-map [menu-bar operate compile] '("Byte-compile" . dired-do-byte-compile)) (define-key dired-mode-map [menu-bar operate compress] '("Compress" . dired-do-compress)) (define-key dired-mode-map [menu-bar operate print] '("Print" . dired-do-print)) (define-key dired-mode-map [menu-bar operate hardlink] '("Hardlink to..." . dired-do-hardlink)) (define-key dired-mode-map [menu-bar operate symlink] '("Symlink to..." . dired-do-symlink)) (define-key dired-mode-map [menu-bar operate command] '("Shell Command..." . dired-do-shell-command)) (define-key dired-mode-map [menu-bar operate delete] '("Delete" . dired-do-delete)) (define-key dired-mode-map [menu-bar operate rename] '("Rename to..." . dired-do-rename)) (define-key dired-mode-map [menu-bar operate copy] '("Copy to..." . dired-do-copy)) ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) (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) dired-directory) (set (make-local-variable 'dired-actual-switches) (or switches dired-listing-switches)) (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 () "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) (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 (dired up) (dired-goto-file dir))))) (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-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))) ;; Check if ls quoted the names, and unquote them. ;; Using read to unquote is much faster than substituting ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop. (cond ((string-match "b" dired-actual-switches) ; System V ls ;; This case is about 20% slower than without -b. (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 you do this, update dired-insert-subdir-validate too ;; ((string-match "Q" dired-actual-switches) ; GNU ls ;; (setq file (read file))) )) (if (eq localp 'no-dir) file (and file (concat (dired-current-directory localp) file))))) (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. ;; 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 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+" eol t) (progn (skip-chars-forward " ") ; there is one SPC after day of month (skip-chars-forward "^ " eol) ; move after time of day (or year) (skip-chars-forward " " eol) ; there is space before the file name ;; Actually, if the year instead of clock time is displayed, ;; there are (only for some ls programs?) two spaces instead ;; of one before the name. ;; If we could depend on ls inserting exactly one SPC we ;; would not bomb on names _starting_ with SPC. (point)) (if raise-error (error "No file on this line") nil))) (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 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) (while alist (setq elt (car alist)) (if (dired-in-this-tree dir (car elt)) (let ((buf (cdr elt))) (if (buffer-name buf) (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. (if (memq (current-buffer) (dired-buffers-for-dir default-directory)) t ; we have already advertised ourselves (setq dired-buffers (cons (cons default-directory (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 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 (re-search-forward dired-subdir-regexp nil t) (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 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 () "In dired, delete the files flagged for deletion." (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) (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)) (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") (looking-at dired-subdir-regexp))) (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 (and (cdr dired-subdir-alist) (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) (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))))) ;; update mode line: (set-buffer-modified-p (buffer-modified-p))) (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) (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.22/lisp/disass.el100444 12120 1 20212 5450404372 13700 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 5 "*") (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)) (and (> (length obj) 4) (aref obj 4))))) (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 (setq bytes (aref obj 1) constvec (aref obj 2))) (let ((lap (byte-decompile-bytecode bytes constvec)) op arg opname) (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 (setq op (car (car lap)) arg (cdr (car lap))) (indent-to indent) (if (eq 'TAG op) (insert (int-to-string (car arg)) ":") (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")) (setq lap (cdr lap))))) nil) ;;; disass.el ends here emacs-19.22/lisp/disp-table.el100444 12120 1 11620 5467460205 14446 0ustar rmsdaemon;;; disp-table.el --- functions for dealing with char tables. ;; 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. ;;; Code: (defun describe-display-table (dt) "Describe the display table DT in a help buffer." (with-output-to-temp-buffer "*Help*" (princ "\nTruncation glyph: ") (prin1 (aref dt 256)) (princ "\nWrap glyph: ") (prin1 (aref dt 257)) (princ "\nEscape glyph: ") (prin1 (aref dt 258)) (princ "\nCtrl glyph: ") (prin1 (aref dt 259)) (princ "\nSelective display glyph sequence: ") (prin1 (aref dt 260)) (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))) (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 make-display-table () "Return a new, empty display table." (make-vector 261 nil)) ;;;###autoload (defun standard-display-8bit (l h) "Display characters in the range L to H literally." (while (<= l h) (if (and (>= l ?\ ) (< l 127)) (if standard-display-table (aset standard-display-table l nil)) (or standard-display-table (setq standard-display-table (make-vector 261 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)) (if standard-display-table (aset standard-display-table l nil)) (or standard-display-table (setq standard-display-table (make-vector 261 nil))) (aset standard-display-table l nil)) (setq l (1+ l)))) ;;;###autoload (defun standard-display-ascii (c s) "Display character C using string S." (or standard-display-table (setq standard-display-table (make-vector 261 nil))) (aset standard-display-table c (apply 'vector (append s nil)))) ;;;###autoload (defun standard-display-g1 (c sc) "Display character C as character SC in the g1 character set." (or standard-display-table (setq standard-display-table (make-vector 261 nil))) (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." (or standard-display-table (setq standard-display-table (make-vector 261 nil))) (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." (or standard-display-table (setq standard-display-table (make-vector 261 nil))) (aset standard-display-table c (vector (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")) (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) (vectorp standard-display-table) (>= (length standard-display-table) 161) (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.22/lisp/dissociate.el100444 74720 14 6140 5427026177 15136 0ustar eggertguest;;; 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)) (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.22/lisp/doctor.el100444 12120 1 143705 5424027217 13741 0ustar rmsdaemon;;; doctor.el --- psychological help for frustrated users. ;; Copyright (C) 1985, 1987 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) (setq feelings-about '((feelings about) (aprehensions toward) (thoughts on) (emotions toward))) (make-local-variable 'random) (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) (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.22/lisp/dunnet.el100444 12120 1 334611 5443137207 13744 0ustar rmsdaemon;;; 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)) (if (and (not (= objnum obj-special)) (not (member objnum (nth dun-current-room dun-room-objects))) (not (member objnum (nth dun-current-room dun-room-silents))) (not (member objnum dun-inventory))) (dun-mprincl "I don't see that here.") (if (and (= objnum obj-special) (not (member obj-tree (nth dun-current-room dun-room-silents)))) (dun-mprincl "There is nothing here to climb.") (if (and (not (= objnum obj-tree)) (not (= objnum obj-special))) (dun-mprincl "You can't climb that.") (dun-mprincl "You manage to get about two feet up the tree and fall back down. You notice that the tree is very unsteady.")))))) (defun dun-eat (obj) (let (objnum) (when (setq objnum (dun-objnum-from-args-std obj)) (if (not (member objnum dun-inventory)) (dun-mprincl "You don't have that.") (if (not (= objnum obj-food)) (progn (dun-mprinc "You forcefully shove ") (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) (dun-mprincl " down your throat, and start choking.") (dun-die "choking")) (dun-mprincl "That tasted horrible.") (dun-remove-obj-from-inven obj-food)))))) (defun dun-put (args) (if dun-inbus (dun-mprincl "You can't do that while on the bus") (let (newargs objnum objnum2 obj) (setq newargs (dun-firstwordl args)) (if (not newargs) (dun-mprincl "You must supply an object") (setq obj (intern (car newargs))) (setq objnum (cdr (assq obj dun-objnames))) (if (not objnum) (dun-mprincl "I don't know what that object is.") (if (not (member objnum dun-inventory)) (dun-mprincl "You don't have that.") (setq newargs (dun-firstwordl (cdr newargs))) (setq newargs (dun-firstwordl (cdr newargs))) (if (not newargs) (dun-mprincl "You must supply an indirect object.") (setq objnum2 (cdr (assq (intern (car newargs)) dun-objnames))) (if (and (eq objnum2 obj-computer) (= dun-current-room pc-area)) (setq objnum2 obj-pc)) (if (not objnum2) (dun-mprincl "I don't know what that indirect object is.") (if (and (not (member objnum2 (nth dun-current-room dun-room-objects))) (not (member objnum2 (nth dun-current-room dun-room-silents))) (not (member objnum2 dun-inventory))) (dun-mprincl "That indirect object is not here.") (dun-put-objs objnum objnum2)))))))))) (defun dun-put-objs (obj1 obj2) (if (and (= obj2 obj-drop) (not dun-nomail)) (setq obj2 obj-chute)) (if (= obj2 obj-disposal) (setq obj2 obj-chute)) (if (and (= obj1 obj-cpu) (= obj2 obj-computer)) (progn (dun-remove-obj-from-inven obj-cpu) (setq dun-computer t) (dun-mprincl "As you put the CPU board in the computer, it immediately springs to life. The lights start flashing, and the fans seem to startup.")) (if (and (= obj1 obj-weight) (= obj2 obj-button)) (dun-drop '("weight")) (if (= obj2 obj-jar) ;; Put something in jar (if (not (member obj1 (list obj-paper obj-diamond obj-emerald obj-license obj-coins obj-egg obj-nitric obj-glycerine))) (dun-mprincl "That will not fit in the jar.") (dun-remove-obj-from-inven obj1) (setq dun-jar (append dun-jar (list obj1))) (dun-mprincl "Done.")) (if (= obj2 obj-chute) ;; Put something in chute (progn (dun-remove-obj-from-inven obj1) (dun-mprincl "You hear it slide down the chute and off into the distance.") (dun-put-objs-in-treas (list obj1))) (if (= obj2 obj-box) ;; Put key in key box (if (= obj1 obj-key) (progn (dun-mprincl "As you drop the key, the box begins to shake. Finally it explodes with a bang. The key seems to have vanished!") (dun-remove-obj-from-inven obj1) (dun-replace dun-room-objects computer-room (append (nth computer-room dun-room-objects) (list obj1))) (dun-remove-obj-from-room dun-current-room obj-box) (setq dun-key-level (1+ dun-key-level))) (dun-mprincl "You can't put that in the key box!")) (if (and (= obj1 obj-floppy) (= obj2 obj-pc)) (progn (setq dun-floppy t) (dun-remove-obj-from-inven obj1) (dun-mprincl "Done.")) (if (= obj2 obj-urinal) ;; Put object in urinal (progn (dun-remove-obj-from-inven obj1) (dun-replace dun-room-objects urinal (append (nth urinal dun-room-objects) (list obj1))) (dun-mprincl "You hear it plop down in some water below.")) (if (= obj2 obj-mail) (dun-mprincl "The mail chute is locked.") (if (member obj1 dun-inventory) (dun-mprincl "I don't know how to combine those objects. Perhaps you should just try dropping it.") (dun-mprincl"You can't put that there."))))))))))) (defun dun-type (args) (if (not (= dun-current-room computer-room)) (dun-mprincl "There is nothing here on which you could type.") (if (not dun-computer) (dun-mprincl "You type on the keyboard, but your characters do not even echo.") (dun-unix-interface)))) ;;; Various movement directions (defun dun-n (args) (dun-move north)) (defun dun-s (args) (dun-move south)) (defun dun-e (args) (dun-move east)) (defun dun-w (args) (dun-move west)) (defun dun-ne (args) (dun-move northeast)) (defun dun-se (args) (dun-move southeast)) (defun dun-nw (args) (dun-move northwest)) (defun dun-sw (args) (dun-move southwest)) (defun dun-up (args) (dun-move up)) (defun dun-down (args) (dun-move down)) (defun dun-in (args) (dun-move in)) (defun dun-out (args) (dun-move out)) (defun dun-go (args) (if (or (not (car args)) (eq (dun-doverb dun-ignore dun-verblist (car args) (cdr (cdr args))) -1)) (dun-mprinc "I don't understand where you want me to go.\n"))) ;;; Uses the dungeon-map to figure out where we are going. If the ;;; requested direction yields 255, we know something special is ;;; supposed to happen, or perhaps you can't go that way unless ;;; certain conditions are met. (defun dun-move (dir) (if (and (not (member dun-current-room dun-light-rooms)) (not (member obj-lamp dun-inventory))) (progn (dun-mprinc "You trip over a grue and fall into a pit and break every bone in your body.") (dun-die "a grue")) (let (newroom) (setq newroom (nth dir (nth dun-current-room dungeon-map))) (if (eq newroom -1) (dun-mprinc "You can't go that way.\n") (if (eq newroom 255) (dun-special-move dir) (setq room -1) (setq dun-lastdir dir) (if dun-inbus (progn (if (or (< newroom 58) (> newroom 83)) (dun-mprincl "The bus cannot go this way.") (dun-mprincl "The bus lurches ahead and comes to a screeching halt.") (dun-remove-obj-from-room dun-current-room obj-bus) (setq dun-current-room newroom) (dun-replace dun-room-objects newroom (append (nth newroom dun-room-objects) (list obj-bus))))) (setq dun-current-room newroom))))))) ;;; Movement in this direction causes something special to happen if the ;;; right conditions exist. It may be that you can't go this way unless ;;; you have a key, or a passage has been opened. ;;; coding note: Each check of the current room is on the same 'if' level, ;;; i.e. there aren't else's. If two rooms next to each other have ;;; specials, and they are connected by specials, this could cause ;;; a problem. Be careful when adding them to consider this, and ;;; perhaps use else's. (defun dun-special-move (dir) (if (= dun-current-room building-front) (if (not (member obj-key dun-inventory)) (dun-mprincl "You don't have a key that can open this door.") (setq dun-current-room old-building-hallway)) (if (= dun-current-room north-end-of-cave-passage) (let (combo) (dun-mprincl "You must type a 3 digit combination code to enter this room.") (dun-mprinc "Enter it here: ") (setq combo (dun-read-line)) (if (not dun-batch-mode) (dun-mprinc "\n")) (if (string= combo dun-combination) (setq dun-current-room gamma-computing-center) (dun-mprincl "Sorry, that combination is incorrect.")))) (if (= dun-current-room bear-hangout) (if (member obj-bear (nth bear-hangout dun-room-objects)) (progn (dun-mprinc "The bear is very annoyed that you would be so presumptuous as to try and walk right by it. He tells you so by tearing your head off. ") (dun-die "a bear")) (dun-mprincl "You can't go that way."))) (if (= dun-current-room vermont-station) (progn (dun-mprincl "As you board the train it immediately leaves the station. It is a very bumpy ride. It is shaking from side to side, and up and down. You sit down in one of the chairs in order to be more comfortable.") (dun-mprincl "\nFinally the train comes to a sudden stop, and the doors open, and some force throws you out. The train speeds away.\n") (setq dun-current-room museum-station))) (if (= dun-current-room old-building-hallway) (if (and (member obj-key dun-inventory) (> dun-key-level 0)) (setq dun-current-room meadow) (dun-mprincl "You don't have a key that can open this door."))) (if (and (= dun-current-room maze-button-room) (= dir northwest)) (if (member obj-weight (nth maze-button-room dun-room-objects)) (setq dun-current-room 18) (dun-mprincl "You can't go that way."))) (if (and (= dun-current-room maze-button-room) (= dir up)) (if (member obj-weight (nth maze-button-room dun-room-objects)) (dun-mprincl "You can't go that way.") (setq dun-current-room weight-room))) (if (= dun-current-room classroom) (dun-mprincl "The door is locked.")) (if (or (= dun-current-room lakefront-north) (= dun-current-room lakefront-south)) (dun-swim nil)) (if (= dun-current-room reception-area) (if (not (= dun-sauna-level 3)) (setq dun-current-room health-club-front) (dun-mprincl "As you exit the building, you notice some flames coming out of one of the windows. Suddenly, the building explodes in a huge ball of fire. The flames engulf you, and you burn to death.") (dun-die "burning"))) (if (= dun-current-room red-room) (if (not (member obj-towel (nth red-room dun-room-objects))) (setq dun-current-room long-n-s-hallway) (dun-mprincl "You can't go that way."))) (if (and (> dir down) (> dun-current-room gamma-computing-center) (< dun-current-room museum-lobby)) (if (not (member obj-bus (nth dun-current-room dun-room-objects))) (dun-mprincl "You can't go that way.") (if (= dir in) (if (member obj-license dun-inventory) (progn (dun-mprincl "You board the bus and get in the driver's seat.") (setq dun-nomail t) (setq dun-inbus t)) (dun-mprincl "You are not licensed for this type of vehicle.")) (dun-mprincl "You hop off the bus.") (setq dun-inbus nil))) (if (= dun-current-room fifth-oaktree-intersection) (if (not dun-inbus) (progn (dun-mprincl "You fall down the cliff and land on your head.") (dun-die "a cliff")) (dun-mprincl "The bus flies off the cliff, and plunges to the bottom, where it explodes.") (dun-die "a bus accident"))) (if (= dun-current-room main-maple-intersection) (progn (if (not dun-inbus) (dun-mprincl "The gate will not open.") (dun-mprincl "As the bus approaches, the gate opens and you drive through.") (dun-remove-obj-from-room main-maple-intersection obj-bus) (dun-replace dun-room-objects museum-entrance (append (nth museum-entrance dun-room-objects) (list obj-bus))) (setq dun-current-room museum-entrance))))) (if (= dun-current-room cave-entrance) (progn (dun-mprincl "As you enter the room you hear a rumbling noise. You look back to see huge rocks sliding down from the ceiling, and blocking your way out.\n") (setq dun-current-room misty-room))))) (defun dun-long (args) (setq dun-mode "long")) (defun dun-turn (obj) (let (objnum direction) (when (setq objnum (dun-objnum-from-args-std obj)) (if (not (or (member objnum (nth dun-current-room dun-room-objects)) (member objnum (nth dun-current-room dun-room-silents)))) (dun-mprincl "I don't see that here.") (if (not (= objnum obj-dial)) (dun-mprincl "You can't turn that.") (setq direction (dun-firstword (cdr obj))) (if (or (not direction) (not (or (string= direction "clockwise") (string= direction "counterclockwise")))) (dun-mprincl "You must indicate clockwise or counterclockwise.") (if (string= direction "clockwise") (setq dun-sauna-level (+ dun-sauna-level 1)) (setq dun-sauna-level (- dun-sauna-level 1))) (if (< dun-sauna-level 0) (progn (dun-mprincl "The dial will not turn further in that direction.") (setq dun-sauna-level 0)) (dun-sauna-heat)))))))) (defun dun-sauna-heat () (if (= dun-sauna-level 0) (dun-mprincl "The termperature has returned to normal room termperature.")) (if (= dun-sauna-level 1) (dun-mprincl "It is now luke warm in here. You begin to sweat.")) (if (= dun-sauna-level 2) (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) (if (= dun-sauna-level 3) (progn (dun-mprincl "It is now very hot. There is something very refreshing about this.") (if (or (member obj-rms dun-inventory) (member obj-rms (nth dun-current-room dun-room-objects))) (progn (dun-mprincl "You notice the wax on your statuette beginning to melt, until it completely melts off. You are left with a beautiful diamond!") (if (member obj-rms dun-inventory) (progn (dun-remove-obj-from-inven obj-rms) (setq dun-inventory (append dun-inventory (list obj-diamond)))) (dun-remove-obj-from-room dun-current-room obj-rms) (dun-replace dun-room-objects dun-current-room (append (nth dun-current-room dun-room-objects) (list obj-diamond)))))) (if (or (member obj-floppy dun-inventory) (member obj-floppy (nth dun-current-room dun-room-objects))) (progn (dun-mprincl "You notice your floppy disk beginning to melt. As you grab for it, the disk bursts into flames, and disintegrates.") (if (member obj-floppy dun-inventory) (dun-remove-obj-from-inven obj-floppy) (dun-remove-obj-from-room dun-current-room obj-floppy)))))) (if (= dun-sauna-level 4) (progn (dun-mprincl "As the dial clicks into place, you immediately burst into flames.") (dun-die "burning")))) (defun dun-press (obj) (let (objnum) (when (setq objnum (dun-objnum-from-args-std obj)) (if (not (or (member objnum (nth dun-current-room dun-room-objects)) (member objnum (nth dun-current-room dun-room-silents)))) (dun-mprincl "I don't see that here.") (if (not (member objnum (list obj-button obj-switch))) (progn (dun-mprinc "You can't ") (dun-mprinc (car line-list)) (dun-mprincl " that.")) (if (= objnum obj-button) (dun-mprincl "As you press the button, you notice a passageway open up, but as you release it, the passageway closes.")) (if (= objnum obj-switch) (if dun-black (progn (dun-mprincl "The button is now in the off position.") (setq dun-black nil)) (dun-mprincl "The button is now in the on position.") (setq dun-black t)))))))) (defun dun-swim (args) (if (not (member dun-current-room (list lakefront-north lakefront-south))) (dun-mprincl "I see no water!") (if (not (member obj-life dun-inventory)) (progn (dun-mprincl "You dive in the water, and at first notice it is quite cold. You then start to get used to it as you realize that you never really learned how to swim.") (dun-die "drowning")) (if (= dun-current-room lakefront-north) (setq dun-current-room lakefront-south) (setq dun-current-room lakefront-north))))) (defun dun-score (args) (if (not dun-endgame) (let (total) (setq total (dun-reg-score)) (dun-mprinc "You have scored ") (dun-mprinc total) (dun-mprincl " out of a possible 90 points.") total) (dun-mprinc "You have scored ") (dun-mprinc (dun-endgame-score)) (dun-mprincl " endgame points out of a possible 110.") (if (= (dun-endgame-score) 110) (dun-mprincl "\n\nCongratulations. You have won. The wizard password is 'moby'")))) (defun dun-help (args) (dun-mprincl "Welcome to dunnet (2.0), by Ron Schnell (ronnie@media.mit.edu). Here is some useful information (read carefully because there are one or more clues in here): - If you have a key that can open a door, you do not need to explicitly open it. You may just use 'in' or walk in the direction of the door. - If you have a lamp, it is always lit. - You will not get any points until you manage to get treasures to a certain place. Simply finding the treasures is not good enough. There is more than one way to get a treasure to the special place. It is also important that the objects get to the special place *unharmed* and *untarnished*. You can tell if you have successfully transported the object by looking at your score, as it changes immediately. Note that an object can become harmed even after you have received points for it. If this happens, your score will decrease, and in many cases you can never get credit for it again. - You can save your game with the 'save' command, and use restore it with the 'restore' command. - There are no limits on lengths of object names. - Directions are: north,south,east,west,northeast,southeast,northwest, southwest,up,down,in,out. - These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out. - If you go down a hole in the floor without an aid such as a ladder, you probably won't be able to get back up the way you came, if at all. - To run this game in batch mode (no emacs window), use: emacs -batch -l dunnet If you have questions or comments, please contact ronnie@media.mit.edu.")) (defun dun-flush (args) (if (not (= dun-current-room bathroom)) (dun-mprincl "I see nothing to flush.") (dun-mprincl "Whoooosh!!") (dun-put-objs-in-treas (nth urinal dun-room-objects)) (dun-replace dun-room-objects urinal nil))) (defun dun-piss (args) (if (not (= dun-current-room bathroom)) (dun-mprincl "You can't do that here, don't even bother trying.") (if (not dun-gottago) (dun-mprincl "I'm afraid you don't have to go now.") (dun-mprincl "That was refreshing.") (setq dun-gottago nil) (dun-replace dun-room-objects urinal (append (nth urinal dun-room-objects) (list obj-URINE)))))) (defun dun-sleep (args) (if (not (= dun-current-room bedroom)) (dun-mprincl "You try to go to sleep while standing up here, but can't seem to do it.") (setq dun-gottago t) (dun-mprincl "As soon as you start to doze off you begin dreaming. You see images of workers digging caves, slaving in the humid heat. Then you see yourself as one of these workers. While no one is looking, you leave the group and walk into a room. The room is bare except for a horseshoe shaped piece of stone in the center. You see yourself digging a hole in the ground, then putting some kind of treasure in it, and filling the hole with dirt again. After this, you immediately wake up."))) (defun dun-break (obj) (let (objnum) (if (not (member obj-axe dun-inventory)) (dun-mprincl "You have nothing you can use to break things.") (when (setq objnum (dun-objnum-from-args-std obj)) (if (member objnum dun-inventory) (progn (dun-mprincl "You take the object in your hands and swing the axe. Unfortunately, you miss the object and slice off your hand. You bleed to death.") (dun-die "an axe")) (if (not (or (member objnum (nth dun-current-room dun-room-objects)) (member objnum (nth dun-current-room dun-room-silents)))) (dun-mprincl "I don't see that here.") (if (= objnum obj-cable) (progn (dun-mprincl "As you break the ethernet cable, everything starts to blur. You collapse for a moment, then straighten yourself up. ") (dun-replace dun-room-objects gamma-computing-center (append (nth gamma-computing-center dun-room-objects) dun-inventory)) (if (member obj-key dun-inventory) (progn (setq dun-inventory (list obj-key)) (dun-remove-obj-from-room gamma-computing-center obj-key)) (setq dun-inventory nil)) (setq dun-current-room computer-room) (setq dun-ethernet nil) (dun-mprincl "Connection closed.") (dun-unix-interface)) (if (< objnum 0) (progn (dun-mprincl "Your axe shatters into a million pieces.") (dun-remove-obj-from-inven obj-axe)) (dun-mprincl "Your axe breaks it into a million pieces.") (dun-remove-obj-from-room dun-current-room objnum))))))))) (defun dun-drive (args) (if (not dun-inbus) (dun-mprincl "You cannot drive when you aren't in a vehicle.") (dun-mprincl "To drive while you are in the bus, just give a direction."))) (defun dun-superb (args) (setq dun-mode 'dun-superb)) (defun dun-reg-score () (let (total) (setq total 0) (dolist (x (nth treasure-room dun-room-objects)) (setq total (+ total (nth x dun-object-pts)))) (if (member obj-URINE (nth treasure-room dun-room-objects)) (setq total 0)) total)) (defun dun-endgame-score () (let (total) (setq total 0) (dolist (x (nth endgame-treasure-room dun-room-objects)) (setq total (+ total (nth x dun-object-pts)))) total)) (defun dun-answer (args) (if (not dun-correct-answer) (dun-mprincl "I don't believe anyone asked you anything.") (setq args (car args)) (if (not args) (dun-mprincl "You must give the answer on the same line.") (if (dun-members args dun-correct-answer) (progn (dun-mprincl "Correct.") (if (= dun-lastdir 0) (setq dun-current-room (1+ dun-current-room)) (setq dun-current-room (- dun-current-room 1))) (setq dun-correct-answer nil)) (dun-mprincl "That answer is incorrect."))))) (defun dun-endgame-question () (if (not dun-endgame-questions) (progn (dun-mprincl "Your question is:") (dun-mprincl "No more questions, just do 'answer foo'.") (setq dun-correct-answer '("foo"))) (let (which i newques) (setq i 0) (setq newques nil) (setq which (random (length dun-endgame-questions))) (dun-mprincl "Your question is:") (dun-mprincl (setq dun-endgame-question (car (nth which dun-endgame-questions)))) (setq dun-correct-answer (cdr (nth which dun-endgame-questions))) (while (< i which) (setq newques (append newques (list (nth i dun-endgame-questions)))) (setq i (1+ i))) (setq i (1+ which)) (while (< i (length dun-endgame-questions)) (setq newques (append newques (list (nth i dun-endgame-questions)))) (setq i (1+ i))) (setq dun-endgame-questions newques)))) (defun dun-power (args) (if (not (= dun-current-room pc-area)) (dun-mprincl "That operation is not applicable here.") (if (not dun-floppy) (dun-dos-no-disk) (dun-dos-interface)))) (defun dun-feed (args) (let (objnum) (when (setq objnum (dun-objnum-from-args-std args)) (if (and (= objnum obj-bear) (member obj-bear (nth dun-current-room dun-room-objects))) (progn (if (not (member obj-food dun-inventory)) (dun-mprincl "You have nothing with which to feed it.") (dun-drop '("food")))) (if (not (or (member objnum (nth dun-current-room dun-room-objects)) (member objnum dun-inventory) (member objnum (nth dun-current-room dun-room-silents)))) (dun-mprincl "I don't see that here.") (dun-mprincl "You cannot feed that.")))))) ;;;; ;;;; This section defines various utility functions used ;;;; by dunnet. ;;;; ;;; Function which takes a verb and a list of other words. Calls proper ;;; function associated with the verb, and passes along the other words. (defun dun-doverb (dun-ignore dun-verblist verb rest) (if (not verb) nil (if (member (intern verb) dun-ignore) (if (not (car rest)) -1 (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) (if (not (cdr (assq (intern verb) dun-verblist))) -1 (setq dun-numcmds (1+ dun-numcmds)) (eval (list (cdr (assq (intern verb) dun-verblist)) (quote rest))))))) ;;; Function to take a string and change it into a list of lowercase words. (defun dun-listify-string (strin) (let (pos ret-list end-pos) (setq pos 0) (setq ret-list nil) (while (setq end-pos (string-match "[ ,:;]" (substring strin pos))) (setq end-pos (+ end-pos pos)) (if (not (= end-pos pos)) (setq ret-list (append ret-list (list (downcase (substring strin pos end-pos)))))) (setq pos (+ end-pos 1))) ret-list)) (defun dun-listify-string2 (strin) (let (pos ret-list end-pos) (setq pos 0) (setq ret-list nil) (while (setq end-pos (string-match " " (substring strin pos))) (setq end-pos (+ end-pos pos)) (if (not (= end-pos pos)) (setq ret-list (append ret-list (list (downcase (substring strin pos end-pos)))))) (setq pos (+ end-pos 1))) ret-list)) (defun dun-replace (list n number) (rplaca (nthcdr n list) number)) ;;; Get the first non-ignored word from a list. (defun dun-firstword (list) (if (not (car list)) nil (while (and list (member (intern (car list)) dun-ignore)) (setq list (cdr list))) (car list))) (defun dun-firstwordl (list) (if (not (car list)) nil (while (and list (member (intern (car list)) dun-ignore)) (setq list (cdr list))) list)) ;;; parse a line passed in as a string Call the proper verb with the ;;; rest of the line passed in as a list. (defun dun-vparse (dun-ignore dun-verblist line) (dun-mprinc "\n") (setq line-list (dun-listify-string (concat line " "))) (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) (defun dun-parse2 (dun-ignore dun-verblist line) (dun-mprinc "\n") (setq line-list (dun-listify-string2 (concat line " "))) (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) ;;; Read a line, in window mode (defun dun-read-line () (let (line) (setq line (read-string "")) (dun-mprinc line) line)) ;;; Insert something into the window buffer (defun dun-minsert (string) (if (stringp string) (insert string) (insert (prin1-to-string string)))) ;;; Print something out, in window mode (defun dun-mprinc (string) (if (stringp string) (insert string) (insert (prin1-to-string string)))) ;;; In window mode, keep screen from jumping by keeping last line at ;;; the bottom of the screen. (defun dun-fix-screen () (interactive) (forward-line (- 0 (- (window-height) 2 ))) (set-window-start (selected-window) (point)) (end-of-buffer)) ;;; Insert something into the buffer, followed by newline. (defun dun-minsertl (string) (dun-minsert string) (dun-minsert "\n")) ;;; Print something, followed by a newline. (defun dun-mprincl (string) (dun-mprinc string) (dun-mprinc "\n")) ;;; Function which will get an object number given the list of ;;; words in the command, except for the verb. (defun dun-objnum-from-args (obj) (let (objnum) (setq obj (dun-firstword obj)) (if (not obj) obj-special (setq objnum (cdr (assq (intern obj) dun-objnames)))))) (defun dun-objnum-from-args-std (obj) (let (result) (if (eq (setq result (dun-objnum-from-args obj)) obj-special) (dun-mprincl "You must supply an object.")) (if (eq result nil) (dun-mprincl "I don't know what that is.")) (if (eq result obj-special) nil result))) ;;; Take a short room description, and change spaces and slashes to dashes. (defun dun-space-to-hyphen (string) (let (space) (if (setq space (string-match "[ /]" string)) (progn (setq string (concat (substring string 0 space) "-" (substring string (1+ space)))) (dun-space-to-hyphen string)) string))) ;;; Given a unix style pathname, build a list of path components (recursive) (defun dun-get-path (dirstring startlist) (let (slash pos) (if (= (length dirstring) 0) startlist (if (string= (substring dirstring 0 1) "/") (dun-get-path (substring dirstring 1) (append startlist (list "/"))) (if (not (setq slash (string-match "/" dirstring))) (append startlist (list dirstring)) (dun-get-path (substring dirstring (1+ slash)) (append startlist (list (substring dirstring 0 slash))))))))) ;;; Is a string a member of a string list? (defun dun-members (string string-list) (let (found) (setq found nil) (dolist (x string-list) (if (string= x string) (setq found t))) found)) ;;; Function to put objects in the treasure room. Also prints current ;;; score to let user know he has scored. (defun dun-put-objs-in-treas (objlist) (let (oscore newscore) (setq oscore (dun-reg-score)) (dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist)) (setq newscore (dun-reg-score)) (if (not (= oscore newscore)) (dun-score nil)))) ;;; Load an encrypted file, and eval it. (defun dun-load-d (filename) (let (old-buffer result) (setq result t) (setq old-buffer (current-buffer)) (switch-to-buffer (get-buffer-create "*loadc*")) (erase-buffer) (condition-case nil (insert-file-contents filename) (error (setq result nil))) (unless (not result) (condition-case nil (dun-rot13) (error (yank))) (eval-current-buffer) (kill-buffer (current-buffer)) (switch-to-buffer old-buffer)) result)) ;;; Functions to remove an object either from a room, or from inventory. (defun dun-remove-obj-from-room (room objnum) (let (newroom) (setq newroom nil) (dolist (x (nth room dun-room-objects)) (if (not (= x objnum)) (setq newroom (append newroom (list x))))) (rplaca (nthcdr room dun-room-objects) newroom))) (defun dun-remove-obj-from-inven (objnum) (let (new-inven) (setq new-inven nil) (dolist (x dun-inventory) (if (not (= x objnum)) (setq new-inven (append new-inven (list x))))) (setq dun-inventory new-inven))) (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper) (setq dun-translate-table (make-vector 256 0)) (while (< i 256) (aset dun-translate-table i i) (setq i (1+ i))) (setq lower (concat lower lower)) (setq upper (upcase lower)) (setq i 0) (while (< i 26) (aset dun-translate-table (+ ?a i) (aref lower (+ i 13))) (aset dun-translate-table (+ ?A i) (aref upper (+ i 13))) (setq i (1+ i)))) (defun dun-rot13 () (let (str len (i 0)) (setq str (buffer-substring (point-min) (point-max))) (setq len (length str)) (while (< i len) (aset str i (aref dun-translate-table (aref str i))) (setq i (1+ i))) (erase-buffer) (insert str))) ;;;; ;;;; This section defines the globals that are used in dunnet. ;;;; ;;;; IMPORTANT ;;;; All globals which can change must be saved from 'save-game. Add ;;;; all new globals to bottom of file. (setq dun-visited '(27)) (setq dun-current-room 1) (setq dun-exitf nil) (setq dun-badcd nil) (defvar dungeon-mode-map nil) (setq dungeon-mode-map (make-sparse-keymap)) (define-key dungeon-mode-map "\r" 'dun-parse) (defvar dungeon-batch-map (make-keymap)) (if (string= (substring emacs-version 0 2) "18") (let (n) (setq n 32) (while (< 0 (setq n (- n 1))) (aset dungeon-batch-map n 'dungeon-nil))) (let (n) (setq n 32) (while (< 0 (setq n (- n 1))) (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil)))) (define-key dungeon-batch-map "\r" 'exit-minibuffer) (define-key dungeon-batch-map "\n" 'exit-minibuffer) (setq dun-computer nil) (setq dun-floppy nil) (setq dun-key-level 0) (setq dun-hole nil) (setq dun-correct-answer nil) (setq dun-lastdir 0) (setq dun-numsaves 0) (setq dun-jar nil) (setq dun-dead nil) (setq room 0) (setq dun-numcmds 0) (setq dun-wizard nil) (setq dun-endgame-question nil) (setq dun-logged-in nil) (setq dungeon-mode 'dungeon) (setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) (rlogin . dun-rlogin) (uncompress . dun-uncompress) (cat . dun-cat) (zippy . dun-zippy))) (setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) (exit . dun-dos-exit) (command . dun-dos-spawn) (b: . dun-dos-invd) (c: . dun-dos-invd) (a: . dun-dos-nil))) (setq dun-batch-mode nil) (setq dun-cdpath "/usr/toukmond") (setq dun-cdroom -10) (setq dun-uncompressed nil) (setq dun-ethernet t) (setq dun-restricted '(dun-room-objects dungeon-map dun-rooms dun-room-silents dun-combination)) (setq dun-ftptype 'ascii) (setq dun-endgame nil) (setq dun-gottago t) (setq dun-black nil) (setq dun-rooms '( ( "You are in the treasure room. A door leads out to the north." "Treasure room" ) ( "You are at a dead end of a dirt road. The road goes to the east. In the distance you can see that it will eventually fork off. The trees here are very tall royal palms, and they are spaced equidistant from each other." "Dead end" ) ( "You are on the continuation of a dirt road. There are more trees on both sides of you. The road continues to the east and west." "E/W Dirt road" ) ( "You are at a fork of two passages, one to the northeast, and one to the southeast. The ground here seems very soft. You can also go back west." "Fork" ) ( "You are on a northeast/southwest road." "NE/SW road" ) ( "You are at the end of the road. There is a building in front of you to the northeast, and the road leads back to the southwest." "Building front" ) ( "You are on a southeast/northwest road." "SE/NW road" ) ( "You are standing at the end of a road. A passage leads back to the northwest." "Bear hangout" ) ( "You are in the hallway of an old building. There are rooms to the east and west, and doors leading out to the north and south." "Old Building hallway" ) ( "You are in a mailroom. There are many bins where the mail is usually kept. The exit is to the west." "Mailroom" ) ( "You are in a computer room. It seems like most of the equipment has been removed. There is a VAX 11/780 in front of you, however, with one of the cabinets wide open. A sign on the front of the machine says: This VAX is named 'pokey'. To type on the console, use the 'type' command. The exit is to the east." "Computer room" ) ( "You are in a meadow in the back of an old building. A small path leads to the west, and a door leads to the south." "Meadow" ) ( "You are in a round, stone room with a door to the east. There is a sign on the wall that reads: 'receiving room'." "Receiving room" ) ( "You are at the south end of a hallway that leads to the north. There are rooms to the east and west." "Northbound Hallway" ) ( "You are in a sauna. There is nothing in the room except for a dial on the wall. A door leads out to west." "Sauna" ) ( "You are at the end of a north/south hallway. You can go back to the south, or off to a room to the east." "End of N/S Hallway" ) ( "You are in an old weight room. All of the equipment is either destroyed or completely broken. There is a door out to the west, and there is a ladder leading down a hole in the floor." "Weight room" ;16 ) ( "You are in a maze of twisty little passages, all alike. There is a button on the ground here." "Maze button room" ) ( "You are in a maze of little twisty passages, all alike." "Maze" ) ( "You are in a maze of thirsty little passages, all alike." "Maze" ;19 ) ( "You are in a maze of twenty little passages, all alike." "Maze" ) ( "You are in a daze of twisty little passages, all alike." "Maze" ;21 ) ( "You are in a maze of twisty little cabbages, all alike." "Maze" ;22 ) ( "You are in a reception area for a health and fitness center. The place appears to have been recently ransacked, and nothing is left. There is a door out to the south, and a crawlspace to the southeast." "Reception area" ) ( "You are outside a large building to the north which used to be a health and fitness center. A road leads to the south." "Health Club front" ) ( "You are at the north side of a lake. On the other side you can see a road which leads to a cave. The water appears very deep." "Lakefront North" ) ( "You are at the south side of a lake. A road goes to the south." "Lakefront South" ) ( "You are in a well-hidden area off to the side of a road. Back to the northeast through the brush you can see the bear hangout." "Hidden area" ) ( "The entrance to a cave is to the south. To the north, a road leads towards a deep lake. On the ground nearby there is a chute, with a sign that says 'put treasures here for points'." "Cave Entrance" ;28 ) ( "You are in a misty, humid room carved into a mountain. To the north is the remains of a rockslide. To the east, a small passage leads away into the darkness." ;29 "Misty Room" ) ( "You are in an east/west passageway. The walls here are made of multicolored rock and are quite beautiful." "Cave E/W passage" ;30 ) ( "You are at the junction of two passages. One goes north/south, and the other goes west." "N/S/W Junction" ;31 ) ( "You are at the north end of a north/south passageway. There are stairs leading down from here. There is also a door leading west." "North end of cave passage" ;32 ) ( "You are at the south end of a north/south passageway. There is a hole in the floor here, into which you could probably fit." "South end of cave passage" ;33 ) ( "You are in what appears to be a worker's bedroom. There is a queen- sized bed in the middle of the room, and a painting hanging on the wall. A door leads to another room to the south, and stairways lead up and down." "Bedroom" ;34 ) ( "You are in a bathroom built for workers in the cave. There is a urinal hanging on the wall, and some exposed pipes on the opposite wall where a sink used to be. To the north is a bedroom." "Bathroom" ;35 ) ( "This is a marker for the urinal. User will not see this, but it is a room that can contain objects." "Urinal" ;36 ) ( "You are at the northeast end of a northeast/southwest passageway. Stairs lead up out of sight." "Ne end of ne/sw cave passage" ;37 ) ( "You are at the junction of northeast/southwest and east/west passages." "Ne/sw-e/w junction" ;38 ) ( "You are at the southwest end of a northeast/southwest passageway." "Sw end of ne/sw cave passage" ;39 ) ( "You are at the east end of an e/w passage. There are stairs leading up to a room above." "East end of e/w cave passage" ;40 ) ( "You are at the west end of an e/w passage. There is a hole on the ground which leads down out of sight." "West end of e/w cave passage" ;41 ) ( "You are in a room which is bare, except for a horseshoe shaped boulder in the center. Stairs lead down from here." ;42 "Horseshoe boulder room" ) ( "You are in a room which is completely empty. Doors lead out to the north and east." "Empty room" ;43 ) ( "You are in an empty room. Interestingly enough, the stones in this room are painted blue. Doors lead out to the east and south." ;44 "Blue room" ) ( "You are in an empty room. Interestingly enough, the stones in this room are painted yellow. Doors lead out to the south and west." ;45 "Yellow room" ) ( "You are in an empty room. Interestingly enough, the stones in this room are painted red. Doors lead out to the west and north." "Red room" ;46 ) ( "You are in the middle of a long north/south hallway." ;47 "Long n/s hallway" ) ( "You are 3/4 of the way towards the north end of a long north/south hallway." "3/4 north" ;48 ) ( "You are at the north end of a long north/south hallway. There are stairs leading upwards." "North end of long hallway" ;49 ) ( "You are 3/4 of the way towards the south end of a long north/south hallway." "3/4 south" ;50 ) ( "You are at the south end of a long north/south hallway. There is a hole to the south." "South end of long hallway" ;51 ) ( "You are at a landing in a stairwell which continues up and down." "Stair landing" ;52 ) ( "You are at the continuation of an up/down staircase." "Up/down staircase" ;53 ) ( "You are at the top of a staircase leading down. A crawlway leads off to the northeast." "Top of staircase." ;54 ) ( "You are in a crawlway that leads northeast or southwest." "Ne crawlway" ;55 ) ( "You are in a small crawlspace. There is a hole in the ground here, and a small passage back to the southwest." "Small crawlspace" ;56 ) ( "You are in the Gamma Computing Center. An IBM 3090/600s is whirring away in here. There is an ethernet cable coming out of one of the units, and going through the ceiling. There is no console here on which you could type." "Gamma computing center" ;57 ) ( "You are near the remains of a post office. There is a mail drop on the face of the building, but you cannot see where it leads. A path leads back to the east, and a road leads to the north." "Post office" ;58 ) ( "You are at the intersection of Main Street and Maple Ave. Main street runs north and south, and Maple Ave runs east off into the distance. If you look north and east you can see many intersections, but all of the buildings that used to stand here are gone. Nothing remains except street signs. There is a road to the northwest leading to a gate that guards a building." "Main-Maple intersection" ;59 ) ( "You are at the intersection of Main Street and the west end of Oaktree Ave." "Main-Oaktree intersection" ;60 ) ( "You are at the intersection of Main Street and the west end of Vermont Ave." "Main-Vermont intersection" ;61 ) ( "You are at the north end of Main Street at the west end of Sycamore Ave." ;62 "Main-Sycamore intersection" ) ( "You are at the south end of First Street at Maple Ave." ;63 "First-Maple intersection" ) ( "You are at the intersection of First Street and Oaktree Ave." ;64 "First-Oaktree intersection" ) ( "You are at the intersection of First Street and Vermont Ave." ;65 "First-Vermont intersection" ) ( "You are at the north end of First Street at Sycamore Ave." ;66 "First-Sycamore intersection" ) ( "You are at the south end of Second Street at Maple Ave." ;67 "Second-Maple intersection" ) ( "You are at the intersection of Second Street and Oaktree Ave." ;68 "Second-Oaktree intersection" ) ( "You are at the intersection of Second Street and Vermont Ave." ;69 "Second-Vermont intersection" ) ( "You are at the north end of Second Street at Sycamore Ave." ;70 "Second-Sycamore intersection" ) ( "You are at the south end of Third Street at Maple Ave." ;71 "Third-Maple intersection" ) ( "You are at the intersection of Third Street and Oaktree Ave." ;72 "Third-Oaktree intersection" ) ( "You are at the intersection of Third Street and Vermont Ave." ;73 "Third-Vermont intersection" ) ( "You are at the north end of Third Street at Sycamore Ave." ;74 "Third-Sycamore intersection" ) ( "You are at the south end of Fourth Street at Maple Ave." ;75 "Fourth-Maple intersection" ) ( "You are at the intersection of Fourth Street and Oaktree Ave." ;76 "Fourth-Oaktree intersection" ) ( "You are at the intersection of Fourth Street and Vermont Ave." ;77 "Fourth-Vermont intersection" ) ( "You are at the north end of Fourth Street at Sycamore Ave." ;78 "Fourth-Sycamore intersection" ) ( "You are at the south end of Fifth Street at the east end of Maple Ave." ;79 "Fifth-Maple intersection" ) ( "You are at the intersection of Fifth Street and the east end of Oaktree Ave. There is a cliff off to the east." "Fifth-Oaktree intersection" ;80 ) ( "You are at the intersection of Fifth Street and the east end of Vermont Ave." "Fifth-Vermont intersection" ;81 ) ( "You are at the north end of Fifth Street and the east end of Sycamore Ave." "Fifth-Sycamore intersection" ;82 ) ( "You are in front of the Museum of Natural History. A door leads into the building to the north, and a road leads to the southeast." "Museum entrance" ;83 ) ( "You are in the main lobby for the Museum of Natural History. In the center of the room is the huge skeleton of a dinosaur. Doors lead out to the south and east." "Museum lobby" ;84 ) ( "You are in the geological display. All of the objects that used to be on display are missing. There are rooms to the east, west, and north." "Geological display" ;85 ) ( "You are in the marine life area. The room is filled with fish tanks, which are filled with dead fish that have apparently died due to starvation. Doors lead out to the south and east." "Marine life area" ;86 ) ( "You are in some sort of maintenance room for the museum. There is a switch on the wall labeled 'BL'. There are doors to the west and north." "Maintenance room" ;87 ) ( "You are in a classroom where school children were taught about natural history. On the blackboard is written, 'No children allowed downstairs.' There is a door to the east with an 'exit' sign on it. There is another door to the west." "Classroom" ;88 ) ( "You are at the Vermont St. subway station. A train is sitting here waiting." "Vermont station" ;89 ) ( "You are at the Museum subway stop. A passage leads off to the north." "Museum station" ;90 ) ( "You are in a north/south tunnel." "N/S tunnel" ;91 ) ( "You are at the north end of a north/south tunnel. Stairs lead up and down from here. There is a garbage disposal here." "North end of n/s tunnel" ;92 ) ( "You are at the top of some stairs near the subway station. There is a door to the west." "Top of subway stairs" ;93 ) ( "You are at the bottom of some stairs near the subway station. There is a room to the northeast." "Bottom of subway stairs" ;94 ) ( "You are in another computer room. There is a computer in here larger than you have ever seen. It has no manufacturers name on it, but it does have a sign that says: This machine's name is 'endgame'. The exit is to the southwest. There is no console here on which you could type." "Endgame computer room" ;95 ) ( "You are in a north/south hallway." "Endgame n/s hallway" ;96 ) ( "You have reached a question room. You must answer a question correctly in order to get by. Use the 'answer' command to answer the question." "Question room 1" ;97 ) ( "You are in a north/south hallway." "Endgame n/s hallway" ;98 ) ( "You are in a second question room." "Question room 2" ;99 ) ( "You are in a north/south hallway." "Endgame n/s hallway" ;100 ) ( "You are in a third question room." "Question room 3" ;101 ) ( "You are in the endgame treasure room. A door leads out to the north, and a hallway leads to the south." "Endgame treasure room" ;102 ) ( "You are in the winner's room. A door leads back to the south." "Winner's room" ;103 ) ( "You have reached a dead end. There is a PC on the floor here. Above it is a sign that reads: Type the 'reset' command to type on the PC. A hole leads north." "PC area" ;104 ) )) (setq dun-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83)) (setq dun-verblist '((die . dun-die) (ne . dun-ne) (north . dun-n) (south . dun-s) (east . dun-e) (west . dun-w) (u . dun-up) (d . dun-down) (i . dun-inven) (inventory . dun-inven) (look . dun-examine) (n . dun-n) (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se) (nw . dun-nw) (sw . dun-sw) (up . dun-up) (down . dun-down) (in . dun-in) (out . dun-out) (go . dun-go) (drop . dun-drop) (southeast . dun-se) (southwest . dun-sw) (northeast . dun-ne) (northwest . dun-nw) (save . dun-save-game) (restore . dun-restore) (long . dun-long) (dig . dun-dig) (shake . dun-shake) (wave . dun-shake) (examine . dun-examine) (describe . dun-examine) (climb . dun-climb) (eat . dun-eat) (put . dun-put) (type . dun-type) (insert . dun-put) (score . dun-score) (help . dun-help) (quit . dun-quit) (read . dun-examine) (verbose . dun-long) (urinate . dun-piss) (piss . dun-piss) (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) (x . dun-examine) (break . dun-break) (drive . dun-drive) (board . dun-in) (enter . dun-in) (turn . dun-turn) (press . dun-press) (push . dun-press) (swim . dun-swim) (on . dun-in) (off . dun-out) (chop . dun-break) (switch . dun-press) (cut . dun-break) (exit . dun-out) (leave . dun-out) (reset . dun-power) (flick . dun-press) (superb . dun-superb) (answer . dun-answer) (throw . dun-drop) (l . dun-examine) (take . dun-take) (get . dun-take) (feed . dun-feed))) (setq dun-inbus nil) (setq dun-nomail nil) (setq dun-ignore '(the to at)) (setq dun-mode 'moby) (setq dun-sauna-level 0) (defconst north 0) (defconst south 1) (defconst east 2) (defconst west 3) (defconst northeast 4) (defconst southeast 5) (defconst northwest 6) (defconst southwest 7) (defconst up 8) (defconst down 9) (defconst in 10) (defconst out 11) (setq dungeon-map '( ; no so ea we ne se nw sw up do in ot ( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;104 ) ; no so ea we ne se nw sw up do in ot ) ;;; How the user references *all* objects, permanent and regular. (setq dun-objnames '( (shovel . 0) (lamp . 1) (cpu . 2) (board . 2) (card . 2) (food . 3) (key . 4) (paper . 5) (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) (diamond . 7) (weight . 8) (life . 9) (preserver . 9) (bracelet . 10) (emerald . 10) (gold . 11) (platinum . 12) (towel . 13) (beach . 13) (axe . 14) (silver . 15) (license . 16) (coins . 17) (egg . 18) (jar . 19) (bone . 20) (acid . 21) (nitric . 21) (glycerine . 22) (ruby . 23) (amethyst . 24) (mona . 25) (bill . 26) (floppy . 27) (disk . 27) (boulder . -1) (tree . -2) (trees . -2) (bear . -3) (bin . -4) (bins . -4) (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) (protoplasm . -6) (dial . -7) (button . -8) (chute . -9) (painting . -10) (bed . -11) (urinal . -12) (URINE . -13) (pipes . -14) (pipe . -14) (box . -15) (slit . -15) (cable . -16) (ethernet . -16) (mail . -17) (drop . -17) (bus . -18) (gate . -19) (cliff . -20) (skeleton . -21) (dinosaur . -21) (fish . -22) (tanks . -23) (switch . -24) (blackboard . -25) (disposal . -26) (garbage . -26) (ladder . -27) (subway . -28) (train . -28) (pc . -29) (drive . -29) )) (dolist (x dun-objnames) (let (name) (setq name (concat "obj-" (prin1-to-string (car x)))) (eval (list 'defconst (intern name) (cdr x))))) (defconst obj-special 255) ;;; The initial setup of what objects are in each room. ;;; Regular objects have whole numbers lower than 255. ;;; Objects that cannot be taken but might move and are ;;; described during room description are negative. ;;; Stuff that is described and might change are 255, and are ;;; handled specially by 'dun-describe-room. (setq dun-room-objects (list nil (list obj-shovel) ;; treasure-room (list obj-boulder) ;; dead-end nil nil nil (list obj-food) ;; se-nw-road (list obj-bear) ;; bear-hangout nil nil (list obj-special) ;; computer-room (list obj-lamp obj-license obj-silver);; meadow nil nil (list obj-special) ;; sauna nil (list obj-weight obj-life) ;; weight-room nil nil (list obj-rms obj-floppy) ;; thirsty-maze nil nil nil nil nil nil nil (list obj-emerald) ;; hidden-area nil (list obj-gold) ;; misty-room nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil (list obj-towel obj-special) ;; red-room nil nil nil nil nil (list obj-box) ;; stair-landing nil nil nil (list obj-axe) ;; smal-crawlspace nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil (list obj-special) ;; fourth-vermont-intersection nil nil (list obj-coins) ;; fifth-oaktree-intersection nil (list obj-bus) ;; fifth-sycamore-intersection nil (list obj-bone) ;; museum-lobby nil (list obj-jar obj-special obj-ruby) ;; marine-life-area (list obj-nitric) ;; maintenance-room (list obj-glycerine) ;; classroom nil nil nil nil nil (list obj-amethyst) ;; bottom-of-subway-stairs nil nil (list obj-special) ;; question-room-1 nil (list obj-special) ;; question-room-2 nil (list obj-special) ;; question-room-three nil (list obj-mona) ;; winner's-room nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)) ;;; These are objects in a room that are only described in the ;;; room description. They are permanent. (setq dun-room-silents (list nil (list obj-tree) ;; dead-end (list obj-tree) ;; e-w-dirt-road nil nil nil nil nil nil (list obj-bin) ;; mailroom (list obj-computer) ;; computer-room nil nil nil (list obj-dial) ;; sauna nil (list obj-ladder) ;; weight-room (list obj-button obj-ladder) ;; maze-button-room nil nil nil nil nil nil nil nil nil nil (list obj-chute) ;; cave-entrance nil nil nil nil nil (list obj-painting obj-bed) ;; bedroom (list obj-urinal obj-pipes) ;; bathroom nil nil nil nil nil nil (list obj-boulder) ;; horseshoe-boulder-room nil nil nil nil nil nil nil nil nil nil nil nil nil nil (list obj-computer obj-cable) ;; gamma-computing-center (list obj-mail) ;; post-office (list obj-gate) ;; main-maple-intersection nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil (list obj-cliff) ;; fifth-oaktree-intersection nil nil nil (list obj-dinosaur) ;; museum-lobby nil (list obj-fish obj-tanks) ;; marine-life-area (list obj-switch) ;; maintenance-room (list obj-blackboard) ;; classroom (list obj-train) ;; vermont-station nil nil (list obj-disposal) ;; north-end-of-n-s-tunnel nil nil (list obj-computer) ;; endgame-computer-room nil nil nil nil nil nil nil nil (list obj-pc) ;; pc-area nil nil nil nil nil nil )) (setq dun-inventory '(1)) ;;; Descriptions of objects, as they appear in the room description, and ;;; the inventory. (setq dun-objects '( ("There is a shovel here." "A shovel") ;0 ("There is a lamp nearby." "A lamp") ;1 ("There is a CPU card here." "A computer board") ;2 ("There is some food here." "Some food") ;3 ("There is a shiny brass key here." "A brass key") ;4 ("There is a slip of paper here." "A slip of paper") ;5 ("There is a wax statuette of Richard Stallman here." ;6 "An RMS statuette") ("There is a shimmering diamond here." "A diamond") ;7 ("There is a 10 pound weight here." "A weight") ;8 ("There is a life preserver here." "A life preserver");9 ("There is an emerald bracelet here." "A bracelet") ;10 ("There is a gold bar here." "A gold bar") ;11 ("There is a platinum bar here." "A platinum bar") ;12 ("There is a beach towel on the ground here." "A beach towel") ("There is an axe here." "An axe") ;14 ("There is a silver bar here." "A silver bar") ;15 ("There is a bus driver's license here." "A license") ;16 ("There are some valuable coins here." "Some valuable coins") ("There is a jewel-encrusted egg here." "A valuable egg") ;18 ("There is a glass jar here." "A glass jar") ;19 ("There is a dinosaur bone here." "A bone") ;20 ("There is a packet of nitric acid here." "Some nitric acid") ("There is a packet of glycerine here." "Some glycerine") ;22 ("There is a valuable ruby here." "A ruby") ;23 ("There is a valuable amethyst here." "An amethyst") ;24 ("The Mona Lisa is here." "The Mona Lisa") ;25 ("There is a 100 dollar bill here." "A $100 bill") ;26 ("There is a floppy disk here." "A floppy disk") ;27 ) ) ;;; Weight of objects (setq dun-object-lbs '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) (setq dun-object-pts '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) ;;; Unix representation of objects. (setq dun-objfiles '( "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" "ruby.o" "amethyst.o" )) ;;; These are the descriptions for the negative numbered objects from ;;; dun-room-objects (setq dun-perm-objects '( nil ("There is a large boulder here.") nil ("There is a ferocious bear here!") nil nil ("There is a worthless pile of protoplasm here.") nil nil nil nil nil nil ("There is a strange smell in this room.") nil ( "There is a box with a slit in it, bolted to the wall here." ) nil nil ("There is a bus here.") nil nil nil )) ;;; These are the descriptions the user gets when regular objects are ;;; examined. (setq dun-physobj-desc '( "It is a normal shovel with a price tag attached that says $19.99." "The lamp is hand-crafted by Geppetto." "The CPU board has a VAX chip on it. It seems to have 2 Megabytes of RAM onboard." "It looks like some kind of meat. Smells pretty bad." nil "The paper says: Don't forget to type 'help' for help. Also, remember this word: 'worms'" "The statuette is of the likeness of Richard Stallman, the author of the famous EMACS editor. You notice that he is not wearing any shoes." nil "You observe that the weight is heavy." "It says S. S. Minnow." nil nil nil "It has a picture of snoopy on it." nil nil "It has your picture on it!" "They are old coins from the 19th century." "It is a valuable Fabrege egg." "It is a a plain glass jar." nil nil nil nil nil ) ) ;;; These are the descriptions the user gets when non-regular objects ;;; are examined. (setq dun-permobj-desc '( nil "It is just a boulder. It cannot be moved." "They are palm trees with a bountiful supply of coconuts in them." "It looks like a grizzly to me." "All of the bins are empty. Looking closely you can see that there are names written at the bottom of each bin, but most of them are faded away so that you cannot read them. You can only make out three names: Jeffrey Collier Robert Toukmond Thomas Stock " nil "It is just a garbled mess." "The dial points to a temperature scale which has long since faded away." nil nil "It is a velvet painting of Elvis Presly. It seems to be nailed to the wall, and you cannot move it." "It is a queen sized bed, with a very firm mattress." "The urinal is very clean compared with everything else in the cave. There isn't even any rust. Upon close examination you realize that the drain at the bottom is missing, and there is just a large hole leading down the pipes into nowhere. The hole is too small for a person to fit in. The flush handle is so clean that you can see your reflection in it." nil nil "The box has a slit in the top of it, and on it, in sloppy handwriting, is written: 'For key upgrade, put key in here.'" nil "It says 'express mail' on it." "It is a 35 passenger bus with the company name 'mobytours' on it." "It is a large metal gate that is too big to climb over." "It is a HIGH cliff." "Unfortunately you do not know enough about dinosaurs to tell very much about it. It is very big, though." "The fish look like they were once quite beautiful." nil nil nil nil "It is a normal ladder that is permanently attached to the hole." "It is a passenger train that is ready to go." "It is a personal computer that has only one floppy disk drive." ) ) (setq dun-diggables (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil ;11-20 nil nil nil nil nil nil nil nil nil nil ;21-30 nil nil nil nil nil nil nil nil nil nil ;31-40 nil (list obj-platinum) nil nil nil nil nil nil nil nil)) (setq scroll-step 2) (setq dun-room-shorts nil) (dolist (x dun-rooms) (setq dun-room-shorts (append dun-room-shorts (list (downcase (dun-space-to-hyphen (cadr x))))))) (setq dun-endgame-questions '( ( "What is your password on the machine called 'pokey'?" "robert") ( "What password did you use during anonymous ftp to gamma?" "foo") ( "Excluding the endgame, how many places are there where you can put treasures for points?" "4" "four") ( "What is your login name on the 'endgame' machine?" "toukmond" ) ( "What is the nearest whole dollar to the price of the shovel?" "20" "twenty") ( "What is the name of the bus company serving the town?" "mobytours") ( "Give either of the two last names in the mailroom, other than your own." "collier" "stock") ( "What cartoon character is on the towel?" "snoopy") ( "What is the last name of the author of EMACS?" "stallman") ( "How many megabytes of memory is on the CPU board for the Vax?" "2") ( "Which street in town is named after a U.S. state?" "vermont") ( "How many pounds did the weight weigh?" "ten" "10") ( "Name the STREET which runs right over the subway stop." "fourth" "4" "4th") ( "How many corners are there in town (excluding the one with the Post Office)?" "24" "twentyfour" "twenty-four") ( "What type of bear was hiding your key?" "grizzly") ( "Name either of the two objects you found by digging." "cpu" "card" "vax" "board" "platinum") ( "What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp") )) (let (a) (setq a 0) (dolist (x dun-room-shorts) (eval (list 'defconst (intern x) a)) (setq a (+ a 1)))) ;;;; ;;;; This section defines the UNIX emulation functions for dunnet. ;;;; (defun dun-unix-parse (args) (interactive "*p") (beginning-of-line) (let (beg esign) (setq beg (+ (point) 2)) (end-of-line) (if (and (not (= beg (point))) (string= "$" (buffer-substring (- beg 2) (- beg 1)))) (progn (setq line (downcase (buffer-substring beg (point)))) (princ line) (if (eq (dun-parse2 nil dun-unix-verbs line) -1) (progn (if (setq esign (string-match "=" line)) (dun-doassign line esign) (dun-mprinc (car line-list)) (dun-mprincl ": not found."))))) (goto-char (point-max)) (dun-mprinc "\n")) (if (eq dungeon-mode 'unix) (progn (dun-fix-screen) (dun-mprinc "$ "))))) (defun dun-doassign (line esign) (if (not dun-wizard) (let (passwd) (dun-mprinc "Enter wizard password: ") (setq passwd (dun-read-line)) (if (not dun-batch-mode) (dun-mprinc "\n")) (if (string= passwd "moby") (progn (setq dun-wizard t) (dun-doassign line esign)) (dun-mprincl "Incorrect."))) (let (varname epoint afterq i value) (setq varname (substring line 0 esign)) (if (not (setq epoint (string-match ")" line))) (if (string= (substring line (1+ esign) (+ esign 2)) "\"") (progn (setq afterq (substring line (+ esign 2))) (setq epoint (+ (string-match "\"" afterq) (+ esign 3)))) (if (not (setq epoint (string-match " " line))) (setq epoint (length line)))) (setq epoint (1+ epoint)) (while (and (not (= epoint (length line))) (setq i (string-match ")" (substring line epoint)))) (setq epoint (+ epoint i 1)))) (setq value (substring line (1+ esign) epoint)) (dun-eval varname value)))) (defun dun-eval (varname value) (let (eval-error) (switch-to-buffer (get-buffer-create "*dungeon-eval*")) (erase-buffer) (insert "(setq ") (insert varname) (insert " ") (insert value) (insert ")") (setq eval-error nil) (condition-case nil (eval-current-buffer) (error (setq eval-error t))) (kill-buffer (current-buffer)) (switch-to-buffer "*dungeon*") (if eval-error (dun-mprincl "Invalid syntax.")))) (defun dun-unix-interface () (dun-login) (if dun-logged-in (progn (setq dungeon-mode 'unix) (define-key dungeon-mode-map "\r" 'dun-unix-parse) (dun-mprinc "$ ")))) (defun dun-login () (let (tries username password) (setq tries 4) (while (and (not dun-logged-in) (> (setq tries (- tries 1)) 0)) (dun-mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: ") (setq username (dun-read-line)) (if (not dun-batch-mode) (dun-mprinc "\n")) (dun-mprinc "password: ") (setq password (dun-read-line)) (if (not dun-batch-mode) (dun-mprinc "\n")) (if (or (not (string= username "toukmond")) (not (string= password "robert"))) (dun-mprincl "login incorrect") (setq dun-logged-in t) (dun-mprincl " Welcome to Unix\n Please clean up your directories. The filesystem is getting full. Our tcp/ip link to gamma is a little flakey, but seems to work. The current version of ftp can only send files from the current directory, and deletes them after they are sent! Be careful. Note: Restricted bourne shell in use.\n"))) (setq dungeon-mode 'dungeon))) (defun dun-ls (args) (if (car args) (let (ocdpath ocdroom) (setq ocdpath dun-cdpath) (setq ocdroom dun-cdroom) (if (not (eq (dun-cd args) -2)) (dun-ls nil)) (setq dun-cdpath ocdpath) (setq dun-cdroom ocdroom)) (if (= dun-cdroom -10) (dun-ls-inven)) (if (= dun-cdroom -2) (dun-ls-rooms)) (if (= dun-cdroom -3) (dun-ls-root)) (if (= dun-cdroom -4) (dun-ls-usr)) (if (> dun-cdroom 0) (dun-ls-room)))) (defun dun-ls-root () (dun-mprincl "total 4 drwxr-xr-x 3 root staff 512 Jan 1 1970 . drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. drwxr-xr-x 3 root staff 2048 Jan 1 1970 usr drwxr-xr-x 3 root staff 2048 Jan 1 1970 rooms")) (defun dun-ls-usr () (dun-mprincl "total 4 drwxr-xr-x 3 root staff 512 Jan 1 1970 . drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 toukmond")) (defun dun-ls-rooms () (dun-mprincl "total 16 drwxr-xr-x 3 root staff 512 Jan 1 1970 . drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dolist (x dun-visited) (dun-mprinc "drwxr-xr-x 3 root staff 512 Jan 1 1970 ") (dun-mprincl (nth x dun-room-shorts)))) (defun dun-ls-room () (dun-mprincl "total 4 drwxr-xr-x 3 root staff 512 Jan 1 1970 . drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. -rwxr-xr-x 3 root staff 2048 Jan 1 1970 description") (dolist (x (nth dun-cdroom dun-room-objects)) (if (and (>= x 0) (not (= x 255))) (progn (dun-mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") (dun-mprincl (nth x dun-objfiles)))))) (defun dun-ls-inven () (dun-mprinc "total 467 drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 . drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (dolist (x dun-unix-verbs) (if (not (eq (car x) 'IMPOSSIBLE)) (progn (dun-mprinc" -rwxr-xr-x 1 toukmond restricted 10423 Jan 1 1970 ") (dun-mprinc (car x))))) (dun-mprinc "\n") (if (not dun-uncompressed) (dun-mprincl "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 paper.o.Z")) (dolist (x dun-inventory) (dun-mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") (dun-mprincl (nth x dun-objfiles)))) (defun dun-echo (args) (let (nomore var) (setq nomore nil) (dolist (x args) (if (not nomore) (progn (if (not (string= (substring x 0 1) "$")) (progn (dun-mprinc x) (dun-mprinc " ")) (setq var (intern (substring x 1))) (if (not (boundp var)) (dun-mprinc " ") (if (member var dun-restricted) (progn (dun-mprinc var) (dun-mprinc ": Permission denied") (setq nomore t)) (eval (list 'dun-mprinc var)) (dun-mprinc " "))))))) (dun-mprinc "\n"))) (defun dun-ftp (args) (let (host username passwd ident newlist) (if (not (car args)) (dun-mprincl "ftp: hostname required on command line.") (setq host (intern (car args))) (if (not (member host '(gamma dun-endgame))) (dun-mprincl "ftp: Unknown host.") (if (eq host 'dun-endgame) (dun-mprincl "ftp: connection to endgame not allowed") (if (not dun-ethernet) (dun-mprincl "ftp: host not responding.") (dun-mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70") (dun-mprinc "Username: ") (setq username (dun-read-line)) (if (string= username "toukmond") (if dun-batch-mode (dun-mprincl "toukmond ftp access not allowed.") (dun-mprincl "\ntoukmond ftp access not allowed.")) (if (string= username "anonymous") (if dun-batch-mode (dun-mprincl "Guest login okay, send your user ident as password.") (dun-mprincl "\nGuest login okay, send your user ident as password.")) (if dun-batch-mode (dun-mprinc "Password required for ") (dun-mprinc "\nPassword required for ")) (dun-mprincl username)) (dun-mprinc "Password: ") (setq ident (dun-read-line)) (if (not (string= username "anonymous")) (if dun-batch-mode (dun-mprincl "Login failed.") (dun-mprincl "\nLogin failed.")) (if dun-batch-mode (dun-mprincl "Guest login okay, user access restrictions apply.") (dun-mprincl "\nGuest login okay, user access restrictions apply.")) (dun-ftp-commands) (setq newlist '("What password did you use during anonymous ftp to gamma?")) (setq newlist (append newlist (list ident))) (rplaca (nthcdr 1 dun-endgame-questions) newlist))))))))) (defun dun-ftp-commands () (setq dun-exitf nil) (let (line) (while (not dun-exitf) (dun-mprinc "ftp> ") (setq line (dun-read-line)) (if (eq (dun-parse2 nil '((type . dun-ftptype) (binary . dun-bin) (bin . dun-bin) (send . dun-send) (put . dun-send) (quit . dun-ftpquit) (help . dun-ftphelp)(ascii . dun-fascii) ) line) -1) (dun-mprincl "No such command. Try help."))) (setq dun-ftptype 'ascii))) (defun dun-ftptype (args) (if (not (car args)) (dun-mprincl "Usage: type [binary | ascii]") (setq args (intern (car args))) (if (eq args 'binary) (dun-bin nil) (if (eq args 'ascii) (dun-fascii 'nil) (dun-mprincl "Unknown type."))))) (defun dun-bin (args) (dun-mprincl "Type set to binary.") (setq dun-ftptype 'binary)) (defun dun-fascii (args) (dun-mprincl "Type set to ascii.") (setq dun-ftptype 'ascii)) (defun dun-ftpquit (args) (setq dun-exitf t)) (defun dun-send (args) (if (not (car args)) (dun-mprincl "Usage: send ") (setq args (car args)) (let (counter foo) (setq foo nil) (setq counter 0) ;;; User can send commands! Stupid user. (if (assq (intern args) dun-unix-verbs) (progn (rplaca (assq (intern args) dun-unix-verbs) 'IMPOSSIBLE) (dun-mprinc "Sending ") (dun-mprinc dun-ftptype) (dun-mprinc " file for ") (dun-mprincl args) (dun-mprincl "Transfer complete.")) (dolist (x dun-objfiles) (if (string= args x) (progn (if (not (member counter dun-inventory)) (progn (dun-mprincl "No such file.") (setq foo t)) (dun-mprinc "Sending ") (dun-mprinc dun-ftptype) (dun-mprinc " file for ") (dun-mprinc (downcase (cadr (nth counter dun-objects)))) (dun-mprincl ", (0 bytes)") (if (not (eq dun-ftptype 'binary)) (progn (if (not (member obj-protoplasm (nth receiving-room dun-room-objects))) (dun-replace dun-room-objects receiving-room (append (nth receiving-room dun-room-objects) (list obj-protoplasm)))) (dun-remove-obj-from-inven counter)) (dun-remove-obj-from-inven counter) (dun-replace dun-room-objects receiving-room (append (nth receiving-room dun-room-objects) (list counter)))) (setq foo t) (dun-mprincl "Transfer complete.")))) (setq counter (+ 1 counter))) (if (not foo) (dun-mprincl "No such file.")))))) (defun dun-ftphelp (args) (dun-mprincl "Possible commands are:\nsend quit type ascii binary help")) (defun dun-uexit (args) (setq dungeon-mode 'dungeon) (dun-mprincl "\nYou step back from the console.") (define-key dungeon-mode-map "\r" 'dun-parse) (if (not dun-batch-mode) (dun-messages))) (defun dun-pwd (args) (dun-mprincl dun-cdpath)) (defun dun-uncompress (args) (if (not (car args)) (dun-mprincl "Usage: uncompress ") (setq args (car args)) (if (or dun-uncompressed (and (not (string= args "paper.o")) (not (string= args "paper.o.z")))) (dun-mprincl "Uncompress command failed.") (setq dun-uncompressed t) (setq dun-inventory (append dun-inventory (list obj-paper)))))) (defun dun-rlogin (args) (let (passwd) (if (not (car args)) (dun-mprincl "Usage: rlogin ") (setq args (car args)) (if (string= args "endgame") (dun-rlogin-endgame) (if (not (string= args "gamma")) (dun-mprincl "No such host.") (if (not dun-ethernet) (dun-mprincl "Host not responding.") (dun-mprinc "Password: ") (setq passwd (dun-read-line)) (if (not (string= passwd "worms")) (dun-mprincl "\nlogin incorrect") (dun-mprinc "\nYou begin to feel strange for a moment, and you lose your items." ) (dun-replace dun-room-objects computer-room (append (nth computer-room dun-room-objects) dun-inventory)) (setq dun-inventory nil) (setq dun-current-room receiving-room) (dun-uexit nil)))))))) (defun dun-cd (args) (let (tcdpath tcdroom path-elemants room-check) (if (not (car args)) (dun-mprincl "Usage: cd ") (setq tcdpath dun-cdpath) (setq tcdroom dun-cdroom) (setq dun-badcd nil) (condition-case nil (setq path-elements (dun-get-path (car args) nil)) (error (dun-mprincl "Invalid path.") (setq dun-badcd t))) (dolist (pe path-elements) (unless dun-badcd (if (not (string= pe ".")) (if (string= pe "..") (progn (if (> tcdroom 0) ;In a room (progn (setq tcdpath "/rooms") (setq tcdroom -2)) ;In /rooms,/usr,root (if (or (= tcdroom -2) (= tcdroom -4) (= tcdroom -3)) (progn (setq tcdpath "/") (setq tcdroom -3)) (if (= tcdroom -10) ;In /usr/toukmond (progn (setq tcdpath "/usr") (setq tcdroom -4)))))) (if (string= pe "/") (progn (setq tcdpath "/") (setq tcdroom -3)) (if (= tcdroom -4) (if (string= pe "toukmond") (progn (setq tcdpath "/usr/toukmond") (setq tcdroom -10)) (dun-nosuchdir)) (if (= tcdroom -10) (dun-nosuchdir) (if (> tcdroom 0) (dun-nosuchdir) (if (= tcdroom -3) (progn (if (string= pe "rooms") (progn (setq tcdpath "/rooms") (setq tcdroom -2)) (if (string= pe "usr") (progn (setq tcdpath "/usr") (setq tcdroom -4)) (dun-nosuchdir)))) (if (= tcdroom -2) (progn (dolist (x dun-visited) (setq room-check (nth x dun-room-shorts)) (if (string= room-check pe) (progn (setq tcdpath (concat "/rooms/" room-check)) (setq tcdroom x)))) (if (= tcdroom -2) (dun-nosuchdir))))))))))))) (if (not dun-badcd) (progn (setq dun-cdpath tcdpath) (setq dun-cdroom tcdroom) 0) -2)))) (defun dun-nosuchdir () (dun-mprincl "No such directory.") (setq dun-badcd t)) (defun dun-cat (args) (let (doto checklist) (if (not (setq args (car args))) (dun-mprincl "Usage: cat ") (if (string-match "/" args) (dun-mprincl "cat: only files in current directory allowed.") (if (and (> dun-cdroom 0) (string= args "description")) (dun-mprincl (car (nth dun-cdroom dun-rooms))) (if (setq doto (string-match "\\.o" args)) (progn (if (= dun-cdroom -10) (setq checklist dun-inventory) (setq checklist (nth dun-cdroom dun-room-objects))) (if (not (member (cdr (assq (intern (substring args 0 doto)) dun-objnames)) checklist)) (dun-mprincl "File not found.") (dun-mprincl "Ascii files only."))) (if (assq (intern args) dun-unix-verbs) (dun-mprincl "Ascii files only.") (dun-mprincl "File not found.")))))))) (defun dun-zippy (args) (dun-mprincl (yow))) (defun dun-rlogin-endgame () (if (not (= (dun-score nil) 90)) (dun-mprincl "You have not achieved enough points to connect to endgame.") (dun-mprincl"\nWelcome to the endgame. You are a truly noble adventurer.") (setq dun-current-room treasure-room) (setq dun-endgame t) (dun-replace dun-room-objects endgame-treasure-room (list obj-bill)) (dun-uexit nil))) (random t) (setq tloc (+ 60 (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.22/lisp/ebuff-menu.el100444 74777 1 22514 5355241773 14635 0ustar ericdaemon;;; ebuff-menu.el --- electric-buffer-list mode ;; Copyright (C) 1985, 1986 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 Space 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 ((first (progn (goto-char (point-min)) (forward-line 2) (point))) (last (progn (goto-char (point-max)) (forward-line -1) (point))) (goal-column 0)) (goto-char first) (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-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) (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-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.22/lisp/echistory.el100444 12120 1 14414 5406124736 14436 0ustar rmsdaemon;;; 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 \\[Help-for-help] for help, ? for commands, 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.22/lisp/edebug.el100444 12120 1 242462 5474346412 13710 0ustar rmsdaemon;;; edebug.el --- a source-level debugger for emacs lisp ;; Copyright (C) 1988, 1989, 1990, 1991 Free Software Foundation, Inc ;; Author: Daniel LaLiberte ;; Keywords: lisp, tools, maint ;; This is Dan's 2.5 version with some header comments rearranged to separate ;; the Change Log from the Commentary (so the package-finder code can browse ;; the Commentary). ;; 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. ;;;; Commentary: ;;; This minor mode allows programmers to step through Emacs Lisp source ;;; code while executing, set breakpoints, etc. See the texinfo ;;; document (being constructed...) for more detailed instructions ;;; than contained here. Send me your enhancement, ideas, bugs, or ;;; fixes. ;;; Daniel LaLiberte 217-244-0785 ;;; University of Illinois, Urbana-Champaign ;;; Department of Computer Science ;;; 1304 W Springfield ;;; Urbana, IL 61801 ;;; uiucdcs!liberte ;;; liberte@cs.uiuc.edu ;;; Contents: ;;; ========= ;;; Installation ;;; Change list ;;; Utilities ;;; Parser ;;; Debugger ;;; Installation ;;; ------------ ;; Put edebug.el in some directory in your load-path and byte-compile it. ;; Put the following forms in your .emacs file. ;; (define-key emacs-lisp-mode-map "\^Xx" 'edebug-defun) ;; (autoload 'edebug-defun "edebug") ;; (autoload 'edebug-debug "edebug") ;; (setq debugger 'edebug-debug) ;; ... other options, described in the next section. ;; Evaluate a defun for edebug with edebug-defun. ;; Evaluate your function normally. ;; Use the "?" command in edebug to describe other commands. ;; See edebug.texinfo for more instructions. ;;; Change Log: ;;; Revision 2.5 91/07/25 13:32:53 liberte ;;; Doc string cleanup. ;;; If edebug-form-hook is t, evaluate all arguments. ;;; If edebug-form-hook is 0, evaluate no arguments. ;;; If edebug-form-hook is nil, evaluate macro args according ;;; to edebug-eval-macro-args. ;;; Save the outside value of executing macro. ;;; Save and restore the outside restriction. ;;; Dont force update for go and Go-nonstop. ;;; Save and restore last-command-char, last-command, ;;; this-command, last-input-char. ;;; For epoch, do epoch::dispatch-events before sit-for ;;; and input-pending-p since X events could interfere. ;;; Warn about unsetting non-existent breakpoint. ;;; Fix edebug-forward-sexp with prefix arg. ;;; Add edebug-step-out to exit from current sexp. ;;; ;;; Revision 2.4 91/03/18 12:35:44 liberte ;;; Force update after go or Go-nonstop modes, so overlay arrow is correct. ;;; Support debug-on-quit. Remove edebug-on-error. ;;; Fix edebug-anonymous. Bug found by jackr@wpd.sgi.com (Jack Repenning). ;;; Don't discard-input anymore. Easier to change modes this way. ;;; Fix max-lisp-eval-depth and max-specpdl-size incrementing. ;;; Save and restore points in all buffers, if ;;; edebug-save-buffer-points is non-nil. Expensive! ;;; Bug caught by wolfgang@wsrcc.com (Wolfgang S. Rupprecht) ;;; Save standard-output and standard-input in edebug-recursive-edit ;;; so that edebug-outside-excursion can restore them. ;;; Call set-buffer in edebug-pop-to-buffer since ;;; select-window does not do that. ;;; Fix edebug's eval-defun to remember current buffer inside evaluations ;;; and to evaluate top-level forms. Found by Jamie Zawinski. ;;; Add edebug-interactive-entry to support interactive forms with ;;; non-string arg. Bug found by Jack Repenning. ;;; Simplify edebug-restore-match-data to just store-match-data. ;;; Motivated by linus@lysator.liu.se. ;;; Move the match-data call to before the outside ;;; buffer is changed, since it assumes that. ;;; ;;; Revision 2.3 91/01/17 20:55:14 liberte ;;; Fix bug found by hollen@megatek.uucp. ;;; Current buffer was not being restored. ;;; Call edebug with (edebug begin end 'exp) ;;; and add additional wrapper around body of functions: ;;; (edebug-enter function body). ;;; Make &optional only apply to immediate next arg ;;; in edebug-form-parser (was edebug-macro-parser). ;;; Catch debug errors with edebug. Yeah! ;;; Reset edebug-mode on first function entry. Yeah! ;;; Motivated by Dion Hollenbeck. ;;; Add the missing bindings to the global-edebug-map. ;;; eval-current-buffer now uses eval-region. ;;; eval-region now does not narrow region. ;;; Narrowing was the cause of the window-start being set wrong. ;;; Reset edebug-mode only on ;;; first entry of any function at each recursive-edit level. ;;; Add edebug-backtrace, to generate cleaned up ;;; backtrace. It doesn't "work" like the debug backtrace, however. ;;; Require reselecting outside window even if ;;; quit occurs, otherwise save-excursions may restore ;;; buffer to the wrong window. ;;; ;;; Revision 2.2 90/11/26 21:14:22 liberte ;;; Shadow eval-defun and eval-region. Toggle ;;; edebugging with edebug-all-defuns. ;;; Call edebug with (edebug 'function begin end 'exp) ;;; Suggested by Jamie Zawinski . ;;; Add edebug-form-parser to process macro args. ;;; Motivated by Darryl Okahata darrylo@hpnmxx.hp.com. ;;; Fix by Roland McGrath ;;; to wrap body of edebug-save-restriction in progn. ;;; Fix by Darryl Okahata ;;; to add (set-window-hscroll (selected-window) 0) to ;;; edebug-pop-to-buffer. ;;; ;;; Revision 2.1 90/11/16 21:55:35 liberte ;;; Clean up. ;;; Add edebug-form-hook to edebug macro calls. Thanks to Joe Wells. ;;; edebug-forward-sexp uses step mode if no forward-sexp. ;;; ;;; Revision 2.0 90/11/14 22:30:54 liberte ;;; Handle lambda forms, function, interactive evals, defmacro. ;;; Clean up display for Epoch - save and restore screen configurations. ;;; Note: epoch 3.2 broke set-window-configuration. ;;; Also, sit-for pauses do not always work in epoch. ;;; Display evaluations window. ;;; Display result after expression evaluation. ;;; Thanks to discussions with Shinichirou Sugou. ;;; Conditional and temporary breakpoints. ;;; Change "continue" to "go" mode and add different "continue" mode. ;;; Option to stop before symbols. ;;; ;;; Fix by: Glen Ditchfield gjditchfield@violet.uwaterloo.ca ;;; to handle ?# type chars. ;;; ;;; Revision 1.5 89/05/10 02:39:27 liberte ;;; Fix condition-case expression lists. ;;; Reorganize edebug. ;;; ;;; Revision 1.4 89/02/14 22:58:34 liberte ;;; Fix broken breakpointing. ;;; Temporarily widen Emacs Lisp buffer during edebug. ;;; ;;; Revision 1.3 89/01/30 00:26:09 liberte ;;; More bug fixes for cond and let. ;;; Another parsing fix backquote. ;;; Fix for lambda forms inside defuns. ;;; Leave point at syntax error, mark at starting position. ;;; ;;; Revision 1.2 88/11/28 12:14:15 liberte ;;; Bug fixes: cond construct didn't execute. ;;; () in sexp list didn't parse ;;; () as variable in condition-case didn't parse. ;;; ;;; Revision 1.1 88/11/28 12:11:27 liberte ;;; Initial revision ;;; ;;; Code: ;;; Options ;;; ------- (defvar edebug-all-defuns nil "*If non-nil, all defuns and defmacros evaluated will use edebug. eval-defun without prefix arg and eval-region will use edebug-defun. If nil, eval-region evaluates normally, but eval-defun with prefix arg uses edebug-defun. eval-region is called by eval-defun, eval-last-sexp, and eval-print-last-sexp. You may wish to make this variable local to each Emacs Lisp buffer by calling (make-local-variable 'edebug-all-defuns) in your emacs-lisp-mode-hook. You can use the function edebug-all-defuns to toggle its value.") (defvar edebug-eval-macro-args nil "*If non-nil, edebug will assume that all macro call arguments for macros that have no edebug-form-hook may be evaluated, otherwise it will not. To specify exceptions for macros that have some arguments evaluated and some not, you should specify an edebug-form-hook") (defvar edebug-stop-before-symbols nil "*Non-nil causes edebug to stop before symbols as well as after. In any case, it is possible to stop before a symbol with a breakpoint or interrupt.") (defvar edebug-save-windows t "*If non-nil, save and restore window configuration on edebug calls. It takes some time to save and restore, so if your program does not care what happens to the window configurations, it is better to set this variable to nil.") (defvar edebug-save-point t "*If non-nil, save and restore the point and mark in source code buffers.") (defvar edebug-save-buffer-points nil "*If non-nil, save and restore the points of all buffers, displayed or not. Saving and restoring buffer points 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 all the points is an expensive operation since it visits each buffer twice for each edebug call, so it is best to avoid it if you can.") (defvar edebug-initial-mode 'step "*Global initial mode for edebug, if non-nil. This is used when edebug is first entered for each recursive-edit level. Possible values are nil (meaning keep using edebug-mode), step, go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast.") (defvar edebug-trace nil "*Non-nil if edebug should show 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-entry and edebug-print-trace-exit.") ;;;======================================================================== ;;; Utilities ;;; --------- (defun edebug-which-function () "Return the symbol of the function we are in" (save-excursion (end-of-defun) (beginning-of-defun) (down-list 1) (if (not (memq (read (current-buffer)) '(defun defmacro))) (error "Not in defun or defmacro")) (read (current-buffer)))) (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 doesn't 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-get-buffer-points () "Return a list of buffer point pairs, for all buffers." (save-excursion (mapcar (function (lambda (buf) (set-buffer buf) (cons buf (point)))) (buffer-list)))) (defun edebug-set-buffer-points () "Restore the buffer-points given by edebug-get-buffer-points." (mapcar (function (lambda (buf-point) (if (buffer-name (car buf-point)) ; still exists (progn (set-buffer (car buf-point)) (goto-char (cdr buf-point)))))) edebug-buffer-points)) (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)))))) (defun edebug-macrop (object) "Return the macro named by OBJECT, or nil if it is not a macro." (while (and (symbolp object) (fboundp object)) (setq object (symbol-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." (while (and (symbolp object) (fboundp object)) (setq object (symbol-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)))))) (put 'edebug-save-restriction 'edebug-form-hook '(&rest form)) (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)))))) ;;;============================================================= ;;; Redefine eval-defun, eval-region, and eval-current-buffer. ;;; ----------------------------------------------------------- (defun edebug-all-defuns () "Toggle edebugging of all defuns and defmacros, not including those evaluated in the minibuffer, or during load." (interactive) (setq edebug-all-defuns (not edebug-all-defuns)) (message "Edebugging is %s." (if edebug-all-defuns "on" "off"))) (if (not (fboundp 'edebug-emacs-eval-defun)) (fset 'edebug-emacs-eval-defun (symbol-function 'eval-defun))) ;;(fset 'eval-defun (symbol-function 'edebug-emacs-eval-defun)) (defun eval-defun (edebug-debug) "Edebug replacement for eval-defun. Print value in the minibuffer. Evaluate the top-level form that point is in or before. Note: eval-defun normally evaluates any top-level form, not just defuns. Here are the differences from the standard eval-defun. If the prefix argument is the same as edebug-all-defuns (nil or non-nil), evaluate normally; otherwise edebug-defun is called to wrap edebug calls around evaluatable expressions in the defun or defmacro body. Also, the value printed by edebug-defun is not just the function name." (interactive "P") (let ((edebug-all-defuns (not (eq (not edebug-debug) (not edebug-all-defuns))))) (edebug-emacs-eval-defun nil) )) (if (not (fboundp 'edebug-emacs-eval-region)) (fset 'edebug-emacs-eval-region (symbol-function 'eval-region))) ;; (fset 'eval-region (symbol-function 'edebug-emacs-eval-region)) (defun eval-region (edebug-e-r-start edebug-e-r-end &optional edebug-e-r-output) "Edebug replacement for eval-defun. Like eval-region, but call edebug-defun for defuns or defmacros. Also, this eval-region does not narrow to the region and if an error occurs, point is left at the error." ;; One other piddling difference concerns whitespace after the expression. (interactive "r") (let ((standard-output (or edebug-e-r-output 'symbolp)) (edebug-e-r-pnt (point)) (edebug-e-r-buf (current-buffer)) (edebug-e-r-inside-buf (current-buffer)) ;; Mark the end because it may move. (edebug-e-r-end-marker (set-marker (make-marker) edebug-e-r-end)) edebug-e-r-val ) (goto-char edebug-e-r-start) (edebug-skip-whitespace) (while (< (point) edebug-e-r-end-marker) (if (and edebug-all-defuns (eq 'lparen (edebug-next-token-class)) (save-excursion (forward-char 1) ; skip \( (memq (edebug-read-sexp) '(defun defmacro)))) (progn (edebug-defun) ;; Potential problem: edebug-defun always prints name. (forward-sexp 1) ; skip the defun ) (if (and (eq 'lparen (edebug-next-token-class)) (save-excursion (forward-char 1) ; skip \( (memq (edebug-read-sexp) '(defun defmacro)))) ;; If it's a defun or defmacro, but not edebug-all-defuns ;; reset the symbols edebug property to be just a marker at ;; the definitions source code. (put (edebug-which-function) 'edebug (point-marker))) ;; Evaluate normally - after restoring the current-buffer. (setq edebug-e-r-val (edebug-read-sexp)) (save-excursion (set-buffer edebug-e-r-inside-buf) (setq edebug-e-r-val (eval edebug-e-r-val)) ;; Remember current buffer for next time. (setq edebug-e-r-inside-buf (current-buffer))) (if edebug-e-r-output (progn (setq values (cons edebug-e-r-val values)) (if (eq standard-output t) (prin1 edebug-e-r-val) (print edebug-e-r-val)))) ) (goto-char (min (max edebug-e-r-end-marker (point)) (progn (edebug-skip-whitespace) (point)))) ) ; while (if (null edebug-e-r-output) ;; do the save-excursion recovery (progn ;; but mark is not restored (set-buffer edebug-e-r-buf) (goto-char edebug-e-r-pnt))) nil )) (defun edebug-eval-current-buffer (&optional edebug-e-c-b-output) "Call eval-region on the whole buffer." (interactive) (eval-region (point-min) (point-max) edebug-e-c-b-output)) (defun edebug-eval-buffer (&optional buffer edebug-e-c-b-output) "Call eval-region on the whole buffer." (interactive "bEval buffer: ") (save-excursion (set-buffer buffer) (eval-region (point-min) (point-max) edebug-e-c-b-output))) ;; The standard eval-current-buffer doesn't use eval-region. (if (and (fboundp 'eval-current-buffer) (not (fboundp 'edebug-emacs-eval-current-buffer))) (progn (fset 'edebug-emacs-eval-current-buffer (symbol-function 'eval-current-buffer)) (fset 'eval-current-buffer 'edebug-eval-current-buffer))) (if (and (fboundp 'eval-buffer) (not (fboundp 'edebug-emacs-eval-buffer))) (progn (fset 'edebug-emacs-eval-buffer (symbol-function 'eval-buffer)) (fset 'eval-buffer 'edebug-eval-buffer))) ;;;====================================================================== ;;; The Parser ;;; ---------- ;;; The top level function for parsing defuns is edebug-defun; 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 ;;; function edebug together with indexes into a table of positions of ;;; all expressions. Thus an expression "exp" in function foo ;;; becomes: ;;; (edebug 1 2 'exp) ;;; First point moved to to the beginning of exp (offset 1 of the ;;; current function). Then the expression is evaluated and point is ;;; moved to offset 2, at the end of exp. ;;; The top 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 and edebug-enter ;;; for more details. ;;;###autoload (defun edebug-defun () "Evaluate defun or defmacro, like eval-defun, but with edebug calls. Print its name in the minibuffer and leave point after any error it finds, with mark at the original point." (interactive) (let (def-kind ; whether defmacro or defun def-name def-args def-docstring defun-interactive (edebug-offset-index 0) edebug-offset-list edebug-func-mark (starting-point (point)) tmp-point (parse-sexp-ignore-comments t)) (condition-case err (progn (end-of-defun) (beginning-of-defun) (down-list 1) (setq edebug-func-mark (point-marker)) (if (not (eq 'defun (setq def-kind (edebug-read-sexp)))) (if (not (eq 'defmacro def-kind)) (edebug-syntax-error "%s is not a defun or defmacro." def-kind))) (setq def-name (edebug-read-sexp)) (if (not (symbolp def-name)) (edebug-syntax-error "Bad defun name: %s" def-name)) (setq def-args (edebug-read-sexp)) (if (not (listp def-args)) (edebug-syntax-error "Bad defun arg list: %s" def-args)) ;; look for doc string (setq tmp-point (point)) (if (eq 'string (edebug-next-token-class)) (progn (setq def-docstring (edebug-read-sexp)) (setq tmp-point (point)))) ;; look for interactive form (if (eq 'lparen (edebug-next-token-class)) (progn (forward-char 1) ; skip \( (if (eq 'interactive (edebug-read-sexp)) (progn (setq defun-interactive (cons 'interactive (edebug-interactive))) (forward-char 1) ; skip \) (setq tmp-point (point)) )))) (goto-char tmp-point) ;; build the new definition (fset def-name (` (lambda (, def-args) (, def-docstring) (, defun-interactive) ;; the remainder is a list of sexps (edebug-enter (quote (, def-name)) (quote (, def-args)) (quote (progn (,@ (edebug-sexp-list t))))) ))) ;; if it is a defmacro, prepend 'macro (if (eq 'defmacro def-kind) (fset def-name (cons 'macro (symbol-function def-name)))) ;; recover point, like save-excursion but only if no error occurs (goto-char starting-point) ;; store the offset list in functions property list (put def-name 'edebug (list edebug-func-mark nil ; clear breakpoints (vconcat (nreverse edebug-offset-list)))) (message "edebug: %s" def-name) ) ; progn (invalid-read-syntax ;; Set mark at starting-point so user can return. ;; Leave point at error. (save-excursion (goto-char starting-point) (set-mark-command nil)) (message "Syntax error: %s" (cdr err)) ;; (signal 'invalid-read-syntax (cdr err)) ; pass it on, to who? ) ) ; condition-case def-name )) (defun edebug-sexp-list (debuggable) "Return an edebug form built from the sexp list following point in the current buffer. If DEBUGGABLE then wrap edebug calls around each sexp. The sexp list does not start with a left paren; we are already in the list. Leave point at (before) the trailing right paren." (let (sexp-list) (while (not (eq 'rparen (edebug-next-token-class))) (setq sexp-list (cons (if debuggable (edebug-form) (edebug-read-sexp)) sexp-list))) (nreverse sexp-list))) (defun edebug-increment-offset () ;; accesses edebug-offset-index and edebug-offset-list (setq edebug-offset-index (1+ edebug-offset-index)) (setq edebug-offset-list (cons (- (point) edebug-func-mark) edebug-offset-list))) (defun edebug-make-edebug-form (index form) "Return the edebug form for the current function at offset INDEX given FORM. Looks like: (edebug def-name INDEX edebug-offset-index 'FORM). Also increment the offset index." (prog1 (list 'edebug index edebug-offset-index (list 'quote form)) (edebug-increment-offset) )) (defun edebug-form () "Return the debug form for the following form. Add the point offset to the edebug-offset-list for the function and move point to immediately after the form." (let* ((index edebug-offset-index) form class) ;; The point must be added to the offset list now ;; because edebug-list will add more offsets indirectly. (edebug-skip-whitespace) (edebug-increment-offset) (setq class (edebug-next-token-class)) (cond ((eq 'lparen class) (edebug-make-edebug-form index (edebug-list))) ((eq 'symbol class) (if (and (not (memq (setq form (edebug-read-sexp)) '(nil t))) ;; note: symbol includes numbers, see parsing utilities (not (numberp form))) (edebug-make-edebug-form index form) form)) (t (edebug-read-sexp))))) (defun edebug-list () "Return an edebug form built from the list form that follows point. Insert debug calls as appropriate to the form. Start with point at the left paren. Leave point after the right paren." (let ((beginning (point)) class head) (forward-char 1) ; skip \( (setq class (edebug-next-token-class)) (cond ((eq 'symbol class) (setq head (edebug-read-sexp))) ((eq 'lparen class) (setq head (edebug-anonymous))) ((eq 'rparen class) (setq head nil)) (t (edebug-syntax-error "Head of list must be a symbol or lambda expression."))) (prog1 (if head (cons head (cond ;; None of the edebug-form-hooks defined below are used, for speed. ;; They are included for documentation, though the hook would not ;; necessarily behave the same as the function it is replacing. ;;; Using the edebug-form-hooks should work, but would take more time. ;;; ((symbolp head) ;;; (let ((form (get head 'edebug-form-hook))) ;;; (if form ;;; (edebug-form-parser form) ;;; (if (edebug-macrop head) ;;; (if edebug-eval-macro-args ;;; (edebug-sexp-list t) ;;; (edebug-sexp-list nil)) ;;; ;; assume it is a function ;;; (edebug-sexp-list t))))) ;; handle all special-forms with unevaluated arguments ((memq head '(let let*)) (edebug-let)) ((memq head '(setq setq-default)) (edebug-setq)) ((eq head 'cond) (edebug-cond)) ((eq head 'condition-case) (edebug-condition-case)) ((memq head '(quote ; permits more than one arg defun defvar defconst defmacro)) (edebug-sexp-list nil)) ((eq head 'function) (list (if (eq 'lparen (edebug-next-token-class)) (edebug-anonymous) (edebug-read-sexp) ; should be just a symbol ))) ;; is it a lisp macro? ((edebug-macrop head) (or (and (symbolp head) (let ((form (get head 'edebug-form-hook))) (if form (if (eq form t) (edebug-sexp-list t) (if (eq form 0) (edebug-sexp-list nil) (edebug-form-parser form)))))) (edebug-sexp-list edebug-eval-macro-args))) ((eq head 'interactive) (edebug-syntax-error "interactive not expected here.")) ;; otherwise it is a function call (t (edebug-sexp-list t)) ))) (if (eq 'rparen (edebug-next-token-class)) (forward-char 1) ; skip \) (edebug-syntax-error "Too many arguments.")) ))) (defun edebug-form-parser (args) "Parse the macro arguments that follow based on ARGS. ARGS describes the types of the arguments of a list form. Each of the ARGS is processed left to right, in the same order as the arguments of the list form. See the edebug documentation for more details. The ARGS may be one of the following: symbolp - an unevaluated symbol integerp - an unevaluated number stringp - an unevaluated string vectorp - an unevaluated vector atom - an unevaluated number, string, symbol, or vector sexp - an unevaluated sexp (atom or list); may not be empty form - an evaluated sexp; may not be empty foo - any other symbol should be the name of a function; this function is called on the argument as a predicate and an error is signaled if the predicate fails. &optional - one following arg in the list may or may not appear. &rest - all following args are repeated zero or more times as a group. This is an extension of the normal meaning of &rest. &or - each of the following args are alternatives, processed left to right until one succeeds. There is no way to group more than one list element as one alternative. (...) - a sublist, of the same format as the top level, processed recursively. Special case: if the car of the list is quote, the argument must match the quoted sexp (see example below of 'for macro). " (let ((arglist args) arg form form-list class &optional &rest &or) (while (and arglist (not (eq 'rparen (setq class (edebug-next-token-class))))) (catch 'no-match (setq arg (car arglist)) (setq arglist (cdr arglist)) (if (and &rest (null arglist)) (setq arglist &rest)) (cond ((memq arg '(&optional &rest &or)) ;; remember arglist at this point (set arg arglist) (throw 'no-match nil)) ((eq arg 'form) (setq form (edebug-form))) ((eq arg 'sexp) (setq form (edebug-read-sexp))) ((listp arg) (if (eq 'quote (car arg)) ;; special case, match the quoted symbol (let ((pnt (point))) (setq arg (car (cdr arg))) (if (not (eq arg (setq form (edebug-read-sexp)))) (edebug-form-parser-error) )) (if (eq class 'lparen) (progn (forward-char 1) ; skip \( (setq form (edebug-form-parser arg)) (forward-char 1) ; skip \) )))) ((symbolp arg) (let ((pnt (point)) (pred (if (fboundp arg) (symbol-function arg)))) (and pred (not (funcall pred (setq form (edebug-read-sexp)))) (edebug-form-parser-error) ))) (t (throw 'no-match nil)) ) ; cond (setq &optional nil) ; only lasts for one match (setq form-list (cons form form-list)) ; skipped by no-match throw )) ; while (if (and arglist (not (or &optional &rest (memq (car arglist) '(&optional &rest))))) (edebug-syntax-error "Not enough arguments.")) (if (not (eq 'rparen (edebug-next-token-class))) (if &or (edebug-syntax-error "Unrecognized argument.") (edebug-syntax-error "Too many arguments."))) (nreverse form-list))) (defun edebug-form-parser-error () (goto-char pnt) (if &or (throw 'no-match nil) (if &optional (progn (setq &optional nil) ; only lasts for one failed match not in &or (throw 'no-match nil)) (edebug-syntax-error "%s is not %s" form arg)))) ;; for loop defined in Emacs Lisp manual (put 'for 'edebug-form-hook '(symbolp 'from form 'to form 'do &rest form)) ;; case and do defined in cl.el (put 'case 'edebug-form-hook '(form &rest (sexp form))) (put 'do 'edebug-form-hook '((&rest &or symbolp (symbolp &optional form &optional form)) (form &rest form) &rest body)) (put 'defvar 'edebug-form-hook (put 'defconst 'edebug-form-hook '(symbolp &optional form &optional stringp))) (put 'defun 'edebug-form-hook (put 'defmacro 'edebug-form-hook '(symbolp (&rest symbolp) &optional stringp &optional ('interactive &or stringp form) &rest form))) (put 'anonymous 'edebug-form-hook '(&optional 'macro 'lambda (&rest symbolp) &rest form)) (defun edebug-anonymous () "Return the edebug form for an anonymous lambda or macro. Point starts before the left paren and ends after it." (forward-char 1) ; skip \( (prog1 (let ((head (edebug-read-sexp))) (cond ((eq head 'lambda) (edebug-lambda)) ((eq head 'macro) (if (not (eq 'lambda (edebug-read-sexp))) (edebug-syntax-error "lambda expected.")) (cons 'macro (edebug-lambda))) (t (edebug-syntax-error "Anonymous lambda or macro expected.")))) (forward-char 1) ; skip \) )) (defun edebug-lambda () "Return the edebug form for the lambda form that follows. Point starts after the lambda symbol and is moved to before the right paren." (append (list 'lambda (edebug-read-sexp)) ; the args (edebug-sexp-list t))) ; the body (put 'let 'edebug-form-hook (put 'let* 'edebug-form-hook '((&rest &or (symbolp &optional form) symbolp) &rest form))) (defun edebug-let () "Return the edebug form of the let or let* form. Leave point before the right paren." (let (var-value-list token class) (cons ;; first process the var/value list (if (not (eq 'lparen (edebug-next-token-class))) (if (setq token (edebug-read-sexp)) (edebug-syntax-error "Bad var list in let.") ; should be nil token ; == nil ) (forward-char 1) ; lparen (while (not (eq 'rparen (setq class (edebug-next-token-class)))) (setq var-value-list (cons (if (not (eq 'lparen class)) (edebug-read-sexp) (forward-char 1) ; lparen (prog1 (edebug-var-value) (if (not (eq 'rparen (edebug-next-token-class))) (edebug-syntax-error "Right paren expected in let.") (forward-char 1) ; rparen ))) var-value-list))) (forward-char 1) ; rparen (nreverse var-value-list)) ;; now process the expression list (edebug-sexp-list t)))) (defun edebug-var-value () "Return the edebug form of the var and optional value that follow point. Leave point after the value, if there is one." (list (edebug-read-sexp) ; the variable (and (not (eq 'rparen (edebug-next-token-class))) (edebug-form)))) (put 'setq 'edebug-form-hook (put 'setq-default 'edebug-form-hook '(&rest symbolp form))) (defun edebug-setq () "Return the edebug form of the setq or setq-default var-value list." (let (var-value-list) (while (not (eq 'rparen (edebug-next-token-class))) (setq var-value-list (append var-value-list (edebug-var-value)))) var-value-list)) (put 'interactive 'edebug-form-hook '(&optional &or stringp form)) (defun edebug-interactive () "Return the edebug form of the interactive form." (list (if (not (eq 'rparen (edebug-next-token-class))) (if (eq 'string (edebug-next-token-class)) (edebug-read-sexp) (prog1 (` (edebug-interactive-entry (quote (, def-name)) (quote ((,@ (edebug-form)))))) (if (not (eq 'rparen (edebug-next-token-class))) (edebug-syntax-error "Only first expression used in interactive form."))))))) (put 'cond 'edebug-form-hook '(&rest (form &rest form))) (defun edebug-cond () "Return the edebug form of the cond form." (let (value-value-list class) (while (not (eq 'rparen (setq class (edebug-next-token-class)))) (setq value-value-list (cons (if (not (eq 'lparen class)) (let ((thing (edebug-read-sexp))) (if thing (edebug-syntax-error "Condition expected in cond") nil)) (forward-char 1) ; \( (prog1 (cons (edebug-form) (if (eq 'rparen (edebug-next-token-class)) nil (edebug-sexp-list t))) (if (not (eq 'rparen (edebug-next-token-class))) (edebug-syntax-error "Right paren expected in cond")) (forward-char 1) ; \) )) value-value-list))) (nreverse value-value-list))) ;; Bug: this doesn't support condition name lists (put 'condition-case 'edebug-form-hook '(symbolp form &rest (symbolp &optional form))) (defun edebug-condition-case () "Return the edebug form of the condition-case form." (cons (let (token) ;; read the variable or nil (setq token (edebug-read-sexp)) (if (not (symbolp token)) (edebug-syntax-error "Variable or nil required for condition-case; found: %s" token)) token) (cons (edebug-form) ; the form ;; process handlers (let (symb-sexp-list class) (while (not (eq 'rparen (setq class (edebug-next-token-class)))) (setq symb-sexp-list (cons (if (not (eq 'lparen class)) (edebug-syntax-error "Bad handler in condition-case.") (forward-char 1) ; \( (prog1 (cons (edebug-read-sexp) ; the error-condition (and (not (eq 'rparen (edebug-next-token-class))) (edebug-sexp-list t))) (forward-char 1) ; \) )) symb-sexp-list))) (nreverse symb-sexp-list))))) ;;------------------------------------------------ ;; Parser utilities (defun edebug-syntax-error (msg &rest args) "Signal an invalid-read-syntax with MSG and ARGS. This is caught by edebug-defun." (signal 'invalid-read-syntax (apply 'format msg args))) (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) ?\;) (skip-chars-forward "^\n\r") ; skip the comment (skip-chars-forward " \t\r\n\f"))) (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 is gummed up by parser inconsistencies (bugs?) (let (token) (edebug-skip-whitespace) (if (or (= (following-char) ?\[) (= (following-char) ??)) ;; scan-sexps doesn't read vectors or character literals correctly, ;; but read does. (setq token (read (current-buffer))) (goto-char (min ; use the lesser of the read and scan-sexps motion ;; read goes one too far if (quoted) string or symbol ;; is immediately followed by non-whitespace (save-excursion (setq token (read (current-buffer))) (point)) ;; scan-sexps reads too far if a quoting character is read (scan-sexps (point) 1)))) token)) (defconst edebug-syntax-table (let ((table (make-vector 256 'symbol))) ;; Treat numbers as symbols, because of confusion with -, -1, and 1-. (aset table ?\( 'lparen) (aset table ?\) 'rparen) (aset table ?\' 'quote) (aset table ?\" 'string) (aset table ?\? 'char) (aset table ?\[ 'vector) (aset table ?\. 'dot) ;; We dont care about any other chars since they wont be seen. table) "Lookup table for the token class of each character.") (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-syntax-table (following-char))) ;;;================================================================= ;;; 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-backtrace nil "Stack of active functions evaluated via edebug. Should be nil at the top level.") (defvar edebug-offset-indices nil ; not used yet. "Stack of offset indices of visited edebug sexps. Should be nil at the top level.") (defvar edebug-entered nil "Non-nil if edebug has already been entered at this recursive edit level.") (defun edebug-enter (edebug-func 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-defun is entered. Return the result of BODY." ;; Is this the first time we are entering edebug since ;; lower-level recursive-edit command? (if (and (not edebug-entered) edebug-initial-mode) ;; Reset edebug-mode to the initial mode. (setq edebug-mode edebug-initial-mode)) (let* ((edebug-entered t) (pre-command-hook (if (memq edebug-func pre-command-hook) nil pre-command-hook)) (post-command-hook (if (memq edebug-func post-command-hook) nil post-command-hook)) (edebug-data (get edebug-func 'edebug)) ;; pull out parts of the edebug-data (edebug-func-mark (car edebug-data)) ; mark at function start (edebug-buffer (marker-buffer edebug-func-mark)) (edebug-backtrace (cons edebug-func edebug-backtrace)) (max-lisp-eval-depth (+ 6 max-lisp-eval-depth)) ; too much?? (max-specpdl-size (+ 10 max-specpdl-size)) ; the args and these vars ) (if edebug-trace (let ((edebug-stack-depth (1- (length edebug-backtrace))) edebug-result) (edebug-print-trace-entry "*edebug-trace*" edebug-func edebug-args edebug-stack-depth) (setq edebug-result (eval edebug-body)) (edebug-print-trace-exit "*edebug-trace*" edebug-func edebug-result edebug-stack-depth) edebug-result) (eval edebug-body) ))) (defun edebug-interactive-entry (edebug-func edebug-args) "Evaluating FUNCs non-string argument of interactive form ARGS." (if (and (not edebug-entered) edebug-initial-mode) ;; Reset edebug-mode to the initial mode. (setq edebug-mode edebug-initial-mode)) (let* ((edebug-entered t) (edebug-data (get edebug-func 'edebug)) ;; pull out parts of the edebug-data (edebug-func-mark (car edebug-data)) ; mark at function start (edebug-buffer (marker-buffer edebug-func-mark)) ;; (edebug-backtrace (cons edebug-func edebug-backtrace)) ) (eval edebug-args))) (defun edebug-print-trace-entry (edebug-stream edebug-function edebug-args edebug-stack-depth) (edebug-trace-display edebug-stream "%sEnter: %s\n" (make-string edebug-stack-depth ?\ ) edebug-function) ) (defun edebug-print-trace-exit (edebug-stream edebug-function edebug-result edebug-stack-depth) (edebug-trace-display edebug-stream "%sExit: %s\n" (make-string edebug-stack-depth ?\ ) edebug-function) ) (defun edebug (edebug-before-index edebug-after-index edebug-exp) "Debug current function given BEFORE and AFTER positions around EXP. BEFORE and AFTER are indexes into the position offset vector in the functions 'edebug property. edebug is called from functions compiled with edebug-defun." (let ((max-lisp-eval-depth (+ 5 max-lisp-eval-depth)) ; enough?? (max-specpdl-size (+ 7 max-specpdl-size)) ; the args and these vars (edebug-offset-indices (cons edebug-before-index edebug-offset-indices)) ;; Save the outside value of executing macro. (edebug-outside-executing-macro executing-macro) ;; Don't keep reading from an executing kbd macro within edebug! (executing-macro nil) ) (if (and (eq edebug-mode 'Go-nonstop) (not (edebug-input-pending-p))) ;; Just return evalled expression. (eval edebug-exp) (edebug-debugger edebug-before-index 'enter edebug-exp) (edebug-debugger edebug-after-index 'exit (eval edebug-exp)) ))) (defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-exp) "Determine if edebug display should be updated." (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 (if edebug-break-data (let ((edebug-break-condition (car (cdr edebug-break-data)))) (or (not edebug-break-condition) (eval edebug-break-condition))))) ) (if (and edebug-break (car (cdr (cdr edebug-break-data)))) ; is it temporary? ;; Delete the breakpoint. (setcdr edebug-data (cons (delq edebug-break-data edebug-breakpoints) (cdr (cdr edebug-data))))) ;; Dont do anything if mode is go, continue, or Continue-fast ;; and no break, and no input. (if (or (and (not (memq edebug-mode '(go continue Continue-fast))) (or edebug-stop-before-symbols (not (and (eq edebug-arg-mode 'enter) (symbolp edebug-exp))))) (edebug-input-pending-p) edebug-break) (edebug-display)) edebug-exp )) (defvar edebug-window-start 0 "Remember where each buffers' window starts between edebug calls. This is to avoid spurious recentering.") (setq-default edebug-window-start 0) (make-variable-buffer-local 'edebug-window-start) (defun edebug-display () "Setup windows for edebug, determine mode, maybe enter recursive-edit." ;; uses local variables of edebug-enter, edebug, and edebug-debugger. (let ((edebug-active t) ; for minor mode alist edebug-stop ; should we enter recursive-edit (edebug-point (+ edebug-func-mark (aref (car (cdr (cdr edebug-data))) edebug-offset-index))) (edebug-buffer-points (if edebug-save-buffer-points (edebug-get-buffer-points))) edebug-window ; window displaying edebug-buffer edebug-inside-window ; window displayed after recursive edit (edebug-outside-window (selected-window)) (edebug-outside-buffer (current-buffer)) (edebug-outside-point (point)) (edebug-outside-mark (mark t)) edebug-outside-windows ; window or screen configuration edebug-outside-edebug-point ; old point in edebug buffer edebug-outside-edebug-mark edebug-eval-buffer ; declared here so we can kill it below (edebug-eval-result-list (and edebug-eval-list (edebug-eval-result-list))) (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) edebug-outside-point-min edebug-outside-point-max overlay-arrow-position 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-func))) ;; Save windows now before we modify them. (if edebug-save-windows (setq edebug-outside-windows (edebug-current-window-configuration))) ;; If edebug-buffer is not currently displayed, ;; first find a window for it. (edebug-pop-to-buffer edebug-buffer) (setq edebug-window (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 quit. (edebug-eval-display edebug-eval-result-list) (select-window edebug-window) (if edebug-save-point (progn (setq edebug-outside-edebug-point (point)) (setq edebug-outside-edebug-mark (mark t)))) (edebug-save-restriction (setq edebug-outside-point-min (point-min)) (setq edebug-outside-point-max (point-max)) (widen) (goto-char edebug-point) (setq edebug-window-start (edebug-adjust-window edebug-window-start)) (if (edebug-input-pending-p) ; not including keyboard macros (progn (setq edebug-mode 'step) (setq edebug-stop t) (edebug-stop) ;; (discard-input) ; is this unfriendly?? )) (edebug-overlay-arrow) (cond ((eq 'exit edebug-arg-mode) ;; Display result of previous evaluation. (setq edebug-previous-result edebug-exp) (edebug-previous-result)) ((eq 'error edebug-arg-mode) ;; Display error message (beep) (if (eq 'quit (car edebug-exp)) (message "Quit") (message "%s: %s" (get (car edebug-exp) 'error-message) (car (cdr edebug-exp))))) (edebug-break (message "Break")) (t (message ""))) (if edebug-break (if (not (memq edebug-mode '(continue Continue-fast))) (setq edebug-stop t) (if (eq edebug-mode 'continue) (edebug-sit-for 1) (edebug-sit-for 0))) ;; not edebug-break (if (eq edebug-mode 'trace) (edebug-sit-for 1) ; Force update and pause. (if (eq edebug-mode 'Trace-fast) (edebug-sit-for 0) ; Force update and continue. ))) (unwind-protect (if (or edebug-stop (eq edebug-mode 'step) (eq edebug-arg-mode 'error)) (progn (setq edebug-mode 'step) (edebug-overlay-arrow) ; this doesn't always show up. (edebug-recursive-edit));; <<<<<< Recursive edit ) (if edebug-save-buffer-points (edebug-set-buffer-points)) ;; Since we may be in a save-excursion, in case of quit ;; restore the outside window only. (select-window edebug-outside-window) ) ; unwind-protect ;; None of the following is done if quit or signal occurs. (if edebug-save-point ;; Restore point and mark in edebug-buffer. ;; This does the save-excursion recovery only if no quit. ;; If edebug-buffer == edebug-outside-buffer, ;; then this is redundant with outside save-excursion. (progn (set-buffer edebug-buffer) (goto-char edebug-outside-edebug-point) (if (mark-marker) (set-marker (mark-marker) edebug-outside-edebug-mark)) )) ) ; edebug-save-restriction ;; Restore windows, buffer, point, and mark. (if edebug-save-windows ;; Restore windows before continuing. (edebug-set-window-configuration edebug-outside-windows)) (set-buffer edebug-outside-buffer) (goto-char edebug-outside-point) (if (mark-marker) (set-marker (mark-marker) edebug-outside-mark)) ;; The following is not sufficient, and sometimes annoying. ;; (if (memq edebug-mode '(go Go-nonstop)) ;; (edebug-sit-for 0)) )) (defvar edebug-depth 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.") (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. (let ((edebug-buffer-read-only buffer-read-only) ;; match-data must be done in the outside buffer (edebug-outside-match-data (save-excursion (set-buffer edebug-outside-buffer) (match-data))) (edebug-depth (1+ edebug-depth)) (edebug-recursion-depth (recursion-depth)) edebug-entered ; bind locally to nil 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-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) ;; Declare the following local variables to protect global values. ;; We could set these to the values for previous edebug call. ;; But instead make it local, but use global value. (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-events. ;; (unread-command-char -1) (debug-on-error debug-on-error) ;; others?? ) (if (and (eq edebug-mode 'go) (not (memq edebug-arg-mode '(exit error)))) (message "Break")) (edebug-mode) (if (boundp 'edebug-outside-debug-on-error) (setq debug-on-error edebug-outside-debug-on-error)) (setq buffer-read-only t) (unwind-protect (recursive-edit) ; <<<<<<<<<< Recursive edit ;; Do the following, even if quit occurs. (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-mode '(go Go-nonstop)) (edebug-overlay-arrow)) (setq buffer-read-only edebug-buffer-read-only) (use-local-map edebug-outside-map) ;; Remember current window-start for next visit. (select-window edebug-window) (if (eq edebug-buffer (window-buffer edebug-window)) (setq edebug-window-start (window-start))) (select-window edebug-inside-window) )) ))) ;;-------------------------- ;; Display related functions (defun edebug-adjust-window (old-start) "Adjust window to fit as much as possible following point. The display should prefer to start at OLD-START if point is not visible. Return the new window-start." (if (not (pos-visible-in-window-p)) (progn (set-window-start (selected-window) old-start) (if (not (pos-visible-in-window-p)) (let ((start (window-start)) (pnt (point))) (set-window-start (selected-window) (save-excursion (forward-line (if (< pnt start) -1 ; one line before (- (/ (window-height) 2)) ; center the line )) (beginning-of-line) (point))))))) (window-start)) (defconst edebug-arrow-alist '((Continue-fast . ">") (Trace-fast . ">") (continue . ">") (trace . "->") (step . "=>") (go . "<>") (Go-nonstop . "..") ; not used ) "Association list of arrows for each edebug mode. If you come up with arrows that make more sense, let me know.") (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-mode." (let* ((pos)) (save-excursion (beginning-of-line) (setq pos (point))) (setq overlay-arrow-string (cdr (assq edebug-mode edebug-arrow-alist))) (setq overlay-arrow-position (make-marker)) (set-marker overlay-arrow-position pos (current-buffer)))) (put 'edebug-outside-excursion 'edebug-form-hook '(&rest form)) (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-window-configuration)) ;; Restore outside windows. (edebug-set-window-configuration edebug-outside-windows))) (set-buffer edebug-buffer) ;; Restore outside context. (let ((edebug-inside-map (current-local-map)) (last-command-char edebug-outside-last-command-char) (last-command edebug-outside-last-command) (this-command edebug-outside-this-command) ;; (unread-command-char edebug-outside-unread-command-char) (last-input-char edebug-outside-last-input-char) (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) (standard-output edebug-outside-standard-output) (standard-input edebug-outside-standard-input) (executing-macro edebug-outside-executing-macro) ) (unwind-protect (save-restriction (narrow-to-region edebug-outside-point-min edebug-outside-point-max) (save-excursion ; of edebug-buffer (if edebug-save-point (progn (goto-char edebug-outside-edebug-point) (if (mark-marker) (set-marker (mark-marker) edebug-outside-edebug-mark)) )) (use-local-map edebug-outside-map) (store-match-data edebug-outside-match-data) (select-window edebug-outside-window) (set-buffer edebug-outside-buffer) (goto-char edebug-outside-point) (,@ body) ) ; save-excursion ) ; save-restriction ;; Back to edebug-buffer. Restore rest of inside context. (use-local-map edebug-inside-map) (if edebug-save-windows ;; Restore inside windows. (edebug-set-window-configuration edebug-inside-windows)) )) ; let ))) (defun edebug-toggle-save-windows () "Toggle the edebug-save-windows variable. Each time you toggle it, the inside and outside window configurations become the same as the current configuration." (interactive) (if (setq edebug-save-windows (not edebug-save-windows)) (setq edebug-inside-windows (setq edebug-outside-windows (edebug-current-window-configuration)))) (message "Window saving is %s." (if edebug-save-windows "on" "off"))) (defun edebug-where () "Show the debug windows and where we stopped in the program." (interactive) (if (not edebug-active) (error "edebug is not active")) (edebug-pop-to-buffer edebug-buffer) (goto-char edebug-point) ; from edebug ) (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-window-configuration)) (edebug-set-window-configuration 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 () "Bounce the point in the outside current buffer." (interactive) (if (not edebug-active) (error "edebug is not active")) (save-excursion ;; If the buffer's currently displayed, avoid the set-window-configuration. (save-window-excursion (edebug-pop-to-buffer edebug-outside-buffer) ;; (edebug-sit-for 1) ; this shouldnt be necessary (goto-char edebug-outside-point) ;; (message "current buffer: %s" (current-buffer)) (edebug-sit-for 1) (edebug-pop-to-buffer edebug-buffer)))) ;;-------------------------- ;; epoch related things (defvar edebug-epoch-running (and (boundp 'epoch::version) epoch::version) "non-nil if epoch is running. Windows are handled a little differently under epoch.") (defun edebug-current-window-configuration () "Return the current window or frame configuration." (if edebug-epoch-running (edebug-current-screen-configuration) (current-window-configuration))) (defun edebug-set-window-configuration (conf) "Set the window or frame configuration to CONF." (if edebug-epoch-running (edebug-set-screen-configuration conf) (set-window-configuration conf))) (defun edebug-get-buffer-window (buffer) (if edebug-epoch-running (epoch::get-buffer-window buffer) (get-buffer-window buffer))) (defun edebug-pop-to-buffer (buffer) "Like pop-to-buffer, but select a frame that buffer was shown in." (let ((edebug-window (edebug-get-buffer-window buffer))) (if edebug-window (select-window edebug-window) ;; It is not currently displayed, so find some place to display it. (if edebug-epoch-running ;; Select a screen that the buffer has been displayed in before ;; or the current screen otherwise. (select-screen ;; allowed-screens in epoch 3.2, was called screens before that (or (car (symbol-buffer-value 'allowed-screens buffer)) (epoch::current-screen)))) (if (one-window-p) (split-window)) (select-window (next-window)) (set-window-buffer (selected-window) buffer) (set-window-hscroll (selected-window) 0) )) ;; Selecting the window does not set the buffer. (set-buffer buffer) ) (defun edebug-current-screen-configuration () "Return an object recording the current configuration of Epoch screen-list. The object is a list of pairs of the form (SCREEN . CONFIGURATION) where SCREEN has window-configuration CONFIGURATION. The current screen is the head of the list." (let ((screen-list (epoch::screen-list 'unmapped)) (current-screen (epoch::get-screen)) (current-buffer (current-buffer)) ) ;; put current screen first (setq screen-list (cons current-screen (delq current-screen screen-list))) (prog1 (mapcar (function (lambda (screen) (cons screen (progn (epoch::select-screen screen) (current-window-configuration))))) screen-list) (epoch::select-screen current-screen) (set-buffer current-buffer) ))) (defun edebug-set-screen-configuration (sc) "Set the window-configuration for all the screens in SC. Set the current screen to be the head of SC." (mapcar (function (lambda (screen-conf) (if (epoch::screen-p (car screen-conf)) ; still exist? (progn (epoch::select-screen (car screen-conf)) (set-window-configuration (cdr screen-conf)))))) sc) (if (epoch::screen-p (car (car sc))) (epoch::select-screen (car (car sc)))) ) (defun edebug-sit-for (arg) (if edebug-epoch-running (epoch::dispatch-events)) (sit-for arg) ) (defun edebug-input-pending-p () (if edebug-epoch-running (epoch::dispatch-events)) (input-pending-p) ) ;;-------------------------- ;; breakpoint related functions (defun edebug-find-stop-point () "Return (function . index) of the nearest edebug stop point." (let* ((def-name (edebug-which-function)) (edebug-data (or (get def-name 'edebug) (error "%s must first be evaluated with edebug-defun" def-name))) ;; pull out parts of edebug-data. (edebug-func-mark (car edebug-data)) (edebug-breakpoints (car (cdr edebug-data))) (offset-vector (car (cdr (cdr edebug-data)))) (offset (- (save-excursion (if (looking-at "[ \t]") ;; skip backwards until non-whitespace, or bol (skip-chars-backward " \t")) (point)) edebug-func-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 def-name i) (message "Point is not on an expression in %s." 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* ((def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get def-name 'edebug)) ;; pull out parts of edebug-data (edebug-func-mark (car edebug-data)) (edebug-breakpoints (car (cdr edebug-data))) (offset-vector (car (cdr (cdr 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-func-mark (aref offset-vector (car breakpoint)))) (message (concat (if (car (cdr (cdr breakpoint))) "Temporary " "") (if (car (cdr breakpoint)) (format "Condition: %s" (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* ((def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) (edebug-data (get def-name 'edebug)) ;; pull out parts of edebug-data (edebug-func-mark (car edebug-data)) (edebug-breakpoints (car (cdr edebug-data))) (offset-vector (car (cdr (cdr 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) '<)) (message "Breakpoint set in %s." def-name)) (if present (message "Breakpoint unset in %s." def-name) (message "No breakpoint here."))) (setcdr edebug-data (cons edebug-breakpoints (cdr (cdr edebug-data)))) (goto-char (+ edebug-func-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)) (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: ") (edebug-modify-breakpoint t condition arg)) ;;-------------------------- ;; Mode switching functions (defun edebug-set-mode (mode shortmsg msg) "Set the edebug mode to MODE. Display SHORTMSG, or MSG if not within edebug." (interactive) (setq edebug-mode mode) (if (< 0 edebug-depth) (if (eq (current-buffer) edebug-buffer) (progn (message shortmsg) (exit-recursive-edit))) (message msg))) (defun edebug-step-through () "Proceed to next debug step." (interactive) (edebug-set-mode 'step "" "edebug will stop before next eval.")) (defun edebug-go (arg) "Go, evaluating until break. With ARG set temporary break at stop 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 () "Go, evaluating without debugging." (interactive) (edebug-set-mode 'Go-nonstop "Go-Nonstop..." "edebug will not stop at breaks.")) (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 err (let ((parse-sexp-ignore-comments t)) ;; Call forward-sexp repeatedly until done or failure. (forward-sexp arg) (edebug-go 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 err (let ((parse-sexp-ignore-comments t)) (up-list 1) (save-excursion ;; Is there still a containing expression? (up-list 1)) (edebug-go 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-through) ; No more at this level, so step. (edebug-go t) ))))) (defun edebug-goto-here () "Proceed to this stop point." (interactive) (edebug-go t) ) (defun edebug-trace () "Begin trace mode." (interactive) (edebug-set-mode 'trace "Tracing..." "edebug will trace with pause.")) (defun edebug-Trace-fast () "Trace with no wait at each step." (interactive) (edebug-set-mode 'Trace-fast "Trace fast..." "edebug will trace without pause.")) (defun edebug-continue () "Begin continue mode." (interactive) (edebug-set-mode 'continue "Continue..." "edebug will pause at breakpoints.")) (defun edebug-Continue-fast () "Trace with no wait at each step." (interactive) (edebug-set-mode 'Continue-fast "Continue fast..." "edebug will stop and go at breakpoints.")) (defun edebug-step-in () "Step into the function about to be called. Do this before the arguments are evaluated since otherwise it will be too late. One side effect of using edebug-step-in is that the next time the function is called, edebug will be called there as well." (interactive) (if (not (eq 'enter edebug-arg-mode)) (error "You must be in front of a function or macro call")) (let* ((func (car edebug-exp)) (func-marker (get func 'edebug))) (cond ((markerp func-marker) (save-excursion (set-buffer (marker-buffer func-marker)) (goto-char func-marker) (edebug-defun))) ((listp func-marker) ;; its already been evaluated for edebug nil) (t (error "You must first evaluate %s in a buffer" func)))) (exit-recursive-edit)) ;;(defun edebug-exit-out () ;; "Go until the current function exits." ;; (interactive) ;; (edebug-set-mode 'exiting "Exit...")) (defun edebug-stop () "Useful for exiting from trace loop." (interactive) (message "Stop")) ;;; 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 (defvar edebug-previous-result nil "Last result returned from an expression.") (defun edebug-previous-result () "Return the previous result." (interactive) (let ((print-escape-newlines t) (print-length 20)) (message "Result: %s" (prin1-to-string edebug-previous-result)))) (defun edebug-eval (expr) "Evaluate EXPR in the outside environment." (if (not edebug-active) (error "edebug is not active")) (edebug-outside-excursion (eval expr))) (defun edebug-eval-expression (expr) "Prompt and evaluate an expression in the outside environment. Print result in minibuffer." (interactive "xEval: ") (prin1 (edebug-eval expr))) (defun edebug-eval-last-sexp () "Evaluate sexp before point in the outside environment; print value in minibuffer." (interactive) (prin1 (edebug-eval (edebug-last-sexp)))) (defun edebug-eval-print-last-sexp () "Evaluate sexp before point in the outside environment; print value into current buffer." (interactive) (let ((standard-output (current-buffer))) (print (condition-case err (edebug-eval (edebug-last-sexp)) (error (format "%s: %s" (get (car err) 'error-message) (car (cdr err)))))))) ;;;--------------------------------- ;;; edebug minor mode initialization (defvar edebug-mode 'step "Current edebug mode set by user.") (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-through) (define-key edebug-mode-map "g" 'edebug-go) (define-key edebug-mode-map "G" 'edebug-Go-nonstop) (define-key edebug-mode-map "t" 'edebug-trace) (define-key edebug-mode-map "T" 'edebug-Trace-fast) (define-key edebug-mode-map "c" 'edebug-continue) (define-key edebug-mode-map "C" 'edebug-Continue-fast) (define-key edebug-mode-map "f" 'edebug-forward-sexp) (define-key edebug-mode-map "h" 'edebug-goto-here) (define-key edebug-mode-map "r" 'edebug-previous-result) (define-key edebug-mode-map "i" 'edebug-step-in) (define-key edebug-mode-map "o" 'edebug-step-out) ;; (define-key edebug-mode-map "m" 'edebug-set-initial-mode) (define-key edebug-mode-map "q" 'top-level) (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) ;; evaluation (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) (define-key edebug-mode-map "p" 'edebug-bounce-point) (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) )) ;;;###autoload (defvar global-edebug-prefix "\^XX" "Prefix key for global edebug commands, available from any buffer.") ;;;###autoload (defvar global-edebug-map nil "Global map of edebug commands, available from any buffer.") ;;;###autoload (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 "X" 'edebug-step-through) (define-key global-edebug-map "d" 'edebug-defun) (define-key global-edebug-map " " 'edebug-step-through) (define-key global-edebug-map "g" 'edebug-go) (define-key global-edebug-map "G" 'edebug-Go-nonstop) (define-key global-edebug-map "t" 'edebug-trace) (define-key global-edebug-map "T" 'edebug-Trace-fast) (define-key global-edebug-map "c" 'edebug-continue) (define-key global-edebug-map "C" 'edebug-Continue-fast) ;; (define-key global-edebug-map "m" 'edebug-set-initial-mode) (define-key global-edebug-map "b" 'edebug-set-breakpoint) (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint) (define-key global-edebug-map "u" 'edebug-unset-breakpoint) (define-key global-edebug-map "w" 'edebug-where) (define-key global-edebug-map "q" 'top-level) ) (defun edebug-help () (interactive) (describe-function 'edebug-mode)) (defun edebug-mode () "Mode for Emacs Lisp buffers while in edebug. Under construction. There are both buffer local and global key bindings to several functions. E.g. edebug-step-through is bound to \\[edebug-step-through] in the debug buffer and \\\\[edebug-step-through] in any buffer. edebug buffer commands: \\{edebug-mode-map} Global commands prefixed by global-edbug-prefix: \\{global-edebug-map} Options: edebug-all-defuns edebug-eval-macro-args edebug-stop-before-symbols edebug-save-windows edebug-save-point edebug-save-buffer-points edebug-initial-mode edebug-trace " (use-local-map edebug-mode-map)) ;;=============================================== ;; edebug eval list mode ;; A list of expressions and their evaluations is displayed ;; in edebug-eval-buffer (defvar edebug-eval-list nil "List of expressions to evaluate.") ;;(defvar edebug-eval-buffer "*edebug*" ;; "*Declared globally so edebug-eval-display can be called independent ;;of edebug (not implemented yet).") (defun edebug-eval-result-list () "Return a list of evaluations of edebug-eval-list" ;; Assumes in outside environment. (mapcar (function (lambda (expr) (condition-case err (eval expr) (error (format "%s: %s" (get (car err) 'error-message) (car (cdr err)))) ))) 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-display-line (format ";%s\n" (make-string (- (window-width) 2) ?-)))) (edebug-pop-to-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-display-line) (setq edebug-eval-list-temp (cdr edebug-eval-list-temp)) (setq edebug-eval-result-list (cdr edebug-eval-result-list))) )) (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-pop-to-buffer edebug-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-pop-to-buffer edebug-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 data display buffer while in edebug. Under construction. ... ignore the following... There are both buffer local and global key bindings to several functions. E.g. edebug-step-through is bound to \\[edebug-step-through] in the debug buffer and \\\\[edebug-step-through] in any buffer. Eval list buffer commands: \\{edebug-eval-mode-map} Global commands prefixed by global-edbug-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-debug) ;; (setq debugger 'debug) ; use the default ;; Note that debug and its utilities must be byte-compiled to work, since ;; they depend on the backtrace looking a certain way. ;;;###autoload (defun edebug-debug (&rest debugger-args) "Replacement for debug. If an error or quit occurred and we are running an edebugged function, show where we last were. Otherwise call debug normally." (if (and edebug-backtrace ; anything active? (eq (recursion-depth) edebug-recursion-depth) ) ;; Where were we before the error occurred? (let ((edebug-offset-index (car edebug-offset-indices)) (edebug-arg-mode (car debugger-args)) (edebug-exp (car (cdr debugger-args))) edebug-break-data edebug-break (edebug-outside-debug-on-eror debug-on-error) (debug-on-error nil)) (edebug-display) ) ;; Otherwise call debug normally. ;; Still need to remove extraneous edebug calls from stack. (apply 'debug debugger-args) )) (defun edebug-backtrace () "Display a non-working backtrace. Better than nothing..." (interactive) (let ((old-buf (current-buffer))) (if (not edebug-backtrace-buffer) (setq edebug-backtrace-buffer (let ((default-major-mode 'fundamental-mode)) (generate-new-buffer "*Backtrace*")))) (edebug-pop-to-buffer edebug-backtrace-buffer) (erase-buffer) (let ((standard-output (current-buffer)) (print-escape-newlines t) (print-length 50) last-ok-point ) (setq truncate-lines t) (backtrace) ;; Clean up the backtrace. (goto-char (point-min)) (delete-region (point) (progn ;; Everything up to the first edebug is internal. (re-search-forward "^ edebug(") (forward-line 1) (point))) (forward-line 1) (setq last-ok-point (point)) ;; Delete interspersed edebug internals. (while (re-search-forward "^ edebug" nil t) (if (looking-at "-enter") ;; delete extraneous progn at top level of function body (save-excursion (goto-char last-ok-point) (forward-line -1) (setq last-ok-point (point)))) (forward-line 1) (delete-region last-ok-point (point)) (forward-line 1) ; skip past the good line (setq last-ok-point (point)) ) ) (edebug-pop-to-buffer old-buf) )) ;;======================================================================== ;; Trace display - append text to a buffer, and update display. ;;; e.g. ;;; (edebug-trace-display ;;; "*trace-point*" ;;; "saving: point = %s window-start = %s\n" ;;; (point) (window-start)) (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." (let* ((selected-window (selected-window)) (buffer (get-buffer-create buf-name)) (buf-window)) (edebug-pop-to-buffer buffer) (save-excursion (setq buf-window (selected-window)) (set-buffer buffer) (goto-char (point-max)) (insert (apply 'format fmt args)) (set-window-point buf-window (point)) (forward-line (- 1 (window-height buf-window))) (set-window-start buf-window (point)) ;; (edebug-sit-for 1) (bury-buffer buffer) ) (select-window selected-window))) (provide 'edebug) ;;; edebug.el ends here emacs-19.22/lisp/edmacro.el100444 12120 1 61360 5447474160 14045 0ustar rmsdaemon;;; edmacro.el --- keyboard macro editor ;; Copyright (C) 1993 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: (require 'cl) ;;; The user-level commands for editing macros. ;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro) (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)) ((symbolp cmd) (setq mac (symbol-function cmd))) (t (setq mac cmd) (setq cmd nil))) (unless (arrayp mac) (error "Not a keyboard macro: %s" cmd)) (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) nil))) (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 (equalp 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 (equalp 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 nil) 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) (list (current-local-map) (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) (- (lsh 1 23) 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 (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-" (subseq rest-mac 0 i) " ") (callf 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 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 " (subseq rest-mac 1 i) " ") (callf 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 (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 (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 (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 (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 '(18 22 20 23 19 21) when (/= (logand ch (lsh 1 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 (mismatch rest-mac rest-mac :end1 bind-len :start2 pos :end2 (+ 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 (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-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 (subseq macro 0 i) (vector 'menu-bar (car ev)) (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 (lsh 1 (cdr (assq (aref word 0) '((?A . 18) (?C . 22) (?H . 20) (?M . 23) (?s . 19) (?S . 21)))))) (incf prefix 2) (callf substring word 2)) (when (string-match "^\\^.$" word) (incf bits (lsh 1 22)) (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 (lsh 1 23)) (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 (lsh 1 22)) 0) (stringp word) (string-match "[@-_.a-z?]" word)) (setq key (list (+ bits (- (lsh 1 22)) (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 (subseq res 2 -2))) (if (and (not need-vector) (loop for ch across res always (and (integerp ch) (let ((ch2 (logand ch (lognot (lsh 1 23))))) (and (>= ch2 0) (<= ch2 127)))))) (concat (loop for ch across res collect (if (= (logand ch (lsh 1 23)) 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 nil))) (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.22/lisp/edt.el100444 12120 1 46142 5424025260 13174 0ustar rmsdaemon;;; edt.el --- EDT emulation in Emacs ;; Copyright (C) 1986 Free Software Foundation, Inc. ;; Author: Mike Clarkson ;; Maintainer: FSF ;; Created: 27 Aug 1986 ;; Keywords: emulations ;; This started from public domain code by Mike Clarkson ;; but has been greatly altered. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Here's my EDT emulation for GNU Emacs that is based on the EDT emulation ;; for Gosling's Emacs sent out on the net a couple of years ago by Lynn Olson ;; at Tektronics. This emulation was widely distributed as the file edt.ml ;; in the maclib directory of most Emacs distributions. ;; ;; I will gladly take all criticisms and complaints to heart, and will fix what ;; bugs I can find. As this is my first Emacs Lisp hack, you may have to root ;; out a few nasties hidden in the code. Please let me know if you find any ;; (sorry, no rewards :-). I would also be interested if there are better, ;; cleaner, faster ways of doing some of the things that I have done. ;; ;; You must understand some design considerations that I had in mind. ;; The intention was not really to "emulate" EDT, but rather to take advantage ;; of the years of EDT experience that had accumulated in my right hand, ;; while at the same time taking advantage of EMACS. ;; ;; Some major differences are: ;; ;; HELP is describe-key; ;; GOLD/HELP is describe-function; ;; FIND is isearch-forward/backward; ;; GOLD/HELP is occur-menu, which finds all instances of a search string; ;; ENTER is other-window; ;; SUBS is subprocess-command. Note that you have to change this ;; to `shell' if you are running Un*x; ;; PAGE is next-paragraph, because that's more useful than page. ;; SPECINS is copy-to-killring; ;; GOLD/GOLD is mark-section-wisely, which is my command to mark the ;; section in a manner consistent with the major-mode. It ;; uses mark-defun for emacs-lisp, lisp, mark-c-function for C, ;; and mark-paragraph for other modes. ;; ;; ;; Some subtle differences are: ;; ;; APPEND is append-to-buffer. One doesn't append to the kill ring ;; much and SPECINS is now copy-to-killring; ;; REPLACE is replace-regexp; ;; FILL is fill-region-wisely, which uses indent-region for C, lisp ;; emacs-lisp, and fill-region for others. It asks if you ;; really want to fill-region in TeX-mode, because I find this ;; to be very dangerous. ;; CHNGCASE is case-flip for the character under the cursor only. ;; I felt that case-flip region is unlikely, as usually you ;; upcase-region or downcase region. Also, unlike EDT it ;; is independent of the direction you are going, as that ;; drives me nuts. ;; ;; I use Emacs definition of what a word is. This is considerably different ;; from what EDT thinks a word is. This is not good for dyed-in-the-wool EDT ;; fans, but is probably preferable for experienced Emacs users. My assumption ;; is that the former are a dying breed now that GNU Emacs has made it to VMS, ;; but let me know how you feel. Also, when you undelete a word it leave the ;; point at the end of the undeleted text, rather than the beginning. I might ;; change this as I'm not sure if I like this or not. I'm also not sure if I ;; want it to set the mark each time you delete a character or word. ;; ;; Backspace does not invoke beginning-of-line, because ^H is the help prefix, ;; and I felt it should be left as such. You can change this if you like. ;; ;; The ADVANCE and BACKUP keys do not work as terminators for forward or ;; backward searches. In Emacs, all search strings are terminated by return. ;; The searches will however go forward or backward depending on your current ;; direction. Also, when you change directions, the mode line will not be ;; updated immediately, but only when you next execute an emacs function. ;; Personally, I consider this to be a bug, not a feature. ;; ;; This should also work with VT-2xx's, though I haven't tested it extensively ;; on those terminals. It assumes that the CSI-map of vt_200.el has been ;; defined. ;; ;; There are also a whole bunch of GOLD letter, and GOLD character bindings: ;; look at edtdoc.el for them, or better still, look at the edt.el lisp code, ;; because after all, in the true Lisp tradition, the source code is *assumed* ;; to be self-documenting :-) ;; ;; Mike Clarkson, ...!allegra \ BITNET: mike@YUYETTI or ;; CRESS, York University, ...!decvax \ SYMALG@YUSOL ;; 4700 Keele Street, ...!ihnp4 > !utzoo!yetti!mike ;; North York, Ontario, ...!linus / ;; CANADA M3J 1P3. ...!watmath / Phone: +1 (416) 736-2100 x 7767 ;; ;; Note that I am not on ARPA, and must gateway any ARPA mail through BITNET or ;; UUCP. If you have a UUCP or BITNET address please use it for communication ;; so that I can reach you directly. If you have both, the BITNET address ;; is preferred. ;;; Code: (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.") (defun 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 EDT `undelete-lines' command." (interactive "p") (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)))) (defun 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 EDT `undelete-lines' command." (interactive "p") (let ((beg (point))) (forward-char 1) (end-of-line num) (setq edt-last-deleted-lines (buffer-substring beg (point))) (delete-region beg (point)))) (defun delete-current-word (num) "Delete one or specified number of words after point. They are saved for the EDT `undelete-words' command." (interactive "p") (let ((beg (point))) (forward-word num) (setq edt-last-deleted-words (buffer-substring beg (point))) (delete-region beg (point)))) (defun edt-delete-previous-word (num) "Delete one or specified number of words before point. They are saved for the EDT `undelete-words' command." (interactive "p") (let ((beg (point))) (forward-word (- num)) (setq edt-last-deleted-words (buffer-substring (point) beg)) (delete-region beg (point)))) (defun delete-current-char (num) "Delete one or specified number of characters after point. They are saved for the EDT `undelete-chars' command." (interactive "p") (setq edt-last-deleted-chars (buffer-substring (point) (min (point-max) (+ (point) num)))) (delete-region (point) (min (point-max) (+ (point) num)))) (defun delete-previous-char (num) "Delete one or specified number of characters before point. They are saved for the EDT `undelete-chars' command." (interactive "p") (setq edt-last-deleted-chars (buffer-substring (max (point-min) (- (point) num)) (point))) (delete-region (max (point-min) (- (point) num)) (point))) (defun undelete-lines () "Yank lines deleted by last EDT `line-delete' command." (interactive) (insert edt-last-deleted-lines)) (defun undelete-words () "Yank words deleted by last EDT `word-delete' command." (interactive) (insert edt-last-deleted-words)) (defun undelete-chars () "Yank characters deleted by last EDT `character-delete' command." (interactive) (insert edt-last-deleted-chars)) (defun 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) (end-of-line num)) (defun 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 forward-to-word (num) "Move to next word-beginning, or to Nth following word-beginning." (interactive "p") (forward-word (1+ num)) (forward-word -1)) (defun backward-to-word (num) "Move back to word-end, or to Nth word-end seen." (interactive "p") (forward-word (- (1+ num))) (forward-word 1)) (defun backward-line (num) "Move point to start of previous line. Prefix argument serves as repeat-count." (interactive "p") (forward-line (- num))) (defun scroll-window-down (num) "Scroll the display down a window-full. Accepts a prefix argument for the number of window-fulls to scroll." (interactive "p") (scroll-down (- (* (window-height) num) 2))) (defun scroll-window-up (num) "Scroll the display up a window-full. Accepts a prefix argument for the number of window-fulls to scroll." (interactive "p") (scroll-up (- (* (window-height) num) 2))) (defun next-paragraph (num) "Move to beginning of the next indented paragraph. Accepts a prefix argument for the number of paragraphs." (interactive "p") (while (> num 0) (next-line 1) (forward-paragraph) (previous-line 1) (if (eolp) (next-line 1)) (setq num (1- num)))) (defun previous-paragraph (num) "Move to beginning of previous indented paragraph. Accepts a prefix argument for the number of paragraphs." (interactive "p") (while (> num 0) (backward-paragraph) (previous-line 1) (if (eolp) (next-line 1)) (setq num (1- num)))) (defun move-to-beginning () "Move cursor to the beginning of buffer, but don't set the mark." (interactive) (goto-char (point-min))) (defun move-to-end () "Move cursor to the end of buffer, but don't set the mark." (interactive) (goto-char (point-max))) (defun 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 update-mode-line () "Ensure mode-line reflects all changes." (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)) (defun advance-direction () "Set EDT Advance mode so keypad commands move forward." (interactive) (setq edt-direction-string " ADVANCE") (global-set-key [kp-f3] 'isearch-forward) (global-set-key [kp-8] 'scroll-window-up) (global-set-key [kp-7] 'next-paragraph) (global-set-key [kp-1] 'forward-to-word) (global-set-key [kp-2] 'next-end-of-line) (global-set-key [kp-3] 'forward-char) (global-set-key [kp-0] 'forward-line) (update-mode-line)) (defun backup-direction () "Set EDT Backup mode so keypad commands move backward." (interactive) (setq edt-direction-string " BACKUP") (global-set-key [kp-f3] 'isearch-backward) (global-set-key [kp-8] 'scroll-window-down) (global-set-key [kp-7] 'previous-paragraph) (global-set-key [kp-1] 'backward-to-word) (global-set-key [kp-2] 'previous-end-of-line) (global-set-key [kp-3] 'backward-char) (global-set-key [kp-9] 'backward-line) (update-mode-line)) (defun edt-beginning-of-window () "Home cursor to top of window." (interactive) (move-to-window-line 0)) (defun edt-line-to-bottom-of-window () "Move the current line to the top of the window." (interactive) (recenter -1)) (defun edt-line-to-top-of-window () "Move the current line to the top of the window." (interactive) (recenter 0)) (defun case-flip-character (num) "Change the case of the character under the cursor. Accepts a prefix argument of the number of characters to invert." (interactive "p") (while (> num 0) (funcall (if (<= ?a (following-char)) 'upcase-region 'downcase-region) (point) (1+ (point))) (forward-char 1) (setq num (1- num)))) (defun indent-or-fill-region () "Fill region in text modes, indent region in programming language modes." (interactive) (if (string= paragraph-start "^$\\|^ ") (indent-region (point) (mark) nil) (fill-region (point) (mark)))) (defun mark-section-wisely () "Mark the section in a manner consistent with the major-mode. Uses mark-defun for emacs-lisp, lisp, mark-c-function for C, and mark-paragraph for other modes." (interactive) (cond ((eq major-mode 'emacs-lisp-mode) (mark-defun)) ((eq major-mode 'lisp-mode) (mark-defun)) ((eq major-mode 'c-mode) (mark-c-function)) (t (mark-paragraph)))) ;;; Key Bindings ;;;###autoload (defun edt-emulation-on () "Emulate DEC's EDT editor. Note that many keys are rebound; including nearly all keypad keys. Use \\[edt-emulation-off] to undo all rebindings except the keypad keys." (interactive) (advance-direction) (edt-bind-gold-keypad) (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\")) (global-set-key "\C-\\" 'quoted-insert) (setq edt-mode-old-delete (lookup-key global-map "\177")) (global-set-key "\177" 'delete-previous-char) ;"Delete" (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177")) (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete" (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete" (setq edt-mode-old-linefeed (lookup-key global-map "\C-j")) (global-set-key "\C-j" 'edt-delete-previous-word) ;"LineFeed" (define-key esc-map "?" 'apropos)) ;"?" (defun edt-emulation-off () "Return from EDT emulation to normal Emacs key bindings. The keys redefined by \\[edt-emulation-on] are given their old definitions." (interactive) (setq edt-direction-string nil) (global-set-key "\C-\\" edt-mode-old-c-\\) (global-set-key "\177" edt-mode-old-delete) ;"Delete" (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete" (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete" (global-set-key "\C-j" edt-mode-old-linefeed)) ;"LineFeed" (defvar GOLD-map (make-keymap) "`GOLD-map' maps the function keys on the VT100 keyboard preceded by the PF1 key. GOLD is the ASCII the 7-bit escape sequence OP.") (defalias 'GOLD-prefix GOLD-map) (global-set-key [home] 'edt-beginning-of-window) (global-set-key [kp-f2] 'describe-key) (global-set-key [kp-f4] 'delete-current-line) (global-set-key [kp-9] 'append-to-buffer) (global-set-key [kp-subtract] 'delete-current-word) (global-set-key [kp-4] 'advance-direction) (global-set-key [kp-5] 'backup-direction) (global-set-key [kp-6] 'kill-region) (global-set-key [kp-separator] 'delete-current-char) (global-set-key [kp-decimal] 'set-mark-command) (global-set-key [kp-enter] 'other-window) (global-set-key [kp-f1] 'GOLD-prefix) ;;Bind GOLD/Keyboard keys (define-key GOLD-map "\C-g" 'keyboard-quit) ; just for safety (define-key GOLD-map "\177" 'delete-window) ;"Delete" (define-key GOLD-map "\C-h" 'delete-other-windows) ;"BackSpace" (define-key GOLD-map "\C-m" 'newline-and-indent) ;"Return" (define-key GOLD-map " " 'undo) ;"Spacebar" (define-key GOLD-map "%" 'goto-percent) ; "%" (define-key GOLD-map "=" 'goto-line) ; "=" (define-key GOLD-map "`" 'what-line) ; "`" (define-key GOLD-map "\C-\\" 'split-window-vertically) ; "Control-\" ; GOLD letter combinations: (define-key GOLD-map "b" 'buffer-menu) ; "b" (define-key GOLD-map "B" 'buffer-menu) ; "B" (define-key GOLD-map "d" 'delete-window) ; "d" (define-key GOLD-map "D" 'delete-window) ; "D" (define-key GOLD-map "e" 'compile) ; "e" (define-key GOLD-map "E" 'compile) ; "E" (define-key GOLD-map "i" 'insert-file) ; "i" (define-key GOLD-map "I" 'insert-file) ; "I" (define-key GOLD-map "l" 'goto-line) ; "l" (define-key GOLD-map "L" 'goto-line) ; "L" (define-key GOLD-map "m" 'save-some-buffers) ; "m" (define-key GOLD-map "M" 'save-some-buffers) ; "m" (define-key GOLD-map "n" 'next-error) ; "n" (define-key GOLD-map "N" 'next-error) ; "N" (define-key GOLD-map "o" 'switch-to-buffer-other-window) ; "o" (define-key GOLD-map "O" 'switch-to-buffer-other-window) ; "O" (define-key GOLD-map "r" 'revert-file) ; "r" (define-key GOLD-map "r" 'revert-file) ; "R" (define-key GOLD-map "s" 'save-buffer) ; "s" (define-key GOLD-map "S" 'save-buffer) ; "S" (define-key GOLD-map "v" 'find-file-other-window) ; "v" (define-key GOLD-map "V" 'find-file-other-window) ; "V" (define-key GOLD-map "w" 'write-file) ; "w" (define-key GOLD-map "w" 'write-file) ; "W" ;(define-key GOLD-map "z" 'shrink-window) ; "z" ;(define-key GOLD-map "Z" 'shrink-window) ; "z" ;Bind GOLD/Keypad keys (defun edt-bind-gold-keypad () (define-key GOLD-map [up] 'edt-line-to-top-of-window) (define-key GOLD-map [down] 'edt-line-to-bottom-of-window) (define-key GOLD-map [left] 'backward-sentence) (define-key GOLD-map [right] 'forward-sentence) (define-key GOLD-map [kp-f1] 'mark-section-wisely) (define-key GOLD-map [kp-f2] 'describe-function) (define-key GOLD-map [kp-f3] 'occur) (define-key GOLD-map [kp-f4] 'undelete-lines) (define-key GOLD-map [kp-0] 'open-line) (define-key GOLD-map [kp-1] 'case-flip-character) (define-key GOLD-map [kp-2] 'delete-to-eol) (define-key GOLD-map [kp-3] 'copy-region-as-kill) (define-key GOLD-map [kp-4] 'move-to-end) (define-key GOLD-map [kp-5] 'move-to-beginning) (define-key GOLD-map [kp-6] 'yank) (define-key GOLD-map [kp-7] 'execute-extended-command) (define-key GOLD-map [kp-8] 'indent-or-fill-region) (define-key GOLD-map [kp-9] 'replace-regexp) (define-key GOLD-map [kp-subtract] 'undelete-words) (define-key GOLD-map [kp-separator] 'undelete-chars) (define-key GOLD-map [kp-decimal] 'redraw-display) (define-key GOLD-map [kp-enter] 'shell-command)) ;; Make direction of motion show in mode line ;; while EDT emulation is turned on. ;; Note that the keypad is always turned on when in Emacs. (or (assq 'edt-direction-string minor-mode-alist) (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string) minor-mode-alist))) ;;; edt.el ends here emacs-19.22/lisp/ehelp.el100444 13437 1 26602 5431043276 13655 0ustar jimbdaemon;;; ehelp.el --- bindings for electric-help mode ;; Copyright (C) 1986 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. ;;; 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))) (fillarray (car (cdr map)) 'electric-help-undefined) (define-key map (char-to-string meta-prefix-char) (copy-keymap map)) (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) (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) ;; this is done below in with-electric-help ;(run-hooks 'electric-help-mode-hook) ) (defun with-electric-help (thunk &optional buffer noerase) "Arguments are THUNK &optional BUFFER NOERASE. BUFFER defaults to \"*Help*\" THUNK is a function of no arguments which is called to initialize the contents of BUFFER. BUFFER will be erased before THUNK is called unless NOERASE is non-nil. THUNK will be called with `standard-output' bound to the buffer specified by BUFFER 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. 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)) (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) (electric-help-mode) (setq buffer-read-only nil) (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)))))) (defun electric-help-command-loop () (catch 'exit (if (pos-visible-in-window-p (point-max)) (progn (message "<<< Press Space to bury the help buffer >>>") (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 "q") 'electric-help-exit)))) (Electric-command-loop 'exit (function (lambda () (let ((min (pos-visible-in-window-p (point-min))) (max (pos-visible-in-window-p (point-max)))) (cond ((and min max) (cond (standard "Press Q to exit ") (neither) (t (setq neither (substitute-command-keys "Press \\[scroll-up] to exit "))))) (min (cond (standard "Press SPC to scroll, Q to exit ") (up) (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll; \\[electric-help-exit] to exit "))))) (max (cond (standard "Press DEL to scroll back, Q to exit ") (down) (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[scroll-up] to exit "))))) (t (cond (standard "Press SPC to scroll, DEL to scroll back, Q to exit ") (both) (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit "))))))))) 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) (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)) (message "SPC scrolls forward, DEL scrolls back, Q exits and burys help buffer") ;; to give something for user to look at while slow substitute-cmd-keys ;; grinds away (message "Help...") (message "%s" (substitute-command-keys "\\[scroll-up] scrolls forward, \\[scroll-down] scrolls back, \\[electric-help-exit] exits."))) (sit-for 2)) (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)))) (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) ;;;; ehelp-map (defvar ehelp-map ()) (if ehelp-map nil (let ((map (copy-keymap help-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))) ;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win (provide 'ehelp) ;;; ehelp.el ends here emacs-19.22/lisp/electric.el100444 12120 1 13426 5403272222 14210 0ustar rmsdaemon;;; electric.el --- window maker and Command loop for `electric' modes. ;; Copyright (C) 1985, 1986 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 a prompt string (defaults to "->"). 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) (if (not prompt) (setq prompt "->")) (let (cmd (err nil)) (while t (setq cmd (read-key-sequence (if (stringp prompt) prompt (funcall prompt)))) (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.22/lisp/emacsbug.el100444 74777 1 3445 5354206542 14346 0ustar ericdaemon;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list. ;; Copyright (C) 1985 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. (defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu" "Address of site maintaining mailing list for GNU Emacs bugs.") ;;;###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-max)) (insert "\nIn " (emacs-version) "\n\n") (message (substitute-command-keys "Type \\[mail-send] to send bug report."))) (provide 'emacsbug) ;;; emacsbug.el ends here emacs-19.22/lisp/emerge.el100444 12120 1 340251 5432234253 13705 0ustar rmsdaemon;;; 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: ;;; 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 (setq 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.") ;; 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.") ;; 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)) (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.") ;; 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 (getenv "TMPDIR")) 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-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))) ;; 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)) (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f) (and current-prefix-arg (emerge-read-file-name "Output file" emerge-last-dir-output f f))))) (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)) (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f) (emerge-read-file-name "Ancestor file" emerge-last-dir-ancestor nil f) (and current-prefix-arg (emerge-read-file-name "Output file" emerge-last-dir-output f f))))) (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) '(, 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) '(, exit-func))))) file-out) (throw 'client-wait nil)) (defun emerge-remote-exit (file-out exit-func) (emerge-write-and-delete file-out) (kill-buffer emerge-merge-buffer) (funcall exit-func (if emerge-prefix-argument 1 0))) ;;; Functions to start Emerge on RCS versions (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))) (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'.") (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) ;; 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)))) (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)) (A-hidden-lines (emerge-eval-in-buffer A-buffer (save-restriction (widen) (count-lines 1 A-point-min)))) (B-point-min (emerge-eval-in-buffer B-buffer (point-min))) (B-hidden-lines (emerge-eval-in-buffer B-buffer (save-restriction (widen) (count-lines 1 B-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 (goto-line (+ a-begin A-hidden-lines)) (setq a-begin-marker (point-marker)) (goto-line (+ a-end A-hidden-lines)) (setq a-end-marker (point-marker))) (emerge-eval-in-buffer B-buffer (goto-line (+ b-begin B-hidden-lines)) (setq b-begin-marker (point-marker)) (goto-line (+ b-end B-hidden-lines)) (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)) (window-B (get-buffer-window buffer-B)) (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)) (window-B (get-buffer-window buffer-B)) (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 A set")) (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 B set")) (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 redisplay (set-buffer-modified-p (buffer-modified-p))) (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 redisplay (set-buffer-modified-p (buffer-modified-p))) (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-skip-prefers "Auto-advance set" "Auto-advance cleared")) ;; force mode line redisplay (set-buffer-modified-p (buffer-modified-p))) (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 redisplay (set-buffer-modified-p (buffer-modified-p))) (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)))) (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-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' 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) ;; `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)) '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 '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 '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 redisplay (set-buffer-modified-p (buffer-modified-p))) ;; 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)))) ;; (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.22/lisp/env.el100444 12120 1 4252 5406175005 13167 0ustar rmsdaemon;;; env.el --- functions to manipulate environment variables. ;;; Copyright Free Software Foundation 1991 ;; 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: ;;;###autoload (defun setenv (variable &optional value) "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. This function works by modifying `process-environment'." (interactive "sSet environment variable: \nsSet %s to value: ") (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)) (while scan (cond ((string-match pattern (car scan)) (if (eq nil value) (setq process-environment (delq (car scan) process-environment)) (setcar scan (concat variable "=" value))) (setq scan nil)) ((null (setq scan (cdr scan))) (setq process-environment (cons (concat variable "=" value) process-environment)))))))) (provide 'env) ;;; env.el ends here emacs-19.22/lisp/etags.el100444 12120 1 150166 5475064105 13554 0ustar rmsdaemon;;; etags.el --- etags facility for Emacs ;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993 ;; 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.") (defvar tags-add-tables nil "*Non-nil means always add a new tags table to the current list. This eliminates the need to ask the user whether to add a new tags table to the current list (as opposed to starting a new list).") (defvar tags-table-list-pointer nil "Pointer into `tags-table-list' where the current state of searching is. Might instead point into a list of included tags tables. Use `visit-tags-table-buffer' to cycle through tags tables in this list.") (defvar tags-table-list-started-at nil "Pointer into `tags-table-list', where the current search started.") (defvar tags-table-parent-pointer-list nil "Saved state of the tags table that included this one. Each element is (POINTER . STARTED-AT), giving the values of `tags-table-list-pointer' and `tags-table-list-started-at' from before we moved into the current table.") (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-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)) ;; 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 'same) (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))) ;; Move tags-table-list-pointer along and set tags-file-name. ;; If NO-INCLUDES is non-nil, ignore included tags tables. ;; Returns nil when out of tables. (defun tags-next-table (&optional no-includes) ;; Do we have any included tables? (if (and (not no-includes) (visit-tags-table-buffer 'same) (tags-included-tables)) ;; Move into the included tags tables. (setq tags-table-parent-pointer-list ;; Save the current state of what table we are in. (cons (cons tags-table-list-pointer tags-table-list-started-at) tags-table-parent-pointer-list) ;; Start the pointer in the list of included tables. tags-table-list-pointer tags-included-tables tags-table-list-started-at tags-included-tables) ;; No included tables. 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-list)) (if (eq tags-table-list-pointer tags-table-list-started-at) ;; We have come full circle. No more tables. (if tags-table-parent-pointer-list ;; Pop back to the tags table which includes this one. (progn ;; Restore the state variables. (setq tags-table-list-pointer (car (car tags-table-parent-pointer-list)) tags-table-list-started-at (cdr (car tags-table-parent-pointer-list)) tags-table-parent-pointer-list (cdr tags-table-parent-pointer-list)) ;; Recurse to skip to the next table after the parent. (tags-next-table t)) ;; All out of tags tables. (setq tags-table-list-pointer nil)))) (and tags-table-list-pointer ;; Set tags-file-name to the fully-expanded name. (setq tags-file-name (tags-expand-table-name (car tags-table-list-pointer))))) ;; 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)) ;; Return the cdr of LIST (default: tags-table-list) whose car ;; is equal to FILE after tags-expand-table-name on both sides. (defun tags-table-list-member (file &optional list) (or list (setq list tags-table-list)) (setq file (tags-expand-table-name file)) (while (and list (not (string= file (tags-expand-table-name (car list))))) (setq list (cdr list))) list) ;; Local var in visit-tags-table-buffer-cont ;; which is set by tags-table-including. (defvar visit-tags-table-buffer-cont) ;; Subroutine of visit-tags-table-buffer. Frobs its local vars. ;; Search TABLES for one that has tags for THIS-FILE. Recurses on ;; included tables. Returns the tail of TABLES (or of an inner ;; included list) whose car is a table listing THIS-FILE. 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 tables core-only &optional recursing) (let ((found nil)) ;; Loop over TABLES, looking for one containing tags for THIS-FILE. (while (and (not found) tables) (let ((tags-file-name (tags-expand-table-name (car tables)))) (if (or (get-file-buffer tags-file-name) (and (not core-only) (file-exists-p tags-file-name))) (progn ;; Select the tags table buffer and get the file list up to date. (visit-tags-table-buffer 'same) (or tags-table-files (setq tags-table-files (funcall tags-table-files-function))) (cond ((member this-file tags-table-files) ;; Found it. (setq found tables)) ((tags-included-tables) ;; This table has included tables. Check them. (let ((old tags-table-parent-pointer-list)) (unwind-protect (progn (or recursing ;; At top level (not in an included tags ;; table), set the list to nil so we can ;; collect just the elts from this run. (setq tags-table-parent-pointer-list nil)) (setq found ;; Recurse on the list of included tables. (tags-table-including this-file tags-included-tables core-only t)) (if found ;; One of them lists THIS-FILE. ;; Set the table list state variables to move ;; us inside the list of included tables. (setq tags-table-parent-pointer-list (cons (cons tags-table-list-pointer tags-table-list-started-at) tags-table-parent-pointer-list) tags-table-list-pointer found tags-table-list-started-at found ;; Set a local variable of ;; our caller, visit-tags-table-buffer. ;; Set it so we won't frob lists later. visit-tags-table-buffer-cont 'included))) (or recursing ;; tags-table-parent-pointer-list now describes ;; the path of included tables taken by recursive ;; invocations of this function. The recursive ;; calls have consed onto the front of the list, ;; so it is now outermost first. We want it ;; innermost first, so reverse it. Then append ;; the old list (from before we were called the ;; outermost time), to get the complete current ;; state of included tables. (setq tags-table-parent-pointer-list (nconc (nreverse tags-table-parent-pointer-list) old)))))))))) (setq tables (cdr tables))) found)) (defun visit-tags-table-buffer (&optional cont) "Select the buffer containing the current 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. (let ((visit-tags-table-buffer-cont cont)) (cond ((eq visit-tags-table-buffer-cont 'same) ;; Use the ambient value of tags-file-name. (or tags-file-name (error (substitute-command-keys (concat "No tags table in use! " "Use \\[visit-tags-table] to select one.")))) ;; Set VISIT-TAGS-TABLE-BUFFER-CONT to nil ;; so the code below will make sure tags-file-name ;; is in tags-table-list. (setq visit-tags-table-buffer-cont nil)) (visit-tags-table-buffer-cont ;; Find the next table. (if (tags-next-table) ;; Skip over nonexistent files. (while (and (let ((file (tags-expand-table-name tags-file-name))) (not (or (get-file-buffer file) (file-exists-p file)))) (tags-next-table))))) (t ;; Pick a table out of our hat. (setq tags-file-name (or ;; First, try a local variable. (cdr (assq 'tags-file-name (buffer-local-variables))) ;; Second, try a user-specified function to guess. (and default-tags-table-function (funcall default-tags-table-function)) ;; Third, look for a tags table that contains ;; tags for the current buffer's file. ;; If one is found, the lists will be frobnicated, ;; and VISIT-TAGS-TABLE-BUFFER-CONT ;; will be set non-nil so we don't do it below. (car (or ;; First check only tables already in buffers. (save-excursion (tags-table-including buffer-file-name tags-table-list t)) ;; Since that didn't find any, now do the ;; expensive version: reading new files. (save-excursion (tags-table-including buffer-file-name tags-table-list nil)))) ;; Fourth, use the user variable tags-file-name, if it is not ;; already in tags-table-list. (and tags-file-name (not (tags-table-list-member tags-file-name)) tags-file-name) ;; Fifth, use the user variable giving the table list. ;; Find the first element of the list that actually exists. (let ((list tags-table-list) file) (while (and list (setq file (tags-expand-table-name (car list))) (not (get-file-buffer file)) (not (file-exists-p file))) (setq list (cdr list))) (car list)) ;; Finally, prompt the user for a file name. (expand-file-name (read-file-name "Visit tags table: (default TAGS) " default-directory "TAGS" t)))))) ;; Expand the table name into a full file name. (setq tags-file-name (tags-expand-table-name tags-file-name)) (if (and (eq visit-tags-table-buffer-cont t) (null tags-table-list-pointer)) ;; All out of tables. nil ;; Verify that tags-file-name is a valid tags table. (if (if (get-file-buffer tags-file-name) ;; The file is already in a buffer. Check for the visited file ;; having changed since we last used it. (let (win) (set-buffer (get-file-buffer tags-file-name)) (setq win (or verify-tags-table-function (initialize-new-tags-table))) (if (or (verify-visited-file-modtime (current-buffer)) (not (yes-or-no-p "Tags file has changed, read new contents? "))) (and win (funcall verify-tags-table-function)) (revert-buffer t t) (initialize-new-tags-table))) (set-buffer (find-file-noselect tags-file-name)) (or (string= tags-file-name buffer-file-name) ;; find-file-noselect has changed the file name. ;; Propagate the change to tags-file-name and tags-table-list. (let ((tail (member tags-file-name tags-table-list))) (if tail (setcar tail buffer-file-name)) (setq tags-file-name buffer-file-name))) (initialize-new-tags-table)) ;; We have a valid tags table. (progn ;; Bury the tags table buffer so it ;; doesn't get in the user's way. (bury-buffer (current-buffer)) (if visit-tags-table-buffer-cont ;; No list frobbing required. nil ;; Look in the list for the table we chose. (let ((elt (tags-table-list-member tags-file-name))) (or elt ;; The table is not in the current set. ;; Try to find it in another previously used set. (let ((sets tags-table-set-list)) (while (and sets (not (setq elt (tags-table-list-member tags-file-name (car sets))))) (setq sets (cdr sets))) (if sets ;; Found in some other set. Switch to that set. (progn (or (memq tags-table-list tags-table-set-list) ;; Save the current list. (setq tags-table-set-list (cons tags-table-list tags-table-set-list))) (setq tags-table-list (car sets))) ;; Not found in any existing set. (if (and tags-table-list (or tags-add-tables (y-or-n-p (concat "Add to current list" " of tags tables? ")))) ;; Add it to the current list. (setq tags-table-list (cons tags-file-name tags-table-list)) ;; Make a fresh list, and store the old one. (message "Starting a new list of tags tables") (or (memq tags-table-list tags-table-set-list) (setq tags-table-set-list (cons tags-table-list tags-table-set-list))) (setq tags-table-list (list tags-file-name))) (setq elt tags-table-list)))) ;; Set the tags table list state variables to point at the table ;; we want to use first. (setq tags-table-list-started-at elt tags-table-list-pointer elt))) ;; Return of t says the tags table is valid. t) ;; The buffer was not valid. Don't use it again. (let ((file tags-file-name)) (kill-local-variable 'tags-file-name) (if (eq file tags-file-name) (setq tags-file-name nil))) (error "File %s is not a valid tags table" buffer-file-name))))) (defun file-of-tag () "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))))) ;;;###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: ")) ;; Save the current buffer's value of `find-tag-hook' before selecting the ;; tags table buffer. (let ((local-find-tag-hook find-tag-hook)) (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)) (prog1 ;; Record the location so we can pop back to it later. (marker-buffer (car (setq tags-location-stack (cons (let ((marker (make-marker))) (save-excursion (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 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)))) tags-location-stack)))) (run-hooks 'local-find-tag-hook))))) ;;;###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)) ;; 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 ) (save-excursion (or first-search ;find-tag-noselect has already done it. (visit-tags-table-buffer 'same)) ;; Get a qualified match. (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))) (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) (funcall goto-func tag-info) ;; Give this buffer a local value of tags-file-name. ;; The next time visit-tags-table-buffer is called, ;; it will use the same tags table that found a match in this buffer. (make-local-variable 'tags-file-name) (setq tags-file-name tags-table-file) ;; 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-exact-match-p tag-word-match-p tag-any-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 (search-backward "\f\n") (forward-char 2) (buffer-substring (point) (progn (skip-chars-forward "^,") (point))))) (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 "^\\(\\(.+[^-a-zA-Z0-9_$]+\\)?\\([-a-zA-Z0-9_$]+\\)\ \[^-a-zA-Z0-9_$]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\),\\([0-9]+\\)\n" nil t) (intern (if (match-beginning 5) ;; There is an explicit tag name. (buffer-substring (match-beginning 5) (match-end 5)) ;; No explicit tag name. Best guess. (buffer-substring (match-beginning 3) (match-end 3))) table))) table)) (defun etags-snarf-tag () (let (tag-text 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) (search-forward ",") (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 startpos))) (defun etags-goto-tag-location (tag-info) (let ((startpos (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))))) (or startpos (setq startpos (point-min))) (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 "`%s' not found in %s; time to rerun etags" pat buffer-file-name))) ;; Position point at the right place ;; if the search string matched an extra Ctrl-m at the beginning. (and (eq selective-display t) (looking-at "\^m") (forward-char 1)) (beginning-of-line)) (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"))) (princ (buffer-substring (point) (progn (skip-chars-forward "^\177") (point)))) (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)) (skip-chars-forward "^,\n") (or (looking-at ",include$") ;; Expand in the default-directory of the tags table buffer. (setq files (cons (expand-file-name (buffer-substring beg (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)) (skip-chars-forward "^,\n") (if (looking-at ",include$") ;; Expand in the default-directory of the tags table buffer. (setq files (cons (expand-file-name (buffer-substring beg (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 (looking-at (concat "[^\177]*\177" (regexp-quote tag) "\001")) ;; We also call it "exact" if it is surrounded by symbol boundaries. ;; This is needed because etags does not always generate explicit names. (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")))) ;; 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." (interactive "P") (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) (setq next-file-list (tags-table-files)))) (t ;; Initialize the list by evalling the argument. (setq next-file-list (eval initialize)))) (or next-file-list (save-excursion ;; Get the files from the next tags table. ;; When doing (visit-tags-table-buffer t), ;; the tags table buffer must be current. (if (and (visit-tags-table-buffer 'same) (visit-tags-table-buffer t)) (setq next-file-list (tags-table-files)) (and novisit (get-buffer " *next-file*") (kill-buffer " *next-file*")) (error "All files processed.")))) (let ((new (not (get-file-buffer (car next-file-list))))) (if (not (and new novisit)) (set-buffer (find-file-noselect (car next-file-list) novisit)) ;; Like find-file, but avoids random warning messages. (set-buffer (get-buffer-create " *next-file*")) (kill-all-local-variables) (erase-buffer) (setq new (car next-file-list)) (insert-file-contents new nil)) (setq next-file-list (cdr next-file-list)) 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 execute to operate on an interesting file If the latter returns non-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)) (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 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 "sTags query replace (regexp): \nsTags query replace %s by: \nP") (setq tags-loop-scan (list 'prog1 (list 'if (list 're-search-forward 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 from to t t delimited)) (tags-loop-continue (or file-list-form t))) ;;;###autoload (defun list-tags (file) "Display list of tags in file FILE. FILE should not contain a directory specification." (interactive (list (completing-read "List tags in file: " (save-excursion (visit-tags-table-buffer) (mapcar 'list (mapcar 'file-name-nondirectory (tags-table-files)))) nil t nil))) (with-output-to-temp-buffer "*Tags List*" (princ "Tags in file ") (princ file) (terpri) (save-excursion (let ((first-time t) (gotany nil)) (while (visit-tags-table-buffer (not first-time)) (setq first-time nil) (if (funcall list-tags-function file) (setq gotany t))) (or gotany (error "File %s not in current tags tables" file)))))) ;;;###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-file-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) (setq selective-display t selective-display-ellipses nil) (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 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) (setq buffer-read-only t mode-name "Select Tags Table") (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) (use-local-map map))) (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) (provide 'etags) ;;; etags.el ends here emacs-19.22/lisp/faces.el100444 12120 1 104300 5475263226 13524 0ustar rmsdaemon;;; faces.el --- Lisp interface to the c "face" structure ;; 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: ;; Mostly derived from Lucid. ;;; Code: ;;;; Functions for manipulating face vectors. ;;; A face vector is a vector of the form: ;;; [face ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE] ;;; Type checkers. (defsubst internal-facep (x) (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face))) (defmacro internal-check-face (face) (` (while (not (internal-facep (, face))) (setq (, face) (signal 'wrong-type-argument (list 'internal-facep (, face))))))) ;;; Accessors. (defsubst face-name (face) "Return the name of face FACE." (aref (internal-get-face face) 1)) (defsubst face-id (face) "Return the internal ID number of face FACE." (aref (internal-get-face face) 2)) (defsubst 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)) (defsubst 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)) (defsubst 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)) ;;(defsubst face-background-pixmap (face &optional frame) ;; "Return the background pixmap name of face FACE, or nil if unspecified. ;;If the optional argument FRAME is given, report on face FACE in that frame. ;;Otherwise report on the defaults for face FACE (for new frames)." ;; (aref (internal-get-face face frame) 6)) (defsubst 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. (defsubst 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 face frame))) (internal-set-face-1 face 'font font 3 frame)) (defsubst 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)) (defsubst 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")) (internal-set-face-1 face 'background color 5 frame)) ;;(defsubst set-face-background-pixmap (face name &optional frame) ;; "Change the background 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 "background-pixmap")) ;; (internal-set-face-1 face 'background-pixmap name 6 frame)) (defsubst 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)) ;;;; 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 (eq window-system 'x) (make-face-x-resource-internal face)) face))) ;; 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 (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 ".attributeBackgroundPixmap") ;; "Face.AttributeBackgroundPixmap") ;; (and set-anyway (face-background-pixmap face)))) (ulp (or (x-get-resource (concat name ".attributeUnderline") "Face.AttributeUnderline") (and set-anyway (face-underline-p face)))) ) (if fn (condition-case () (set-face-font face fn frame) (error (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-background-pixmap 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-name &optional frame new-frame) "Define a face just like OLD-FACE, with name NEW-NAME. If NEW-NAME already exists as a face, it is modified to be like OLD-FACE. If the optional argument FRAME is given, this applies only to that frame. Otherwise it applies to each frame separately. If the optional fourth argument NEW-FRAME is given, copy the information from face OLD-FACE on frame FRAME to face NEW-NAME on frame NEW-FRAME." (or new-frame (setq new-frame frame)) (setq old-face (internal-get-face old-face frame)) (let* ((inhibit-quit t) (new-face (or (internal-find-face new-name new-frame) (make-face new-name)))) (if (null frame) (let ((frames (frame-list))) (while frames (copy-face old-face new-name (car frames)) (setq frames (cdr frames))) (copy-face old-face new-name t)) (set-face-font new-face (face-font old-face frame) new-frame) (set-face-foreground new-face (face-foreground old-face frame) new-frame) (set-face-background new-face (face-background old-face frame) new-frame) ;;; (set-face-background-pixmap ;;; new-face (face-background-pixmap old-face frame) new-frame) (set-face-underline-p new-face (face-underline-p old-face frame) new-frame)) new-face)) (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)) ;; (equal (face-background-pixmap face1 frame) ;; (face-background-pixmap 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." (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-background-pixmap default frame) ;;; (face-background-pixmap face frame)) ;;; (null (face-background-pixmap face frame))) (equal (face-underline-p default 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) ;;; 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 - 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, try to return a font which is also the same size as FACE on FRAME." (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 (error "No fonts matching pattern are the same size as `%s'" face) (error "No fonts match `%s'" pattern))) (car fonts)) (cdr (assq 'font (frame-parameters (selected-frame)))))) (defun x-frob-font-weight (font which) (if (or (string-match x-font-regexp font) (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))) nil)) (defun x-frob-font-slant (font which) (cond ((or (string-match x-font-regexp font) (string-match x-font-regexp-head font)) (concat (substring font 0 (match-beginning 2)) which (substring font (match-end 2)))) ((string-match x-font-regexp-slant font) (concat (substring font 0 (match-beginning 1)) which (substring font (match-end 1)))) (t nil))) (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 ((ofont (face-font face frame)) font f2) (if (null frame) (let ((frames (frame-list))) ;; Make this face bold in global-face-data. (make-face-bold face t noerror) ;; Make this face bold in each frame. (while frames (make-face-bold face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font (or (face-font face frame) (face-font face t))) (if (listp font) (setq font nil)) (setq font (or font (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (make-face-bold-internal face frame)) (or (not (equal ofont (face-font face))) (and (not noerror) (error "No bold version of %S" font)))))) (defun make-face-bold-internal (face frame) (or (and (setq f2 (x-make-font-bold font)) (internal-try-face-font face f2 frame)) (and (setq f2 (x-make-font-demibold font)) (internal-try-face-font face f2 frame)))) (defun make-face-italic (face &optional frame noerror) "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 ((ofont (face-font face frame)) font f2) (if (null frame) (let ((frames (frame-list))) ;; Make this face italic in global-face-data. (make-face-italic face t noerror) ;; Make this face italic in each frame. (while frames (make-face-italic face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font (or (face-font face frame) (face-font face t))) (if (listp font) (setq font nil)) (setq font (or font (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (make-face-italic-internal face frame)) (or (not (equal ofont (face-font face))) (and (not noerror) (error "No italic version of %S" font)))))) (defun make-face-italic-internal (face frame) (or (and (setq f2 (x-make-font-italic font)) (internal-try-face-font face f2 frame)) (and (setq f2 (x-make-font-oblique font)) (internal-try-face-font face f2 frame)))) (defun make-face-bold-italic (face &optional frame noerror) "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 ((ofont (face-font face frame)) font) (if (null frame) (let ((frames (frame-list))) ;; Make this face bold-italic in global-face-data. (make-face-bold-italic face t noerror) ;; Make this face bold in each frame. (while frames (make-face-bold-italic face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font (or (face-font face frame) (face-font face t))) (if (listp font) (setq font nil)) (setq font (or font (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (make-face-bold-italic-internal face frame)) (or (not (equal ofont (face-font face))) (and (not noerror) (error "No bold italic version of %S" font)))))) (defun make-face-bold-italic-internal (face frame) (let (f2 f3) (or (and (setq f2 (x-make-font-italic font)) (not (equal font f2)) (setq f3 (x-make-font-bold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame)) (and (setq f2 (x-make-font-oblique font)) (not (equal font f2)) (setq f3 (x-make-font-bold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame)) (and (setq f2 (x-make-font-italic font)) (not (equal font f2)) (setq f3 (x-make-font-demibold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame)) (and (setq f2 (x-make-font-oblique font)) (not (equal font f2)) (setq f3 (x-make-font-demibold f2)) (not (equal f2 f3)) (internal-try-face-font face f3 frame))))) (defun make-face-unbold (face &optional frame noerror) "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 ((ofont (face-font face frame)) font font1) (if (null frame) (let ((frames (frame-list))) ;; Make this face unbold in global-face-data. (make-face-unbold face t noerror) ;; Make this face unbold in each frame. (while frames (make-face-unbold face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font1 (or (face-font face frame) (face-font face t))) (if (listp font1) (setq font1 nil)) (setq font1 (or font1 (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (setq font (x-make-font-unbold font1)) (if font (internal-try-face-font face font frame))) (or (not (equal ofont (face-font face))) (and (not noerror) (error "No unbold version of %S" font1)))))) (defun make-face-unitalic (face &optional frame noerror) "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 ((ofont (face-font face frame)) font font1) (if (null frame) (let ((frames (frame-list))) ;; Make this face unitalic in global-face-data. (make-face-unitalic face t noerror) ;; Make this face unitalic in each frame. (while frames (make-face-unitalic face (car frames) noerror) (setq frames (cdr frames)))) (setq face (internal-get-face face frame)) (setq font1 (or (face-font face frame) (face-font face t))) (if (listp font1) (setq font1 nil)) (setq font1 (or font1 (face-font 'default frame) (cdr (assq 'font (frame-parameters frame))))) (setq font (x-make-font-unitalic font1)) (if font (internal-try-face-font face font frame))) (or (not (equal ofont (face-font face))) (and (not noerror) (error "No unitalic version of %S" font1)))))) (defvar list-faces-sample-text "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" "*Text string to display as the sample text for `list-faces-display'.") ;; The name list-faces would be more consistent, but let's avoid a conflict ;; with Lucid, which uses that name differently. (defun list-faces-display () "List all faces, using the same sample text in each. The sample text is a string that comes from the variable `list-faces-sample-text'. It is possible to give a particular face name different appearances in different frames. This command shows the appearance in the selected frame." (interactive) (let ((faces (sort (face-list) (function string-lessp))) (face nil) (frame (selected-frame)) disp-frame window) (with-output-to-temp-buffer "*Faces*" (save-excursion (set-buffer standard-output) (setq truncate-lines t) (while faces (setq face (car faces)) (setq faces (cdr faces)) (insert (format "%25s " (symbol-name face))) (let ((beg (point))) (insert list-faces-sample-text) (insert "\n") (put-text-property beg (1- (point)) 'face face))) (goto-char (point-min)))) ;; If the *Faces* buffer appears in a different frame, ;; copy all the face definitions from FRAME, ;; so that the display will reflect the frame that was selected. (setq window (get-buffer-window (get-buffer "*Faces*") t)) (setq disp-frame (if window (window-frame window) (car (frame-list)))) (or (eq frame disp-frame) (let ((faces (face-list))) (while faces (copy-face (car faces) (car faces) frame disp-frame) (setq faces (cdr faces))))))) ;;; Make the default and modeline faces; the C code knows these as ;;; faces 0 and 1, respectively, 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. ;; The X-specific code is clever at them. ;; (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)) ;; Set up the faces of all existing X Window frames. (let ((frames (frame-list))) (while frames (if (eq (framep (car frames)) 'x) (x-initialize-frame-faces (car frames))) (setq frames (cdr frames))))) ;;; This really belongs in setting a frame's own font. ;;; ;; ;;; ;; No font specified in the resource database; try to cope. ;;; ;; ;;; (internal-try-face-font default "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*" ;;; frame) ;;; (internal-try-face-font default "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*" ;;; frame) ;;; (internal-try-face-font default "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*" frame) ;;; (internal-try-face-font default "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*" frame) ;;; (internal-try-face-font default "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*" frame) ;;; (internal-try-face-font default "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*" frame) ;;; (internal-try-face-font default "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*" frame) ;;; This is called from make-screen-initial-faces to make sure that the ;;; "default" and "modeline" faces for this screen have enough attributes ;;; specified for emacs to be able to display anything on it. This had ;;; better not signal an error. ;;; (defun x-initialize-frame-faces (frame) (or (face-differs-from-default-p 'bold frame) (make-face-bold 'bold frame t) ;; if default font is bold, then make the `bold' face be unbold. (make-face-unbold 'bold frame t) ;; otherwise the luser specified one of the bogus font names (internal-x-complain-about-font 'bold frame) ) (or (face-differs-from-default-p 'italic frame) (make-face-italic 'italic frame t) (progn (make-face-bold 'italic frame t) (internal-x-complain-about-font 'italic frame)) ) (or (face-differs-from-default-p 'bold-italic frame) (make-face-bold-italic 'bold-italic frame t) ;; if we couldn't get a bold-italic version, try just bold. (make-face-bold 'bold-italic frame t) ;; if we couldn't get bold or bold-italic, then that's probably because ;; the default font is bold, so make the `bold-italic' face be unbold. (and (make-face-unbold 'bold-italic frame t) (make-face-italic 'bold-italic frame t)) ;; if that didn't work, try italic (can this ever happen? what the hell.) (progn (make-face-italic 'bold-italic frame t) ;; then bitch and moan. (internal-x-complain-about-font 'bold-italic frame)) ) (or (face-differs-from-default-p 'highlight frame) (if (or (not (x-display-color-p)) (= (x-display-planes) 1)) (invert-face 'highlight frame) (condition-case () (condition-case () (set-face-background 'highlight "darkseagreen2" frame) (error (set-face-background 'highlight "green" frame))) ;;; (set-face-background-pixmap 'highlight "gray1" frame) (error (invert-face 'highlight frame))))) (or (face-differs-from-default-p 'region frame) (if (= (x-display-planes) 1) (invert-face 'region frame) (condition-case () (set-face-background 'region "gray" frame) (error (invert-face 'region frame))))) (or (face-differs-from-default-p 'modeline frame) (invert-face 'modeline frame)) (or (face-differs-from-default-p 'underline frame) (set-face-underline-p 'underline t frame)) (or (face-differs-from-default-p 'secondary-selection frame) (if (or (not (x-display-color-p)) (= (x-display-planes) 1)) (invert-face 'secondary-selection frame) (condition-case () (condition-case () ;; some older X servers don't have this one. (set-face-background 'secondary-selection "paleturquoise" frame) (error (set-face-background 'secondary-selection "green" frame))) ;;; (set-face-background-pixmap 'secondary-selection "gray1" frame) (error (invert-face 'secondary-selection frame))))) ) (defun internal-x-complain-about-font (face frame) ;;; It's annoying to bother the user about this, ;;; since it happens under normal circumstances. ;;; (message "No %s version of %S" ;;; face ;;; (or (face-font face frame) ;;; (face-font face t) ;;; (face-font 'default frame) ;;; (cdr (assq 'font (frame-parameters frame))))) ;;; (sit-for 1) ) ;; Like x-create-frame but also set up the faces. (defun x-create-frame-with-faces (&optional parameters) (if (null global-face-data) (x-create-frame parameters) (let* ((frame (x-create-frame parameters)) (faces (copy-alist global-face-data)) (rest faces)) (set-frame-face-alist frame faces) (if (cdr (or (assq 'reverse parameters) (assq 'reverse default-frame-alist) (cons nil (member (x-get-resource "reverseVideo" "ReverseVideo") '("on" "true"))))) (let ((params (frame-parameters frame))) (modify-frame-parameters frame (list (cons 'foreground-color (cdr (assq 'background-color params))) (cons 'background-color (cdr (assq 'foreground-color params))) (cons 'mouse-color (cdr (assq 'background-color params))) (cons 'cursor-color (cdr (assq 'background-color params))) (cons 'border-color (cdr (assq 'background-color params))))))) ;; Copy the vectors that represent the faces. ;; Also fill them in from X resources. (while rest (setcdr (car rest) (copy-sequence (cdr (car rest)))) (condition-case nil (if (listp (face-font (cdr (car rest)))) (let ((bold (memq 'bold (face-font (cdr (car rest))))) (italic (memq 'italic (face-font (cdr (car rest)))))) (if (and bold italic) (make-face-bold-italic (car (car rest)) frame) (if bold (make-face-bold (car (car rest)) frame) (if italic (make-face-italic (car (car rest)) frame)))))) (error nil)) (make-face-x-resource-internal (cdr (car rest)) frame t) (setq rest (cdr rest))) (x-initialize-frame-faces frame) frame))) ;; If we are already using x-window frames, initialize faces for them. (if (eq (framep (selected-frame)) 'x) (face-initialize)) (provide 'faces) ;;; faces.el ends here emacs-19.22/lisp/files.el100444 12120 1 227321 5475226226 13555 0ustar rmsdaemon;;; files.el --- file input and output commands for Emacs ;; Copyright (C) 1985, 1986, 1987, 1992, 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: ;; 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 a buffer's auto-save file when the buffer is saved.") (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-truename nil "The truename of the file visited in the current buffer. This variable is automatically local in all buffers, when non-nil.") (make-variable-buffer-local 'buffer-file-truename) (put 'buffer-file-truename 'permanent-local t) (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.") (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 trim-versions-without-asking nil "*If t, deletes excess backup versions silently. If nil, asks 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 (file-name-handler-alist) (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.") (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 ":")) (while (setq cd-colon (string-match ":" 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." (setq dir (abbreviate-file-name (expand-file-name dir))) (if (not (eq system-type 'vax-vms)) (setq dir (file-name-as-directory 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 "FChange default directory: ") (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)) ;; OTHER is the other file to be compared. (defun file-local-copy (file) "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))) (if handler (funcall handler 'file-local-copy file) nil))) (defun file-truename (filename) "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." (if (or (string= filename "~") (and (string= (substring filename 0 1) "~") (string-match "~[^/]*" filename))) (progn (setq filename (expand-file-name filename)) (if (string= filename "") (setq filename "/")))) (let ((handler (find-file-name-handler filename))) ;; 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 (funcall handler 'file-truename filename) (let ((dir (file-name-directory filename)) 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) (setq dir (file-name-as-directory (file-truename dirfile)))) (if (equal ".." (file-name-nondirectory filename)) (directory-file-name (file-name-directory (directory-file-name dir))) (if (equal "." (file-name-nondirectory filename)) (directory-file-name dir) ;; 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. (if (file-name-absolute-p target) (file-truename target) (file-truename (concat dir target))) ;; No, we are done! 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)) ;; 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))) (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 (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) ;; (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))) (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 (string-match abbreviated-home-dir filename) (setq filename (concat "~" ;; If abbreviated-home-dir ends with a slash, ;; don't remove the corresponding slash from ;; filename. On MS-DOS and OS/2, you can have ;; home directories like "g:/", in which it is ;; important not to remove the slash. And what ;; about poor root on Unix systems? (if (eq ?/ (aref abbreviated-home-dir (1- (length abbreviated-home-dir)))) "/" "") (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-file-noselect (filename &optional nowarn) "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. (same-truename (or buf ; Shortcut (let (found (list (buffer-list))) (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))) (same-number (or buf ; Shortcut (and number (let (found (list (buffer-list))) (while (and (not found) list) (save-excursion (set-buffer (car list)) (if (and (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)))) error) ;; Let user know if there is a buffer with the same truename. (if (and (not buf) same-truename (not nowarn)) (message "%s and %s are the same file (%s)" filename (buffer-file-name same-truename) truename) (if (and (not buf) same-number (not nowarn)) (message "%s and %s are the same file" filename (buffer-file-name same-number)))) ;; Optionally also find that buffer. (if (or find-file-existing-other-name find-file-visit-truename) (setq buf (or same-truename same-number))) (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 (format (if (buffer-modified-p buf) "File %s changed on disk. Discard your edits? " "File %s changed on disk. Read the new version? ") (file-name-nondirectory filename))) (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 buf) (erase-buffer) (condition-case () (insert-file-contents filename t) (file-error (setq error t) ;; Run find-file-not-found-hooks until one returns non-nil. (let ((hooks find-file-not-found-hooks)) (while (and hooks (not (and (funcall (car hooks)) ;; If a hook succeeded, clear error. (progn (setq error nil) ;; Also exit the loop. t)))) (setq hooks (cdr hooks)))))) ;; Find the file's truename, and maybe use that as visited name. (setq buffer-file-truename (abbreviate-file-name 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))) (after-find-file error (not nowarn)))) buf))) (defun after-find-file (&optional error warn noauto) "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. 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) (mapcar 'funcall 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) ("\\.mss\\'" . scribe-mode) ("\\.pl\\'" . prolog-mode) ("\\.cc\\'" . c++-mode) ("\\.hh\\'" . c++-mode) ("\\.C\\'" . c++-mode) ("\\.H\\'" . c++-mode) ;;; ("\\.mk\\'" . makefile-mode) ;;; ("[Mm]akefile" . makefile-mode) ;;; Less common extensions come here ;;; so more common ones above are found faster. ("\\.s\\'" . asm-mode) ("ChangeLog\\'" . change-log-mode) ("ChangeLog.[0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) ;; The following should come after the ChangeLog pattern ;; for the sake of ChangeLog.1, etc. ("\\.[12345678]\\'" . nroff-mode) ("\\.TeX\\'" . TeX-mode) ("\\.sty\\'" . LaTeX-mode) ("\\.bbl\\'" . LaTeX-mode) ("\\.bib\\'" . bibtex-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) ("\\.texinfo\\'" . texinfo-mode) ("\\.texi\\'" . texinfo-mode) ("\\.lsp\\'" . lisp-mode) ("\\.awk\\'" . awk-mode) ("\\.prolog\\'" . prolog-mode) ("\\.tar\\'" . tar-mode) ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message ("^/tmp/Re" . text-mode) ("/Message[0-9]*\\'" . text-mode) ;; some news reader is reported to use this ("^/tmp/fol/" . text-mode) ("\\.y\\'" . c-mode) ("\\.lex\\'" . c-mode) ("\\.oak\\'" . scheme-mode) ("\\.scm.[0-9]*\\'" . 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) ("\\.ml\\'" . lisp-mode))) "\ Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION). Visiting a file whose name matches REGEXP causes FUNCTION to be called.") (defconst inhibit-local-variables-regexps '("\\.tar$") "List of regexps; if one matches a file name, don't look for local vars.") (defun set-auto-mode () "Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, or compares the filename against the entries in auto-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) (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-local-variables-regexps. (let ((temp inhibit-local-variables-regexps)) (while (and temp (not (string-match (car temp) buffer-file-name))) (setq temp (cdr temp))) (not temp)) (search-forward "-*-" (save-excursion ;; If the file begins with "#!" ;; (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 hem left to right. (while (let ((case-fold-search t)) (search-forward "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") (funcall (intern (concat (downcase (buffer-substring beg (point))) "-mode")))) ;; Simple -*-MODE-*- case. (funcall (intern (concat (downcase (buffer-substring beg end)) "-mode")))) (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 ((alist auto-mode-alist) (name buffer-file-name) mode) (let ((case-fold-search (eq system-type 'vax-vms))) ;; Remove backup-suffixes from file name. (setq name (file-name-sans-versions name)) ;; Find first matching alist entry. (while (and (not mode) alist) (if (string-match (car (car alist)) name) (setq mode (cdr (car alist)))) (setq alist (cdr alist)))) (if mode (funcall mode))))))) (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)) (skip-chars-forward " \t\n\r") (let ((result '()) (end (save-excursion (end-of-line) (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 -*-". (setq result (list (cons 'mode (intern (buffer-substring (match-beginning 1) (match-end 1))))))) (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)) (let ((key (intern (downcase (buffer-substring (match-beginning 1) (match-end 1))))) (val (save-restriction (narrow-to-region (point) end) (read (current-buffer))))) (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 (switch-to-buffer (current-buffer)) (y-or-n-p (format "Set local variables as specified in -*- line of %s? " (file-name-nondirectory buffer-file-name))))))) (while result (let ((key (car (car result))) (val (cdr (car result)))) (or (eq key 'mode) (hack-one-local-variable key val))) (setq result (cdr result))))))) (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)))))))) (defconst ignored-local-variables '(enable-local-eval) "Variables to be ignored in a file's local variable spec.") ;; "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 (eq var 'eval) (string-match "-hooks?$\\|-functions?$" (symbol-name var))) (if (and (not (string= (user-login-name) "root")) (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 filename (setq filename (if (string-equal filename "") nil (expand-file-name filename)))) (or (equal filename buffer-file-name) (null filename) (progn (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)) (rename-buffer new-name t))) (setq buffer-backed-up nil) (clear-visited-file-modtime) (if filename (progn (setq buffer-file-truename (abbreviate-file-name (file-truename buffer-file-name))) (if find-file-visit-truename (setq buffer-file-name buffer-file-truename)) (setq buffer-file-number (nth 10 (file-attributes buffer-file-name)))) (setq buffer-file-truename nil buffer-file-number 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) ;; 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) "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." ;; (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))))) (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)))) (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)) (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 trim-versions-without-asking t) (eq trim-versions-without-asking nil)) (or trim-versions-without-asking (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) (/= (nth 2 attr) (user-uid)))))) (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))) (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 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." (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." (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 (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-1 (directory) (cond ((string= directory "/") filename) ((string-match (concat "^" (regexp-quote directory)) filename) (substring filename (match-end 0))) (t (file-relative-name-1 (file-name-directory (substring directory 0 -1)))))) (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)))) (file-relative-name-1 directory)) (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 `trim-versions-without-asking' 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 (and make-backup-files (not (eq args 0))))) (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)))) (defun basic-save-buffer () "Save the current buffer in its visited file, if it has been modified." (interactive) (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 (set-visited-file-name (expand-file-name (read-file-name "File to save in: ") nil))) (or (verify-visited-file-modtime (current-buffer)) (not (file-exists-p buffer-file-name)) (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) (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))) (let ((hooks (append write-contents-hooks local-write-file-hooks write-file-hooks)) (done nil)) (while (and hooks (not (setq done (funcall (car hooks))))) (setq hooks (cdr hooks))) ;; If a hook returned t, file is already "written". (cond ((not done) (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))) (if file-precious-flag ;; If file is precious, write temp name, then rename it. (let ((dir (file-name-directory buffer-file-name)) (realname buffer-file-name) tempname temp nogood i succeed) (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) (setq succeed t)) ;; If writing the temp file fails, ;; delete the temp file. (or succeed (delete-file tempname))) ;; 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))))) (setq buffer-file-number (nth 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) (run-hooks 'after-save-hook)) (message "(No changes need to be saved)"))) (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 (if (zerop (map-y-or-n-p (function (lambda (buffer) (and (buffer-modified-p 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")) )) (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." (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 redisplay (set-buffer-modified-p (buffer-modified-p))) (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) (let* ((new-buf (generate-new-buffer (buffer-name))) (name (buffer-name new-buf))) (kill-buffer new-buf) (rename-buffer name) (set-buffer-modified-p (buffer-modified-p)))) ; 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))) (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.") (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.") (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." ;; 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 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))) ;; 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)) (let ((buffer-read-only nil) ;; 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)) (erase-buffer)) (insert-file-contents file-name (not auto-save-p)))) (goto-char (min opoint (point-max))) (after-find-file nil nil t) t))))) (defun recover-file (file) "Visit file FILE, but get contents from its last auto-save file." (interactive (let ((prompt-file buffer-file-name) (file-name nil) (file-dir nil)) (and prompt-file (setq file-name (file-name-nondirectory prompt-file) file-dir (file-name-directory prompt-file))) (list (read-file-name "Recover file: " file-dir nil nil file-name)))) (setq file (expand-file-name file)) (if (auto-save-file-name-p file) (error "%s is an auto-save file" file)) (let ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))) (cond ((not (file-newer-than-file-p file-name file)) (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 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) (not buffer-auto-save-file-name) (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 (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) "#") ;; For non-file bfr, use bfr name and Emacs pid. (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*") (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. 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'." (let ((handler (find-file-name-handler file))) (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))))) (call-process shell-file-name nil t nil "-c" (concat insert-directory-program " -d " switches " " (file-name-nondirectory file)))) ;; SunOS 4.1.3, SVr4 and others need the "." to list the ;; directory if FILE is a symbolic link. (call-process insert-directory-program nil t nil switches (if full-directory-p (concat (file-name-as-directory file) ".") file))))))) (defun save-buffers-kill-emacs (&optional arg) "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? ")))) (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.22/lisp/fill.el100444 12120 1 33070 5471016631 13346 0ustar rmsdaemon;;; fill.el --- fill commands for Emacs ;; Copyright (C) 1985, 1986, 1992 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. Nil means that any change in indentation starts a new 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 (beginning-of-line) (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.") (defun fill-region-as-paragraph (from to &optional justify-flag) "Fill region as one paragraph: break lines to fit fill-column. Prefix arg means justify too. From program, pass args FROM, TO and JUSTIFY-FLAG." (interactive "r\nP") ;; 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))) ;; 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 ""))) (save-excursion (goto-char (min from to)) (if (eolp) (forward-line 1)) (forward-line 1) (if (< (point) (max from to)) (let ((start (point))) (re-search-forward adaptive-fill-regexp) (setq fill-prefix (buffer-substring start (point)))) (goto-char (min from to)) (if (eolp) (forward-line 1)) ;; If paragraph has only one line, don't assume ;; that additional lines would have the same starting ;; decoration. Assume no indentation. ;; (re-search-forward adaptive-fill-regexp) ;; (setq fill-prefix (make-string (current-column) ?\ )) ))) (save-restriction (narrow-to-region from to) (goto-char (point-min)) (skip-chars-forward "\n") (narrow-to-region (point) (point-max)) (setq from (point)) (goto-char (point-max)) (let ((fpre (and fill-prefix (not (equal fill-prefix "")) (regexp-quote fill-prefix)))) ;; Delete the fill prefix from every line except the first. ;; The first line may not even have a fill prefix. (and fpre (progn (if (>= (length fill-prefix) fill-column) (error "fill-prefix too long for specified width")) (goto-char (point-min)) (forward-line 1) (while (not (eobp)) (if (looking-at fpre) (delete-region (point) (match-end 0))) (forward-line 1)) (goto-char (point-min)) (and (looking-at fpre) (forward-char (length fill-prefix))) (setq from (point))))) ;; from is 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") (goto-char from) (while (re-search-forward "[.?!][])}\"']*$" nil t) (insert ? )) ;; Then change all newlines to spaces. (subst-char-in-region from (point-max) ?\n ?\ ) ;; Flush excess spaces, except in the paragraph indentation. (goto-char from) (skip-chars-forward " \t") ;; nuke tabs while we're at it; they get screwed up in a fill ;; this is quick, but loses when a sole tab follows the end of a sentence. ;; actually, it is difficult to tell that from "Mr.\tSmith". ;; blame the typist. (subst-char-in-region (point) (point-max) ?\t ?\ ) (while (re-search-forward " *" nil t) (delete-region (+ (match-beginning 0) (if (save-excursion (skip-chars-backward " ]})\"'") (memq (preceding-char) '(?. ?? ?!))) 2 1)) (match-end 0))) (goto-char (point-max)) (delete-horizontal-space) (insert " ") (goto-char (point-min)) ;; This is the actual filling loop. (let ((prefixcol 0) linebeg) (while (not (eobp)) (setq linebeg (point)) (move-to-column (1+ fill-column)) (if (eobp) nil ;; 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. (while (and (> (point) (+ linebeg 2)) (eq (preceding-char) ?\ ) (not (eq (following-char) ?\ )) (eq (char-after (- (point) 2)) ?\.)) (forward-char -2) (skip-chars-backward "^ \n" linebeg)) (if (if (zerop prefixcol) (save-excursion (skip-chars-backward " " linebeg) (bolp)) (>= prefixcol (current-column))) ;; Keep at least one word even if fill prefix exceeds margin. ;; This handles all but the first line of the paragraph. ;; Meanwhile, don't stop at a period followed by one space. (let ((first t)) (move-to-column prefixcol) (while (and (not (eobp)) (or first (and (not (bobp)) (save-excursion (forward-char -1) (looking-at "\\. "))))) (skip-chars-forward " ") (skip-chars-forward "^ \n") (setq first nil))) ;; Normally, move back over the single space between the words. (forward-char -1)) (if (and fill-prefix (zerop prefixcol) (< (- (point) (point-min)) (length fill-prefix)) (string= (buffer-substring (point-min) (point)) (substring fill-prefix 0 (- (point) (point-min))))) ;; Keep at least one word even if fill prefix exceeds margin. ;; This handles the first line of the paragraph. ;; Don't stop at a period followed by just one space. (let ((first t)) (while (and (not (eobp)) (or first (and (not (bobp)) (save-excursion (forward-char -1) (looking-at "\\. "))))) (skip-chars-forward " ") (skip-chars-forward "^ \n") (setq first nil))))) ;; Replace all whitespace here with one newline. ;; Insert before deleting, so we don't forget which side of ;; the whitespace point or markers used to be on. (skip-chars-backward " ") (insert ?\n) (delete-horizontal-space) ;; Insert the fill prefix at start of each line. ;; Set prefixcol so whitespace in the prefix won't get lost. (and (not (eobp)) fill-prefix (not (equal fill-prefix "")) (progn (insert fill-prefix) (setq prefixcol (current-column)))) ;; Justify the line just ended, if desired. (and justify-flag (not (eobp)) (progn (forward-line -1) (justify-current-line) (forward-line 1)))))))) (defun fill-paragraph (arg) "Fill paragraph at or after point. Prefix arg means justify as well." (interactive "P") (let ((before (point))) (save-excursion (forward-paragraph) (or (bolp) (newline 1)) (let ((end (point)) (beg (progn (backward-paragraph) (point)))) (goto-char before) (fill-region-as-paragraph beg end arg))))) (defun fill-region (from to &optional justify-flag) "Fill each of the paragraphs in the region. Prefix arg (non-nil third arg, if called from program) means justify as well." (interactive "r\nP") (save-restriction (narrow-to-region from to) (goto-char (point-min)) (while (not (eobp)) (let ((initial (point)) (end (progn (forward-paragraph 1) (point)))) (forward-paragraph -1) (if (>= (point) initial) (fill-region-as-paragraph (point) end justify-flag) (goto-char end)))))) (defun justify-current-line () "Add spaces to line point is in, so it ends at `fill-column'." (interactive) (save-excursion (save-restriction (let (ncols beg indent) (beginning-of-line) (forward-char (length fill-prefix)) (skip-chars-forward " \t") (setq indent (current-column)) (setq beg (point)) (end-of-line) (narrow-to-region beg (point)) (goto-char beg) (while (re-search-forward " *" nil t) (delete-region (+ (match-beginning 0) (if (save-excursion (skip-chars-backward " ])\"'") (memq (preceding-char) '(?. ?? ?!))) 2 1)) (match-end 0))) (goto-char beg) (while (re-search-forward "[.?!][])\"']*\n" nil t) (forward-char -1) (insert ? )) (goto-char (point-max)) ;; Note that the buffer bounds start after the indentation, ;; so the columns counted by INDENT don't appear in (current-column). (setq ncols (- fill-column (current-column) indent)) (if (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 " ") (skip-chars-backward " ") (setq ncols (1- ncols))))))) nil) (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-FLAG and MAIL-FLAG: JUSTIFY-FLAG to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines." (interactive "r\nP") (let ((fill-individual-varying-indent t)) (fill-individual-paragraphs min max justifyp mailp))) (defun fill-individual-paragraphs (min max &optional justifyp 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-FLAG and MAIL-FLAG: JUSTIFY-FLAG to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines." (interactive "r\nP") (save-restriction (save-excursion (goto-char min) (beginning-of-line) (if mailp (while (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))) (beginning-of-line) (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 (buffer-substring (point) (save-excursion (skip-chars-forward " \t") (point))) fill-prefix-regexp (regexp-quote fill-prefix))) (forward-line 1) ;; 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) justifyp) (or had-newline (delete-char -1)))))))) ;;; fill.el ends here emacs-19.22/lisp/find-dired.el100444 12241 1 21160 5401261642 15101 0ustar rolanddaemon;;; find-dired.el --- run a `find' command and dired the output ;;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Roland McGrath , ;; Sebastian Kremer ;; Maintainer: Sebastian Kremer ;; Keywords: unix (defconst find-dired-version (substring "$Revision: 1.13 $" 11 -2) "$Id: find-dired.el,v 1.13 1993/05/28 00:58:08 roland Exp $") ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; 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. ;;; ;;; 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: ;; LISPDIR ENTRY for the Elisp Archive =============================== ;; LCD Archive Entry: ;; find-dired|Roland McGrath, Sebastian Kremer ;; |roland@gnu.ai.mit.edu, sk@thp.uni-koeln.de ;; |Run a `find' command and dired the output ;; |$Date: 1993/05/28 00:58:08 $|$Revision: 1.13 $| ;; INSTALLATION ====================================================== ;; To use this file, byte-compile it, install it somewhere in your ;; load-path, and put: ;; (autoload 'find-dired "find-dired" nil t) ;; (autoload 'find-name-dired "find-dired" nil t) ;; (autoload 'find-grep-dired "find-dired" nil t) ;; in your ~/.emacs, or site-init.el, etc. ;; To bind it to a key, put, e.g.: ;; ;; (global-set-key "\C-cf" 'find-dired) ;; (global-set-key "\C-cn" 'find-name-dired) ;; (global-set-key "\C-cl" 'find-grep-dired) ;; ;; in your ~/.emacs. ;;; Code: (require 'dired) ;;;###autoload (defvar find-ls-option (if (eq system-type 'berkeley-unix) "-ls" "-exec ls -ldi {} \\;") "*Option to `find' to produce an `ls -l'-type listing.") ;;;###autoload (defvar find-grep-options (if (eq system-type 'berkeley-unix) "-s" "-l") "*Option to grep to be as silent as possible. On Berkeley systems, this is `-s', for others it seems impossible to suppress all output, so `-l' is used to print nothing more than the file name.") (defvar find-args nil "Last arguments given to `find' by \\[find-dired].") ;;;###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) (if (featurep 'gmhist) (read-with-history-in 'find-args-history "Run find (with args): ") (read-string "Run find (with args): " find-args)))) ;; 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 " \\) ")) find-ls-option)) ;; The next statement will bomb in classic dired (no optional arg allowed) ;; find(1)'s -ls corresponds to these switches. ;; Note -b, at least GNU find quotes spaces etc. in filenames (dired-mode dir "-gilsb") ;; 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 (set-process-filter (start-process-shell-command "find" (current-buffer) args) (function find-dired-filter)) (set-process-sentinel (get-buffer-process (current-buffer)) (function find-dired-sentinel)) (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 args): ") ;; 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 backup up a bit: (goto-char (- end 3)) ; no error if < 0 (while (search-forward " ./" nil t) (delete-region (point) (- (point) 2))))))) ;; 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 redisplay soon. (set-buffer-modified-p (buffer-modified-p)))) (message "find-dired %s finished." (current-buffer)))))) (or (fboundp 'start-process-shell-command) ;; From version 19 subr.el. (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 handle as usual in the shell." (if (eq system-type 'vax-vms) (apply 'start-process name buffer args) (start-process name buffer shell-file-name "-c" (concat "exec " (mapconcat 'identity args " ")))))) (provide 'find-dired) ;;; find-dired.el ends here emacs-19.22/lisp/find-gc.el100444 74777 1 12075 5353250220 14075 0ustar ericdaemon;;; 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.22/lisp/finder-inf.el100666 12120 1 55064 5474470103 14457 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 '( ("abbrev.el" "abbrev mode commands for Emacs" (abbrev)) ("abbrevlist.el" "list one abbrev table alphabetically ordered." (abbrev)) ("ada.el" "Ada editing support package in GNUlisp. v1.0" (languages)) ("add-log.el" "change log maintenance commands for Emacs" (maint)) ("advice.el" "advice mechanism for Emacs Lisp functions" (extensions lisp tools)) ("allout.el" nil nil) ("ange-ftp.el" "transparent FTP support for GNU Emacs" (comm)) ("appt.el" "appointment notification functions." (calendar)) ("apropos.el" "faster apropos commands." (help)) ("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)) ("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" "backquoting for Emacs Lisp macros" (extensions)) ("bib-mode.el" "bib-mode, major mode for editing bib files." (bib)) ("bibtex.el" "BibTeX mode for GNU Emacs" (tex bib)) ("blackbox.el" "blackbox game in Emacs Lisp" (games)) ("bookmark.el" "set bookmarks, jump to them later." (bookmarks placeholders)) ("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)) ("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)) ("calendar.el" "Calendar functions." (calendar)) ("case-table.el" "code to extend the character set and support case tables." (i18n)) ("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.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 nil) ("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)) ("cplus-md1.el" "major mode for editing C++ (and C) code" (languages)) ("cust-print.el" "handles print-level and print-circle." (extensions)) ("dabbrev.el" "dynamic abbreviation package for GNU Emacs." (abbrev)) ("debug.el" "debuggers and related commands for Emacs" (lisp tools maint)) ("default.el" nil nil) ("delsel.el" "delete selection if you insert" nil) ("desktop.el" "save partial status of Emacs when killed" nil) ("diary-ins.el" "calendar functions for adding diary entries." (diary calendar)) ("diary.el" "diary functions." (calendar)) ("diff.el" "Run `diff' in compilation-mode." (unix tools)) ("dired-aux.el" "all of dired except what people usually use" nil) ("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)) ("doctor.el" "psychological help for frustrated users." (games)) ("dunnet.el" "Text adventure for Emacs" (games)) ("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)) ("edmacro.el" "keyboard macro editor" (abbrev)) ("edt.el" "EDT emulation in Emacs" (emulations)) ("ehelp.el" "bindings for electric-help mode" (help extensions)) ("electric.el" "window maker and Command loop for `electric' modes." (extensions)) ("emacsbug.el" "command to report Emacs bugs to appropriate mailing list." (maint)) ("emerge.el" "merge diffs under Emacs control" (unix tools)) ("env.el" "functions to manipulate environment variables." (processes unix)) ("etags.el" "etags facility for Emacs" (tools)) ("faces.el" "Lisp interface to the c \"face\" structure" nil) ("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-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)) ("font-lock.el" nil (languages faces)) ("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.el" nil (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)) ("gosmacs.el" "rebindings to imitate Gosmacs." (emulations)) ("grow-vers.el" "increment Emacs version number" (internal)) ("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)) ("hilit19.el" nil (faces)) ("hippie-exp.el" "expand text trying various ways to find its expansion." (extensions)) ("holidays.el" "holiday functions for the calendar package" (holidays calendar)) ("icon.el" "mode for editing Icon code" (languages)) ("inc-vers.el" "load this to increment the recorded Emacs version number." (internal)) ("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-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" "this is the GNU EMACS interface to GNU ISPELL version 4." (wp)) ("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-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)) ("medit.el" "front-end to the MEDIT package for editing MDL" (languages)) ("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-e.el" "GNU Emacs interface to the MH mail system" (mail)) ("mhspool.el" "MH folder access using NNTP for GNU Emacs" (mail news)) ("mim-mode.el" "Mim (MDL in MDL) mode." (languages)) ("mim-syntax.el" "syntax checker for Mim (MDL)." (languages)) ("misc.el" "basic editing commands for Emacs" nil) ("mlconvert.el" "convert buffer of Mocklisp code to real lisp." (emulations)) ("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)) ("netunam.el" "HP-UX RFA Commands" (comm)) ("nnspool.el" "spool access using NNTP for GNU Emacs" (news)) ("nntp.el" "NNTP (RFC977) Interface for GNU Emacs" (news)) ("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" nil) ("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 (languages)) ("paths.el" "define pathnames for use by various Emacs commands." (internal)) ("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)) ("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" (tools mail lisp extensions)) ("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) ("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)) ("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)) ("site-load.el" nil nil) ("solar.el" "calendar functions for solar events." (calendar)) ("sort.el" "commands to sort text in an Emacs buffer." (unix)) ("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) ("tar-mode.el" "simple editing of tar files from GNU emacs" (unix)) ("tcp.el" nil nil) ("telnet.el" "run a telnet session from within an Emacs buffer" nil) ("term-nasty.el" "Damned Things from terminfo.el" 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) ("tpu-doc.el" "Documentation for TPU-edt" (emulations)) ("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) ("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)) ("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) ("ws-mode.el" "WordStar emulation mode for GNU Emacs" (emulations)) ("x-menu.el" "menu support for X " nil) ("xscheme.el" "run Scheme under Emacs" (languages lisp)) ("yow.el" "quote random zippyisms" (games)) )) (provide 'finder-inf) ;;; finder-inf.el ends here emacs-19.22/lisp/finder.el100444 12120 1 22037 5474463046 13701 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; 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 . "C and C++ language support") (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") (games . "games, jokes and amusements") (hardware . "support for interfacing with exotic hardware") (help . "support for on-line help systems") (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") (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) ;(if finder-mode-map ; nil (setq finder-mode-map (make-sparse-keymap)) (define-key finder-mode-map " " 'finder-select) (define-key finder-mode-map "?" 'finder-summary) (define-key finder-mode-map "q" 'finder-exit) (define-key finder-mode-map "f" 'finder-list-keywords) ; ) ;;; 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 fill 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] = back to finder, \\[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.22/lisp/float-sup.el100444 12120 1 4132 5257335254 14316 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.22/lisp/float.el100444 13437 1 35533 5405344024 13664 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.22/lisp/flow-ctrl.el100444 12120 1 7223 5406143415 14311 0ustar rmsdaemon;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control ;;; Copyright (C) 1990, 1991 Free Software Foundation, Inc. ;; Author Kevin Gallagher ;; Maintainer: FSF ;; Adapted-By: ESR ;; Keywords: hardware ;;; 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. ;;; 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: ;;;###autoload (defun enable-flow-control () "Enable use of flow control; let user type C-s as C-\\ and C-q as C-^." (interactive) ;; 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. (let ((the-table (make-string 128 0))) (let ((i 0) (j (length keyboard-translate-table))) (while (< i j) (aset the-table i (elt keyboard-translate-table i)) (setq i (1+ i))) (while (< i 128) (aset the-table i i) (setq i (1+ i)))) (setq keyboard-translate-table the-table)) ;; Swap C-s and C-\ (aset keyboard-translate-table ?\034 ?\^s) (aset keyboard-translate-table ?\^s ?\034) ;; Swap C-q and C-^ (aset keyboard-translate-table ?\036 ?\^q) (aset keyboard-translate-table ?\^q ?\036) (message (concat "XON/XOFF adjustment for " (getenv "TERM") ": use C-\\ for C-s and use C-^ for C-q.")) (sleep-for 2)) ; Give user a chance to see message. (defun enable-flow-control-memstr= (e s) (cond ((null s) nil) ((string= e (car s)) t) (t (enable-flow-control-memstr= e (cdr s))))) ;;;###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) ;; Strip off hyphen and what follows (while (setq hyphend (string-match "[-_][^-_]+$" term)) (setq term (substring term 0 hyphend))) (and (enable-flow-control-memstr= term losing-terminal-types) (enable-flow-control)))) (provide 'flow-ctrl) ;;; flow-ctrl.el ends here emacs-19.22/lisp/font-lock.el100444 12120 1 56110 5472421271 14315 0ustar rmsdaemon;; Electric Font Lock Mode ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. ;; Author: jwz, then rms ;; Maintainer: FSF ;; Keywords: languages, faces ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Font-lock-mode is a minor mode that causes your comments to be ;; displayed in one face, strings in another, reserved words in another, ;; documentation strings in another, and so on. ;; ;; Comments will be displayed in `font-lock-comment-face'. ;; Strings will be displayed in `font-lock-string-face'. ;; Doc strings will be displayed in `font-lock-doc-string-face'. ;; Function and variable names (in their defining forms) will be ;; displayed in `font-lock-function-name-face'. ;; Reserved words will be displayed in `font-lock-keyword-face'. ;; ;; To make the text you type be fontified, use M-x font-lock-mode. ;; When this minor mode is on, the fonts of the current line are ;; updated with every insertion or deletion. ;; ;; To define new reserved words or other patterns to highlight, use ;; the `font-lock-keywords' variable. This should be mode-local. ;; ;; To turn this on automatically, add this to your .emacs file: ;; ;; (setq emacs-lisp-mode-hook '(lambda () (font-lock-mode 1))) ;; ;; On a Sparc2, the initial fontification takes about 12 seconds for a 120k ;; file of C code, using the default configuration. You can speed this up ;; substantially by removing some of the patterns that are highlighted by ;; default. Fontifying Lisp code is significantly faster, because Lisp has a ;; more regular syntax than C, so the expressions don't have to be as hairy. ;;; Code: (or (internal-find-face 'underline) (copy-face 'default 'underline)) (set-face-underline-p 'underline t) (defvar font-lock-comment-face 'italic "Face to use for comments.") (defvar font-lock-doc-string-face 'italic "Face to use for documentation strings.") (defvar font-lock-string-face 'underline "Face to use for string constants.") (defvar font-lock-function-name-face 'bold-italic "Face to use for function names.") (defvar font-lock-keyword-face 'bold "Face to use for keywords.") (defvar font-lock-type-face 'italic "Face to use for data types.") (make-variable-buffer-local 'font-lock-keywords) (defvar font-lock-keywords nil "*The keywords to highlight. If this is a list, then elements may be of the forms: \"string\" ; A regexp to highlight in the ; `font-lock-keyword-face'. (\"string\" . N) ; Highlight subexpression N of the regexp. (\"string\" . face-name) ; Use the named face (\"string\" N face-name) ; Both of the above (\"string\" N face-name t) ; This allows highlighting to override ; already-highlighted regions. (\"string\" N face-name keep) ; This allows highlighting to occur ; even if some parts of what STRING matches ; are already highlighted--but does not alter ; the existing highlighting of those parts. These regular expressions should not match text which spans lines. While \\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating when you edit the buffer does not, since it considers text one line at a time. Be careful composing regexps for this list; the wrong pattern can dramatically slow things down!") (defvar font-lock-keywords-case-fold-search nil "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.") (defvar font-lock-verbose t "*Non-nil means `font-lock-fontify-buffer' should print status messages.") ;;;###autoload (defvar font-lock-mode-hook nil "Function or functions to run on entry to Font Lock mode.") ;;; These variables record, for each buffer, ;;; the parse state at a particular position, always the start of a line. ;;; This is used to make font-lock-fontify-region faster. (defvar font-lock-cache-position nil) (defvar font-lock-cache-state nil) (make-variable-buffer-local 'font-lock-cache-position) (make-variable-buffer-local 'font-lock-cache-state) (defun font-lock-fontify-region (start end) "Put proper face on each string and comment between START and END." (save-excursion (goto-char start) (beginning-of-line) (setq end (min end (point-max))) (let ((buffer-read-only nil) state startline prev prevstate (modified (buffer-modified-p))) ;; Find the state at the line-beginning before START. (setq startline (point)) (if (eq (point) font-lock-cache-position) (setq state font-lock-cache-state) ;; Find outermost containing sexp. (beginning-of-defun) ;; Find the state at STARTLINE. (while (< (point) startline) (setq state (parse-partial-sexp (point) startline 0))) (setq font-lock-cache-state state font-lock-cache-position (point))) ;; Now find the state precisely at START. (setq state (parse-partial-sexp (point) start nil nil state)) ;; If the region starts inside a string, show the extent of it. (if (nth 3 state) (let ((beg (point))) (while (and (re-search-forward "\\s\"" end 'move) (nth 3 (parse-partial-sexp beg (point) nil nil state)))) (put-text-property beg (point) 'face font-lock-string-face) (setq state (parse-partial-sexp beg (point) nil nil state)))) ;; Likewise for a comment. (if (or (nth 4 state) (nth 7 state)) (let ((beg (point))) (while (and (re-search-forward (if comment-end (concat "\\s>\\|" (regexp-quote comment-end)) "\\s>") end 'move) (nth 3 (parse-partial-sexp beg (point) nil nil state)))) (put-text-property beg (point) 'face font-lock-comment-face) (setq state (parse-partial-sexp beg (point) nil nil state)))) ;; Find each interesting place between here and END. (while (and (< (point) end) (setq prev (point) prevstate state) (re-search-forward (if comment-start-skip (concat "\\s\"\\|" comment-start-skip) "\\s\"") end t) ;; Clear out the fonts of what we skip over. (progn (remove-text-properties prev (point) '(face nil)) t) ;; Verify the state at that place ;; so we don't get fooled by \" or \;. (setq state (parse-partial-sexp prev (point) nil nil state))) (let ((here (point))) (if (or (nth 4 state) (nth 7 state)) ;; We found a real comment start. (let ((beg (match-beginning 0))) (goto-char beg) (save-restriction (narrow-to-region (point-min) end) (condition-case nil (progn (forward-comment 1) ;; forward-comment skips all whitespace, ;; so go back to the real end of the comment. (skip-chars-backward " \t")) (error (goto-char end)))) (put-text-property beg (point) 'face font-lock-comment-face) (setq state (parse-partial-sexp here (point) nil nil state))) (if (nth 3 state) (let ((beg (match-beginning 0))) (while (and (re-search-forward "\\s\"" end 'move) (nth 3 (parse-partial-sexp here (point) nil nil state)))) (put-text-property beg (point) 'face font-lock-string-face) (setq state (parse-partial-sexp here (point) nil nil state)))) )) ;; Make sure PREV is non-nil after the loop ;; only if it was set on the very last iteration. (setq prev nil)) (and prev (remove-text-properties prev end '(face nil))) (set-buffer-modified-p modified)))) ;; This code used to be used to show a string on reaching the end of it. ;; It is probably not needed due to later changes to handle strings ;; starting before the region in question. ;; (if (and (null (nth 3 state)) ;; (eq (char-syntax (preceding-char)) ?\") ;; (save-excursion ;; (nth 3 (parse-partial-sexp prev (1- (point)) ;; nil nil prevstate)))) ;; ;; We found the end of a string. ;; (save-excursion ;; (setq foo2 (point)) ;; (let ((ept (point))) ;; (forward-sexp -1) ;; ;; Highlight the string when we see the end. ;; ;; Doing it at the start leads to trouble: ;; ;; either it fails to handle multiline strings ;; ;; or it can run away when an unmatched " is inserted. ;; (put-text-property (point) ept 'face ;; (if (= (car state) 1) ;; font-lock-doc-string-face ;; font-lock-string-face))))) (defun font-lock-unfontify-region (beg end) (let ((modified (buffer-modified-p)) (buffer-read-only nil)) (remove-text-properties beg end '(face nil)) (set-buffer-modified-p modified))) ;; Called when any modification is made to buffer text. (defun font-lock-after-change-function (beg end old-len) (save-excursion (save-match-data (goto-char beg) ;; Discard the cache info if text before it has changed. (and font-lock-cache-position (> font-lock-cache-position beg) (setq font-lock-cache-position nil)) ;; Rescan till end of line. yes! (goto-char end) (end-of-line) (setq end (point)) (goto-char beg) (beginning-of-line) (setq beg (point)) ;; First scan for strings and comments. ;; Must scan from line start in case of ;; inserting space into `intfoo () {}'. (font-lock-fontify-region beg (1+ end)) ;; Now scan for keywords. (font-lock-hack-keywords beg end)))) ;;; Fontifying arbitrary patterns (defsubst font-lock-any-properties-p (start end) (or (get-text-property start 'face) (let ((next (next-single-property-change start 'face))) (and next (< next end))))) (defun font-lock-hack-keywords (start end &optional loudly) (goto-char start) (let ((case-fold-search font-lock-keywords-case-fold-search) (rest font-lock-keywords) (count 0) (buffer-read-only nil) (modified (buffer-modified-p)) first str match face s e allow-overlap-p) (while rest (setq first (car rest) rest (cdr rest)) (goto-char start) (cond ((consp first) (setq str (car first)) (cond ((consp (cdr first)) (setq match (nth 1 first) face (eval (nth 2 first)) allow-overlap-p (nth 3 first))) ((symbolp (cdr first)) (setq match 0 allow-overlap-p nil face (eval (cdr first)))) (t (setq match (cdr first) allow-overlap-p nil face font-lock-keyword-face)))) (t (setq str first match 0 allow-overlap-p nil face font-lock-keyword-face))) ;(message "regexp: %s" str) (while (re-search-forward str end t) (setq s (match-beginning match) e (match-end match)) (or s (error "expression did not match subexpression %d" match)) ;; don't fontify this keyword if we're already in some other context. (or (if allow-overlap-p nil (font-lock-any-properties-p s e)) (if (not (memq allow-overlap-p '(t nil))) (save-excursion (goto-char s) (save-restriction (narrow-to-region s e) (while (not (eobp)) (let ((next (next-single-property-change (point) 'face))) (if (or (null next) (> next (point-max))) (setq next (point-max))) (if (not (get-text-property (point) 'face)) (put-text-property (point) next 'face face)) (goto-char next))))) (put-text-property s e 'face face)))) (if loudly (message "Fontifying %s... (regexps...%s)" (buffer-name) (make-string (setq count (1+ count)) ?.)))) (set-buffer-modified-p modified))) ;; The user level functions (defvar font-lock-mode nil) ; for modeline (or (assq 'font-lock-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist '((font-lock-mode " Font"))))) (defvar font-lock-fontified nil) ; whether we have hacked this buffer (put 'font-lock-fontified 'permanent-local t) ;;;###autoload (defun font-lock-mode (&optional arg) "Toggle Font Lock mode. With arg, turn Font Lock mode on if and only if arg is positive. When Font Lock mode is enabled, text is fontified as you type it: - comments are displayed in `font-lock-comment-face'; (That is a variable whose value should be a face name.) - strings are displayed in `font-lock-string-face'; - documentation strings are displayed in `font-lock-doc-string-face'; - function and variable names in their defining forms are displayed in `font-lock-function-name-face'; - and certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. When you turn Font Lock mode on/off, the buffer is fontified/defontified. To fontify a buffer without having newly typed text become fontified, you can use \\[font-lock-fontify-buffer]." (interactive "P") (let ((on-p (if (null arg) (not font-lock-mode) (> (prefix-numeric-value arg) 0)))) (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... (setq on-p nil)) (or (memq after-change-function '(nil font-lock-after-change-function)) (error "after-change-function is %s" after-change-function)) (set (make-local-variable 'after-change-function) (if on-p 'font-lock-after-change-function nil)) (set (make-local-variable 'font-lock-mode) on-p) (cond (on-p (font-lock-set-defaults) (run-hooks 'font-lock-mode-hook) (or font-lock-fontified (font-lock-fontify-buffer))) (font-lock-fontified (setq font-lock-fontified nil) (font-lock-unfontify-region (point-min) (point-max)))) (force-mode-line-update))) (defun font-lock-fontify-buffer () "Fontify the current buffer the way `font-lock-mode' would: - comments are displayed in `font-lock-comment-face'; - strings are displayed in `font-lock-string-face'; - documentation strings are displayed in `font-lock-doc-string-face'; - function and variable names in their defining forms are displayed in `font-lock-function-name-face'; - and certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. This can take a while for large buffers." (interactive) (let ((was-on font-lock-mode) (font-lock-verbose (or font-lock-verbose (interactive-p)))) (if font-lock-verbose (message "Fontifying %s..." (buffer-name))) ;; Turn it on to run hooks and get the right font-lock-keywords. (or was-on (font-lock-set-defaults)) (font-lock-unfontify-region (point-min) (point-max)) (if font-lock-verbose (message "Fontifying %s... (syntactically...)" (buffer-name))) ;; (buffer-syntactic-context-flush-cache) (save-excursion (font-lock-fontify-region (point-min) (point-max)) (if font-lock-verbose (message "Fontifying %s... (regexps...)" (buffer-name))) (font-lock-hack-keywords (point-min) (point-max) font-lock-verbose)) (set (make-local-variable 'font-lock-fontified) t) (if font-lock-verbose (message "Fontifying %s... done." (buffer-name))) )) ;;; Various mode-specific information. (defun font-lock-set-defaults () "Set `font-lock-keywords' to something appropriate for this mode." (setq font-lock-keywords (cond ((eq major-mode 'lisp-mode) lisp-font-lock-keywords) ((eq major-mode 'emacs-lisp-mode) lisp-font-lock-keywords) ((eq major-mode 'c-mode) c-font-lock-keywords) ((eq major-mode 'c++-c-mode) c-font-lock-keywords) ((eq major-mode 'c++-mode) c++-font-lock-keywords) ((eq major-mode 'perl-mode) perl-font-lock-keywords) ((eq major-mode 'tex-mode) tex-font-lock-keywords) ((eq major-mode 'texinfo-mode) texi-font-lock-keywords) (t nil)))) (defconst lisp-font-lock-keywords-1 '(;; ;; highlight defining forms. This doesn't work too nicely for ;; (defun (setf foo) ...) but it does work for (defvar foo) which ;; is more important. ("^(def[-a-z]+\\s +\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face) ;; ;; highlight CL keywords ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) ;; ;; this is highlights things like (def* (setf foo) (bar baz)), but may ;; be slower (I haven't really thought about it) ; ("^(def[-a-z]+\\s +\\(\\s(\\S)*\\s)\\|\\S(\\S *\\)" ; 1 font-lock-function-name-face) ) "For consideration as a value of `lisp-font-lock-keywords'. This does fairly subdued highlighting.") (defconst lisp-font-lock-keywords-2 (append lisp-font-lock-keywords-1 '(;; ;; Highlight control structures ("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \t\n]" . 1) ("(\\(while\\|do\\|let*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \t\n]" . 1) ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \t\n]" . 1) ("(\\(save-restriction\\|save-window-restriction\\)[ \t\n]" . 1) ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \t\n]" . 1) ;; ;; highlight function names in emacs-lisp docstrings (in the syntax ;; that substitute-command-keys understands.) ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t) ;; ;; highlight words inside `' which tend to be function names ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" 1 font-lock-keyword-face t) )) "For consideration as a value of `lisp-font-lock-keywords'. This does a lot more highlighting.") ;; default to the gaudier variety? ;(defvar lisp-font-lock-keywords lisp-font-lock-keywords-2 ; "Additional expressions to highlight in Lisp modes.") (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 "Additional expressions to highlight in Lisp modes.") (defconst c-font-lock-keywords-1 nil "For consideration as a value of `c-font-lock-keywords'. This does fairly subdued highlighting.") (defconst c-font-lock-keywords-2 nil "For consideration as a value of `c-font-lock-keywords'. This does a lot more highlighting.") (let ((storage "auto\\|extern\\|register\\|static\\|volatile") (prefixes "unsigned\\|short\\|long") (types (concat "int\\|char\\|float\\|double\\|void\\|struct\\|" "union\\|enum\\|typedef")) (ctoken "[a-zA-Z0-9_:~*]+") ) (setq c-font-lock-keywords-1 (list ;; fontify preprocessor directives as comments. '("^#[ \t]*[a-z]+" . font-lock-comment-face) ;; ;; fontify names being defined. '("^#[ \t]*\\(define\\|undef\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 font-lock-function-name-face) ;; ;; fontify other preprocessor lines. '("^#[ \t]*\\(if\\)[ \t]+\\([^\n]+\\)" 2 font-lock-function-name-face keep) '("^#[ \t]*\\(endif\\|else\\)[ \t]+\\([^\n]+\\)" 2 font-lock-function-name-face keep) '("^#[ \t]*\\(ifn?def\\)[ \t]+\\([^ \t\n]+\\)" 2 font-lock-function-name-face t) ;; ;; fontify the filename in #include <...> ;; don't need to do this for #include "..." because those were ;; already fontified as strings by the syntactic pass. '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) ;; ;; fontify the names of functions being defined. (list (concat "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? "\\(" ctoken "[ \t]+\\)?" "\\([*&]+[ \t]*\\)?" ; pointer "\\(" ctoken "\\)[ \t]*(") ; name 5 'font-lock-function-name-face) ;; ;; ;; Fontify structure names (in structure definition form). (list (concat "^\\(typedef[ \t]+struct\\|struct\\|static[ \t]+struct\\)" "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") 2 'font-lock-function-name-face) ;; ;; Fontify case clauses. This is fast because its anchored on the left. '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\):". 1) '("\\<\\(default\\):". 1) )) (setq c-font-lock-keywords-2 (append c-font-lock-keywords-1 (list ;; ;; fontify all storage classes and type specifiers (cons (concat "\\<\\(" storage "\\)\\>") 'font-lock-type-face) (cons (concat "\\<\\(" types "\\)\\>") 'font-lock-type-face) (cons (concat "\\<\\(" prefixes "[ \t]+" types "\\)\\>") 'font-lock-type-face) ;; ;; fontify all builtin tokens (cons (concat "[ \t]\\(" (mapconcat 'identity '("for" "while" "do" "return" "goto" "case" "break" "switch" "if" "then" "else if" "else" "return" "default" "continue" "default" ) "\\|") "\\)[ \t\n(){};,]") 1) ;; ;; fontify case targets and goto-tags. This is slow because the ;; expression is anchored on the right. "\\(\\(\\sw\\|\\s_\\)+\\):" ;; ;; Fontify variables declared with structures, or typedef names. '("}[ \t*]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t]*[,;]" 1 font-lock-function-name-face) ;; ;; Fontify global variables without a type. ; '("^\\([_a-zA-Z0-9:~*]+\\)[ \t]*[[;={]" 1 font-lock-function-name-face) ))) ) ; default to the gaudier variety? ;(defvar c-font-lock-keywords c-font-lock-keywords-2 ; "Additional expressions to highlight in C mode.") (defvar c-font-lock-keywords c-font-lock-keywords-1 "Additional expressions to highlight in C mode.") (defvar c++-font-lock-keywords c-font-lock-keywords "Additional expressions to highlight in C++ mode.") (defvar perl-font-lock-keywords (list (cons (concat "[ \n\t{]*\\(" (mapconcat 'identity '("if" "until" "while" "elsif" "else" "unless" "for" "foreach" "continue" "exit" "die" "last" "goto" "next" "redo" "return" "local" "exec") "\\|") "\\)[ \n\t;(]") 1) (mapconcat 'identity '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" "#define" "#undef") "\\|") '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face) '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face) '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-doc-string-face) ) "Additional expressions to highlight in Perl mode.") (defvar tex-font-lock-keywords (list '("\\(\\\\\\w+\\)" 1 font-lock-keyword-face t) '("{\\\\em\\([^}]+\\)}" 1 font-lock-comment-face t) '("{\\\\bf\\([^}]+\\)}" 1 font-lock-keyword-face t) '("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face t) '("\\\\\\(begin\\|end\\){\\([a-zA-Z0-9\\*]+\\)}" 2 font-lock-function-name-face t) '("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) ; '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) ) "Additional expressions to highlight in TeX mode.") (defvar texi-font-lock-keywords (list "@\\(@\\|[^}\t \n{]+\\)" ;commands '("^\\(@c\\|@comment\\)[ \t].*$" . font-lock-comment-face) ;comments '("^\\(*.*\\)[\t ]*$" 1 font-lock-function-name-face t) ;menu items '("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face t) '("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face t) '("@\\(samp\\|code\\|var\\){\\([^}]+\\)" 2 font-lock-function-name-face t) '("@\\(xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-keyword-face t) '("@end *\\([a-zA-Z0-9]+\\)[ \t]*$" 1 font-lock-function-name-face t) '("@item \\(.*\\)$" 1 font-lock-function-name-face t) '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) ) "Additional expressions to highlight in TeXinfo mode.") (provide 'font-lock) ;;; font-lock.el ends here emacs-19.22/lisp/forms-d2.el100666 12120 24 4545 5415145172 13750 0ustar rmsother;; demo2 -- demo forms-mode -*- emacs-lisp -*- ;; SCCS Status : @(#)@ demo2 1.1.2 ;; Author : Johan Vromans ;; Created On : 1989 ;; Last Modified By: Johan Vromans ;; Last Modified On: Mon Jul 1 13:56:31 1991 ;; Update Count : 2 ;; Status : OK ;; ;; 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. ;; This example uses the (defun ...) method of defining. ;; (defun forms-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 ) ;; 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.22/lisp/forms-pass.el100444 12120 24 1060 5033667401 14370 0ustar rmsother;; demo for forms-mode -*-emacs-lisp-*- ;; ;; 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.22/lisp/forms.el100444 12120 1 154543 5473242134 13600 0ustar rmsdaemon;;; forms.el -- Forms mode: edit a file as a form to fill in. ;;; Copyright (C) 1991, 1993 Free Software Foundation, Inc. ;; Author: Johan Vromans ;; Version: $Revision: 2.3 $ ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; 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-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-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. ;;; 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-s forms-search ;;; \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 ;;; s forms-search ;;; 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.3 $" 11 -2) "The version number of forms-mode (as string). The complete RCS id is: $Id: forms.el,v 2.3 1993/10/21 00:43:51 rms 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-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-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.") (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-s forms-search 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) (make-local-variable 'forms-new-record-filter) (make-local-variable 'forms-modified-record-filter) ;; Make sure no filters exist. (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...") (eval-current-buffer) ;; check if the mandatory variables make sense. (or forms-file (error (concat "Forms control file error: " "'forms-file' has not been set"))) (or forms-number-of-fields (error (concat "Forms control file error: " "'forms-number-of-fields' has not been set"))) (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 (stringp forms-field-sep) (error (concat "Forms control file error: " "'forms-field-sep' is not a string"))) (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. (setq buffer-file-name nil) (auto-save-mode nil) ;; Prepare this buffer for further processing. (setq buffer-read-only nil) (erase-buffer) ;;(message "forms: setting up... done.") )) ;; Copy desired faces to the actual variables used by the forms formatter. (if (fboundp 'make-face) (progn (make-local-variable 'forms--ro-face) (make-local-variable 'forms--rw-face) (if forms-read-only (progn (setq forms--ro-face forms-ro-face) (setq forms--rw-face forms-ro-face)) (setq forms--ro-face forms-ro-face) (setq forms--rw-face forms-rw-face)))) ;; Make more local variables. (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.") ) ;; find the data file (setq forms--file-buffer (find-file-noselect forms-file)) ;; 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...") ;; set the major mode indicator (setq major-mode 'forms-mode) (setq mode-name "Forms") ;; 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) ;; 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) ;; initialization done (setq forms--mode-setup t)) (defun forms--process-format-list () ;; Validate `forms-format-list' and set some global variables. ;; Symbols in the list are evaluated, and consecutive strings are ;; concatenated. ;; Array `forms--elements' is constructed that contains the order ;; of the fields on the display. This array is used by ;; `forms--parser-using-text-properties' to extract the fields data ;; from the form on the screen. ;; Upon completion, `forms-format-list' is garanteed correct, so ;; `forms--make-format' and `forms--make-parser' do not need to perform ;; any checks. ;; Verify that `forms-format-list' is not nil. (or forms-format-list (error (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)))))) ;; 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))) 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(face read-only insert-in-front-hooks)))))) ((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))) 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(read-only face insert-in-front-hooks)))))) ;; 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 here there)) (aset forms--recordv (aref forms--elements i) (buffer-substring here (point-max))))) (setq i (1+ i))))) (defun forms--make-parser-elt (el) "Helper routine to generate forms parser function." ;; The parse routine will look like: ;; ;; (lambda nil ;; (let (here) ;; (goto-char (point-min)) ;; ;; ;; "text: " ;; (if (not (looking-at "text: ")) ;; (error "Parse error: cannot find \"text: \"")) ;; (forward-char 6) ; past "text: " ;; ;; ;; 6 ;; ;; "\nmore text: " ;; (setq here (point)) ;; (if (not (search-forward "\nmore text: " nil t nil)) ;; (error "Parse error: cannot find \"\\nmore text: \"")) ;; (aset forms--recordv 5 (buffer-substring here (- (point) 12))) ;; ;; ;; (tocol 40) ;; (let ((forms--dyntext (car-safe forms--dynamic-text))) ;; (if (not (looking-at (regexp-quote forms--dyntext))) ;; (error "Parse error: not looking at \"%s\"" forms--dyntext)) ;; (forward-char (length forms--dyntext)) ;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text))) ;; ... ;; ;; final flush (due to terminator sentinel, see below) ;; (aset forms--recordv 7 (buffer-substring (point) (point-max))) (cond ((stringp el) (prog1 (if forms--field (` ((setq here (point)) (if (not (search-forward (, el) nil t nil)) (error "Parse error: cannot find \"%s\"" (, el))) (aset forms--recordv (, (1- forms--field)) (buffer-substring here (- (point) (, (length el))))))) (` ((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 (point) (point-max))))))) ((listp el) (prog1 (if forms--field (` ((let ((here (point)) (forms--dyntext (aref forms--dyntexts (, forms--dyntext)))) (if (not (search-forward forms--dyntext nil t nil)) (error "Parse error: cannot find \"%s\"" forms--dyntext)) (aset forms--recordv (, (1- forms--field)) (buffer-substring here (- (point) (length forms--dyntext))))))) (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext)))) (if (not (looking-at (regexp-quote forms--dyntext))) (error "Parse error: not looking at \"%s\"" forms--dyntext)) (forward-char (length forms--dyntext)))))) (setq forms--dyntext (1+ forms--dyntext)) (setq forms--seen-text t) (setq forms--field nil))) )) (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-s" 'forms-search) (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 "?" 'describe-mode) (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 "s" 'forms-search) (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) ;; 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) ) (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 -> forms--save-buffer (make-local-variable 'local-write-file-hooks) (add-hook 'local-write-file-hooks (function (lambda (nil) (forms--checkmod) (save-excursion (set-buffer forms--file-buffer) (save-buffer)) t))) ;; 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." ;; We should use (message (substitute-command-keys (concat "\\[forms-next-record]:next" " \\[forms-prev-record]:prev" " \\[forms-first-record]:first" " \\[forms-last-record]:last" " \\[describe-mode]:help")))) ; but it's too slow .... ; (if forms-read-only ; (message "SPC:next DEL:prev <:first >:last ?:help q:exit") ; (message "C-c n:next C-c p:prev C-c <:first C-c >:last C-c ?:help C-c q:exit")) ; ) (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)) (save-excursion (set-buffer forms--file-buffer) (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 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 (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)) ;; 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: ") (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: ") (find-file-other-window fn) (eval-current-buffer) (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 (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (1+ (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 (regexp) "Search REGEXP in file buffer." (interactive (list (read-string (concat "Search 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-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)) (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)) (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))))))) ;;; ;;; 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.22/lisp/fortran.el100444 12120 1 136363 5472642462 14134 0ustar rmsdaemon;;; fortran.el --- Fortran mode for GNU Emacs ;;; Copyright (c) 1986, 1993 Free Software Foundation, Inc. ;; Author: Michael D. Prange ;; Maintainer: bug-fortran-mode@erl.mit.edu ;; Version 1.30.3 (November 16, 1993) ;; 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.3") ;;; 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 and MAP 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 "*From a Fortran ENDIF statement, blink the matching IF 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-do-auto-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 ?\n ">" fortran-mode-syntax-table)) (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 and map 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 From a Fortran ENDIF statement, blink the matching IF 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-do-auto-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) (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'. 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 ((count 1) (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 (save-excursion (while (and (not (= count 0)) (not (eq (fortran-previous-statement) 'first-statement)) (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]"))) ; Keep local to subprogram (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))))) (if (not (= count 0)) (setq message "No matching if.") (if (< (point) top-of-window) (setq message (concat "Matches " (buffer-substring (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))) (setq matching-if (point))))) (if message (message "%s" message) (goto-char matching-if) (sit-for 1) (goto-char endif-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-do-auto-fill))) (if fortran-blink-matching-if (fortran-blink-matching-if)))) (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 "\\(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\\)\\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 "\\(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\\)\\b[ \t]*[^ \t=(a-z]") (setq icol (- icol fortran-structure-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) (let ((save-match-beginning) (save-match-end)) (if (save-excursion (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)) (progn (setq save-match-beginning (match-beginning 0)) (setq save-match-end (match-end 0)) (if (fortran-is-in-string-p (match-beginning 0)) (progn (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: 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-indent-line nil)) ;; update mode-line (set-buffer-modified-p (buffer-modified-p)))) (defun fortran-do-auto-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 (forward-line 1) (delete-indentation) (delete-char 2) (delete-horizontal-space) (fortran-do-auto-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.22/lisp/frame.el100444 12120 1 53364 5472070226 13523 0ustar rmsdaemon;;; frame.el --- multi-frame management independent of window systems. ;;;; Copyright (C) 1993 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))) If the value calls for a frame without a minibuffer, and you do not create a minibuffer frame on your own, one is created according to `minibuffer-frame-alist'. Parameters specified here supersede the values given 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 () (new-frame pop-up-frame-alist)))) ;;;; 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) ;;; 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 ;; 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)) (setq default-minibuffer-frame (setq frame-initial-frame (new-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)) ;; Handle `reverse' as a parameter. (if (cdr (or (assq 'reverse initial-frame-alist) (assq 'reverse default-frame-alist) (cons nil (member (x-get-resource "reverseVideo" "ReverseVideo") '("on" "true"))))) (let ((params (frame-parameters frame-initial-frame))) (modify-frame-parameters frame-initial-frame ;; Must set cursor-color after background color. ;; So put it first. (list (cons 'cursor-color (cdr (assq 'background-color params))) (cons 'foreground-color (cdr (assq 'background-color params))) (cons 'background-color (cdr (assq 'foreground-color params))) (cons 'mouse-color (cdr (assq 'background-color params))) (cons 'border-color (cdr (assq 'background-color params))))))))) ;; 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. Arrange to cause errors. (setq frame-creation-function (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 () ;; 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 ((new (new-frame (append initial-frame-alist default-frame-alist (frame-parameters frame-initial-frame))))) ;; 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)) (new-frame (append minibuffer-frame-alist '((minibuffer . only))))) ;; 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)) (setq tail allparms) ;; Find just the parms that have changed since we first ;; made this frame. Those are the ones actually set by ;; the init file. For those parms whose values we already knew ;; (such as those spec'd by command line options) ;; it is undesirable to specify the parm again ;; once the user has seen the frame and been able to alter it ;; manually. (while tail (let (newval oldval) (setq oldval (cdr (assq (car (car tail)) frame-initial-frame-alist))) (setq newval (cdr (assq (car (car tail)) allparms))) (or (eq oldval newval) (setq newparms (cons (cons (car (car tail)) newval) newparms)))) (setq tail (cdr tail))) (modify-frame-parameters frame-initial-frame (nreverse newparms))))) ;; Restore the original buffer. (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))) ;;;; 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)) (new-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))) ;; 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 one of the following forms: \(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. The documentation for the function `x-create-frame' describes additional frame parameters that Emacs recognizes for X window frames." (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', and `height' 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))) (setcdr tail (cdr (cdr tail))) (setq tail (cdr tail))))) (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) (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)))) (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))) ;;;; 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)))) (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)))) (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." (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." (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" 'new-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.22/lisp/gnus.el100444 12120 1 753031 5472425051 13423 0ustar rmsdaemon;;; GNUS: an NNTP-based News Reader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/gnus.el,v 1.30 1993/11/17 13:41:50 rms Exp $ ;; 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: ;; How to Install GNUS: ;; (0) First of all, remove GNUS related OLD *.elc files (at least ;; nntp.elc). ;; (1) Unshar gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el, and ;; nntp.el. ;; (2) byte-compile-file nntp.el, gnus.el, gnuspost.el, gnusmail.el, ;; and gnusmisc.el. If you have a local news spool, ;; byte-compile-file nnspool.el, too. ;; (3) Define three environment variables in .login file as follows: ;; ;; setenv NNTPSERVER flab ;; setenv DOMAINNAME "stars.flab.Fujitsu.CO.JP" ;; setenv ORGANIZATION "Fujitsu Laboratories Ltd., Kawasaki, Japan." ;; ;; Or instead, define lisp variables in your .emacs, site-init.el, ;; or default.el as follows: ;; ;; (setq gnus-nntp-server "flab") ;; (setq gnus-local-domain "stars.flab.Fujitsu.CO.JP") ;; (setq gnus-local-organization "Fujitsu Laboratories Ltd., ...") ;; ;; If the function (system-name) returns the full internet name, ;; you don't have to define the domain. ;; ;; (4) You may have to define NNTP service name as number 119. ;; ;; (setq gnus-nntp-service 119) ;; ;; Or, if you'd like to use a local news spool directly in stead ;; of NNTP, install nnspool.el and set the variable to nil as ;; follows: ;; ;; (setq gnus-nntp-service nil) ;; ;; (5) If you'd like to use the GENERICFROM feature like the Bnews, ;; define the variable as follows: ;; ;; (setq gnus-use-generic-from t) ;; ;; (6) Define autoload entries in .emacs file as follows: ;; ;; (autoload 'gnus "gnus" "Read network news." t) ;; (autoload 'gnus-post-news "gnuspost" "Post a news." t) ;; ;; (7) Read nntp.el if you have problems with NNTP or kanji handling. ;; ;; (8) Install mhspool.el, tcp.el, and tcp.c if it is necessary. ;; ;; mhspool.el is a package for reading articles or mail in your ;; private directory using GNUS. ;; ;; tcp.el and tcp.c are necessary if and only if your Emacs does ;; not have the function `open-network-stream' which is used for ;; communicating with NNTP server inside Emacs. ;; ;; (9) Install an Info file generated from the texinfo manual gnus.texinfo. ;; ;; If you are not allowed to create the Info file to the standard ;; Info-directory, create it in your private directory and set the ;; variable gnus-info-directory to that directory. ;; ;; For getting more information about GNUS, consult USENET newsgorup ;; gnu.emacs.gnus. ;; TO DO: ;; (1) Incremental update of active info. ;; (2) Asynchronous transmission of large messages. ;;; Code: (provide 'gnus) (require 'nntp) (require 'mail-utils) (defvar gnus-default-nntp-server nil "*Specify default NNTP server. This variable should be defined in paths.el.") (defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server) "*The name of the host running NNTP server. If it is a string such as `:DIRECTORY', the user's private DIRECTORY is used as a news spool. Initialized from the NNTPSERVER environment variable.") (defvar gnus-nntp-service "nntp" "*NNTP service name (\"nntp\" or 119). Go to a local news spool if its value is nil.") (defvar gnus-startup-file "~/.newsrc" "*Your `.newsrc' file. Use `.newsrc-SERVER' instead if exists.") (defvar gnus-signature-file "~/.signature" "*Your `.signature' file. Use `.signature-DISTRIBUTION' instead if exists.") (defvar gnus-use-cross-reference t "*Specifies what to do with cross references (Xref: field). If nil, ignore cross references. If t, mark articles as read in subscribed newsgroups. Otherwise, if not nil nor t, mark articles as read in all newsgroups.") (defvar gnus-use-followup-to t "*Specifies what to do with Followup-To: field. If nil, ignore followup-to: field. If t, use its value except for `poster'. Otherwise, if not nil nor t, always use its value.") (defvar gnus-large-newsgroup 50 "*The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than the value, confirmation is required for selecting the newsgroup.") (defvar gnus-author-copy (getenv "AUTHORCOPY") "*File name saving a copy of an article posted using FCC: field. Initialized from the AUTHORCOPY environment variable. Articles are saved using a function specified by the the variable `gnus-author-copy-saver' (`rmail-output' is default) if a file name is given. Instead, if the first character of the name is `|', the contents of the article is piped out to the named program. It is possible to save an article in an MH folder as follows: (setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")") (defvar gnus-author-copy-saver (function rmail-output) "*A function called with a file name to save an author copy to. The default function is `rmail-output' which saves in Unix mailbox format.") (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) "*Non-nil means that a newsgroup name is used as a default file name to save articles to. If it's nil, the directory form of a newsgroup is used instead.") (defvar gnus-article-save-directory (getenv "SAVEDIR") "*A directory name to save articles to (default to ~/News). Initialized from the SAVEDIR environment variable.") (defvar gnus-default-article-saver (function 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 (in Rmail format) gnus-summary-save-in-mail (in Unix mail format) gnus-summary-save-in-folder (in an MH folder) gnus-summary-save-in-file (in article 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-kill-file-name "KILL" "*File name of a KILL file.") (defvar gnus-novice-user t "*Non-nil means that you are a novice to USENET. If non-nil, verbose messages may be displayed or your confirmations may be required.") (defvar gnus-interactive-catchup t "*Require your confirmation when catching up a newsgroup if non-nil.") (defvar gnus-interactive-post t "*Newsgroup, subject, and distribution will be asked for if non-nil.") (defvar gnus-interactive-exit t "*Require your confirmation when exiting GNUS if non-nil.") (defvar gnus-user-login-name nil "*The login name of the user. Got from the USER and LOGNAME environment variable if undefined.") (defvar gnus-user-full-name nil "*The full name of the user. Got from the NAME environment variable if undefined.") (defvar gnus-show-mime nil "*Show MIME message if non-nil.") (defvar gnus-show-threads t "*Show conversation threads in Summary Mode if non-nil.") (defvar gnus-thread-hide-subject t "*Non-nil means hide subjects for thread subtrees.") (defvar gnus-thread-hide-subtree nil "*Non-nil means hide thread subtrees initially. If non-nil, you have to run the command `gnus-summary-show-thread' by hand or by using `gnus-select-article-hook' to show hidden threads.") (defvar gnus-thread-hide-killed t "*Non-nil means hide killed thread subtrees automatically.") (defvar gnus-thread-ignore-subject nil "*Don't take care of subject differences, but only references if non-nil. If it is non-nil, some commands work with subjects do not work properly.") (defvar gnus-thread-indent-level 4 "*Indentation of thread subtrees.") (defvar gnus-ignored-newsgroups "^to\\..*$" "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, thus making them effectively invisible.") (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:" "*All random fields within the header of a message.") (defvar gnus-required-headers '(From Date Newsgroups Subject Message-ID Path Organization Distribution) "*All required fields for articles you post. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID and Path fields. Organization, Distribution and Lines are optional. If you want GNUS not to insert some field, remove it from the variable.") (defvar gnus-show-all-headers nil "*Show all headers of an article if non-nil.") (defvar gnus-save-all-headers t "*Save all headers of an article if non-nil.") (defvar gnus-optional-headers (function gnus-optional-lines-and-from) "*A function generating a optional string displayed in GNUS Summary mode buffer. The function is called with an article HEADER. The result must be a string excluding `[' and `]'.") (defvar gnus-auto-extend-newsgroup t "*Extend visible articles to forward and backward if non-nil.") (defvar gnus-auto-select-first t "*Select the first unread article automagically if non-nil. If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in `gnus-select-group-hook' or `gnus-apply-kill-hook'.") (defvar gnus-auto-select-next t "*Select the next newsgroup automagically if non-nil. If the value is t and the next newsgroup is empty, GNUS will exit Summary mode and go back to Group mode. If the value is neither nil nor t, GNUS will select the following unread newsgroup. Especially, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations.") (defvar gnus-auto-select-same nil "*Select the next article with the same subject automagically if non-nil.") (defvar gnus-auto-center-summary t "*Always center the current summary in GNUS Summary window if non-nil.") (defvar gnus-auto-mail-to-author nil "*Insert `To: author' of the article when following up if non-nil. Mail is sent using the function specified by the variable `gnus-mail-send-method'.") (defvar gnus-break-pages t "*Break an article into pages if non-nil. Page delimiter is specified by the variable `gnus-page-delimiter'.") (defvar gnus-page-delimiter "^\^L" "*Regexp describing line-beginnings that separate pages of news article.") (defvar gnus-digest-show-summary t "*Show a summary of undigestified messages if non-nil.") (defvar gnus-digest-separator "^Subject:[ \t]" "*Regexp that separates messages in a digest article.") (defvar gnus-use-full-window t "*Non-nil means to take up the entire screen of Emacs.") (defvar gnus-window-configuration '((summary (0 1 0)) (newsgroups (1 0 0)) (article (0 3 10))) "*Specify window configurations for each action. The format of the variable is a list of (ACTION (G S A)), where G, S, and A are the relative height of Group, Summary, and Article windows, respectively. ACTION is `summary', `newsgroups', or `article'.") (defvar gnus-show-mime-method (function metamail-buffer) "*Function to process a MIME message. The function is expected to process current buffer as a MIME message.") (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail) "*Function to compose reply mail. The function `gnus-mail-reply-using-mail' uses usual sendmail mail program. The function `gnus-mail-reply-using-mhe' uses the MH-E mail program. You can use yet another program by customizing this variable.") (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail) "*Function to forward current message to another user. The function `gnus-mail-reply-using-mail' uses usual sendmail mail program. You can use yet another program by customizing this variable.") (defvar gnus-mail-other-window-method (function gnus-mail-other-window-using-mail) "*Function to compose mail in other window. The function `gnus-mail-other-window-using-mail' uses the usual sendmail mail program. The function `gnus-mail-other-window-using-mhe' uses the MH-E mail program. You can use yet another program by customizing this variable.") (defvar gnus-mail-send-method send-mail-function "*Function to mail a message too which is being posted as an article. The message must have To: or Cc: field. The default is copied from the variable `send-mail-function'.") (defvar gnus-subscribe-newsgroup-method (function gnus-subscribe-alphabetically) "*Function called with a newsgroup name when new newsgroup is found. The function `gnus-subscribe-randomly' inserts a new newsgroup a the beginning of newsgroups. The function `gnus-subscribe-alphabetically' inserts it in strict alphabetic order. The function `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup order. The function `gnus-subscribe-interactively' asks for your decision.") (defvar gnus-group-mode-hook nil "*A hook for GNUS Group Mode.") (defvar gnus-summary-mode-hook nil "*A hook for GNUS Summary Mode.") (defvar gnus-article-mode-hook nil "*A hook for GNUS Article Mode.") (defvar gnus-kill-file-mode-hook nil "*A hook for GNUS KILL File Mode.") (defvar gnus-open-server-hook nil "*A hook called just before opening connection to news server.") (defvar gnus-startup-hook nil "*A hook called at start up time. This hook is called after GNUS is connected to the NNTP server. So, it is possible to change the behavior of GNUS according to the selected NNTP server.") (defvar gnus-group-prepare-hook nil "*A hook called after newsgroup list is created in the Newsgroup buffer. If you want to modify the Newsgroup buffer, you can use this hook.") (defvar gnus-summary-prepare-hook nil "*A hook called after summary list is created in the Summary buffer. 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 is prepared in the Article buffer. If you want to run a special decoding program like nkf, use this hook.") (defvar gnus-select-group-hook nil "*A hook called when a newsgroup is selected. If you want to sort Summary buffer by date and then by subject, you can use the following hook: \(setq gnus-select-group-hook (list (function (lambda () ;; First of all, sort by date. (gnus-keysort-headers (function string-lessp) (function (lambda (a) (gnus-sortable-date (gnus-header-date a))))) ;; Then sort by subject string ignoring `Re:'. ;; If case-fold-search is non-nil, case of letters is ignored. (gnus-keysort-headers (function string-lessp) (function (lambda (a) (if case-fold-search (downcase (gnus-simplify-subject (gnus-header-subject a) t)) (gnus-simplify-subject (gnus-header-subject a) t))))) )))) If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the following hook: \(setq gnus-select-group-hook (list (function (lambda () (mapcar (function (lambda (header) (nntp-set-header-subject header (gnus-simplify-subject (gnus-header-subject header) 're-only)))) gnus-newsgroup-headers))))) In some newsgroups author name is meaningless. It is possible to prevent listing author names in GNUS Summary buffer as follows: \(setq gnus-select-group-hook (list (function (lambda () (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name) (setq gnus-optional-headers (function gnus-optional-lines))) (t (setq gnus-optional-headers (function gnus-optional-lines-and-from))))))))") (defvar gnus-select-article-hook '(gnus-summary-show-thread) "*A hook called when an article is selected. The default hook shows conversation thread subtrees of the selected article automatically using `gnus-summary-show-thread'. If you'd like to run RMAIL on a digest article automagically, you can use the following hook: \(setq gnus-select-article-hook (list (function (lambda () (gnus-summary-show-thread) (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name) (gnus-summary-rmail-digest)) ((and (string-equal \"comp.text\" gnus-newsgroup-name) (string-match \"^TeXhax Digest\" (gnus-header-subject gnus-current-headers))) (gnus-summary-rmail-digest) ))))))") (defvar gnus-select-digest-hook (list (function (lambda () ;; Reply-To: is required by `undigestify-rmail-message'. (or (mail-position-on-field "Reply-to" t) (progn (mail-position-on-field "Reply-to") (insert (gnus-fetch-field "From"))))))) "*A hook called when reading digest messages using Rmail. This hook can be used to modify incomplete digest articles as follows \(this is the default): \(setq gnus-select-digest-hook (list (function (lambda () ;; Reply-To: is required by `undigestify-rmail-message'. (or (mail-position-on-field \"Reply-to\" t) (progn (mail-position-on-field \"Reply-to\") (insert (gnus-fetch-field \"From\"))))))))") (defvar gnus-rmail-digest-hook nil "*A hook called when reading digest messages using Rmail. This hook is intended to customize Rmail mode for reading digest articles.") (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) "*A hook called when a newsgroup is selected and summary list is prepared. This hook is intended to apply a KILL file to the selected newsgroup. The function `gnus-apply-kill-file' is called by default. Since a general KILL file is too heavy to use only for a few 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 (function (lambda () (cond ((string-match \"control\" gnus-newsgroup-name) (gnus-kill \"Subject\" \"rmgroup\") (gnus-expunge \"X\")))))))") (defvar gnus-mark-article-hook (list (function (lambda () (or (memq gnus-current-article gnus-newsgroup-marked) (gnus-summary-mark-as-read gnus-current-article)) (gnus-summary-set-current-mark "+")))) "*A hook called when an article is selected at the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected. If you'd like to mark as unread (-) instead, use the following hook: \(setq gnus-mark-article-hook (list (function (lambda () (gnus-summary-mark-as-unread gnus-current-article) (gnus-summary-set-current-mark \"+\")))))") (defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature)) "*A hook called after preparing body, but before preparing header fields. The default hook (`gnus-inews-insert-signature') inserts a signature file specified by the variable `gnus-signature-file'.") (defvar gnus-inews-article-hook (list (function gnus-inews-do-fcc)) "*A hook called before finally posting an article. The default hook (`gnus-inews-do-fcc') does FCC processing (save article to a file).") (defvar gnus-exit-group-hook nil "*A hook called when exiting (not quitting) Summary mode. If your machine is so slow that exiting from Summary mode takes very long time, set the variable `gnus-use-cross-reference' to nil. This inhibits marking articles as read using cross-reference information.") (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 (not suspending) GNUS.") (defvar gnus-save-newsrc-hook nil "*A hook called when saving the newsrc file. This hook is called before saving the `.newsrc' file.") ;; Site dependent variables. You have to define these variables in ;; site-init.el, default.el or your .emacs. (defvar gnus-local-timezone nil "*Local time zone. This value is used only if `current-time-zone' does not work in your Emacs. It specifies the GMT offset, i.e. a decimal integer of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT. For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT. For backwards compatibility, it may also be a string like \"JST\", but strings are obsolescent: you should use numeric offsets instead.") (defvar gnus-local-domain nil "*Local domain name without a host name like: \"stars.flab.Fujitsu.CO.JP\" The `DOMAINNAME' environment variable is used instead if defined. If the function (system-name) returns the full internet name, there is no need to define the name.") (defvar gnus-local-organization nil "*Local organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\" The `ORGANIZATION' environment variable is used instead if defined.") (defvar gnus-local-distributions '("local" "world") "*List of distributions. The first element in the list is used as default. If distributions file is available, its content is also used.") (defvar gnus-use-generic-from nil "*If nil, prepend local host name to the defined domain in the From: field; if stringp, use this; if non-nil, strip of the local host name.") (defvar gnus-use-generic-path nil "*If nil, use the NNTP server name in the Path: field; if stringp, use this; if non-nil, use no host name (user name only)") ;; Internal variables. (defconst gnus-version "GNUS 4.1" "Version numbers of this version of GNUS.") (defconst gnus-emacs-version (progn (string-match "[0-9]*" emacs-version) (string-to-int (substring emacs-version (match-beginning 0) (match-end 0)))) "Major version number of this emacs.") (defvar gnus-info-nodes '((gnus-group-mode "(gnus)Newsgroup Commands") (gnus-summary-mode "(gnus)Summary Commands") (gnus-article-mode "(gnus)Article Commands") (gnus-kill-file-mode "(gnus)Kill File") (gnus-browse-killed-mode "(gnus)Maintaining Subscriptions")) "Assoc list of major modes and related Info nodes.") ;; Alist syntax is different from that of 3.14.3. (defvar gnus-access-methods '((nntp (gnus-retrieve-headers nntp-retrieve-headers) (gnus-open-server nntp-open-server) (gnus-close-server nntp-close-server) (gnus-server-opened nntp-server-opened) (gnus-status-message nntp-status-message) (gnus-request-article nntp-request-article) (gnus-request-group nntp-request-group) (gnus-request-list nntp-request-list) (gnus-request-list-newsgroups nntp-request-list-newsgroups) (gnus-request-list-distributions nntp-request-list-distributions) (gnus-request-post nntp-request-post)) (nnspool (gnus-retrieve-headers nnspool-retrieve-headers) (gnus-open-server nnspool-open-server) (gnus-close-server nnspool-close-server) (gnus-server-opened nnspool-server-opened) (gnus-status-message nnspool-status-message) (gnus-request-article nnspool-request-article) (gnus-request-group nnspool-request-group) (gnus-request-list nnspool-request-list) (gnus-request-list-newsgroups nnspool-request-list-newsgroups) (gnus-request-list-distributions nnspool-request-list-distributions) (gnus-request-post nnspool-request-post)) (mhspool (gnus-retrieve-headers mhspool-retrieve-headers) (gnus-open-server mhspool-open-server) (gnus-close-server mhspool-close-server) (gnus-server-opened mhspool-server-opened) (gnus-status-message mhspool-status-message) (gnus-request-article mhspool-request-article) (gnus-request-group mhspool-request-group) (gnus-request-list mhspool-request-list) (gnus-request-list-newsgroups mhspool-request-list-newsgroups) (gnus-request-list-distributions mhspool-request-list-distributions) (gnus-request-post mhspool-request-post))) "Access method for NNTP, nnspool, and mhspool.") (defvar gnus-group-buffer "*Newsgroup*") (defvar gnus-summary-buffer "*Summary*") (defvar gnus-article-buffer "*Article*") (defvar gnus-digest-buffer "GNUS Digest") (defvar gnus-digest-summary-buffer "GNUS Digest-summary") (defvar gnus-buffer-list (list gnus-group-buffer gnus-summary-buffer gnus-article-buffer gnus-digest-buffer gnus-digest-summary-buffer) "GNUS buffer names which should be killed when exiting.") (defvar gnus-variable-list '(gnus-newsrc-options gnus-newsrc-options-n-yes gnus-newsrc-options-n-no gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc) "GNUS variables saved in the quick startup file.") (defvar gnus-overload-functions '((news-inews gnus-inews-news "rnewspost") (caesar-region gnus-caesar-region "rnews")) "Functions overloaded by gnus. It is a list of `(original overload &optional file)'.") (defvar gnus-distribution-list nil) (defvar gnus-newsrc-options nil "Options line in the .newsrc file.") (defvar gnus-newsrc-options-n-yes nil "Regexp representing subscribed newsgroups.") (defvar gnus-newsrc-options-n-no nil "Regexp representing unsubscribed newsgroups.") (defvar gnus-newsrc-assoc 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-assoc.") (defvar gnus-killed-assoc nil "Assoc list of newsgroups removed from gnus-newsrc-assoc. gnus-killed-hashtb should be kept so that both hold the same information.") (defvar gnus-killed-hashtb nil "Hashtable of gnus-killed-assoc.") (defvar gnus-marked-assoc nil "Assoc list of articles marked as unread. gnus-marked-hashtb should be kept so that both hold the same information.") (defvar gnus-marked-hashtb nil "Hashtable of gnus-marked-assoc.") (defvar gnus-unread-hashtb nil "Hashtable of unread articles.") (defvar gnus-active-hashtb nil "Hashtable of active articles.") (defvar gnus-octive-hashtb nil "Hashtable of OLD active articles.") (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-have-all-newsgroups 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-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-marked nil "List of marked articles in the current newsgroup (a subset of unread art).") (defvar gnus-newsgroup-headers nil "List of article headers in the current newsgroup. If the variable is modified (added or deleted), the function gnus-clear-hashtables-for-newsgroup-headers must be called to clear the hash tables.") (defvar gnus-newsgroup-headers-hashtb-by-id nil) (defvar gnus-newsgroup-headers-hashtb-by-number nil) (defvar gnus-current-article nil) (defvar gnus-current-headers nil) (defvar gnus-current-history nil) (defvar gnus-have-all-headers nil "Must be either T or NIL.") (defvar gnus-last-article nil) (defvar gnus-current-kill-article nil) ;; Save window configuration. (defvar gnus-winconf-kill-file nil) (defvar gnus-group-mode-map nil) (defvar gnus-summary-mode-map nil) (defvar gnus-article-mode-map nil) (defvar gnus-kill-file-mode-map nil) (defvar rmail-last-file (expand-file-name "~/XMBOX")) (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS")) ;; Define GNUS Subsystems. (autoload 'gnus-group-post-news "gnuspost" "Post an article." t) (autoload 'gnus-summary-post-news "gnuspost" "Post an article." t) (autoload 'gnus-summary-followup "gnuspost" "Post a reply article." t) (autoload 'gnus-summary-followup-with-original "gnuspost" "Post a reply article with original article." t) (autoload 'gnus-summary-cancel-article "gnuspost" "Cancel an article you posted." t) (autoload 'gnus-summary-reply "gnusmail" "Reply mail to news author." t) (autoload 'gnus-summary-reply-with-original "gnusmail" "Reply mail to news author with original article." t) (autoload 'gnus-summary-mail-forward "gnusmail" "Forward the current message to another user." t) (autoload 'gnus-summary-mail-other-window "gnusmail" "Compose mail in other window." t) (autoload 'gnus-group-kill-group "gnusmisc" "Kill newsgroup on current line." t) (autoload 'gnus-group-yank-group "gnusmisc" "Yank the last killed newsgroup on current line." t) (autoload 'gnus-group-kill-region "gnusmisc" "Kill newsgroups in current region." t) (autoload 'gnus-group-transpose-groups "gnusmisc" "Exchange current newsgroup and previous newsgroup." t) (autoload 'gnus-list-killed-groups "gnusmisc" "List the killed newsgroups." t) (autoload 'gnus-gmt-to-local "gnusmisc" "Rewrite Date field in GMT to local in current buffer.") (autoload 'metamail-buffer "metamail" "Process current buffer through 'metamail'." t) (autoload 'timezone-make-sortable-date "timezone") (autoload 'timezone-parse-date "timezone") (autoload 'rmail-output "rmailout" "Append this message to Unix mail file named FILE-NAME." t) (autoload 'mail-position-on-field "sendmail") (autoload 'mh-find-path "mh-e") (autoload 'mh-prompt-for-folder "mh-e") (put 'gnus-group-mode 'mode-class 'special) (put 'gnus-summary-mode 'mode-class 'special) (put 'gnus-article-mode 'mode-class 'special) ;;(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) (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-make-hashtable (&optional hashsize) "Make a hash table (default and minimum size is 200). Optional argument HASHSIZE specifies the table size." (` (make-vector (, (if hashsize (` (max (, hashsize) 200)) 200)) 0))) (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)))) ;; Note: Macros defined here are also defined in nntp.el. I don't like ;; to put them here, but many users got troubled with the old ;; definitions in nntp.elc. These codes are NNTP 3.10 version. (defmacro nntp-header-number (header) "Return article number in HEADER." (` (aref (, header) 0))) (defmacro nntp-set-header-number (header number) "Set article number of HEADER to NUMBER." (` (aset (, header) 0 (, number)))) (defmacro nntp-header-subject (header) "Return subject string in HEADER." (` (aref (, header) 1))) (defmacro nntp-set-header-subject (header subject) "Set article subject of HEADER to SUBJECT." (` (aset (, header) 1 (, subject)))) (defmacro nntp-header-from (header) "Return author string in HEADER." (` (aref (, header) 2))) (defmacro nntp-set-header-from (header from) "Set article author of HEADER to FROM." (` (aset (, header) 2 (, from)))) (defmacro nntp-header-xref (header) "Return xref string in HEADER." (` (aref (, header) 3))) (defmacro nntp-set-header-xref (header xref) "Set article xref of HEADER to xref." (` (aset (, header) 3 (, xref)))) (defmacro nntp-header-lines (header) "Return lines in HEADER." (` (aref (, header) 4))) (defmacro nntp-set-header-lines (header lines) "Set article lines of HEADER to LINES." (` (aset (, header) 4 (, lines)))) (defmacro nntp-header-date (header) "Return date in HEADER." (` (aref (, header) 5))) (defmacro nntp-set-header-date (header date) "Set article date of HEADER to DATE." (` (aset (, header) 5 (, date)))) (defmacro nntp-header-id (header) "Return Id in HEADER." (` (aref (, header) 6))) (defmacro nntp-set-header-id (header id) "Set article Id of HEADER to ID." (` (aset (, header) 6 (, id)))) (defmacro nntp-header-references (header) "Return references in HEADER." (` (aref (, header) 7))) (defmacro nntp-set-header-references (header ref) "Set article references of HEADER to REF." (` (aset (, header) 7 (, ref)))) ;;; ;;; GNUS Group Mode ;;; (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 "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 "\C-n" 'gnus-group-next-group) (define-key gnus-group-mode-map "\C-p" 'gnus-group-prev-group) (define-key gnus-group-mode-map "\r" 'next-line) ;;(define-key gnus-group-mode-map "/" 'isearch-forward) (define-key gnus-group-mode-map "<" 'beginning-of-buffer) (define-key gnus-group-mode-map ">" 'end-of-buffer) (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) (define-key gnus-group-mode-map "C" 'gnus-group-catchup-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 "g" 'gnus-group-get-new-news) (define-key gnus-group-mode-map "R" 'gnus-group-restart) (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups) (define-key gnus-group-mode-map "r" 'gnus-group-restrict-groups) (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-list-killed-groups) (define-key gnus-group-mode-map "V" 'gnus-version) ;;(define-key gnus-group-mode-map "x" 'gnus-group-force-update) (define-key gnus-group-mode-map "s" 'gnus-group-force-update) (define-key gnus-group-mode-map "z" 'gnus-group-suspend) (define-key gnus-group-mode-map "q" 'gnus-group-exit) (define-key gnus-group-mode-map "Q" 'gnus-group-quit) (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly) (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)) (defun gnus-group-mode () "Major mode for reading network news. All normal editing commands are turned off. Instead, these commands are available: SPC Read articles in this newsgroup. = Select this newsgroup. j Move to the specified newsgroup. n Move to the next unread newsgroup. p Move to the previous unread newsgroup. C-n Move to the next newsgroup. C-p Move to the previous newsgroup. < Move point to the beginning of this buffer. > Move point to the end of this buffer. u Unsubscribe from (subscribe to) this newsgroup. U Unsubscribe from (subscribe to) the specified newsgroup. c Mark all articles as read, preserving marked articles. C Mark all articles in this newsgroup as read. l Revert this buffer. L List all newsgroups. g Get new news. R Force to read the raw .newsrc file and get new news. b Check bogus newsgroups. r Restrict visible newsgroups to the current region. a Post a new article. ESC k Edit a local KILL file applied to this newsgroup. ESC K Edit a global KILL file applied to all newsgroups. C-k Kill this newsgroup. C-y Yank killed newsgroup here. C-w Kill newsgroups in current region (excluding current point). C-x C-t Exchange this newsgroup and previous newsgroup. C-c C-l list killed newsgroups. s Save .newsrc file. z Suspend reading news. q Quit reading news. Q Quit reading news without saving .newsrc file. V Show the version number of this GNUS. ? Describe Group Mode commands briefly. C-h m Describe Group Mode. C-c C-i Read Info about Group Mode. The name of the host running NNTP server is asked for if no default host is specified. It is also possible to choose another NNTP server even when the default server is defined by giving a prefix argument to the command `\\[gnus]'. If an NNTP server is preceded by a colon such as `:Mail', the user's private directory `~/Mail' is used as a news spool. This makes it possible to read mail stored in MH folders or articles saved by GNUS. File names of mail or articles must consist of only numeric characters. Otherwise, they are ignored. If there is a file named `~/.newsrc-SERVER', it is used as the startup file instead of standard one when talking to SERVER. It is possible to talk to many hosts by using different startup files for each. Option `-n' of the options line in the startup file is recognized properly the same as the Bnews system. For example, if the options line is `options -n !talk talk.rumors', newsgroups under the `talk' hierarchy except for `talk.rumors' are ignored while checking new newsgroups. If there is a file named `~/.signature-DISTRIBUTION', it is used as signature file instead of standard one when posting a news in DISTRIBUTION. If an Info file generated from `gnus.texinfo' is installed, you can read an appropriate Info node of the Info file according to the current major mode of GNUS by \\[gnus-info-find-node]. The variable `gnus-version', `nntp-version', `nnspool-version', and `mhspool-version' have the version numbers of this version of gnus.el, nntp.el, nnspool.el, and mhspoo.el, respectively. User customizable variables: gnus-nntp-server Specifies the name of the host running the NNTP server. If its value is a string such as `:DIRECTORY', the user's private DIRECTORY is used as a news spool. The variable is initialized from the NNTPSERVER environment variable. gnus-nntp-service Specifies a NNTP service name. It is usually \"nntp\" or 119. Nil forces GNUS to use a local news spool if the variable `gnus-nntp-server' is set to the local host name. gnus-startup-file Specifies a startup file (.newsrc). If there is a file named `.newsrc-SERVER', it's used instead when talking to SERVER. I recommend you to use the server specific file, if you'd like to talk to many servers. Especially if you'd like to read your private directory, the name of the file must be `.newsrc-:DIRECTORY'. gnus-signature-file Specifies a signature file (.signature). If there is a file named `.signature-DISTRIBUTION', it's used instead when posting an article in DISTRIBUTION. Set the variable to nil to prevent appending the file automatically. If you use an NNTP inews which comes with the NNTP package, you may have to set the variable to nil. gnus-use-cross-reference Specifies what to do with cross references (Xref: field). If it is nil, cross references are ignored. If it is t, articles in subscribed newsgroups are only marked as read. Otherwise, if it is not nil nor t, articles in all newsgroups are marked as read. gnus-use-followup-to Specifies what to do with followup-to: field. If it is nil, its value is ignored. If it is non-nil, its value is used as followup newsgroups. Especially, if it is t and field value is `poster', your confirmation is required. gnus-author-copy Specifies a file name to save a copy of article you posted using FCC: field. If the first character of the value is `|', the contents of the article is piped out to a program specified by the rest of the value. The variable is initialized from the AUTHORCOPY environment variable. gnus-author-copy-saver Specifies a function to save an author copy. The function is called with a file name. The default function `rmail-output' saves in Unix mail format. gnus-kill-file-name Use specified file name as a KILL file (default to `KILL'). gnus-novice-user Non-nil means that you are a novice to USENET. If non-nil, verbose messages may be displayed or your confirmations may be required. gnus-interactive-post Non-nil means that newsgroup, subject and distribution are asked for interactively when posting a new article. gnus-use-full-window Non-nil means to take up the entire screen of Emacs. gnus-window-configuration Specifies the configuration of Group, Summary, and Article windows. It is a list of (ACTION (G S A)), where G, S, and A are the relative height of Group, Summary, and Article windows, respectively. ACTION is `summary', `newsgroups', or `article'. gnus-subscribe-newsgroup-method Specifies a function called with a newsgroup name when new newsgroup is found. The default definition adds new newsgroup at the beginning of other newsgroups. And more and more. Please refer to texinfo documentation. Various hooks for customization: gnus-group-mode-hook Entry to this mode calls the value with no arguments, if that value is non-nil. This hook is called before GNUS is connected to the NNTP server. So, you can change or define the NNTP server in this hook. gnus-startup-hook Called with no arguments after the NNTP server is selected. It is possible to change the behavior of GNUS or initialize the variables according to the selected NNTP server. gnus-group-prepare-hook Called with no arguments after a newsgroup list is created in the Newsgroup buffer, if that value is non-nil. gnus-save-newsrc-hook Called with no arguments when saving newsrc file if that value is non-nil. gnus-prepare-article-hook Called with no arguments after preparing message body, but before preparing header fields which is automatically generated if that value is non-nil. The default hook (gnus-inews-insert-signature) inserts a signature file. gnus-inews-article-hook Called with no arguments when posting an article if that value is non-nil. This hook is called just before posting an article. The default hook does FCC (save an article to the specified file). gnus-suspend-gnus-hook Called with no arguments when suspending (not exiting) GNUS, if that value is non-nil. gnus-exit-gnus-hook Called with no arguments when exiting (not suspending) GNUS, if that value is non-nil." (interactive) (kill-all-local-variables) ;; Gee. Why don't you upgrade? (cond ((boundp 'mode-line-modified) (setq mode-line-modified "--- ")) ((listp (default-value 'mode-line-format)) (setq mode-line-format (cons "--- " (cdr (default-value 'mode-line-format))))) (t (setq mode-line-format "--- GNUS: List of Newsgroups %[(%m)%]----%3p-%-"))) (setq major-mode 'gnus-group-mode) (setq mode-name "Newsgroup") (setq mode-line-buffer-identification "GNUS: List of Newsgroups") (setq mode-line-process nil) (use-local-map gnus-group-mode-map) (buffer-flush-undo (current-buffer)) (setq buffer-read-only t) ;Disable modification (run-hooks 'gnus-group-mode-hook)) ;;;###autoload (defun gnus (&optional confirm) "Read network news. If optional argument CONFIRM is non-nil, ask NNTP server." (interactive "P") (unwind-protect (progn (switch-to-buffer (get-buffer-create gnus-group-buffer)) (gnus-group-mode) (gnus-start-news-server confirm)) (if (not (gnus-server-opened)) (gnus-group-quit) ;; NNTP server is successfully open. (setq mode-line-process (format " {%s}" gnus-nntp-server)) (let ((buffer-read-only nil)) (erase-buffer) (gnus-group-startup-message) (sit-for 0)) (run-hooks 'gnus-startup-hook) (gnus-setup-news) (if gnus-novice-user (gnus-group-describe-briefly)) ;Show brief help message. (gnus-group-list-groups nil) ))) (defun gnus-group-startup-message () "Insert startup message in current buffer." ;; Insert the message. (insert (format " %s NNTP-based News Reader for GNU Emacs If you have any trouble with this software, please let me know. I will fix your problems in the next release. Comments, suggestions, and bug fixes are welcome. Masanobu UMEDA umerin@mse.kyutech.ac.jp" gnus-version)) ;; And then hack it. ;; 57 is the longest line. (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2)) (goto-char (point-min)) ;; +4 is fuzzy factor. (insert-char ?\n (/ (max (- (window-height) 18) 0) 2))) (defun gnus-group-list-groups (show-all) "List newsgroups in the Newsgroup buffer. If argument SHOW-ALL is non-nil, unsubscribed groups are also listed." (interactive "P") (let ((case-fold-search nil) (last-group ;Current newsgroup. (gnus-group-group-name)) (next-group ;Next possible newsgroup. (progn (gnus-group-search-forward nil nil) (gnus-group-group-name))) (prev-group ;Previous possible newsgroup. (progn (gnus-group-search-forward t nil) (gnus-group-group-name)))) (set-buffer gnus-group-buffer) ;May call from out of Group buffer (gnus-group-prepare show-all) (if (zerop (buffer-size)) (message "No news is good news") ;; Go to last newsgroup if possible. If cannot, try next and ;; previous. If all fail, go to first unread newsgroup. (goto-char (point-min)) (or (and last-group (re-search-forward (gnus-group-make-regexp last-group) nil t)) (and next-group (re-search-forward (gnus-group-make-regexp next-group) nil t)) (and prev-group (re-search-forward (gnus-group-make-regexp prev-group) nil t)) (gnus-group-search-forward nil nil t)) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) ))) (defun gnus-group-prepare (&optional all) "Prepare list of newsgroups in current buffer. If optional argument ALL is non-nil, unsubscribed groups are also listed." (let ((buffer-read-only nil) (newsrc gnus-newsrc-assoc) (group-info nil) (group-name nil) (unread-count 0) ;; This specifies the format of Group buffer. (cntl "%s%s%5d: %s\n")) (erase-buffer) ;; List newsgroups. (while newsrc (setq group-info (car newsrc)) (setq group-name (car group-info)) (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb))) (if (or all (and (nth 1 group-info) ;Subscribed. (> unread-count 0))) ;There are unread articles. ;; Yes, I can use gnus-group-prepare-line, but this is faster. (insert (format cntl ;; Subscribed or not. (if (nth 1 group-info) " " "U") ;; Has new news? (if (and (> unread-count 0) (>= 0 (- unread-count (length (cdr (gnus-gethash group-name gnus-marked-hashtb)))))) "*" " ") ;; Number of unread articles. unread-count ;; Newsgroup name. group-name)) ) (setq newsrc (cdr newsrc)) ) (setq gnus-have-all-newsgroups all) (goto-char (point-min)) (run-hooks 'gnus-group-prepare-hook) )) (defun gnus-group-prepare-line (info) "Return a string for the Newsgroup buffer from INFO. INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc." (let* ((group-name (car info)) (unread-count (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb)) ;; Not in hash table, so compute it now. (gnus-number-of-articles (gnus-difference-of-range (nth 2 (gnus-gethash group-name gnus-active-hashtb)) (nthcdr 2 info))))) ;; This specifies the format of Group buffer. (cntl "%s%s%5d: %s\n")) (format cntl ;; Subscribed or not. (if (nth 1 info) " " "U") ;; Has new news? (if (and (> unread-count 0) (>= 0 (- unread-count (length (cdr (gnus-gethash group-name gnus-marked-hashtb)))))) "*" " ") ;; Number of unread articles. unread-count ;; Newsgroup name. group-name ))) (defun gnus-group-update-group (group &optional visible-only) "Update newsgroup info of GROUP. If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored." (let ((buffer-read-only nil) (case-fold-search nil) ;appleIIgs vs. appleiigs (regexp (gnus-group-make-regexp group)) (visible nil)) ;; 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. ;; And then if current point is in the first half, search from ;; the beginning. Otherwise, search from the end. (if (cond ((progn (beginning-of-line) (looking-at regexp))) ((and (> (/ (buffer-size) 2) (point)) ;In the first half. (progn (goto-char (point-min)) (re-search-forward regexp nil t)))) ((progn (goto-char (point-max)) (re-search-backward regexp nil t)))) ;; 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, so insert it at the top. (goto-char (point-min))) (if (or visible (not visible-only)) (progn (insert (gnus-group-prepare-line (gnus-gethash group gnus-newsrc-hashtb))) (forward-line -1) ;Move point on that line. )) ))) (defun gnus-group-group-name () "Get newsgroup name around point." (save-excursion (beginning-of-line) (if (looking-at "^.+:[ \t]+\\([^ \t\n]+\\)\\([ \t].*\\|$\\)") (buffer-substring (match-beginning 1) (match-end 1)) ))) (defun gnus-group-make-regexp (newsgroup) "Return regexp that matches for a line of NEWSGROUP." (concat "^.+: " (regexp-quote newsgroup) "\\([ \t].*\\|$\\)")) (defun gnus-group-search-forward (backward norest &optional heretoo) "Search for the next (or previous) newsgroup. If 1st argument BACKWARD is non-nil, search backward instead. If 2nd argument NOREST is non-nil, don't care about newsgroup property. If optional argument HERETOO is non-nil, current line is searched for, too." (let ((case-fold-search nil) (func (if backward (function re-search-backward) (function re-search-forward))) (regexp (format "^%s[ \t]*\\(%s\\):" (if norest ".." " [ \t]") (if norest "[0-9]+" "[1-9][0-9]*"))) (found nil)) (if backward (if heretoo (end-of-line) (beginning-of-line)) (if heretoo (beginning-of-line) (end-of-line))) (setq found (funcall func regexp nil t)) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) ;; Return T if found. found )) ;; GNUS Group mode command (defun gnus-group-read-group (all &optional no-article) "Read news in this newsgroup. If argument ALL is non-nil, already read articles become readable. If optional argument NO-ARTICLE is non-nil, no article body is displayed." (interactive "P") (let ((group (gnus-group-group-name))) ;Newsgroup name to read. (if group (gnus-summary-read-group group (or all ;;(not (nth 1 (gnus-gethash group gnus-newsrc-hashtb))) ;Unsubscribed (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb)))) ;No unread no-article )) )) (defun gnus-group-select-group (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-jump-to-group (group) "Jump to newsgroup GROUP." (interactive (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match))) (let ((case-fold-search nil)) (goto-char (point-min)) (or (re-search-forward (gnus-group-make-regexp group) nil t) (if (gnus-gethash group gnus-newsrc-hashtb) ;; Add GROUP entry, then seach again. (gnus-group-update-group group))) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) )) (defun gnus-group-next-group (n) "Go to next N'th newsgroup." (interactive "p") (while (and (> n 1) (gnus-group-search-forward nil t)) (setq n (1- n))) (or (gnus-group-search-forward nil t) (message "No more newsgroups"))) (defun gnus-group-next-unread-group (n) "Go to next N'th unread newsgroup." (interactive "p") (while (and (> n 1) (gnus-group-search-forward nil nil)) (setq n (1- n))) (or (gnus-group-search-forward nil nil) (message "No more unread newsgroups"))) (defun gnus-group-prev-group (n) "Go to previous N'th newsgroup." (interactive "p") (while (and (> n 1) (gnus-group-search-forward t t)) (setq n (1- n))) (or (gnus-group-search-forward t t) (message "No more newsgroups"))) (defun gnus-group-prev-unread-group (n) "Go to previous N'th unread newsgroup." (interactive "p") (while (and (> n 1) (gnus-group-search-forward t nil)) (setq n (1- n))) (or (gnus-group-search-forward t nil) (message "No more unread newsgroups"))) (defun gnus-group-catchup (all) "Mark all articles not marked as unread in current newsgroup as read. If prefix argument ALL is non-nil, all articles are marked as read. Cross references (Xref: field) of articles are ignored." (interactive "P") (let* ((group (gnus-group-group-name)) (marked (if (not all) (cdr (gnus-gethash group gnus-marked-hashtb))))) (and group (or (not gnus-interactive-catchup) ;Without confirmation? (y-or-n-p (if all "Do you really want to mark everything as read? " "Delete all articles not marked as read? "))) (progn (message "") ;Clear "Yes or No" question. ;; Any marked articles will be preserved. (gnus-update-unread-articles group marked marked) (gnus-group-update-group group) (gnus-group-next-group 1))) )) (defun gnus-group-catchup-all () "Mark all articles in current newsgroup as read. Cross references (Xref: field) of articles are ignored." (interactive) (gnus-group-catchup t)) (defun gnus-group-unsubscribe-current-group () "Toggle subscribe from/to unsubscribe current group." (interactive) (gnus-group-unsubscribe-group (gnus-group-group-name)) (gnus-group-next-group 1)) (defun gnus-group-unsubscribe-group (group) "Toggle subscribe from/to unsubscribe GROUP. New newsgroup is added to .newsrc automatically." (interactive (list (completing-read "Newsgroup: " gnus-active-hashtb nil 'require-match))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond ((not (null newsrc)) ;; Toggle subscription flag. (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc))) (gnus-update-newsrc-buffer group) (gnus-group-update-group group) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t)) ((and (stringp group) (gnus-gethash group gnus-active-hashtb)) ;; Add new newsgroup. (gnus-add-newsgroup group) (gnus-group-update-group group) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t)) (t (error "No such newsgroup: %s" group))) )) (defun gnus-group-list-all-groups () "List all of newsgroups in the Newsgroup buffer." (interactive) (gnus-group-list-groups t)) (defun gnus-group-get-new-news () "Get newly arrived articles. In fact, read the active file again." (interactive) (gnus-setup-news) (gnus-group-list-groups gnus-have-all-newsgroups)) (defun gnus-group-restart () "Force GNUS to read the raw startup file." (interactive) (gnus-save-newsrc-file) (gnus-setup-news t) ;Force to read the raw startup file. (gnus-group-list-groups gnus-have-all-newsgroups)) (defun gnus-group-check-bogus-groups () "Check bogus newsgroups." (interactive) (gnus-check-bogus-newsgroups t) ;Require confirmation. (gnus-group-list-groups gnus-have-all-newsgroups)) (defun gnus-group-restrict-groups (start end) "Restrict visible newsgroups to the current region (START and END). Type \\[widen] to remove restriction." (interactive "r") (save-excursion (narrow-to-region (progn (goto-char start) (beginning-of-line) (point)) (progn (goto-char end) (forward-line 1) (point)))) (message (substitute-command-keys "Type \\[widen] to remove restriction"))) (defun gnus-group-edit-global-kill () "Edit a global KILL file." (interactive) (setq gnus-current-kill-article nil) ;No articles selected. (gnus-kill-file-edit-file nil) ;Nil stands for global KILL file. (message (substitute-command-keys "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)"))) (defun gnus-group-edit-local-kill () "Edit a local KILL file." (interactive) (setq gnus-current-kill-article nil) ;No articles selected. (gnus-kill-file-edit-file (gnus-group-group-name)) (message (substitute-command-keys "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)"))) (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 ((buffers gnus-buffer-list)) (while buffers (and (not (eq (car buffers) gnus-group-buffer)) (get-buffer (car buffers)) (kill-buffer (car buffers))) (setq buffers (cdr buffers)) )) (bury-buffer)) (defun gnus-group-exit () "Quit reading news after updating .newsrc. The hook gnus-exit-gnus-hook is called before actually quitting." (interactive) (if (or noninteractive ;For gnus-batch-kill (zerop (buffer-size)) ;No news is good news. (not (gnus-server-opened)) ;NNTP connection closed. (not gnus-interactive-exit) ;Without confirmation (y-or-n-p "Are you sure you want to quit reading news? ")) (progn (message "") ;Erase "Yes or No" question. (run-hooks 'gnus-exit-gnus-hook) (gnus-save-newsrc-file) (gnus-clear-system) (gnus-close-server)) )) (defun gnus-group-quit () "Quit reading news without updating .newsrc. The hook gnus-exit-gnus-hook is called before actually quitting." (interactive) (if (or noninteractive ;For gnus-batch-kill (zerop (buffer-size)) (not (gnus-server-opened)) (yes-or-no-p (format "Quit reading news without saving %s? " (file-name-nondirectory gnus-current-startup-file)))) (progn (message "") ;Erase "Yes or No" question. (run-hooks 'gnus-exit-gnus-hook) (gnus-clear-system) (gnus-close-server)) )) (defun gnus-group-describe-briefly () "Describe Group mode commands briefly." (interactive) (message (concat (substitute-command-keys "\\[gnus-group-read-group]:Select ") (substitute-command-keys "\\[gnus-group-next-unread-group]:Forward ") (substitute-command-keys "\\[gnus-group-prev-unread-group]:Backward ") (substitute-command-keys "\\[gnus-group-exit]:Exit ") (substitute-command-keys "\\[gnus-info-find-node]:Run Info ") (substitute-command-keys "\\[gnus-group-describe-briefly]:This help") ))) ;;; ;;; GNUS Summary Mode ;;; (if gnus-summary-mode-map nil (setq gnus-summary-mode-map (make-keymap)) (suppress-keymap gnus-summary-mode-map) (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 "\e\C-n" 'gnus-summary-next-same-subject) (define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-same-subject) ;;(define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-unread-same-subject) ;;(define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-unread-same-subject) (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest) (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest) (define-key gnus-summary-mode-map "\C-n" 'gnus-summary-next-subject) (define-key gnus-summary-mode-map "\C-p" 'gnus-summary-prev-subject) (define-key gnus-summary-mode-map "\en" 'gnus-summary-next-unread-subject) (define-key gnus-summary-mode-map "\ep" 'gnus-summary-prev-unread-subject) ;;(define-key gnus-summary-mode-map "\C-cn" 'gnus-summary-next-group) ;;(define-key gnus-summary-mode-map "\C-cp" 'gnus-summary-prev-group) (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article) ;;(define-key gnus-summary-mode-map "/" 'isearch-forward) (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article) (define-key gnus-summary-mode-map "\es" 'gnus-summary-search-article-forward) ;;(define-key gnus-summary-mode-map "\eS" 'gnus-summary-search-article-backward) (define-key gnus-summary-mode-map "\er" '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 "J" 'gnus-summary-goto-article) (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article) (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article) ;;(define-key gnus-summary-mode-map "\er" 'gnus-summary-refer-article) (define-key gnus-summary-mode-map "\e^" 'gnus-summary-refer-article) (define-key gnus-summary-mode-map "u" 'gnus-summary-mark-as-unread-forward) (define-key gnus-summary-mode-map "U" 'gnus-summary-mark-as-unread-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 "\eu" 'gnus-summary-clear-mark-forward) (define-key gnus-summary-mode-map "\eU" '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 "\e\C-t" 'gnus-summary-toggle-threads) (define-key gnus-summary-mode-map "\e\C-s" 'gnus-summary-show-thread) (define-key gnus-summary-mode-map "\e\C-h" 'gnus-summary-hide-thread) (define-key gnus-summary-mode-map "\e\C-f" 'gnus-summary-next-thread) (define-key gnus-summary-mode-map "\e\C-b" 'gnus-summary-prev-thread) (define-key gnus-summary-mode-map "\e\C-u" 'gnus-summary-up-thread) (define-key gnus-summary-mode-map "\e\C-d" 'gnus-summary-down-thread) (define-key gnus-summary-mode-map "\e\C-k" 'gnus-summary-kill-thread) (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command) ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup) ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all) (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit) ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all-and-exit) (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation) (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read) (define-key gnus-summary-mode-map "X" 'gnus-summary-delete-marked-with) (define-key gnus-summary-mode-map "\C-c\C-sn" 'gnus-summary-sort-by-number) (define-key gnus-summary-mode-map "\C-c\C-sa" 'gnus-summary-sort-by-author) (define-key gnus-summary-mode-map "\C-c\C-ss" 'gnus-summary-sort-by-subject) (define-key gnus-summary-mode-map "\C-c\C-sd" 'gnus-summary-sort-by-date) (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 "=" 'gnus-summary-expand-window) ;;(define-key gnus-summary-mode-map "G" 'gnus-summary-reselect-current-group) (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-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 "g" 'gnus-summary-show-article) (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header) ;;(define-key gnus-summary-mode-map "v" 'gnus-summary-show-all-headers) (define-key gnus-summary-mode-map "\et" 'gnus-summary-toggle-mime) (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-rmail-digest) (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news) (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 "m" 'gnus-summary-mail-other-window) (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article) (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-in-mail) (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output) (define-key gnus-summary-mode-map "\ek" 'gnus-summary-edit-local-kill) (define-key gnus-summary-mode-map "\eK" 'gnus-summary-edit-global-kill) (define-key gnus-summary-mode-map "V" 'gnus-version) (define-key gnus-summary-mode-map "q" 'gnus-summary-exit) (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit) (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly) (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)) (defun gnus-summary-mode () "Major mode for reading articles in this newsgroup. All normal editing commands are turned off. Instead, these commands are available: SPC Scroll to the next page of the current article. The next unread article is selected automatically at the end of the message. DEL Scroll to the previous page of the current article. RET Scroll up (or down) one line the current article. n Move to the next unread article. p Move to the previous unread article. N Move to the next article. P Move to the previous article. ESC C-n Move to the next article which has the same subject as the current article. ESC C-p Move to the previous article which has the same subject as the current article. \\[gnus-summary-next-unread-same-subject] Move to the next unread article which has the same subject as the current article. \\[gnus-summary-prev-unread-same-subject] Move to the previous unread article which has the same subject as the current article. C-c C-n Scroll to the next digested message of the current article. C-c C-p Scroll to the previous digested message of the current article. C-n Move to the next subject. C-p Move to the previous subject. ESC n Move to the next unread subject. ESC p Move to the previous unread subject. \\[gnus-summary-next-group] Exit the current newsgroup and select the next unread newsgroup. \\[gnus-summary-prev-group] Exit the current newsgroup and select the previous unread newsgroup. . Jump to the first unread article in the current newsgroup. s Do an incremental search forward on the current article. ESC s Search for an article containing a regexp forward. ESC r Search for an article containing a regexp backward. < Move point to the beginning of the current article. > Move point to the end of the current article. j Jump to the article specified by the numeric article ID. l Jump to the article you read last. ^ Refer to parent of the current article. ESC ^ Refer to the article specified by the Message-ID. u Mark the current article as unread, and go forward. U Mark the current article as unread, and go backward. d Mark the current article as read, and go forward. D Mark the current article as read, and go backward. ESC u Clear the current article's mark, and go forward. ESC U Clear the current article's mark, and go backward. k Mark articles which has the same subject as the current article as read, and then select the next unread article. C-k Mark articles which has the same subject as the current article as read. ESC k Edit a local KILL file applied to the current newsgroup. ESC K Edit a global KILL file applied to all newsgroups. ESC C-t Toggle showing conversation threads. ESC C-s Show thread subtrees. ESC C-h Hide thread subtrees. \\[gnus-summary-show-all-threads] Show all thread subtrees. \\[gnus-summary-hide-all-threads] Hide all thread subtrees. ESC C-f Go to the same level next thread. ESC C-b Go to the same level previous thread. ESC C-d Go downward current thread. ESC C-u Go upward current thread. ESC C-k Mark articles under current thread as read. & Execute a command for each article conditionally. \\[gnus-summary-catchup] Mark all articles as read in the current newsgroup, preserving articles marked as unread. \\[gnus-summary-catchup-all] Mark all articles as read in the current newsgroup. \\[gnus-summary-catchup-and-exit] Catch up all articles not marked as unread, and then exit the current newsgroup. \\[gnus-summary-catchup-all-and-exit] Catch up all articles, and then exit the current newsgroup. C-t Toggle truncations of subject lines. x Delete subject lines marked as read. X Delete subject lines with the specific marks. C-c C-s C-n Sort subjects by article number. C-c C-s C-a Sort subjects by article author. C-c C-s C-s Sort subjects alphabetically. C-c C-s C-d Sort subjects by date. = Expand Summary window to show headers full window. C-x C-s Reselect the current newsgroup. Prefix argument means to select all. w Stop page breaking by linefeed. C-c C-r Caesar rotates letters by 13/47 places. g Force to show the current article. t Show original article header if pruned header currently shown, or vice versa. ESC-t Toggle MIME processing. C-d Run RMAIL on the current digest article. a Post a new article. f Post a reply article. F Post a reply article with original article. C Cancel the current article. r Mail a message to the author. R Mail a message to the author with original author. C-c C-f Forward the current message to another user. m Mail a message in other window. o Save the current article in your favorite format. C-o Append the current article to a file in Unix mail format. | Pipe the contents of the current article to a subprocess. q Quit reading news in the current newsgroup. Q Quit reading news without recording unread articles information. V Show the version number of this GNUS. ? Describe Summary mode commands briefly. C-h m Describe Summary mode. C-c C-i Read Info about Summary mode. User customizable variables: gnus-large-newsgroup The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than the value, the number of articles to be selected is asked for. If the given value N is positive, the last N articles is selected. If N is negative, the first N articles are selected. An empty string means to select all articles. gnus-use-long-file-name Non-nil means that a newsgroup name is used as a default file name to save articles to. If it's nil, the directory form of a newsgroup is used instead. gnus-default-article-saver Specifies your favorite article saver which is interactively funcallable. Following functions are available: gnus-summary-save-in-rmail (in Rmail format) gnus-summary-save-in-mail (in Unix mail format) gnus-summary-save-in-folder (in MH folder) gnus-summary-save-in-file (in article format). gnus-rmail-save-name gnus-mail-save-name gnus-folder-save-name gnus-file-save-name Specifies a function generating a file name to save articles in specified format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE. Access macros to the headers are defined as nntp-header-FIELD, and functions are defined as gnus-header-FIELD. gnus-article-save-directory Specifies a directory name to save articles to using the commands gnus-summary-save-in-rmail, gnus-summary-save-in-mail and gnus-summary-save-in-file. The variable is initialized from the SAVEDIR environment variable. gnus-show-all-headers Non-nil means that all headers of an article are shown. gnus-save-all-headers Non-nil means that all headers of an article are saved in a file. gnus-show-mime Non-nil means that show a MIME message. gnus-show-threads Non-nil means that conversation threads are shown in tree structure. gnus-thread-hide-subject Non-nil means that subjects for thread subtrees are hidden. gnus-thread-hide-subtree Non-nil means that thread subtrees are hidden initially. gnus-thread-hide-killed Non-nil means that killed thread subtrees are hidden automatically. gnus-thread-ignore-subject Non-nil means that subject differences are ignored in constructing thread trees. gnus-thread-indent-level Indentation of thread subtrees. gnus-optional-headers Specifies a function which generates an optional string displayed in the Summary buffer. The function is called with an article HEADERS. The result must be a string excluding `[' and `]'. The default function returns a string like NNN:AUTHOR, where NNN is the number of lines in an article and AUTHOR is the name of the author. gnus-auto-extend-newsgroup Non-nil means visible articles are extended to forward and backward automatically if possible. gnus-auto-select-first Non-nil means the first unread article is selected automagically when a newsgroup is selected normally (by gnus-group-read-group). If you'd like to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in gnus-select-group-hook or gnus-apply-kill-hook. gnus-auto-select-next Non-nil means the next newsgroup is selected automagically at the end of the newsgroup. If the value is t and the next newsgroup is empty (no unread articles), GNUS will exit Summary mode and go back to Group mode. If the value is neither nil nor t, GNUS won't exit Summary mode but select the following unread newsgroup. Especially, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations. gnus-auto-select-same Non-nil means an article with the same subject as the current article is selected automagically like `rn -S'. gnus-auto-center-summary Non-nil means the point of Summary Mode window is always kept centered. gnus-break-pages Non-nil means an article is broken into pages at page delimiters. This may not work with some versions of GNU Emacs earlier than version 18.50. gnus-page-delimiter Specifies a regexp describing line-beginnings that separate pages of news article. [gnus-more-message is obsolete. overlay-arrow-string interfares with other subsystems, such as dbx mode.] gnus-digest-show-summary Non-nil means that a summary of digest messages is shown when reading a digest article using `gnus-summary-rmail-digest' command. gnus-digest-separator Specifies a regexp separating messages in a digest article. gnus-mail-reply-method gnus-mail-other-window-method Specifies a function to begin composing mail message using commands gnus-summary-reply and gnus-summary-mail-other-window. Functions gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe are available for the value of gnus-mail-reply-method. And functions gnus-mail-other-window-using-mail and gnus-mail-other-window-using-mhe are available for the value of gnus-mail-other-window-method. gnus-mail-send-method Specifies a function to mail a message too which is being posted as an article. The message must have To: or Cc: field. The value of the variable send-mail-function is the default function which uses sendmail mail program. Various hooks for customization: gnus-summary-mode-hook Entry to this mode calls the value with no arguments, if that value is non-nil. gnus-select-group-hook Called with no arguments when newsgroup is selected, if that value is non-nil. It is possible to sort subjects in this hook. See the documentation of this variable for more information. gnus-summary-prepare-hook Called with no arguments after a summary list is created in the Summary buffer, if that value is non-nil. If you'd like to modify the buffer, you can use this hook. gnus-select-article-hook Called with no arguments when an article is selected, if that value is non-nil. See the documentation of this variable for more information. gnus-select-digest-hook Called with no arguments when reading digest messages using Rmail, if that value is non-nil. This hook can be used to modify an article so that Rmail can work with it. See the documentation of the variable for more information. gnus-rmail-digest-hook Called with no arguments when reading digest messages using Rmail, if that value is non-nil. This hook is intended to customize Rmail mode. gnus-apply-kill-hook Called with no arguments when a newsgroup is selected and the Summary buffer is prepared. This hook is intended to apply a KILL file to the selected newsgroup. The format of KILL file is completely different from that of version 3.8. You have to rewrite them in the new format. See the documentation of Kill file mode for more information. gnus-mark-article-hook Called with no arguments when an article is selected at the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected. See the documentation of the variable for more information. gnus-exit-group-hook Called with no arguments when exiting the current newsgroup, if that value is non-nil. If your machine is so slow that exiting from Summary mode takes very long time, inhibit marking articles as read using cross-references by setting the variable gnus-use-cross-reference to nil in this hook." (interactive) (kill-all-local-variables) ;; Gee. Why don't you upgrade? (cond ((boundp 'mode-line-modified) (setq mode-line-modified "--- ")) ((listp (default-value 'mode-line-format)) (setq mode-line-format (cons "--- " (cdr (default-value 'mode-line-format)))))) ;; To disable display-time facility. ;;(make-local-variable 'global-mode-string) ;;(setq global-mode-string nil) (setq major-mode 'gnus-summary-mode) (setq mode-name "Summary") ;;(setq mode-line-process '(" " gnus-newsgroup-name)) (make-local-variable 'minor-mode-alist) (or (assq 'gnus-show-threads minor-mode-alist) (setq minor-mode-alist (cons (list 'gnus-show-threads " Thread") minor-mode-alist))) (gnus-summary-set-mode-line) (use-local-map gnus-summary-mode-map) (buffer-flush-undo (current-buffer)) (setq buffer-read-only t) ;Disable modification (setq truncate-lines t) ;Stop line folding (setq selective-display t) (setq selective-display-ellipses t) ;Display `...' ;;(setq case-fold-search t) (run-hooks 'gnus-summary-mode-hook)) (defun gnus-summary-setup-buffer () "Initialize Summary buffer." (if (get-buffer gnus-summary-buffer) (set-buffer gnus-summary-buffer) (set-buffer (get-buffer-create gnus-summary-buffer)) (gnus-summary-mode) )) (defun gnus-summary-read-group (group &optional show-all no-article) "Start reading news in newsgroup GROUP. If optional 1st argument SHOW-ALL is non-nil, already read articles are also listed. If optional 2nd argument NO-ARTICLE is non-nil, no article is selected initially." (message "Retrieving newsgroup: %s..." group) (if (gnus-select-newsgroup group show-all) (progn ;; Don't switch-to-buffer to prevent displaying old contents ;; of the buffer until new subjects list is created. ;; Suggested by Juha Heinanen (gnus-summary-setup-buffer) ;; You can change the order of subjects in this hook. (run-hooks 'gnus-select-group-hook) (gnus-summary-prepare) ;; Function `gnus-apply-kill-file' must be called in this hook. (run-hooks 'gnus-apply-kill-hook) (if (zerop (buffer-size)) ;; This newsgroup is empty. (progn (gnus-summary-catchup-and-exit nil t) ;Without confirmations. (message "No unread news")) ;; 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)) ;; Window is configured automatically. ;; Current buffer may be changed as a result of hook ;; evaluation, especially by gnus-summary-rmail-digest ;; command, so we should adjust cursor point carefully. (if (eq (current-buffer) (get-buffer gnus-summary-buffer)) (progn ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t))) (gnus-configure-windows 'summary) (pop-to-buffer gnus-summary-buffer) (gnus-summary-set-mode-line) ;; I sometime get confused with the old Article buffer. (if (get-buffer gnus-article-buffer) (if (get-buffer-window gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (erase-buffer))) (kill-buffer gnus-article-buffer))) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t)) )) ;; Cannot select newsgroup GROUP. (if (gnus-gethash group gnus-active-hashtb) (progn ;; If NNTP is used, nntp_access file may not be installed ;; properly. Otherwise, may be active file problem. (ding) (message (gnus-nntp-message (format "Cannot select %s. May be security or active file problem." group))) (sit-for 0)) ;; Check bogus newsgroups. ;; We must be in Group Mode buffer. (gnus-group-check-bogus-groups)) )) (defun gnus-summary-prepare () "Prepare summary list of current newsgroup in Summary buffer." (let ((buffer-read-only nil)) ;; Note: The next codes are not actually used because the user who ;; want it can define them in gnus-select-group-hook. ;; Print verbose messages if too many articles are selected. ;; (and (numberp gnus-large-newsgroup) ;; (> (length gnus-newsgroup-headers) gnus-large-newsgroup) ;; (message "Preparing headers...")) (erase-buffer) (gnus-summary-prepare-threads (if gnus-show-threads (gnus-make-threads gnus-newsgroup-headers) gnus-newsgroup-headers) 0) ;; Erase header retrieval message. (message "") ;; Call hooks for modifying Summary buffer. ;; Suggested by sven@tde.LTH.Se (Sven Mattisson). (goto-char (point-min)) (run-hooks 'gnus-summary-prepare-hook) )) ;; Basic ideas by Paul Dworkin ;; Subject bug fix by jbw@bigbird.bu.edu (Joe Wells) (defun gnus-summary-prepare-threads (threads level &optional parent-subject) "Prepare Summary buffer from THREADS and indentation LEVEL. THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).' Optional PARENT-SUBJECT specifies the subject of the parent." (let ((thread nil) (header nil) (number nil) (subject nil) (child-subject nil) (parent-subject (or parent-subject "")) ;; `M Indent NUM: [OPT] SUBJECT' (cntl (format "%%s %%s%%%dd: [%%s] %%s\n" (length (prin1-to-string gnus-newsgroup-end))))) (while threads (setq thread (car threads)) (setq threads (cdr threads)) ;; If thread is a cons, hierarchical threads is given. ;; Otherwise, thread itself is header. (if (consp thread) (setq header (car thread)) (setq header thread)) ;; Print valid header only. (if (vectorp header) ;Depends on nntp.el. (progn (setq number (nntp-header-number header)) (setq subject (nntp-header-subject header)) (setq child-subject (gnus-simplify-subject subject 're-only)) (insert (format cntl ;; Read or not. (cond ((memq number gnus-newsgroup-marked) "-") ((memq number gnus-newsgroup-unreads) " ") (t "D")) ;; Thread level. (make-string (* level gnus-thread-indent-level) ? ) ;; Article number. number ;; Optional headers. (or (and gnus-optional-headers (funcall gnus-optional-headers header)) "") ;; Its subject string. (concat (if (or (zerop level) (not gnus-thread-hide-subject) ;; Subject is different from the parent. (not (string-equal parent-subject child-subject))) nil (make-string (window-width) ? )) subject) )) )) ;; Print subthreads. (and (consp thread) (cdr thread) (gnus-summary-prepare-threads (cdr thread) (1+ level) child-subject)) ))) ;;(defun gnus-summary-set-mode-line () ;; "Set Summary mode line string." ;; ;; The value must be a string to escape %-constructs. ;; (let ((subject ;; (if gnus-current-headers ;; (nntp-header-subject gnus-current-headers) gnus-newsgroup-name))) ;; (setq mode-line-buffer-identification ;; (concat "GNUS: " ;; subject ;; ;; Enough spaces to pad subject to 17 positions. ;; (make-string (max 0 (- 17 (length subject))) ? )))) ;; (set-buffer-modified-p t)) ;; New implementation in gnus 3.14.3 (defun gnus-summary-set-mode-line () "Set Summary mode line string. If you don't like it, define your own gnus-summary-set-mode-line." (let ((unmarked (- (length gnus-newsgroup-unreads) (length (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-marked)))) (unselected (- (length gnus-newsgroup-unselected) (length (gnus-intersection gnus-newsgroup-unselected gnus-newsgroup-marked))))) (setq mode-line-buffer-identification (list 17 (format "GNUS: %s%s %s" gnus-newsgroup-name (if gnus-current-article (format "/%d" gnus-current-article) "") ;; Basic ideas by tale@pawl.rpi.edu. (cond ((and (zerop unmarked) (zerop unselected)) "") ((zerop unselected) (format "{%d more}" unmarked)) (t (format "{%d(+%d) more}" unmarked unselected))) )))) (set-buffer-modified-p t)) ;; GNUS Summary mode command. (defun gnus-summary-search-group (&optional backward) "Search for next unread newsgroup. If optional argument BACKWARD is non-nil, search backward instead." (save-excursion (set-buffer gnus-group-buffer) (save-excursion ;; We don't want to alter current point of Group mode buffer. (if (gnus-group-search-forward backward nil) (gnus-group-group-name)) ))) (defun gnus-summary-search-subject (backward unread subject) "Search for article forward. If 1st argument BACKWARD is non-nil, search backward. If 2nd argument UNREAD is non-nil, only unread article is selected. If 3rd argument SUBJECT is non-nil, the article which has the same subject will be searched for." (let ((func (if backward (function re-search-backward) (function re-search-forward))) (article nil) ;; We have to take care of hidden lines. (regexp (format "^%s[ \t]+\\([0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s" ;;(if unread " " ".") (cond ((eq unread t) " ") (unread "[ ---]") (t ".")) (if subject (concat "\\([Rr][Ee]:[ \t]+\\)*" (regexp-quote (gnus-simplify-subject subject)) ;; Ignore words in parentheses. "\\([ \t]*([^\r\n]*)\\)*[ \t]*\\(\r\\|$\\)") "") ))) (if backward (beginning-of-line) (end-of-line)) (if (funcall func regexp nil t) (setq article (string-to-int (buffer-substring (match-beginning 1) (match-end 1))))) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) ;; This is the result. article )) (defun gnus-summary-search-forward (&optional unread subject) "Search for article forward. 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-subject nil unread subject)) (defun 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-subject t unread subject)) (defun gnus-summary-article-number () "Article number around point. If nothing, return current number." (save-excursion (beginning-of-line) (if (looking-at ".[ \t]+\\([0-9]+\\):") (string-to-int (buffer-substring (match-beginning 1) (match-end 1))) ;; If search fail, return current article number. gnus-current-article ))) (defun gnus-summary-subject-string () "Return current subject string or nil if nothing." (save-excursion ;; It is possible to implement this function using ;; `gnus-summary-article-number' and `gnus-newsgroup-headers'. (beginning-of-line) ;; We have to take care of hidden lines. (if (looking-at ".[ \t]+[0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]") (buffer-substring (match-beginning 1) (match-end 1))) )) (defun gnus-summary-goto-subject (article) "Move point to ARTICLE's subject." (interactive (list (string-to-int (completing-read "Article number: " (mapcar (function (lambda (headers) (list (int-to-string (nntp-header-number headers))))) gnus-newsgroup-headers) nil 'require-match)))) (let ((current (point))) (goto-char (point-min)) (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t)) (progn (goto-char current) nil)) )) (defun gnus-summary-recenter () "Center point in Summary window." ;; Scroll window so as to cursor comes center of Summary window ;; only when article is displayed. ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. ;; Subbested by popovich@park.cs.columbia.edu (and gnus-auto-center-summary (get-buffer-window gnus-article-buffer) (< (/ (- (window-height) 1) 2) (count-lines (point) (point-max))) (recenter (/ (- (window-height) 2) 2)))) ;; Walking around Group mode buffer. (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)))) (defun gnus-summary-next-group (no-article) "Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially." (interactive "P") ;; Make sure Group mode buffer point is on current newsgroup. (gnus-summary-jump-to-group gnus-newsgroup-name) (let ((group (gnus-summary-search-group))) (if (null group) (progn (message "Exiting %s..." gnus-newsgroup-name) (gnus-summary-exit) (message "")) (message "Selecting %s..." group) (gnus-summary-exit t) ;Exit Summary mode temporary. ;; We are now in Group mode buffer. ;; Make sure Group mode buffer point is on GROUP. (gnus-summary-jump-to-group group) (gnus-summary-read-group group nil no-article) (or (eq (current-buffer) (get-buffer gnus-summary-buffer)) (eq gnus-auto-select-next t) ;; Expected newsgroup has nothing to read since the articles ;; are marked as read by cross-referencing. So, try next ;; newsgroup. (Make sure we are in Group mode buffer now.) (and (eq (current-buffer) (get-buffer gnus-group-buffer)) (gnus-group-group-name) (gnus-summary-read-group (gnus-group-group-name) nil no-article)) ) ))) (defun gnus-summary-prev-group (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") ;; Make sure Group mode buffer point is on current newsgroup. (gnus-summary-jump-to-group gnus-newsgroup-name) (let ((group (gnus-summary-search-group t))) (if (null group) (progn (message "Exiting %s..." gnus-newsgroup-name) (gnus-summary-exit) (message "")) (message "Selecting %s..." group) (gnus-summary-exit t) ;Exit Summary mode temporary. ;; We are now in Group mode buffer. ;; We have to adjust point of Group mode buffer because current ;; point is moved to next unread newsgroup by exiting. (gnus-summary-jump-to-group group) (gnus-summary-read-group group nil no-article) (or (eq (current-buffer) (get-buffer gnus-summary-buffer)) (eq gnus-auto-select-next t) ;; Expected newsgroup has nothing to read since the articles ;; are marked as read by cross-referencing. So, try next ;; newsgroup. (Make sure we are in Group mode buffer now.) (and (eq (current-buffer) (get-buffer gnus-group-buffer)) (gnus-summary-search-group t) (gnus-summary-read-group (gnus-summary-search-group t) nil no-article)) ) ))) ;; Walking around summary lines. (defun gnus-summary-next-subject (n &optional unread) "Go to next N'th summary line. If optional argument UNREAD is non-nil, only unread article is selected." (interactive "p") (while (and (> n 1) (gnus-summary-search-forward unread)) (setq n (1- n))) (cond ((gnus-summary-search-forward unread) (gnus-summary-recenter)) (unread (message "No more unread articles")) (t (message "No more articles")) )) (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") (while (and (> n 1) (gnus-summary-search-backward unread)) (setq n (1- n))) (cond ((gnus-summary-search-backward unread) (gnus-summary-recenter)) (unread (message "No more unread articles")) (t (message "No more articles")) )) (defun gnus-summary-prev-unread-subject (n) "Go to previous N'th unread summary line." (interactive "p") (gnus-summary-prev-subject n t)) ;; Walking around summary lines with displaying articles. (defun gnus-summary-expand-window () "Expand Summary window to show headers full window." (interactive) (gnus-configure-windows 'summary) (pop-to-buffer gnus-summary-buffer)) (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in Article buffer." (if (null article) nil (gnus-configure-windows 'article) (pop-to-buffer gnus-summary-buffer) (gnus-article-prepare article all-header) (gnus-summary-recenter) (gnus-summary-set-mode-line) (run-hooks 'gnus-select-article-hook) ;; Successfully display article. t )) (defun gnus-summary-select-article (&optional all-headers force) "Select the current article. Optional first argument ALL-HEADERS is non-nil, show all header fields. Optional second argument FORCE is nil, the article is only selected again when current header does not match with ALL-HEADERS option." (let ((article (gnus-summary-article-number)) (all-headers (not (not all-headers)))) ;Must be T or NIL. (if (or (null gnus-current-article) (/= article gnus-current-article) (and force (not (eq all-headers gnus-have-all-headers)))) ;; The selected one is different from that of the current article. (gnus-summary-display-article article all-headers) (gnus-configure-windows 'article) (pop-to-buffer gnus-summary-buffer)) )) (defun gnus-summary-set-current-mark (&optional current-mark) "Put `+' at the current article. Optional argument specifies CURRENT-MARK instead of `+'." (save-excursion (set-buffer gnus-summary-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) ;; First of all clear mark at last article. (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t) (progn (delete-char -1) (insert " ") (goto-char (point-min)))) (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t) (progn (delete-char 1) (insert (or current-mark "+")))) ))) ;;(defun gnus-summary-next-article (unread &optional subject) ;; "Select article after current one. ;;If argument UNREAD is non-nil, only unread article is selected." ;; (interactive "P") ;; (cond ((gnus-summary-display-article ;; (gnus-summary-search-forward unread subject))) ;; (unread ;; (message "No more unread articles")) ;; (t ;; (message "No more articles")) ;; )) (defun gnus-summary-next-article (unread &optional subject) "Select article after current one. If argument UNREAD is non-nil, only unread article is selected." (interactive "P") (let ((header nil)) (cond ((gnus-summary-display-article (gnus-summary-search-forward unread subject))) ((and subject gnus-auto-select-same (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) (memq this-command '(gnus-summary-next-unread-article gnus-summary-next-page gnus-summary-kill-same-subject-and-select ;;gnus-summary-next-article ;;gnus-summary-next-same-subject ;;gnus-summary-next-unread-same-subject ))) ;; Wrap article pointer if there are unread articles. ;; Hook function, such as gnus-summary-rmail-digest, may ;; change current buffer, so need check. (let ((buffer (current-buffer)) (last-point (point))) ;; No more articles with same subject, so jump to the first ;; unread article. (gnus-summary-first-unread-article) ;;(and (eq buffer (current-buffer)) ;; (= (point) last-point) ;; ;; Ignore given SUBJECT, and try again. ;; (gnus-summary-next-article unread nil)) (and (eq buffer (current-buffer)) (< (point) last-point) (message "Wrapped")) )) ((and gnus-auto-extend-newsgroup (not unread) ;Not unread only (not subject) ;Only if subject is not specified. (setq header (gnus-more-header-forward))) ;; Extend to next article if possible. ;; Basic ideas by himacdonald@watdragon.waterloo.edu (gnus-extend-newsgroup header nil) ;; Threads feature must be turned off. (let ((buffer-read-only nil)) (goto-char (point-max)) (gnus-summary-prepare-threads (list header) 0)) (gnus-summary-goto-article gnus-newsgroup-end)) (t ;; Select next newsgroup automatically if requested. (let ((cmd (string-to-char (this-command-keys))) (group (gnus-summary-search-group)) (auto-select (and gnus-auto-select-next ;;(null (gnus-set-difference gnus-newsgroup-unreads ;; gnus-newsgroup-marked)) (memq this-command '(gnus-summary-next-unread-article gnus-summary-next-article gnus-summary-next-page gnus-summary-next-same-subject gnus-summary-next-unread-same-subject gnus-summary-kill-same-subject gnus-summary-kill-same-subject-and-select )) ;; Ignore characters typed ahead. (not (input-pending-p)) ))) (message "No more%s articles%s" (if unread " unread" "") (if (and auto-select (not (eq gnus-auto-select-next 'quietly))) (if group (format " (Type %s for %s [%d])" (key-description (char-to-string cmd)) group (nth 1 (gnus-gethash group gnus-unread-hashtb))) (format " (Type %s to exit %s)" (key-description (char-to-string cmd)) gnus-newsgroup-name )) "")) ;; Select next unread newsgroup automagically. (cond ((and auto-select (eq gnus-auto-select-next 'quietly)) ;; Select quietly. (gnus-summary-next-group nil)) (auto-select ;; Confirm auto selection. (let ((char (read-char))) (if (= char cmd) (gnus-summary-next-group nil) (setq unread-command-char char)))) ) )) ))) (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 (unread &optional subject) "Select article before current one. If argument UNREAD is non-nil, only unread article is selected." (interactive "P") (let ((header nil)) (cond ((gnus-summary-display-article (gnus-summary-search-backward unread subject))) ((and subject gnus-auto-select-same (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) (memq this-command '(gnus-summary-prev-unread-article ;;gnus-summary-prev-page ;;gnus-summary-prev-article ;;gnus-summary-prev-same-subject ;;gnus-summary-prev-unread-same-subject ))) ;; Ignore given SUBJECT, and try again. (gnus-summary-prev-article unread nil)) (unread (message "No more unread articles")) ((and gnus-auto-extend-newsgroup (not subject) ;Only if subject is not specified. (setq header (gnus-more-header-backward))) ;; Extend to previous article if possible. ;; Basic ideas by himacdonald@watdragon.waterloo.edu (gnus-extend-newsgroup header t) (let ((buffer-read-only nil)) (goto-char (point-min)) (gnus-summary-prepare-threads (list header) 0)) (gnus-summary-goto-article gnus-newsgroup-begin)) (t (message "No more articles")) ))) (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 (lines) "Show next page of selected article. If end of article, select next article. Argument LINES specifies lines to be scrolled up." (interactive "P") (let ((article (gnus-summary-article-number)) (endp nil)) (if (or (null gnus-current-article) (/= article gnus-current-article)) ;; Selected subject is different from current article's. (gnus-summary-display-article article) (gnus-configure-windows 'article) (pop-to-buffer gnus-summary-buffer) (gnus-eval-in-buffer-window gnus-article-buffer (setq endp (gnus-article-next-page lines))) (cond ((and endp lines) (message "End of message")) ((and endp (null lines)) (gnus-summary-next-unread-article))) ))) (defun gnus-summary-prev-page (lines) "Show previous page of selected article. Argument LINES specifies lines to be scrolled down." (interactive "P") (let ((article (gnus-summary-article-number))) (if (or (null gnus-current-article) (/= article gnus-current-article)) ;; Selected subject is different from current article's. (gnus-summary-display-article article) (gnus-configure-windows 'article) (pop-to-buffer gnus-summary-buffer) (gnus-eval-in-buffer-window gnus-article-buffer (gnus-article-prev-page lines)) ))) (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-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (cond ((> lines 0) (if (gnus-article-next-page lines) (message "End of message"))) ((< lines 0) (gnus-article-prev-page (- 0 lines)))) )) (defun gnus-summary-next-same-subject () "Select next article which has the same subject as current one." (interactive) (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-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-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-summary-prev-article t (gnus-summary-subject-string))) (defun gnus-summary-refer-parent-article (child) "Refer parent article of current article. If a prefix argument CHILD is non-nil, go back to the child article using internally maintained articles history. NOTE: This command may not work with nnspool.el." (interactive "P") (gnus-summary-select-article t t) ;Request all headers. (let ((referenced-id nil)) ;Message-id of parent or child article. (if child ;; Go back to child article using history. (gnus-summary-refer-article nil) (gnus-eval-in-buffer-window gnus-article-buffer ;; Look for parent Message-ID. ;; We cannot use gnus-current-headers to get references ;; because we may be looking at parent or referred article. (let ((references (gnus-fetch-field "References"))) ;; Get the last message-id in the references. (and references (string-match "\\(<[^<>]+>\\)[^>]*\\'" references) (setq referenced-id (substring references (match-beginning 1) (match-end 1)))) )) (if (stringp referenced-id) (gnus-summary-refer-article referenced-id) (error "No more parents")) ))) (defun gnus-summary-refer-article (message-id) "Refer article specified by MESSAGE-ID. If the MESSAGE-ID is nil or an empty string, Message-ID is poped from internally maintained articles history. NOTE: This command may not work with nnspool.el nor mhspool.el." (interactive "sMessage-ID: ") ;; Make sure that this command depends on the fact that article ;; related information is not updated when an article is retrieved ;; by Message-ID. (gnus-summary-select-article t t) ;Request all headers. (if (and (stringp message-id) (> (length message-id) 0)) (gnus-eval-in-buffer-window gnus-article-buffer ;; 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 ">"))) ;; Push current message-id on history. ;; We cannot use gnus-current-headers to get current ;; message-id because we may be looking at parent or referred ;; article. (let ((current (gnus-fetch-field "Message-ID"))) (or (equal current message-id) ;Nothing to do. (equal current (car gnus-current-history)) (setq gnus-current-history (cons current gnus-current-history))) )) ;; Pop message-id from history. (setq message-id (car gnus-current-history)) (setq gnus-current-history (cdr gnus-current-history))) (if (stringp message-id) ;; Retrieve article by message-id. This may not work with ;; nnspool nor mhspool. (gnus-article-prepare message-id t) (error "No such references")) ) (defun gnus-summary-next-digest (nth) "Move to head of NTH next digested message." (interactive "p") (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (gnus-article-next-digest (or nth 1)) )) (defun gnus-summary-prev-digest (nth) "Move to head of NTH previous digested message." (interactive "p") (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (gnus-article-prev-digest (or nth 1)) )) (defun gnus-summary-first-unread-article () "Select first unread article. Return non-nil if successfully selected." (interactive) (let ((begin (point))) (goto-char (point-min)) (if (re-search-forward "^ [ \t]+[0-9]+:" nil t) (gnus-summary-display-article (gnus-summary-article-number)) ;; If there is no unread articles, stay there. (goto-char begin) ;;(gnus-summary-display-article (gnus-summary-article-number)) (message "No more unread articles") nil ) )) (defun gnus-summary-isearch-article () "Do incremental search forward on current article." (interactive) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (isearch-forward))) (defun gnus-summary-search-article-forward (regexp) "Search for an article containing REGEXP forward. gnus-select-article-hook is not called during the search." (interactive (list (read-string (concat "Search forward (regexp): " (if gnus-last-search-regexp (concat "(default " gnus-last-search-regexp ") ")))))) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp)) (if (gnus-summary-search-article regexp nil) (gnus-eval-in-buffer-window gnus-article-buffer (recenter 0) ;;(sit-for 1) ) (error "Search failed: \"%s\"" regexp) )) (defun gnus-summary-search-article-backward (regexp) "Search for an article containing REGEXP backward. gnus-select-article-hook is not called during the search." (interactive (list (read-string (concat "Search backward (regexp): " (if gnus-last-search-regexp (concat "(default " gnus-last-search-regexp ") ")))))) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp)) (if (gnus-summary-search-article regexp t) (gnus-eval-in-buffer-window gnus-article-buffer (recenter 0) ;;(sit-for 1) ) (error "Search failed: \"%s\"" regexp) )) (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) ;; 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) (message "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))) (message "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 (field regexp command &optional backward) "If FIELD of article header matches REGEXP, execute a COMMAND string. If FIELD is an empty string (or nil), entire article body is searched for. If optional (prefix) argument BACKWARD is non-nil, do backward instead." (interactive (list (let ((completion-ignore-case t)) (completing-read "Field name: " '(("Number")("Subject")("From") ("Lines")("Date")("Id") ("Xref")("References")) nil 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) ;; Hidden thread subtrees must be searched for ,too. (gnus-summary-show-all-threads) ;; We don't want to change current point nor window configuration. (save-excursion (save-window-excursion (message "Executing %s..." (key-description command)) ;; We'd like to execute COMMAND interactively so as to give arguments. (gnus-execute field regexp (` (lambda () (call-interactively '(, (key-binding command))))) backward) (message "Executing %s... done" (key-description command))))) (defun gnus-summary-beginning-of-article () "Go to beginning of article body" (interactive) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen) (beginning-of-buffer) (if gnus-break-pages (gnus-narrow-to-page)) )) (defun gnus-summary-end-of-article () "Go to end of article body" (interactive) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen) (end-of-buffer) (if gnus-break-pages (gnus-narrow-to-page)) )) (defun gnus-summary-goto-article (article &optional all-headers) "Read ARTICLE if exists. Optional argument ALL-HEADERS means all headers are shown." (interactive (list (string-to-int (completing-read "Article number: " (mapcar (function (lambda (headers) (list (int-to-string (nntp-header-number headers))))) gnus-newsgroup-headers) nil 'require-match)))) (if (gnus-summary-goto-subject article) (gnus-summary-display-article article all-headers))) (defun gnus-summary-goto-last-article () "Go to last subject line." (interactive) (if gnus-last-article (gnus-summary-goto-article gnus-last-article))) (defun gnus-summary-show-article () "Force to show current article." (interactive) ;; The following is a trick to force to read the current article again. (setq gnus-have-all-headers (not gnus-have-all-headers)) (gnus-summary-select-article (not gnus-have-all-headers) t)) (defun gnus-summary-toggle-header (arg) "Show original header if pruned header currently shown, or vice versa. With arg, show original header iff arg is positive." (interactive "P") ;; Variable gnus-show-all-headers must be NIL to toggle really. (let ((gnus-show-all-headers nil) (all-headers (if (null arg) (not gnus-have-all-headers) (> (prefix-numeric-value arg) 0)))) (gnus-summary-select-article all-headers t))) (defun gnus-summary-show-all-headers () "Show original article header." (interactive) (gnus-summary-select-article t t)) (defun gnus-summary-toggle-mime (arg) "Toggle MIME processing. With arg, turn MIME processing on iff arg is positive." (interactive "P") (setq gnus-show-mime (if (null arg) (not gnus-show-mime) (> (prefix-numeric-value arg) 0))) ;; The following is a trick to force to read the current article again. (setq gnus-have-all-headers (not gnus-have-all-headers)) (gnus-summary-select-article (not gnus-have-all-headers) t)) (defun gnus-summary-stop-page-breaking () "Stop page breaking by linefeed temporary (Widen article buffer)." (interactive) (gnus-summary-select-article) (gnus-eval-in-buffer-window gnus-article-buffer (widen) )) (defun gnus-summary-kill-same-subject-and-select (unmark) "Mark articles which has the same subject as read, and then select next. If argument UNMARK is positive, remove any kinds of marks. If argument UNMARK is negative, mark articles as unread instead." (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))) (message "%d articles are marked as %s" count (if unmark "unread" "read")) )) (defun gnus-summary-kill-same-subject (unmark) "Mark articles which has the same subject as read. If argument UNMARK is positive, remove any kinds of marks. If argument UNMARK is negative, mark articles as unread instead." (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)) (message "%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) (gnus-summary-mark-as-read nil "K")) ((> unmark 0) (gnus-summary-mark-as-unread nil t)) (t (gnus-summary-mark-as-unread))) (while (and subject (gnus-summary-search-forward nil subject)) (cond ((null unmark) (gnus-summary-mark-as-read nil "K")) ((> unmark 0) (gnus-summary-mark-as-unread nil t)) (t (gnus-summary-mark-as-unread))) (setq count (1+ count)) )) ;; Hide killed thread subtrees. Does not work properly always. ;;(and (null unmark) ;; gnus-thread-hide-killed ;; (gnus-summary-hide-thread)) ;; Return number of articles marked as read. count )) (defun gnus-summary-mark-as-unread-forward (count) "Mark current article as unread, and then go forward. Argument COUNT specifies number of articles marked as unread." (interactive "p") (while (> count 0) (gnus-summary-mark-as-unread nil nil) (gnus-summary-next-subject 1 nil) (setq count (1- count)))) (defun gnus-summary-mark-as-unread-backward (count) "Mark current article as unread, and then go backward. Argument COUNT specifies number of articles marked as unread." (interactive "p") (while (> count 0) (gnus-summary-mark-as-unread nil nil) (gnus-summary-prev-subject 1 nil) (setq count (1- count)))) (defun gnus-summary-mark-as-unread (&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." (save-excursion (set-buffer gnus-summary-buffer) ;; First of all, show hidden thread subtrees. (gnus-summary-show-thread) (let* ((buffer-read-only nil) (current (gnus-summary-article-number)) (article (or article current))) (gnus-mark-article-as-unread article clear-mark) (if (or (eq article current) (gnus-summary-goto-subject article)) (progn (beginning-of-line) (delete-char 1) (insert (if clear-mark " " "-")))) ))) (defun gnus-summary-mark-as-read-forward (count) "Mark current article as read, and then go forward. Argument COUNT specifies number of articles marked as read" (interactive "p") (while (> count 0) (gnus-summary-mark-as-read) (gnus-summary-next-subject 1 'unread-only) (setq count (1- count)))) (defun gnus-summary-mark-as-read-backward (count) "Mark current article as read, and then go backward. Argument COUNT specifies number of articles marked as read" (interactive "p") (while (> count 0) (gnus-summary-mark-as-read) (gnus-summary-prev-subject 1 'unread-only) (setq count (1- count)))) (defun gnus-summary-mark-as-read (&optional article mark) "Mark current article as read. Optional 1st argument ARTICLE specifies article number to be marked as read. Optional 2nd argument MARK specifies a string inserted at beginning of line. Any kind of string (length 1) except for a space and `-' is ok." (save-excursion (set-buffer gnus-summary-buffer) ;; First of all, show hidden thread subtrees. (gnus-summary-show-thread) (let* ((buffer-read-only nil) (mark (or mark "D")) ;Default mark is `D'. (current (gnus-summary-article-number)) (article (or article current))) (gnus-mark-article-as-read article) (if (or (eq article current) (gnus-summary-goto-subject article)) (progn (beginning-of-line) (delete-char 1) (insert mark))) ))) (defun gnus-summary-clear-mark-forward (count) "Remove current article's mark, and go forward. Argument COUNT specifies number of articles unmarked" (interactive "p") (while (> count 0) (gnus-summary-mark-as-unread nil t) (gnus-summary-next-subject 1 nil) (setq count (1- count)))) (defun gnus-summary-clear-mark-backward (count) "Remove current article's mark, and go backward. Argument COUNT specifies number of articles unmarked" (interactive "p") (while (> count 0) (gnus-summary-mark-as-unread nil t) (gnus-summary-prev-subject 1 nil) (setq count (1- count)))) (defun gnus-summary-delete-marked-as-read () "Delete lines which is marked as read." (interactive) (if gnus-newsgroup-unreads (let ((buffer-read-only nil)) (save-excursion (goto-char (point-min)) (delete-non-matching-lines "^[ ---]")) ;; Adjust point. (if (eobp) (gnus-summary-prev-subject 1) (beginning-of-line) (search-forward ":" nil t))) ;; It is not so good idea to make the buffer empty. (message "All articles are marked as read") )) (defun gnus-summary-delete-marked-with (marks) "Delete lines which are marked with MARKS (e.g. \"DK\")." (interactive "sMarks: ") (let ((buffer-read-only nil)) (save-excursion (goto-char (point-min)) (delete-matching-lines (concat "^[" marks "]"))) ;; Adjust point. (or (zerop (buffer-size)) (if (eobp) (gnus-summary-prev-subject 1) (beginning-of-line) (search-forward ":" nil t))) )) ;; Thread-based commands. (defun gnus-summary-toggle-threads (arg) "Toggle showing conversation threads. With arg, turn showing conversation threads on iff arg is positive." (interactive "P") (let ((current (gnus-summary-article-number))) (setq gnus-show-threads (if (null arg) (not gnus-show-threads) (> (prefix-numeric-value arg) 0))) (gnus-summary-prepare) (gnus-summary-goto-subject current) )) (defun gnus-summary-show-all-threads () "Show all thread subtrees." (interactive) (if gnus-show-threads (save-excursion (let ((buffer-read-only nil)) (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) )))) (defun gnus-summary-show-thread () "Show thread subtrees." (interactive) (if gnus-show-threads (save-excursion (let ((buffer-read-only nil)) (subst-char-in-region (progn (beginning-of-line) (point)) (progn (end-of-line) (point)) ?\^M ?\n t) )))) (defun gnus-summary-hide-all-threads () "Hide all thread subtrees." (interactive) (if gnus-show-threads (save-excursion ;; Adjust cursor point. (goto-char (point-min)) (search-forward ":" nil t) (let ((level (current-column))) (gnus-summary-hide-thread) (while (gnus-summary-search-forward) (and (>= level (current-column)) (gnus-summary-hide-thread))) )))) (defun gnus-summary-hide-thread () "Hide thread subtrees." (interactive) (if gnus-show-threads (save-excursion ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) (let ((buffer-read-only nil) (init (point)) (last (point)) (level (current-column))) (while (and (gnus-summary-search-forward) (< level (current-column))) ;; Interested in lower levels. (if (< level (current-column)) (progn (setq last (point)) )) ) (subst-char-in-region init last ?\n ?\^M t) )))) (defun gnus-summary-next-thread (n) "Go to the same level next thread. Argument N specifies the number of threads." (interactive "p") ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) (let ((init (point)) (last (point)) (level (current-column))) (while (and (> n 0) (gnus-summary-search-forward) (<= level (current-column))) ;; We have to skip lower levels. (if (= level (current-column)) (progn (setq last (point)) (setq n (1- n)) )) ) ;; Return non-nil if successfully move to the next. (prog1 (not (= init last)) (goto-char last)) )) (defun gnus-summary-prev-thread (n) "Go to the same level previous thread. Argument N specifies the number of threads." (interactive "p") ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) (let ((init (point)) (last (point)) (level (current-column))) (while (and (> n 0) (gnus-summary-search-backward) (<= level (current-column))) ;; We have to skip lower levels. (if (= level (current-column)) (progn (setq last (point)) (setq n (1- n)) )) ) ;; Return non-nil if successfully move to the previous. (prog1 (not (= init last)) (goto-char last)) )) (defun gnus-summary-down-thread (d) "Go downward current thread. Argument D specifies the depth goes down." (interactive "p") ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) (let ((last (point)) (level (current-column))) (while (and (> d 0) (gnus-summary-search-forward) (<= level (current-column))) ;<= can be <. Which do you like? ;; We have to skip the same levels. (if (< level (current-column)) (progn (setq last (point)) (setq level (current-column)) (setq d (1- d)) )) ) (goto-char last) )) (defun gnus-summary-up-thread (d) "Go upward current thread. Argument D specifies the depth goes up." (interactive "p") ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) (let ((last (point)) (level (current-column))) (while (and (> d 0) (gnus-summary-search-backward)) ;; We have to skip the same levels. (if (> level (current-column)) (progn (setq last (point)) (setq level (current-column)) (setq d (1- d)) )) ) (goto-char last) )) (defun gnus-summary-kill-thread (unmark) "Mark articles under current thread as read. If argument UNMARK is positive, remove any kinds of marks. If argument UNMARK is negative, mark articles as unread instead." (interactive "P") (if unmark (setq unmark (prefix-numeric-value unmark))) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) (save-excursion (let ((level (current-column))) ;; Mark current article. (cond ((null unmark) (gnus-summary-mark-as-read nil "K")) ((> unmark 0) (gnus-summary-mark-as-unread nil t)) (t (gnus-summary-mark-as-unread)) ) ;; Mark following articles. (while (and (gnus-summary-search-forward) (< level (current-column))) (cond ((null unmark) (gnus-summary-mark-as-read nil "K")) ((> unmark 0) (gnus-summary-mark-as-unread nil t)) (t (gnus-summary-mark-as-unread)) )) )) ;; 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)) ) (defun gnus-summary-toggle-truncation (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-sort-by-number (reverse) "Sort Summary buffer by article number. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-keysort-summary (function <) (function (lambda (a) (nntp-header-number a))) reverse )) (defun gnus-summary-sort-by-author (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-summary-keysort-summary (function string-lessp) (function (lambda (a) (if case-fold-search (downcase (nntp-header-from a)) (nntp-header-from a)))) reverse )) (defun gnus-summary-sort-by-subject (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-summary-keysort-summary (function string-lessp) (function (lambda (a) (if case-fold-search (downcase (gnus-simplify-subject (nntp-header-subject a) 're-only)) (gnus-simplify-subject (nntp-header-subject a) 're-only)))) reverse )) (defun gnus-summary-sort-by-date (reverse) "Sort Summary buffer by date. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-keysort-summary (function string-lessp) (function (lambda (a) (gnus-sortable-date (nntp-header-date a)))) reverse )) (defun gnus-summary-keysort-summary (predicate key &optional reverse) "Sort Summary buffer by PREDICATE using a value passed by KEY. Optional argument REVERSE means reverse order." (let ((current (gnus-summary-article-number))) (gnus-keysort-headers predicate key reverse) (gnus-summary-prepare) (gnus-summary-goto-subject current) )) (defun gnus-summary-sort-summary (predicate &optional reverse) "Sort Summary buffer by PREDICATE. Optional argument REVERSE means reverse order." (let ((current (gnus-summary-article-number))) (gnus-sort-headers predicate reverse) (gnus-summary-prepare) (gnus-summary-goto-subject current) )) (defun gnus-summary-reselect-current-group (show-all) "Once exit and then reselect the current newsgroup. Prefix argument SHOW-ALL means to select all articles." (interactive "P") (let ((current-subject (gnus-summary-article-number))) (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 gnus-newsgroup-name) (gnus-group-read-group show-all t) (gnus-summary-goto-subject current-subject) )) (defun gnus-summary-caesar-message (rotnum) "Caesar rotates all letters of current message by 13/47 places. With prefix arg, specifies the number of places to rotate each letter forward. Caesar rotates Japanese letters by 47 places in any case." (interactive "P") (gnus-summary-select-article) (gnus-overload-functions) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) ;; We don't want to jump to the beginning of the message. ;; `save-excursion' does not do its job. (move-to-window-line 0) (let ((last (point))) (news-caesar-buffer-body rotnum) (goto-char last) (recenter 0) )) )) (defun gnus-summary-rmail-digest () "Run RMAIL on current digest article. gnus-select-digest-hook will be called with no arguments, if that value is non-nil. It is possible to modify the article so that Rmail can work with it. gnus-rmail-digest-hook will be called with no arguments, if that value is non-nil. The hook is intended to customize Rmail mode." (interactive) (gnus-summary-select-article) (require 'rmail) (let ((artbuf gnus-article-buffer) (digbuf (get-buffer-create gnus-digest-buffer)) (mail-header-separator "")) (set-buffer digbuf) (buffer-flush-undo (current-buffer)) (setq buffer-read-only nil) (erase-buffer) (insert-buffer-substring artbuf) (run-hooks 'gnus-select-digest-hook) (gnus-convert-article-to-rmail) (goto-char (point-min)) ;; Rmail initializations. (rmail-insert-rmail-file-header) (rmail-mode) (rmail-set-message-counters) (rmail-show-message) (condition-case () (progn (undigestify-rmail-message) (rmail-expunge) ;Delete original message. ;; File name is meaningless but `save-buffer' requires it. (setq buffer-file-name "GNUS Digest") (setq mode-line-buffer-identification (concat "Digest: " (nntp-header-subject gnus-current-headers))) ;; There is no need to write this buffer to a file. (make-local-variable 'write-file-hooks) (setq write-file-hooks (list (function (lambda () (set-buffer-modified-p nil) (message "(No changes need to be saved)") 'no-need-to-write-this-buffer)))) ;; Default file name saving digest messages. (setq rmail-last-rmail-file (funcall gnus-rmail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-rmail )) (setq rmail-last-file (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail )) ;; Prevent generating new buffer named *** each time. (setq rmail-summary-buffer (get-buffer-create gnus-digest-summary-buffer)) (run-hooks 'gnus-rmail-digest-hook) ;; Take all windows safely. (gnus-configure-windows '(1 0 0)) (pop-to-buffer gnus-group-buffer) ;; Use Summary Article windows for Digest summary and ;; Digest buffers. (if gnus-digest-show-summary (let ((gnus-summary-buffer gnus-digest-summary-buffer) (gnus-article-buffer gnus-digest-buffer)) (gnus-configure-windows 'article) (pop-to-buffer gnus-digest-buffer) (rmail-summary) (pop-to-buffer gnus-digest-summary-buffer) (message (substitute-command-keys "Type \\[rmail-summary-quit] to return to GNUS"))) (let ((gnus-summary-buffer gnus-digest-buffer)) (gnus-configure-windows 'summary) (pop-to-buffer gnus-digest-buffer) (message (substitute-command-keys "Type \\[rmail-quit] to return to GNUS"))) ) ;; Move the buffers to the end of buffer list. (bury-buffer gnus-article-buffer) (bury-buffer gnus-group-buffer) (bury-buffer gnus-digest-summary-buffer) (bury-buffer gnus-digest-buffer)) (error (set-buffer-modified-p nil) (kill-buffer digbuf) ;; This command should not signal an error because the ;; command is called from hooks. (ding) (message "Article is not a digest"))) )) (defun gnus-summary-save-article () "Save this article using default saver function. The variable `gnus-default-article-saver' specifies the saver function." (interactive) (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers) (if gnus-default-article-saver (call-interactively gnus-default-article-saver) (error "No default saver is defined."))) (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-summary-select-article gnus-save-all-headers gnus-save-all-headers) (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction (widen) (let ((default-name (funcall gnus-rmail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-rmail ))) (or filename (setq filename (read-file-name (concat "Save article in Rmail file: (default " (file-name-nondirectory default-name) ") ") (file-name-directory default-name) default-name))) (gnus-make-directory (file-name-directory filename)) (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-summary-select-article gnus-save-all-headers gnus-save-all-headers) (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction (widen) (let ((default-name (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail ))) (or filename (setq filename (read-file-name (concat "Save article in Unix mail file: (default " (file-name-nondirectory default-name) ") ") (file-name-directory default-name) default-name))) (setq filename (expand-file-name filename (and default-name (file-name-directory default-name)))) (gnus-make-directory (file-name-directory filename)) (if (and (file-readable-p filename) (rmail-file-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-summary-select-article gnus-save-all-headers gnus-save-all-headers) (gnus-eval-in-buffer-window gnus-article-buffer (save-excursion (save-restriction (widen) (let ((default-name (funcall gnus-file-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-file ))) (or filename (setq filename (read-file-name (concat "Save article in file: (default " (file-name-nondirectory default-name) ") ") (file-name-directory default-name) default-name))) (gnus-make-directory (file-name-directory filename)) (gnus-output-to-file filename) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-file filename) ))) )) (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." (interactive) (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) ;; 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*"))) (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-summary-pipe-output () "Pipe this article to subprocess." (interactive) ;; Ignore `gnus-save-all-headers' since this is not save command. ;;(gnus-summary-select-article) ;; Huuum. Is this right? (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) (let ((command (read-string "Shell command on article: " gnus-last-shell-command))) (if (string-equal command "") (setq command gnus-last-shell-command)) (shell-command-on-region (point-min) (point-max) command nil) (setq gnus-last-shell-command command) )) )) (defun gnus-summary-catchup (all &optional quietly) "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." (interactive "P") (if (or quietly (y-or-n-p (if all "Do you really want to mark everything as read? " "Delete all articles not marked as unread? "))) (let ((unmarked (gnus-set-difference gnus-newsgroup-unreads (if (not all) gnus-newsgroup-marked)))) (message "") ;Erase "Yes or No" question. ;; Hidden thread subtrees must be searched for ,too. (gnus-summary-show-all-threads) (while unmarked (gnus-summary-mark-as-read (car unmarked) "C") (setq unmarked (cdr unmarked)) )) )) (defun gnus-summary-catchup-all (&optional quietly) "Mark all articles in this newsgroup as read." (interactive) (gnus-summary-catchup t quietly)) (defun gnus-summary-catchup-and-exit (all &optional 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") (if (or quietly (y-or-n-p (if all "Do you really want to mark everything as read? " "Delete all articles not marked as unread? "))) (let ((unmarked (gnus-set-difference gnus-newsgroup-unreads (if (not all) gnus-newsgroup-marked)))) (message "") ;Erase "Yes or No" question. (while unmarked (gnus-mark-article-as-read (car unmarked)) (setq unmarked (cdr unmarked))) ;; Select next newsgroup or exit. (cond ((eq gnus-auto-select-next 'quietly) ;; Select next newsgroup quietly. (gnus-summary-next-group nil)) (t (gnus-summary-exit))) ))) (defun gnus-summary-catchup-all-and-exit (&optional quietly) "Mark all articles in this newsgroup as read, and then exit." (interactive) (gnus-summary-catchup-and-exit t quietly)) (defun gnus-summary-edit-global-kill () "Edit a global KILL file." (interactive) (setq gnus-current-kill-article (gnus-summary-article-number)) (gnus-kill-file-edit-file nil) ;Nil stands for global KILL file. (message (substitute-command-keys "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)"))) (defun gnus-summary-edit-local-kill () "Edit a local KILL file applied to the current newsgroup." (interactive) (setq gnus-current-kill-article (gnus-summary-article-number)) (gnus-kill-file-edit-file gnus-newsgroup-name) (message (substitute-command-keys "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)"))) (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) (let ((updated nil) (gnus-newsgroup-headers gnus-newsgroup-headers) (gnus-newsgroup-unreads gnus-newsgroup-unreads) (gnus-newsgroup-unselected gnus-newsgroup-unselected) (gnus-newsgroup-marked gnus-newsgroup-marked)) ;; Important internal variables are saved, so we can reenter ;; Summary buffer even if hook changes them. (run-hooks 'gnus-exit-group-hook) (gnus-update-unread-articles gnus-newsgroup-name (append gnus-newsgroup-unselected gnus-newsgroup-unreads) gnus-newsgroup-marked) ;; T means ignore unsubscribed newsgroups. (if gnus-use-cross-reference (setq updated (gnus-mark-as-read-by-xref gnus-newsgroup-name gnus-newsgroup-headers gnus-newsgroup-unreads (eq gnus-use-cross-reference t) ))) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) ;; Update cross referenced group info. (while updated (gnus-group-update-group (car updated) t) ;Ignore invisible group. (setq updated (cdr updated))) (gnus-group-update-group gnus-newsgroup-name)) ;; Make sure where I was, and go to next newsgroup. (gnus-group-jump-to-group gnus-newsgroup-name) (gnus-group-next-unread-group 1) (if temporary ;; If exiting temporary, caller should adjust Group mode ;; buffer point by itself. nil ;Nothing to do. ;; Return to Group mode buffer. (if (get-buffer gnus-summary-buffer) (bury-buffer gnus-summary-buffer)) (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (gnus-configure-windows 'newsgroups) (pop-to-buffer gnus-group-buffer))) (defun gnus-summary-quit () "Quit reading current newsgroup without updating read article info." (interactive) (if (y-or-n-p "Do you really wanna quit reading this group? ") (progn (message "") ;Erase "Yes or No" question. ;; Return to Group selection mode. (if (get-buffer gnus-summary-buffer) (bury-buffer gnus-summary-buffer)) (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (gnus-configure-windows 'newsgroups) (pop-to-buffer gnus-group-buffer) (gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was. (gnus-group-next-group 1) ;(gnus-group-next-unread-group 1) ))) (defun gnus-summary-describe-briefly () "Describe Summary mode commands briefly." (interactive) (message (concat (substitute-command-keys "\\[gnus-summary-next-page]:Select ") (substitute-command-keys "\\[gnus-summary-next-unread-article]:Forward ") (substitute-command-keys "\\[gnus-summary-prev-unread-article]:Backward ") (substitute-command-keys "\\[gnus-summary-exit]:Exit ") (substitute-command-keys "\\[gnus-info-find-node]:Run Info ") (substitute-command-keys "\\[gnus-summary-describe-briefly]:This help") ))) ;;; ;;; GNUS Article Mode ;;; (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 "r" 'gnus-article-refer-article) (define-key gnus-article-mode-map "o" 'gnus-article-pop-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 "?" 'gnus-article-describe-briefly) (define-key gnus-article-mode-map "\C-c\C-i" 'gnus-info-find-node)) (defun gnus-article-mode () "Major mode for browsing through an article. All normal editing commands are turned off. Instead, these commands are available: \\{gnus-article-mode-map} Various hooks for customization: gnus-article-mode-hook Entry to this mode calls the value with no arguments, if that value is non-nil. gnus-article-prepare-hook Called with no arguments after an article is prepared for reading, if that value is non-nil." (interactive) (kill-all-local-variables) ;; Gee. Why don't you upgrade? (cond ((boundp 'mode-line-modified) (setq mode-line-modified "--- ")) ((listp (default-value 'mode-line-format)) (setq mode-line-format (cons "--- " (cdr (default-value 'mode-line-format)))))) ;; To disable display-time facility. ;;(make-local-variable 'global-mode-string) ;;(setq global-mode-string nil) (setq major-mode 'gnus-article-mode) (setq mode-name "Article") (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))) (gnus-article-set-mode-line) (use-local-map gnus-article-mode-map) (make-local-variable 'page-delimiter) (setq page-delimiter gnus-page-delimiter) (make-local-variable 'mail-header-separator) (setq mail-header-separator "") ;For caesar function. (buffer-flush-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." (or (get-buffer gnus-article-buffer) (save-excursion (set-buffer (get-buffer-create gnus-article-buffer)) (gnus-article-mode)) )) (defun gnus-article-prepare (article &optional all-headers) "Prepare ARTICLE in Article mode buffer. ARTICLE can be either a article number or Message-ID. If optional argument ALL-HEADERS is non-nil, all headers are inserted." ;; Make sure a connection to NNTP server is alive. (if (not (gnus-server-opened)) (progn (gnus-start-news-server) (gnus-request-group gnus-newsgroup-name))) (save-excursion (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) (erase-buffer) ;; mhspool does not work with Message-ID. So, let's translate ;; it into an article number as possible as can. This may help ;; nnspool too. ;; Note: this conversion must be done here since if the article ;; is specified by number or message-id has a different meaning ;; in the following. (if (let* ((header (and (stringp article) (gnus-get-header-by-id article))) (article (if header (nntp-header-number header) article))) (gnus-request-article article)) (progn ;; Prepare article buffer (insert-buffer-substring nntp-server-buffer) ;; gnus-have-all-headers must be either T or NIL. (setq gnus-have-all-headers (not (not (or all-headers gnus-show-all-headers)))) (if (and (numberp article) (not (eq article gnus-current-article))) ;; Seems me that a new article has been selected. (progn ;; gnus-current-article must be an article number. (setq gnus-last-article gnus-current-article) (setq gnus-current-article article) ;; (setq gnus-current-headers ;; (gnus-find-header-by-number gnus-newsgroup-headers ;; gnus-current-article)) (setq gnus-current-headers (gnus-get-header-by-number gnus-current-article)) (run-hooks 'gnus-mark-article-hook) )) ;; Clear article history only when the article is ;; retrieved by the article number. (if (numberp article) (setq gnus-current-history nil)) ;; Hooks for modifying contents of the article. This hook ;; must be called before being narrowed. (run-hooks 'gnus-article-prepare-hook) ;; Decode MIME message. (if (and gnus-show-mime (gnus-fetch-field "Mime-Version")) (funcall gnus-show-mime-method)) ;; Delete unnecessary headers. (or gnus-have-all-headers (gnus-article-delete-headers)) ;; Do page break. (goto-char (point-min)) (if gnus-break-pages (gnus-narrow-to-page)) ;; Next function must be called after setting ;; `gnus-current-article' variable and narrowed to page. (gnus-article-set-mode-line) ) ;; There is no such article. (if (numberp article) (gnus-summary-mark-as-read article)) (ding) (message "No such article (may be canceled)")) ))) (defun gnus-article-show-all-headers () "Show all article headers in Article mode buffer." (or gnus-have-all-headers (gnus-article-prepare gnus-current-article t))) ;;(defun gnus-article-set-mode-line () ;; "Set Article mode line string." ;; (setq mode-line-buffer-identification ;; (list 17 ;; (format "GNUS: %s {%d-%d} %d" ;; gnus-newsgroup-name ;; gnus-newsgroup-begin ;; gnus-newsgroup-end ;; gnus-current-article ;; ))) ;; (set-buffer-modified-p t)) ;;(defun gnus-article-set-mode-line () ;; "Set Article mode line string." ;; (let ((unmarked ;; (- (length gnus-newsgroup-unreads) ;; (length (gnus-intersection ;; gnus-newsgroup-unreads gnus-newsgroup-marked)))) ;; (unselected ;; (- (length gnus-newsgroup-unselected) ;; (length (gnus-intersection ;; gnus-newsgroup-unselected gnus-newsgroup-marked))))) ;; (setq mode-line-buffer-identification ;; (list 17 ;; (format "GNUS: %s{%d} %s" ;; gnus-newsgroup-name ;; gnus-current-article ;; ;; This is proposed by tale@pawl.rpi.edu. ;; (cond ((and (zerop unmarked) ;; (zerop unselected)) ;; " ") ;; ((zerop unselected) ;; (format "%d more" unmarked)) ;; (t ;; (format "%d(+%d) more" unmarked unselected))) ;; )))) ;; (set-buffer-modified-p t)) ;; New implementation in gnus 3.14.3 (defun gnus-article-set-mode-line () "Set Article mode line string. If you don't like it, define your own gnus-article-set-mode-line." (let ((maxlen 15) ;Maximum subject length (subject (if gnus-current-headers (nntp-header-subject gnus-current-headers) ""))) ;; The value must be a string to escape %-constructs because of subject. (setq mode-line-buffer-identification (format "GNUS: %s%s %s%s%s" gnus-newsgroup-name (if gnus-current-article (format "/%d" gnus-current-article) "") (substring subject 0 (min (length subject) maxlen)) (if (> (length subject) maxlen) "..." "") (make-string (max 0 (- 17 (length subject))) ? ) ))) (set-buffer-modified-p t)) (defun gnus-article-delete-headers () "Delete unnecessary headers." (save-excursion (save-restriction (goto-char (point-min)) (narrow-to-region (point-min) (progn (search-forward "\n\n" nil 'move) (point))) (goto-char (point-min)) (and (stringp gnus-ignored-headers) (while (re-search-forward gnus-ignored-headers nil t) (beginning-of-line) (delete-region (point) (progn (re-search-forward "\n[^ \t]") (forward-char -1) (point))))) ))) ;; Working on article's buffer (defun gnus-article-next-page (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 (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-next-digest (nth) "Move to head of NTH next digested message. Set mark at end of digested message." ;; Stop page breaking in digest mode. (widen) (end-of-line) ;; Skip NTH - 1 digest. ;; Suggested by Khalid Sattar . ;; Digest separator is customizable. ;; Suggested by Skip Montanaro . (while (and (> nth 1) (re-search-forward gnus-digest-separator nil 'move)) (setq nth (1- nth))) (if (re-search-forward gnus-digest-separator nil t) (let ((begin (point))) ;; Search for end of this message. (end-of-line) (if (re-search-forward gnus-digest-separator nil t) (progn (search-backward "\n\n") ;This may be incorrect. (forward-line 1)) (goto-char (point-max))) (push-mark) ;Set mark at end of digested message. (goto-char begin) (beginning-of-line) ;; Show From: and Subject: fields. (recenter 1)) (message "End of message") )) (defun gnus-article-prev-digest (nth) "Move to head of NTH previous digested message." ;; Stop page breaking in digest mode. (widen) (beginning-of-line) ;; Skip NTH - 1 digest. ;; Suggested by Khalid Sattar . ;; Digest separator is customizable. ;; Suggested by Skip Montanaro . (while (and (> nth 1) (re-search-backward gnus-digest-separator nil 'move)) (setq nth (1- nth))) (if (re-search-backward gnus-digest-separator nil t) (let ((begin (point))) ;; Search for end of this message. (end-of-line) (if (re-search-forward gnus-digest-separator nil t) (progn (search-backward "\n\n") ;This may be incorrect. (forward-line 1)) (goto-char (point-max))) (push-mark) ;Set mark at end of digested message. (goto-char begin) ;; Show From: and Subject: fields. (recenter 1)) (goto-char (point-min)) (message "Top of message") )) (defun gnus-article-refer-article () "Read article specified by message-id around point." (interactive) (save-window-excursion (save-excursion (re-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-pop-article () "Pop up article history." (interactive) (save-window-excursion (set-buffer gnus-summary-buffer) (gnus-summary-refer-article nil))) (defun gnus-article-show-summary () "Reconfigure windows to show Summary buffer." (interactive) (gnus-configure-windows 'article) (pop-to-buffer gnus-summary-buffer) (gnus-summary-goto-subject gnus-current-article)) (defun gnus-article-describe-briefly () "Describe Article mode commands briefly." (interactive) (message (concat (substitute-command-keys "\\[gnus-article-next-page]:Next page ") (substitute-command-keys "\\[gnus-article-prev-page]:Prev page ") (substitute-command-keys "\\[gnus-article-show-summary]:Show Summary ") (substitute-command-keys "\\[gnus-info-find-node]:Run Info ") (substitute-command-keys "\\[gnus-article-describe-briefly]:This help") ))) ;;; ;;; GNUS KILL-File Mode ;;; (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-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) (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node)) (defun gnus-kill-file-mode () "Major mode for editing KILL file. In addition to Emacs-Lisp Mode, the following commands are available: \\[gnus-kill-file-kill-by-subject] Insert KILL command for current subject. \\[gnus-kill-file-kill-by-author] Insert KILL command for current author. \\[gnus-kill-file-apply-buffer] Apply current buffer to selected newsgroup. \\[gnus-kill-file-apply-last-sexp] Apply sexp before point to selected newsgroup. \\[gnus-kill-file-exit] Save file and exit editing KILL file. \\[gnus-info-find-node] Read Info about KILL file. 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 is default 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-File") (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 of 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 '(1 0 0)) ;Take all windows. (pop-to-buffer gnus-group-buffer) (let ((gnus-summary-buffer buffer)) (gnus-configure-windows '(1 1 0)) ;Split into two. (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) )) (defun gnus-kill-file-kill-by-subject () "Insert KILL command for current subject." (interactive) (insert (format "(gnus-kill \"Subject\" %s)\n" (prin1-to-string (if gnus-current-kill-article (regexp-quote (nntp-header-subject ;; No need to speed up this command. ;;(gnus-get-header-by-number gnus-current-kill-article) (gnus-find-header-by-number gnus-newsgroup-headers gnus-current-kill-article))) ""))))) (defun gnus-kill-file-kill-by-author () "Insert KILL command for current author." (interactive) (insert (format "(gnus-kill \"From\" %s)\n" (prin1-to-string (if gnus-current-kill-article (regexp-quote (nntp-header-from ;; No need to speed up this command. ;;(gnus-get-header-by-number gnus-current-kill-article) (gnus-find-header-by-number gnus-newsgroup-headers gnus-current-kill-article))) ""))))) (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. (let ((string (concat "(progn \n" (buffer-string) "\n)" ))) (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-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 (get-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))) ;;; ;;; Utility functions ;;; ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti) (defun gnus-batch-kill () "Run batched KILL. Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..." (if (not noninteractive) (error "gnus-batch-kill is to be used only with -batch")) (let* ((group nil) (subscribed nil) (newsrc nil) (yes-and-no (gnus-parse-n-options (apply (function concat) (mapcar (function (lambda (g) (concat g " "))) command-line-args-left)))) (yes (car yes-and-no)) (no (cdr yes-and-no)) ;; Disable verbose message. (gnus-novice-user nil) (gnus-large-newsgroup nil) (nntp-large-newsgroup nil)) ;; Eat all arguments. (setq command-line-args-left nil) ;; Startup GNUS. (gnus) ;; Apply kills to specified newsgroups in command line arguments. (setq newsrc (copy-sequence gnus-newsrc-assoc)) (while newsrc (setq group (car (car newsrc))) (setq subscribed (nth 1 (car newsrc))) (setq newsrc (cdr newsrc)) (if (and subscribed (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb)))) (if yes (string-match yes group) t) (or (null no) (not (string-match no group)))) (progn (gnus-summary-read-group group nil t) (if (eq (current-buffer) (get-buffer gnus-summary-buffer)) (gnus-summary-exit t)) )) ) ;; Finally, exit Emacs. (set-buffer gnus-group-buffer) (gnus-group-exit) )) ;; For saving articles (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 (gnus-capitalize-newsgroup newsgroup) (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (nntp-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 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 newsgroup (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (nntp-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 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 (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 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 newsgroup (concat (gnus-newsgroup-directory-form newsgroup) "/news")) (or gnus-article-save-directory "~/News")))) (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))))) ;; For KILL files (defun gnus-apply-kill-file () "Apply KILL file to the current newsgroup." ;; Apply the global KILL file. (load (gnus-newsgroup-kill-file nil) t nil t) ;; And then apply the local KILL file. (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t)) (defun gnus-Newsgroup-kill-file (newsgroup) "Return the name of a KILL file of 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-article-save-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-article-save-directory "~/News"))) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) (or gnus-article-save-directory "~/News"))) )) (defun gnus-newsgroup-kill-file (newsgroup) "Return the name of a KILL file of 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-article-save-directory "~/News"))) (gnus-use-long-file-name ;; Append ".KILL" to newsgroup name. (expand-file-name (concat newsgroup "." gnus-kill-file-name) (or gnus-article-save-directory "~/News"))) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) (or gnus-article-save-directory "~/News"))) )) ;; For subscribing new newsgroup (defun gnus-subscribe-randomly (newsgroup) "Subscribe new NEWSGROUP and insert it at the beginning of newsgroups." (gnus-subscribe-newsgroup newsgroup (car (car gnus-newsrc-assoc)))) (defun gnus-subscribe-alphabetically (newgroup) "Subscribe new NEWSGROUP and insert it in strict alphabetic order." ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (let ((groups gnus-newsrc-assoc) (before nil)) (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 nil)) (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. Unless, it is killed." (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup)) (gnus-subscribe-hierarchically newsgroup) ;; Save in kill-ring (gnus-subscribe-newsgroup newsgroup) (gnus-kill-newsgroup newsgroup))) (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. If optional argument NEXT is non-nil, it is inserted before NEXT." (gnus-insert-newsgroup (list newsgroup t) next) (message "Subscribe newsgroup: %s" newsgroup)) ;; For directories (defun gnus-newsgroup-directory-form (newsgroup) "Make hierarchical directory name from NEWSGROUP name." (let ((newsgroup (substring newsgroup 0)) ;Copy string. (len (length newsgroup)) (idx 0)) ;; Replace all occurrences of `.' with `/'. (while (< idx len) (if (= (aref newsgroup idx) ?.) (aset newsgroup idx ?/)) (setq idx (1+ idx))) newsgroup )) (defun gnus-make-directory (directory) "Make DIRECTORY recursively." (let ((directory (expand-file-name directory default-directory))) (or (file-exists-p directory) (gnus-make-directory-1 "" directory)) )) (defun gnus-make-directory-1 (head tail) (cond ((string-match "^/\\([^/]+\\)" tail) ;; ange-ftp interferes with calling match-* after ;; calling file-name-as-directory. (let ((beg (match-beginning 1)) (end (match-end 1))) (setq head (concat (file-name-as-directory head) (substring tail beg end))) (or (file-exists-p head) (call-process "mkdir" nil nil nil head)) (gnus-make-directory-1 head (substring tail end)))) ((string-equal tail "") t) )) (defun gnus-capitalize-newsgroup (newsgroup) "Capitalize NEWSGROUP name with treating '.' and '-' as part of words." ;; Suggested by "Jonathan I. Kamens" . (let ((current-syntax-table (copy-syntax-table (syntax-table)))) (unwind-protect (progn (modify-syntax-entry ?- "w") (modify-syntax-entry ?. "w") (capitalize newsgroup)) (set-syntax-table current-syntax-table)))) (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\\(\\^[0-9]+\\)?:[ \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 )) (defun gnus-optional-lines-and-from (header) "Return a string like `NNN:AUTHOR' from HEADER." (let ((name-length (length "umerin@photon"))) (substring (format "%3d:%s" ;; Lines of the article. ;; Suggested by dana@bellcore.com. (nntp-header-lines header) ;; Its author. (concat (mail-strip-quoted-names (nntp-header-from header)) (make-string name-length ? ))) ;; 4 stands for length of `NNN:'. 0 (+ 4 name-length)))) (defun gnus-optional-lines (header) "Return a string like `NNN' from HEADER." (format "%4d" (nntp-header-lines header))) ;; Basic ideas by flee@cs.psu.edu (Felix Lee) (defun gnus-keysort-headers (predicate key &optional reverse) "Sort current headers by PREDICATE using a value passed by KEY safely. *Safely* means C-g quitting is disabled during sort. Optional argument REVERSE means reverse order." (let ((inhibit-quit t)) (setq gnus-newsgroup-headers (if reverse (nreverse (gnus-keysort (nreverse gnus-newsgroup-headers) predicate key)) (gnus-keysort gnus-newsgroup-headers predicate key))) ;; Make sure we don't have to call ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash ;; tables for the variable gnus-newsgroup-headers since no new ;; entry is added to nor deleted from the variable. )) (defun gnus-keysort (list predicate key) "Sort LIST by PREDICATE using a value passed by KEY." (mapcar (function cdr) (sort (mapcar (function (lambda (a) (cons (funcall key a) a))) list) (function (lambda (a b) (funcall predicate (car a) (car b))))))) (defun gnus-sort-headers (predicate &optional reverse) "Sort current headers by PREDICATE safely. *Safely* means C-g quitting is disabled during sort. Optional argument REVERSE means reverse order." (let ((inhibit-quit t)) (setq gnus-newsgroup-headers (if reverse (nreverse (sort (nreverse gnus-newsgroup-headers) predicate)) (sort gnus-newsgroup-headers predicate))) ;; Make sure we don't have to call ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash ;; tables for the variable gnus-newsgroup-headers since no new ;; entry is added to nor deleted from the variable. )) (defun gnus-string-lessp (a b) "Return T if first arg string is less than second in lexicographic order. If case-fold-search is non-nil, case of letters is ignored." (if case-fold-search (string-lessp (downcase a) (downcase b)) (string-lessp a b))) (defun gnus-date-lessp (date1 date2) "Return T if DATE1 is earlyer than DATE2." (string-lessp (gnus-sortable-date date1) (gnus-sortable-date date2))) (defun gnus-sortable-date (date) "Make sortable string by string-lessp from DATE. Timezone package is used." (let* ((date (timezone-parse-date date)) ;[Y M D T] (year (string-to-int (aref date 0))) (month (string-to-int (aref date 1))) (day (string-to-int (aref date 2))) (time (aref date 3))) ;HH:MM:SS ;; Timezone package is used. But, we don't have to care about ;; the timezone since article's timezones are always GMT. (timezone-make-sortable-date year month day time) )) ;;(defun gnus-sortable-date (date) ;; "Make sortable string by string-lessp from DATE." ;; (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3") ;; ("APR" . " 4")("MAY" . " 5")("JUN" . " 6") ;; ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9") ;; ("OCT" . "10")("NOV" . "11")("DEC" . "12"))) ;; (date (or date ""))) ;; ;; Can understand the following styles: ;; ;; (1) 14 Apr 89 03:20:12 GMT ;; ;; (2) Fri, 17 Mar 89 4:01:33 GMT ;; (if (string-match ;; "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date) ;; (concat ;; ;; Year ;; (substring date (match-beginning 3) (match-end 3)) ;; ;; Month ;; (cdr ;; (assoc ;; (upcase (substring date (match-beginning 2) (match-end 2))) month)) ;; ;; Day ;; (format "%2d" (string-to-int ;; (substring date ;; (match-beginning 1) (match-end 1)))) ;; ;; Time ;; (substring date (match-beginning 4) (match-end 4))) ;; ;; Cannot understand DATE string. ;; date ;; ) ;; )) (defun gnus-fetch-field (field) "Return the value of the header FIELD of current article." (save-excursion (save-restriction (widen) (goto-char (point-min)) (narrow-to-region (point-min) (progn (search-forward "\n\n" nil 'move) (point))) (mail-fetch-field field)))) (fset 'gnus-expunge 'gnus-summary-delete-marked-with) (defun gnus-kill (field regexp &optional command all) "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. (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. (if (null command) (setq command '(gnus-summary-mark-as-read nil "X"))) (gnus-execute field regexp command nil (not all)) ))) (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 unread are ignored." (let ((function nil) (header nil) (article nil)) (if (string-equal field "") (setq field nil)) (if (null field) nil (or (stringp field) (setq field (symbol-name field))) ;; 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. (or (and ignore-marked ;; Articles marked as read and unread should be ignored. (setq article (gnus-summary-article-number)) (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read. (memq article gnus-newsgroup-marked) ;Marked as unread. )) (gnus-execute-1 function regexp form)) (while (gnus-summary-search-subject backward ignore-marked nil) (gnus-execute-1 function regexp form)) )) (defun gnus-execute-1 (function regexp form) (save-excursion ;; The point of Summary buffer must be saved during execution. (let ((article (gnus-summary-article-number))) (if (null article) nil ;Nothing to do. (if function ;; Compare with header field. (let (;;(header (gnus-find-header-by-number ;; gnus-newsgroup-headers article)) (header (gnus-get-header-by-number article)) (value nil)) (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))) (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..." article) (gnus-article-setup-buffer) (gnus-article-prepare article t) (if (save-excursion (set-buffer gnus-article-buffer) (goto-char (point-min)) (re-search-forward regexp nil t)) (if (stringp form) ;Keyboard macro. (execute-kbd-macro form) (funcall form)))) )) ))) ;;; caesar-region written by phr@prep.ai.mit.edu Nov 86 ;;; modified by tower@prep Nov 86 ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47. (defun gnus-caesar-region (&optional n) "Caesar rotation of region by N, default 13, for decrypting netnews. ROT47 will be performed for Japanese text in any case." (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))) ;; ROT47 for Japanese text. ;; Thanks to ichikawa@flab.fujitsu.junet. (setq i 161) (let ((t1 (logior ?O 128)) (t2 (logior ?! 128)) (t3 (logior ?~ 128))) (while (< i 256) (aset caesar-translate-table i (let ((v (aref caesar-translate-table i))) (if (<= v t1) (if (< v t2) v (+ v 47)) (if (<= v t3) (- v 47) v)))) (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) (delete-region from to) (insert str))))) ;; Functions accessing headers. ;; Functions are more convenient than macros in some case. (defun gnus-header-number (header) "Return article number in HEADER." (nntp-header-number header)) (defun gnus-header-subject (header) "Return subject string in HEADER." (nntp-header-subject header)) (defun gnus-header-from (header) "Return author string in HEADER." (nntp-header-from header)) (defun gnus-header-xref (header) "Return xref string in HEADER." (nntp-header-xref header)) (defun gnus-header-lines (header) "Return lines in HEADER." (nntp-header-lines header)) (defun gnus-header-date (header) "Return date in HEADER." (nntp-header-date header)) (defun gnus-header-id (header) "Return Id in HEADER." (nntp-header-id header)) (defun gnus-header-references (header) "Return references in HEADER." (nntp-header-references header)) ;;; ;;; 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-last-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 (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-flush-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) 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-flush-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^_")) ;2 chars: "^" and "_" (goto-char (point-max)) (insert "\^_"))) ;;(defun gnus-convert-article-to-rmail () ;; "Convert article in current buffer to Rmail message format." ;; (let ((buffer-read-only nil)) ;; ;; Insert special header of Unix mail. ;; (goto-char (point-min)) ;; (insert "From " ;; (or (mail-strip-quoted-names (mail-fetch-field "from")) ;; "unknown") ;; " " (current-time-string) "\n") ;; ;; Stop quoting `From' since this seems unnecessary in most cases. ;; ;; ``Quote'' "\nFrom " as "\n>From " ;; ;;(while (search-forward "\nFrom " nil t) ;; ;; (forward-char -5) ;; ;; (insert ?>)) ;; ;; Convert article to babyl format. ;; (rmail-convert-to-babyl-format) ;; )) ;;; ;;; Internal functions. ;;; (defun gnus-start-news-server (&optional confirm) "Open network stream to remote NNTP server. If optional argument CONFIRM is non-nil, ask you host that NNTP server is running even if it is defined. Run gnus-open-server-hook just before opening news server." (if (gnus-server-opened) ;; Stream is already opened. nil ;; Open NNTP server. (if (or confirm (null gnus-nntp-server)) ;; If someone has set the service to nil, then this should always ;; be the local host. (if gnus-nntp-service (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers) ;; Read server name with completion. (setq gnus-nntp-server (completing-read "NNTP server: " (cons (list gnus-nntp-server) gnus-secondary-servers) nil nil gnus-nntp-server)) (setq gnus-nntp-server (read-string "NNTP server: " gnus-nntp-server))) (setq gnus-nntp-server ""))) ;; If no server name is given, local host is assumed. (if (or (string-equal gnus-nntp-server "") (string-equal gnus-nntp-server "::")) ;RMS preference. (setq gnus-nntp-server (system-name))) ;; gnus-nntp-server must be either (system-name), ':DIRECTORY', or ;; nntp server name. I mean '::' cannot be a value of ;; gnus-nntp-server. (cond ((and (null gnus-nntp-service) (string-equal gnus-nntp-server (system-name))) (require 'nnspool) (gnus-define-access-method 'nnspool) (message "Looking up local news spool...")) ((string-match ":" gnus-nntp-server) ;; :DIRECTORY (require 'mhspool) (gnus-define-access-method 'mhspool) (message "Looking up private directory...")) (t (gnus-define-access-method 'nntp) (message "Connecting to NNTP server on %s..." gnus-nntp-server))) (run-hooks 'gnus-open-server-hook) (cond ((gnus-server-opened) ;Maybe opened in gnus-open-server-hook. (message "")) ((gnus-open-server gnus-nntp-server gnus-nntp-service) (message "")) (t (error (gnus-nntp-message (format "Cannot open NNTP server on %s" gnus-nntp-server))))) )) ;; Dummy functions used only once. Should return nil. (defun gnus-server-opened () nil) (defun gnus-close-server () nil) (defun gnus-nntp-message (&optional message) "Return a message returned from NNTP server. If no message is available and optional MESSAGE is given, return it." (let ((status (gnus-status-message)) (message (or message ""))) (if (and (stringp status) (> (length status) 0)) status message))) (defun gnus-define-access-method (method &optional access-methods) "Define access functions for the access METHOD. Methods definition is taken from optional argument ACCESS-METHODS or the variable gnus-access-methods." (let ((bindings (cdr (assoc method (or access-methods gnus-access-methods))))) (if (null bindings) (error "Unknown access method: %s" method) ;; Should not use symbol-function here since overload does not work. (while bindings ;; Alist syntax is different from that of 3.14.3. (fset (car (car bindings)) (car (cdr (car bindings)))) (setq bindings (cdr bindings))) ))) (defun gnus-select-newsgroup (group &optional show-all) "Select newsgroup GROUP. If optional argument SHOW-ALL is non-nil, all of articles in the group are selected." ;; Make sure a connection to NNTP server is alive. (gnus-start-news-server) (if (gnus-request-group group) (let ((articles nil)) (setq gnus-newsgroup-name group) (setq gnus-newsgroup-unreads (gnus-uncompress-sequence (nthcdr 2 (gnus-gethash group gnus-unread-hashtb)))) (cond (show-all ;; Select all active articles. (setq articles (gnus-uncompress-sequence (nthcdr 2 (gnus-gethash group gnus-active-hashtb))))) (t ;; Select unread articles only. (setq articles gnus-newsgroup-unreads))) ;; Require confirmation if selecting large newsgroup. (setq gnus-newsgroup-unselected nil) (if (not (numberp gnus-large-newsgroup)) nil (let ((selected nil) (number (length articles))) (if (> number gnus-large-newsgroup) (progn (condition-case () (let ((input (read-string (format "How many articles from %s (default %d): " gnus-newsgroup-name number)))) (setq selected (if (string-equal input "") number (string-to-int input)))) (quit (setq selected 0))) (cond ((and (> selected 0) (< selected number)) ;; Select last N articles. (setq articles (nthcdr (- number selected) articles))) ((and (< selected 0) (< (- 0 selected) number)) ;; Select first N articles. (setq selected (- 0 selected)) (setq articles (copy-sequence articles)) (setcdr (nthcdr (1- selected) articles) nil)) ((zerop selected) (setq articles nil)) ;; Otherwise select all. ) ;; Get unselected unread articles. (setq gnus-newsgroup-unselected (gnus-set-difference gnus-newsgroup-unreads articles)) )) )) ;; Get headers list. (setq gnus-newsgroup-headers (gnus-retrieve-headers articles)) ;; UNREADS may contain expired articles, so we have to remove ;; them from the list. (setq gnus-newsgroup-unreads (gnus-intersection gnus-newsgroup-unreads (mapcar (function (lambda (header) (nntp-header-number header))) gnus-newsgroup-headers))) ;; Marked article must be a subset of unread articles. (setq gnus-newsgroup-marked (gnus-intersection (append gnus-newsgroup-unselected gnus-newsgroup-unreads) (cdr (gnus-gethash group gnus-marked-hashtb)))) ;; First and last article in this newsgroup. (setq gnus-newsgroup-begin (if gnus-newsgroup-headers (nntp-header-number (car gnus-newsgroup-headers)) 0 )) (setq gnus-newsgroup-end (if gnus-newsgroup-headers (nntp-header-number (gnus-last-element gnus-newsgroup-headers)) 0 )) ;; File name that an article was saved last. (setq gnus-newsgroup-last-rmail nil) (setq gnus-newsgroup-last-mail nil) (setq gnus-newsgroup-last-folder nil) (setq gnus-newsgroup-last-file nil) ;; Reset article pointer etc. (setq gnus-current-article nil) (setq gnus-current-headers nil) (setq gnus-current-history nil) (setq gnus-have-all-headers nil) (setq gnus-last-article nil) ;; Clear old hash tables for the variable gnus-newsgroup-headers. (gnus-clear-hashtables-for-newsgroup-headers) ;; GROUP is successfully selected. t ) )) ;; Hacking for making header search much faster. (defun gnus-get-header-by-number (number) "Return a header specified by a NUMBER. If the variable gnus-newsgroup-headers is updated, the hashed table gnus-newsgroup-headers-hashtb-by-number must be set to nil to indicate rehash is necessary." (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)) (defun gnus-get-header-by-id (id) "Return a header specified by an ID. If the variable gnus-newsgroup-headers is updated, the hashed table gnus-newsgroup-headers-hashtb-by-id must be set to nil to indicate rehash is necessary." (or gnus-newsgroup-headers-hashtb-by-id (gnus-make-headers-hashtable-by-id)) (and (stringp id) (gnus-gethash id gnus-newsgroup-headers-hashtb-by-id))) (defun gnus-make-headers-hashtable-by-number () "Make hashtable for the variable gnus-newsgroup-headers by number." (let ((header nil) (headers gnus-newsgroup-headers)) (setq gnus-newsgroup-headers-hashtb-by-number (gnus-make-hashtable (length headers))) (while headers (setq header (car headers)) (gnus-sethash (int-to-string (nntp-header-number header)) header gnus-newsgroup-headers-hashtb-by-number) (setq headers (cdr headers)) ))) (defun gnus-make-headers-hashtable-by-id () "Make hashtable for the variable gnus-newsgroup-headers by id." (let ((header nil) (headers gnus-newsgroup-headers)) (setq gnus-newsgroup-headers-hashtb-by-id (gnus-make-hashtable (length headers))) (while headers (setq header (car headers)) (gnus-sethash (nntp-header-id header) header gnus-newsgroup-headers-hashtb-by-id) (setq headers (cdr headers)) ))) (defun gnus-clear-hashtables-for-newsgroup-headers () "Clear hash tables created for the variable gnus-newsgroup-headers." (setq gnus-newsgroup-headers-hashtb-by-id nil) (setq gnus-newsgroup-headers-hashtb-by-number nil)) (defun gnus-more-header-backward () "Find new header backward." (let ((first (car (nth 2 (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 (car (gnus-retrieve-headers (list artnum))))) header )) (defun gnus-more-header-forward () "Find new header forward." (let ((last (cdr (nth 2 (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 (car (gnus-retrieve-headers (list 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 (nntp-header-number header))) (setq gnus-newsgroup-headers (if backward (cons header gnus-newsgroup-headers) (append gnus-newsgroup-headers (list header)))) ;; Clear current hash tables for the variable gnus-newsgroup-headers. (gnus-clear-hashtables-for-newsgroup-headers) ;; We have to update unreads and unselected, but don't have to ;; care about gnus-newsgroup-marked. (if (memq artnum gnus-newsgroup-unselected) (setq gnus-newsgroup-unreads (cons artnum gnus-newsgroup-unreads))) (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-mark-article-as-read (article) "Remember that ARTICLE is marked as read." ;; Remove from unread and marked list. (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))) (defun gnus-mark-article-as-unread (article &optional clear-mark) "Remember that ARTICLE is marked as unread. Optional argument CLEAR-MARK means ARTICLE should not be remembered that it was marked as read once." ;; Add to unread list. (or (memq article gnus-newsgroup-unreads) (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads))) ;; If CLEAR-MARK is non-nil, the article must be removed from marked ;; list. Otherwise, it must be added to the list. (if clear-mark (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (or (memq article gnus-newsgroup-marked) (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked))))) (defun gnus-clear-system () "Clear all variables and buffer." ;; Clear GNUS variables. (let ((variables gnus-variable-list)) (while variables (set (car variables) nil) (setq variables (cdr variables)))) ;; Clear other internal variables. (setq gnus-newsrc-hashtb nil) (setq gnus-marked-hashtb nil) (setq gnus-killed-hashtb nil) (setq gnus-active-hashtb nil) (setq gnus-octive-hashtb nil) (setq gnus-unread-hashtb nil) (setq gnus-newsgroup-headers nil) (setq gnus-newsgroup-headers-hashtb-by-id nil) (setq gnus-newsgroup-headers-hashtb-by-number 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))) (setq gnus-current-startup-file nil) ;; Kill GNUS buffers. (let ((buffers gnus-buffer-list)) (while buffers (if (get-buffer (car buffers)) (kill-buffer (car buffers))) (setq buffers (cdr buffers)) ))) (defun gnus-configure-windows (action) "Configure GNUS windows according to the next ACTION. The ACTION is either a symbol, such as `summary', or a configuration list such as `(1 1 2)'. If ACTION is not a list, configuration list is got from the variable gnus-window-configuration." (let* ((windows (if (listp action) action (car (cdr (assq action gnus-window-configuration))))) (grpwin (get-buffer-window gnus-group-buffer)) (subwin (get-buffer-window gnus-summary-buffer)) (artwin (get-buffer-window gnus-article-buffer)) (winsum nil) (height nil) (grpheight 0) (subheight 0) (artheight 0)) (if (or (null windows) ;No configuration is specified. (and (eq (null grpwin) (zerop (nth 0 windows))) (eq (null subwin) (zerop (nth 1 windows))) (eq (null artwin) (zerop (nth 2 windows))))) ;; No need to change window configuration. nil (select-window (or grpwin subwin artwin (selected-window))) ;; First of all, compute the height of each window. (cond (gnus-use-full-window ;; Take up the entire screen. (delete-other-windows) (setq height (window-height (selected-window)))) (t (setq height (+ (if grpwin (window-height grpwin) 0) (if subwin (window-height subwin) 0) (if artwin (window-height artwin) 0))))) ;; The Newsgroup buffer exits always. So, use it to extend the ;; Group window so as to get enough window space. (switch-to-buffer gnus-group-buffer 'norecord) (and (get-buffer gnus-summary-buffer) (delete-windows-on gnus-summary-buffer)) (and (get-buffer gnus-article-buffer) (delete-windows-on gnus-article-buffer)) ;; Compute expected window height. (setq winsum (apply (function +) windows)) (if (not (zerop (nth 0 windows))) (setq grpheight (max window-min-height (/ (* height (nth 0 windows)) winsum)))) (if (not (zerop (nth 1 windows))) (setq subheight (max window-min-height (/ (* height (nth 1 windows)) winsum)))) (if (not (zerop (nth 2 windows))) (setq artheight (max window-min-height (/ (* height (nth 2 windows)) winsum)))) (setq height (+ grpheight subheight artheight)) (enlarge-window (max 0 (- height (window-height (selected-window))))) ;; Then split the window. (and (not (zerop artheight)) (or (not (zerop grpheight)) (not (zerop subheight))) (split-window-vertically (+ grpheight subheight))) (and (not (zerop grpheight)) (not (zerop subheight)) (split-window-vertically grpheight)) ;; Then select buffers in each window. (and (not (zerop grpheight)) (progn (switch-to-buffer gnus-group-buffer 'norecord) (other-window 1))) (and (not (zerop subheight)) (progn (switch-to-buffer gnus-summary-buffer 'norecord) (other-window 1))) (and (not (zerop artheight)) (progn ;; If Article buffer does not exist, it will be created ;; and initialized. (gnus-article-setup-buffer) (switch-to-buffer gnus-article-buffer 'norecord))) ) )) (defun gnus-find-header-by-number (headers number) "Return a header which is a element of HEADERS and has NUMBER." (let ((found nil)) (while (and headers (not found)) ;; We cannot use `=' to accept non-numeric NUMBER. (if (eq number (nntp-header-number (car headers))) (setq found (car headers))) (setq headers (cdr headers))) found )) (defun gnus-find-header-by-id (headers id) "Return a header which is a element of HEADERS and has Message-ID." (let ((found nil)) (while (and headers (not found)) (if (string-equal id (nntp-header-id (car headers))) (setq found (car headers))) (setq headers (cdr headers))) found )) (defun gnus-version () "Version numbers of this version of GNUS." (interactive) (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version)) (message "%s; %s; %s; %s" gnus-version nntp-version nnspool-version mhspool-version)) ((boundp 'mhspool-version) (message "%s; %s; %s" gnus-version nntp-version mhspool-version)) ((boundp 'nnspool-version) (message "%s; %s; %s" gnus-version nntp-version nnspool-version)) (t (message "%s; %s" gnus-version nntp-version)))) (defun gnus-info-find-node () "Find Info documentation of GNUS." (interactive) (require 'info) ;; Enlarge info window if needed. (cond ((eq major-mode 'gnus-group-mode) (gnus-configure-windows '(1 0 0)) ;Take all windows. (pop-to-buffer gnus-group-buffer)) ((eq major-mode 'gnus-summary-mode) (gnus-configure-windows '(0 1 0)) ;Take all windows. (pop-to-buffer gnus-summary-buffer))) (Info-goto-node (car (cdr (assq major-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-make-threads (newsgroup-headers) "Make conversation threads tree from NEWSGROUP-HEADERS." (let ((headers newsgroup-headers) (refer nil) (h nil) (d nil) (roots nil) (dependencies nil)) ;; Make message dependency alist. (while headers (setq h (car headers)) (setq headers (cdr headers)) ;; Ignore invalid headers. (if (vectorp h) ;Depends on nntp.el. (progn ;; Ignore broken references, e.g "<123@a.b.c". (setq refer (nntp-header-references h)) (setq d (and refer (string-match "\\(<[^<>]+>\\)[^>]*$" refer) ;; (gnus-find-header-by-id ;; newsgroup-headers ;; (substring refer (match-beginning 1) (match-end 1))) ;; In fact if the variable newsgroup-headers ;; is not 'equal' to the variable ;; gnus-newsgroup-headers, the following ;; function call may return bogus value. (gnus-get-header-by-id (substring refer (match-beginning 1) (match-end 1))) )) ;; Check subject equality. (or gnus-thread-ignore-subject (null d) (string-equal (gnus-simplify-subject (nntp-header-subject h) 're) (gnus-simplify-subject (nntp-header-subject d) 're)) ;; H should be a thread root. (setq d nil)) ;; H depends on D. (setq dependencies (cons (cons h d) dependencies)) ;; H is a thread root. (if (null d) (setq roots (cons h roots))) )) ) ;; Make complete threads from the roots. ;; Note: dependencies are in reverse order, but ;; gnus-make-threads-1 processes it in reverse order again. So, ;; we don't have to worry about it. (mapcar (function (lambda (root) (gnus-make-threads-1 root dependencies))) (nreverse roots)) )) (defun gnus-make-threads-1 (parent dependencies) (let ((children nil) (d nil) (depends dependencies)) ;; Find children. (while depends (setq d (car depends)) (setq depends (cdr depends)) (and (cdr d) (eq (nntp-header-id parent) (nntp-header-id (cdr d))) (setq children (cons (car d) children)))) ;; Go down. (cons parent (mapcar (function (lambda (child) (gnus-make-threads-1 child dependencies))) children)) )) (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))) )) ;; Create hash table for alist, such as gnus-newsrc-assoc, ;; gnus-killed-assoc, and gnus-marked-assoc. (defun gnus-make-hashtable-from-alist (alist &optional hashsize) "Return hash table for ALIST. Optional argument HASHSIZE specifies the hashtable size. Hash key is a car of alist element, which must be a string." (let ((hashtb (gnus-make-hashtable (or hashsize (length alist))))) (while alist (gnus-sethash (car (car alist)) ;Newsgroup name (car alist) ;Alist element hashtb) (setq alist (cdr alist))) hashtb )) (defun gnus-last-element (list) "Return last element of LIST." (let ((last nil)) (while list (if (null (cdr list)) (setq last (car list))) (setq list (cdr list))) last )) (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-intersection (list1 list2) "Return a list of elements that appear in both LIST1 and LIST2." (let ((result nil)) (while list2 (if (memq (car list2) list1) (setq result (cons (car list2) result))) (setq list2 (cdr list2))) result )) ;;; ;;; Get information about active articles, already read articles, and ;;; still unread articles. ;;; ;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc: ;; (("general" t (1 . 1)) ;; ("misc" t (1 . 10) (12 . 15)) ;; ("test" nil (1 . 99)) ...) ;; GNUS internal format of gnus-marked-assoc: ;; (("general" 1 2 3) ;; ("misc" 2) ...) ;; GNUS internal format of gnus-active-hashtb: ;; (("general" t (1 . 1)) ;; ("misc" t (1 . 10)) ;; ("test" nil (1 . 99)) ...) ;; GNUS internal format of gnus-unread-hashtb: ;; (("general" 1 (1 . 1)) ;; ("misc" 14 (1 . 10) (12 . 15)) ;; ("test" 99 (1 . 99)) ...) (defun gnus-setup-news (&optional rawfile) "Setup news information. If optional argument RAWFILE is non-nil, force to read raw startup file." (let ((init (not (and gnus-newsrc-assoc gnus-active-hashtb gnus-unread-hashtb (not rawfile) )))) ;; We have to clear some variables to re-initialize news info. (if init (setq gnus-newsrc-assoc nil gnus-active-hashtb nil gnus-unread-hashtb nil)) (gnus-read-active-file) ;; Initialize only once. (if init (progn ;; Get distributions only once. (gnus-read-distributions-file) ;; newsrc file must be read after reading active file since ;; its size is used to guess the size of gnus-newsrc-hashtb. (gnus-read-newsrc-file rawfile) )) (gnus-expire-marked-articles) (gnus-get-unread-articles) ;; Check new newsgroups and subscribe them. (if init (let ((new-newsgroups (gnus-find-new-newsgroups))) (while new-newsgroups (funcall gnus-subscribe-newsgroup-method (car new-newsgroups)) (setq new-newsgroups (cdr new-newsgroups)) ))) )) (defun gnus-add-newsgroup (newsgroup) "Subscribe new NEWSGROUP safely and put it at top." (and (null (gnus-gethash newsgroup gnus-newsrc-hashtb)) ;Really new? (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist? (gnus-insert-newsgroup (or (gnus-gethash newsgroup gnus-killed-hashtb) (list newsgroup t)) (car (car gnus-newsrc-assoc))))) (defun gnus-find-new-newsgroups () "Looking for new newsgroups and return names. `-n' option of options line in .newsrc file is recognized." (let ((group nil) (new-newsgroups nil)) (mapatoms (function (lambda (sym) (setq group (symbol-name sym)) ;; Taking account of `-n' option. (and (or (null gnus-newsrc-options-n-no) (not (string-match gnus-newsrc-options-n-no group)) (and gnus-newsrc-options-n-yes (string-match gnus-newsrc-options-n-yes group))) (null (gnus-gethash group gnus-killed-hashtb)) ;Ignore killed. (null (gnus-gethash group gnus-newsrc-hashtb)) ;Really new. ;; Find new newsgroup. (setq new-newsgroups (cons group new-newsgroups))) )) gnus-active-hashtb) ;; Return new newsgroups. new-newsgroups )) (defun gnus-kill-newsgroup (group) "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb." (let ((info (gnus-gethash group gnus-newsrc-hashtb))) (if (null info) nil ;; Delete from gnus-newsrc-assoc and gnus-newsrc-hashtb. (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc)) (gnus-sethash group nil gnus-newsrc-hashtb) ;; Add to gnus-killed-assoc and gnus-killed-hashtb. (setq gnus-killed-assoc (cons info (delq (gnus-gethash group gnus-killed-hashtb) gnus-killed-assoc))) (gnus-sethash group info gnus-killed-hashtb) ;; Clear unread hashtable. ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty). (gnus-sethash group nil gnus-unread-hashtb) ;; Then delete from .newsrc (gnus-update-newsrc-buffer group 'delete) ;; Return the deleted newsrc entry. info ))) (defun gnus-insert-newsgroup (info &optional next) "Insert newsrc INFO entry before NEXT. If optional argument NEXT is nil, appended to the last." (if (null info) (error "Invalid argument: %s" info)) (let* ((group (car info)) ;Newsgroup name. (range (gnus-difference-of-range (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info)))) ;; Check duplication. (if (gnus-gethash group gnus-newsrc-hashtb) (error "Duplicated: %s" group)) ;; Insert to gnus-newsrc-assoc and gnus-newsrc-hashtb. (if (string-equal next (car (car gnus-newsrc-assoc))) (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc)) (let ((found nil) (rest (cdr gnus-newsrc-assoc)) (tail gnus-newsrc-assoc)) ;; Seach insertion point. (while (and (not found) rest) (if (string-equal next (car (car rest))) (setq found t) (setq rest (cdr rest)) (setq tail (cdr tail)) )) ;; Find it. (if (consp tail) (setcdr tail (cons info rest)) ;; gnus-newsrc-assoc must be nil. (setq gnus-newsrc-assoc (append gnus-newsrc-assoc (cons info rest)))) )) (gnus-sethash group info gnus-newsrc-hashtb) ;; Delete from gnus-killed-assoc and gnus-killed-hashtb. (setq gnus-killed-assoc (delq (gnus-gethash group gnus-killed-hashtb) gnus-killed-assoc)) (gnus-sethash group nil gnus-killed-hashtb) ;; Then insert to .newsrc. (gnus-update-newsrc-buffer group nil next) ;; Add to gnus-unread-hashtb. (gnus-sethash group (cons group ;Newsgroup name. (cons (gnus-number-of-articles range) range)) gnus-unread-hashtb) )) (defun gnus-check-killed-newsgroups () "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc. gnus-killed-hashtb is also updated." (let ((group nil) (new-killed nil) (old-killed gnus-killed-assoc)) (while old-killed (setq group (car (car old-killed))) (and (or (null gnus-newsrc-options-n-no) (not (string-match gnus-newsrc-options-n-no group)) (and gnus-newsrc-options-n-yes (string-match gnus-newsrc-options-n-yes group))) (null (gnus-gethash group gnus-newsrc-hashtb)) ;No duplication. ;; Subscribed in options line and not in gnus-newsrc-assoc. (setq new-killed (cons (car old-killed) new-killed))) (setq old-killed (cdr old-killed)) ) (setq gnus-killed-assoc (nreverse new-killed)) (setq gnus-killed-hashtb (gnus-make-hashtable-from-alist gnus-killed-assoc)) )) (defun gnus-check-bogus-newsgroups (&optional confirm) "Delete bogus newsgroups. If optional argument CONFIRM is non-nil, confirm deletion of newsgroups." (let ((group nil) ;Newsgroup name temporary used. (old-newsrc gnus-newsrc-assoc) (new-newsrc nil) (bogus nil) ;List of bogus newsgroups. (old-killed gnus-killed-assoc) (new-killed nil) (old-marked gnus-marked-assoc) (new-marked nil)) (message "Checking bogus newsgroups...") ;; Update gnus-newsrc-assoc and gnus-newsrc-hashtb. (while old-newsrc (setq group (car (car old-newsrc))) (if (or (gnus-gethash group gnus-active-hashtb) (and confirm (not (y-or-n-p (format "Delete bogus newsgroup: %s " group))))) ;; Active newsgroup. (setq new-newsrc (cons (car old-newsrc) new-newsrc)) ;; Found a bogus newsgroup. (setq bogus (cons group bogus))) (setq old-newsrc (cdr old-newsrc)) ) (setq gnus-newsrc-assoc (nreverse new-newsrc)) (setq gnus-newsrc-hashtb (gnus-make-hashtable-from-alist gnus-newsrc-assoc)) ;; Update gnus-killed-assoc and gnus-killed-hashtb. ;; The killed newsgroups are deleted without any confirmations. (while old-killed (setq group (car (car old-killed))) (and (gnus-gethash group gnus-active-hashtb) (null (gnus-gethash group gnus-newsrc-hashtb)) ;; Active and really killed newsgroup. (setq new-killed (cons (car old-killed) new-killed))) (setq old-killed (cdr old-killed)) ) (setq gnus-killed-assoc (nreverse new-killed)) (setq gnus-killed-hashtb (gnus-make-hashtable-from-alist gnus-killed-assoc)) ;; Remove BOGUS from .newsrc file. (while bogus (gnus-update-newsrc-buffer (car bogus) 'delete) (setq bogus (cdr bogus))) ;; Update gnus-marked-assoc and gnus-marked-hashtb. (while old-marked (setq group (car (car old-marked))) (if (and (cdr (car old-marked)) ;Non-empty? (gnus-gethash group gnus-newsrc-hashtb)) ;Not bogus? (setq new-marked (cons (car old-marked) new-marked))) (setq old-marked (cdr old-marked))) (setq gnus-marked-assoc new-marked) (setq gnus-marked-hashtb (gnus-make-hashtable-from-alist gnus-marked-assoc)) (message "Checking bogus newsgroups... done") )) (defun gnus-get-unread-articles () "Compute diffs between active and read articles." (let ((read gnus-newsrc-assoc) (group-info nil) (group-name nil) (active nil) (range nil)) (message "Checking new news...") (or gnus-unread-hashtb (setq gnus-unread-hashtb (gnus-make-hashtable (length gnus-active-hashtb)))) (while read (setq group-info (car read)) ;About one newsgroup (setq group-name (car group-info)) (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb))) (if (and gnus-octive-hashtb ;; Is nothing changed? (equal active (nth 2 (gnus-gethash group-name gnus-octive-hashtb))) ;; Is this newsgroup in the unread hash table? (gnus-gethash group-name gnus-unread-hashtb) ) nil ;Nothing to do. (setq range (gnus-difference-of-range active (nthcdr 2 group-info))) (gnus-sethash group-name (cons group-name ;Group name (cons (gnus-number-of-articles range) range)) ;Range of unread articles gnus-unread-hashtb) ) (setq read (cdr read)) ) (message "Checking new news... done") )) (defun gnus-expire-marked-articles () "Check expired article which is marked as unread." (let ((marked-assoc gnus-marked-assoc) (updated-assoc nil) (marked nil) ;Current marked info. (articles nil) ;List of marked articles. (updated nil) ;List of real marked. (begin nil)) (while marked-assoc (setq marked (car marked-assoc)) (setq articles (cdr marked)) (setq updated nil) (setq begin (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb)))) (while (and begin articles) (if (>= (car articles) begin) ;; This article is still active. (setq updated (cons (car articles) updated))) (setq articles (cdr articles))) (if updated (setq updated-assoc (cons (cons (car marked) updated) updated-assoc))) (setq marked-assoc (cdr marked-assoc))) (setq gnus-marked-assoc updated-assoc) (setq gnus-marked-hashtb (gnus-make-hashtable-from-alist gnus-marked-assoc)) )) (defun gnus-mark-as-read-by-xref (group headers unreads &optional subscribed-only) "Mark articles as read using cross references and return updated newsgroups. Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY." (let ((xref-list nil) (header nil) (xrefs nil) ;One Xref: field info. (xref nil) ;(NEWSGROUP . ARTICLE) (gname nil) ;Newsgroup name (article nil)) ;Article number (while headers (setq header (car headers)) (if (memq (nntp-header-number header) unreads) ;; This article is not yet marked as read. nil (setq xrefs (gnus-parse-xref-field (nntp-header-xref header))) ;; For each cross reference info. in one Xref: field. (while xrefs (setq xref (car xrefs)) (setq gname (car xref)) ;Newsgroup name (setq article (cdr xref)) ;Article number (or (string-equal group gname) ;Ignore current newsgroup. ;; Ignore unsubscribed newsgroup if requested. (and subscribed-only (not (nth 1 (gnus-gethash gname gnus-newsrc-hashtb)))) ;; Ignore article marked as unread. (memq article (cdr (gnus-gethash gname gnus-marked-hashtb))) (let ((group-xref (assoc gname xref-list))) (if group-xref (if (memq article (cdr group-xref)) nil ;Alread marked. (setcdr group-xref (cons article (cdr group-xref)))) ;; Create new assoc entry for GROUP. (setq xref-list (cons (list gname article) xref-list))) )) (setq xrefs (cdr xrefs)) )) (setq headers (cdr headers))) ;; Mark cross referenced articles as read. (gnus-mark-xrefed-as-read xref-list) ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list)) ;; Return list of updated group name. (mapcar (function car) xref-list) )) (defun gnus-parse-xref-field (xref-value) "Parse Xref: field value, and return list of `(group . article-id)'." (let ((xref-list nil) (xref-value (or xref-value ""))) ;; Remove server host name. (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value) (setq xref-value (substring xref-value (match-beginning 1))) (setq xref-value nil)) ;; Process each xref info. (while xref-value (if (string-match "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value) (progn (setq xref-list (cons (cons ;; Group name (substring xref-value (match-beginning 1) (match-end 1)) ;; Article-ID (string-to-int (substring xref-value (match-beginning 2) (match-end 2)))) xref-list)) (setq xref-value (substring xref-value (match-end 2)))) (setq xref-value nil))) ;; Return alist. xref-list )) (defun gnus-mark-xrefed-as-read (xrefs) "Update unread article information using XREFS alist." (let ((group nil) (idlist nil) (unread nil)) (while xrefs (setq group (car (car xrefs))) (setq idlist (cdr (car xrefs))) (setq unread (gnus-uncompress-sequence (nthcdr 2 (gnus-gethash group gnus-unread-hashtb)))) (while idlist (setq unread (delq (car idlist) unread)) (setq idlist (cdr idlist))) (gnus-update-unread-articles group unread 'ignore) (setq xrefs (cdr xrefs)) ))) (defun gnus-update-unread-articles (group unread-list marked-list) "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST." (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb))) (unread (gnus-gethash group gnus-unread-hashtb))) (if (or (null active) (null unread)) ;; Ignore unknown newsgroup. nil ;; Update gnus-unread-hashtb. (if unread-list (setcdr (cdr unread) (gnus-compress-sequence unread-list)) ;; All of the articles are read. (setcdr (cdr unread) '((0 . 0)))) ;; Number of unread articles. (setcar (cdr unread) (gnus-number-of-articles (nthcdr 2 unread))) ;; Update gnus-newsrc-assoc. (if (> (car active) 0) ;; Articles from 1 to N are not active. (setq active (cons 1 (cdr active)))) (setcdr (cdr (gnus-gethash group gnus-newsrc-hashtb)) (gnus-difference-of-range active (nthcdr 2 unread))) ;; Update .newsrc buffer. (gnus-update-newsrc-buffer group) ;; Update gnus-marked-assoc. (if (listp marked-list) ;Includes NIL. (let ((marked (gnus-gethash group gnus-marked-hashtb))) (cond (marked ;There is an entry. (setcdr marked marked-list)) (marked-list ;Non-NIL. (let ((info (cons group marked-list))) ;; hashtb must share the same cons cell. (setq gnus-marked-assoc (cons info gnus-marked-assoc)) (gnus-sethash group info gnus-marked-hashtb) )) ))) ))) (defun gnus-read-active-file () "Get active file from NNTP server." ;; Make sure a connection to NNTP server is alive. (gnus-start-news-server) (message "Reading active file...") (if (gnus-request-list) ;Get active file from server (save-excursion (set-buffer nntp-server-buffer) (gnus-active-to-gnus-format) (message "Reading active file... done")) (error "Cannot read active file from NNTP server."))) (defun gnus-active-to-gnus-format () "Convert active file format to internal format. Lines matching gnus-ignored-newsgroups are ignored." ;; Delete unnecessary lines. (goto-char (point-min)) ;;(delete-matching-lines "^to\\..*$") (delete-matching-lines gnus-ignored-newsgroups) ;; Save OLD active info. (setq gnus-octive-hashtb gnus-active-hashtb) ;; Make large enough hash table. (setq gnus-active-hashtb (gnus-make-hashtable (count-lines (point-min) (point-max)))) ;; Store active file in hashtable. (goto-char (point-min)) (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$" nil t) (gnus-sethash (buffer-substring (match-beginning 1) (match-end 1)) (list (buffer-substring (match-beginning 1) (match-end 1)) (string-equal "y" (buffer-substring (match-beginning 4) (match-end 4))) (cons (string-to-int (buffer-substring (match-beginning 3) (match-end 3))) (string-to-int (buffer-substring (match-beginning 2) (match-end 2))))) gnus-active-hashtb) )) (defun gnus-read-newsrc-file (&optional rawfile) "Read startup FILE. If optional argument RAWFILE is non-nil, the raw startup file is read." (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file)) ;; Reset variables which may be included in the quick startup 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")) (quick-loaded nil)) (save-excursion ;; Prepare .newsrc buffer. (set-buffer (find-file-noselect newsrc-file)) ;; It is not so good idea turning off undo. ;;(buffer-flush-undo (current-buffer)) ;; Load quick .newsrc to restore gnus-marked-assoc and ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date. (condition-case nil (progn (setq quick-loaded (load quick-file t t t)) ;; Recreate hashtables. (setq gnus-killed-hashtb (gnus-make-hashtable-from-alist gnus-killed-assoc)) (setq gnus-marked-hashtb (gnus-make-hashtable-from-alist gnus-marked-assoc)) ) (error nil)) (cond ((and (not rawfile) ;Not forced to read the raw file. ;; .newsrc.el is newer than .newsrc. ;; Do it this way in case timestamps are identical ;; (on fast machines/disks). (not (file-newer-than-file-p newsrc-file quick-file)) quick-loaded gnus-newsrc-assoc ;Really loaded? ) ;; We don't have to read the raw startup file. ;; gnus-newsrc-assoc may be defined in the quick startup file. ;; So, we have to define the hashtable here. (setq gnus-newsrc-hashtb (gnus-make-hashtable-from-alist gnus-newsrc-assoc))) (t ;; Since .newsrc file is newer than quick file, read it. (message "Reading %s..." newsrc-file) (gnus-newsrc-to-gnus-format) (gnus-check-killed-newsgroups) (message "Reading %s... Done" newsrc-file))) ))) (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 "-" gnus-nntp-server))) (if (file-exists-p real-file) real-file file) )) (defun gnus-newsrc-to-gnus-format () "Parse current buffer as .newsrc file." (let ((newsgroup nil) (subscribe nil) (ranges nil) (subrange nil) (read-list nil)) ;; We have to re-initialize these variable (except for ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup ;; file may contain bogus values. (setq gnus-newsrc-options nil) (setq gnus-newsrc-options-n-yes nil) (setq gnus-newsrc-options-n-no nil) (setq gnus-newsrc-assoc nil) ;; Make large enough hash table. (setq gnus-newsrc-hashtb (gnus-make-hashtable (max (length gnus-active-hashtb) (count-lines (point-min) (point-max))))) ;; Save options line to variable. ;; Lines beginning with white spaces are treated as continuation ;; line. Refer man page of newsrc(5). (goto-char (point-min)) (if (re-search-forward "^[ \t]*options[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)[ \t]*$" nil t) (progn ;; Save entire options line. (setq gnus-newsrc-options (buffer-substring (match-beginning 1) (match-end 1))) ;; Compile "-n" option. (if (string-match "\\(^\\|[ \t\n]\\)-n" gnus-newsrc-options) (let ((yes-and-no (gnus-parse-n-options (substring gnus-newsrc-options (match-end 0))))) (setq gnus-newsrc-options-n-yes (car yes-and-no)) (setq gnus-newsrc-options-n-no (cdr yes-and-no)) )) )) ;; Parse body of .newsrc file ;; Options line continuation lines must be also considered here. ;; Before supporting continuation lines, " newsgroup ! 1-5" was ;; okay, but now it is invalid. It should be "newsgroup! 1-5". (goto-char (point-min)) ;; Due to overflows in regex.c, change the following regexp: ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$" ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem) ;; but no longer viable because of extensive backtracking in Emacs 19: ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" ;; but, the following causes trouble on some case: ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\|[^ \t\n].*\\)$" (while (re-search-forward (if (= gnus-emacs-version 18) "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$") nil t) (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1))) ;; Check duplications of newsgroups. ;; Note: Checking the duplications takes very long time. (if (gnus-gethash newsgroup gnus-newsrc-hashtb) (message "Ignore duplicated newsgroup: %s" newsgroup) (setq subscribe (string-equal ":" (buffer-substring (match-beginning 2) (match-end 2)))) (setq ranges (buffer-substring (match-beginning 3) (match-end 3))) (setq read-list nil) (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges) (setq subrange (substring ranges (match-beginning 1) (match-end 1))) (setq ranges (substring ranges (match-end 1))) (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange) (setq read-list (cons (cons (string-to-int (substring subrange (match-beginning 1) (match-end 1))) (string-to-int (substring subrange (match-beginning 2) (match-end 2)))) read-list))) ((string-match "^[0-9]+$" subrange) (setq read-list (cons (cons (string-to-int subrange) (string-to-int subrange)) read-list))) (t (ding) (message "Ignoring bogus lines of %s" newsgroup) (sit-for 0)) )) (setq gnus-newsrc-assoc (cons (cons newsgroup (cons subscribe (nreverse read-list))) gnus-newsrc-assoc)) ;; Update gnus-newsrc-hashtb one by one. (gnus-sethash newsgroup (car gnus-newsrc-assoc) gnus-newsrc-hashtb) )) (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc)) )) (defun gnus-parse-n-options (options) "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps." (let ((yes nil) (no nil) (yes-or-no nil) ;`!' or not. (newsgroup nil)) ;; Parse each newsgroup description such as "comp.all". Commas ;; and white spaces can be a newsgroup separator. (while (string-match "^[ \t\n,]*\\(!?\\)\\([^--- \t\n,][^ \t\n,]*\\)" options) (setq yes-or-no (substring options (match-beginning 1) (match-end 1))) (setq newsgroup (regexp-quote (substring options (match-beginning 2) (match-end 2)))) (setq options (substring options (match-end 2))) ;; Rewrite "all" to ".+" not ".*". ".+" requires at least one ;; character. (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup) (setq newsgroup (concat (substring newsgroup 0 (match-end 1)) ".+" (substring newsgroup (match-beginning 2))))) ;; It is yes or no. (cond ((string-equal yes-or-no "!") (setq no (cons newsgroup no))) ((string-equal newsgroup ".+")) ;Ignore `all'. (t (setq yes (cons newsgroup yes)))) ) ;; Make a cons of regexps from parsing result. ;; We have to append \(\.\|$\) to prevent matching substring of ;; newsgroup. For example, "jp.net" should not match with ;; "jp.network". ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp. (cons (if yes (concat "^\\(" (apply (function concat) (mapcar (function (lambda (newsgroup) (concat newsgroup "\\|"))) (cdr yes))) (car yes) "\\)\\(\\.\\|$\\)")) (if no (concat "^\\(" (apply (function concat) (mapcar (function (lambda (newsgroup) (concat newsgroup "\\|"))) (cdr no))) (car no) "\\)\\(\\.\\|$\\)"))) )) (defun gnus-save-newsrc-file () "Save to .newsrc FILE." ;; Note: We cannot save .newsrc file if all newsgroups are removed ;; from the variable gnus-newsrc-assoc. (and (or gnus-newsrc-assoc gnus-killed-assoc) gnus-current-startup-file (save-excursion ;; A buffer containing .newsrc file may be deleted. (set-buffer (find-file-noselect gnus-current-startup-file)) (if (not (buffer-modified-p)) (message "(No changes need to be saved)") (message "Saving %s..." gnus-current-startup-file) (let ((make-backup-files t) (version-control nil) (require-final-newline t)) ;Don't ask even if requested. ;; Make backup file of master newsrc. ;; You can stop or change version control of backup file. ;; Suggested by jason@violet.berkeley.edu. (run-hooks 'gnus-save-newsrc-hook) (save-buffer)) ;; Quickly loadable .newsrc. (set-buffer (get-buffer-create " *GNUS-newsrc*")) (buffer-flush-undo (current-buffer)) (erase-buffer) (gnus-gnus-to-quick-newsrc-format) (let ((make-backup-files nil) (version-control nil) (require-final-newline t)) ;Don't ask even if requested. (write-file (concat gnus-current-startup-file ".el"))) (kill-buffer (current-buffer)) (message "Saving %s... Done" gnus-current-startup-file) )) )) (defun gnus-update-newsrc-buffer (group &optional delete next) "Incrementally update .newsrc buffer about GROUP. If optional 1st argument DELETE is non-nil, delete the group. If optional 2nd argument NEXT is non-nil, inserted before it." (save-excursion ;; Taking account of the killed startup file. ;; Suggested by tale@pawl.rpi.edu. (set-buffer (or (get-file-buffer gnus-current-startup-file) (find-file-noselect gnus-current-startup-file))) ;; Options line continuation lines must be also considered here. ;; Before supporting continuation lines, " newsgroup ! 1-5" was ;; okay, but now it is invalid. It should be "newsgroup! 1-5". (let ((deleted nil) (case-fold-search nil) ;Should NOT ignore case. (buffer-read-only nil)) ;May be not modifiable. ;; Delete ALL entries which match for GROUP. (goto-char (point-min)) (while (re-search-forward (concat "^" (regexp-quote group) "[:!]") nil t) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) (setq deleted t) ;Old entry is deleted. ) (if delete nil ;; Insert group entry. (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (if (null newsrc) nil ;; Find insertion point. (cond (deleted nil) ;Insert here. ((and (stringp next) (progn (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote next) "[:!]") nil t))) (beginning-of-line)) (t (goto-char (point-max)) (or (bolp) (insert "\n")))) ;; Insert after options line. (if (looking-at "^[ \t]*options\\([ \t]\\|$\\)") (progn (forward-line 1) ;; Skip continuation lines. (while (and (not (eobp)) (looking-at "^[ \t]+")) (forward-line 1)))) (insert group ;Group name (if (nth 1 newsrc) ": " "! ")) ;Subscribed? (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles (insert "\n") ))) ))) (defun gnus-gnus-to-quick-newsrc-format () "Insert GNUS variables such as gnus-newsrc-assoc in lisp format." (insert ";; GNUS internal format of .newsrc.\n") (insert ";; Touch .newsrc instead if you think to remove this file.\n") (let ((variable nil) (variables gnus-variable-list) ;; Temporary rebind to make changes ;; gnus-check-killed-newsgroups in invisible. (gnus-killed-assoc gnus-killed-assoc) (gnus-killed-hashtb gnus-killed-hashtb)) ;; Remove duplicated or unsubscribed newsgroups in ;; gnus-killed-assoc (and gnus-killed-hashtb). (gnus-check-killed-newsgroups) ;; Then, insert lisp expressions. (while variables (setq variable (car variables)) (and (boundp variable) (symbol-value variable) (insert "(setq " (symbol-name variable) " '" (prin1-to-string (symbol-value variable)) ")\n")) (setq variables (cdr variables))) )) (defun gnus-ranges-to-newsrc-format (ranges) "Insert ranges of read articles." (let ((range nil)) ;Range is a pair of BEGIN and END. (while ranges (setq range (car ranges)) (setq ranges (cdr ranges)) (cond ((= (car range) (cdr range)) (if (= (car range) 0) (setq ranges nil) ;No unread articles. (insert (int-to-string (car range))) (if ranges (insert ",")) )) (t (insert (int-to-string (car range)) "-" (int-to-string (cdr range))) (if ranges (insert ",")) )) ))) (defun gnus-compress-sequence (numbers) "Convert list of sorted numbers to ranges." (let* ((numbers (sort (copy-sequence numbers) (function <))) (first (car numbers)) (last (car numbers)) (result nil)) (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 (cons first last) result)) (setq first (car numbers)) (setq last (car numbers))) ) (setq numbers (cdr numbers)) ) (nreverse (cons (cons first last) result)) )) (defun gnus-uncompress-sequence (ranges) "Expand compressed format of sequence." (let ((first nil) (last nil) (result nil)) (while ranges (setq first (car (car ranges))) (setq last (cdr (car ranges))) (while (< first last) (setq result (cons first result)) (setq first (1+ first))) (setq result (cons first result)) (setq ranges (cdr ranges)) ) (nreverse result) )) (defun gnus-number-of-articles (range) "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'." (let ((count 0)) (while range (if (/= (cdr (car range)) 0) ;; If end1 is 0, it must be skipped. Usually no articles in ;; this group. (setq count (+ count 1 (- (cdr (car range)) (car (car range)))))) (setq range (cdr range)) ) count ;Result )) (defun gnus-difference-of-range (src obj) "Compute (SRC - OBJ) on range. Range of SRC is expressed as `(beg . end)'. Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)." (let ((beg (car src)) (end (cdr src)) (range nil)) ;This is result. ;; Src may be nil. (while (and src obj) (let ((beg1 (car (car obj))) (end1 (cdr (car obj)))) (cond ((> beg end) (setq obj nil)) ;Terminate loop ((< beg beg1) (setq range (cons (cons beg (min (1- beg1) end)) range)) (setq beg (1+ end1))) ((>= beg beg1) (setq beg (max beg (1+ end1)))) ) (setq obj (cdr obj)) ;Next OBJ )) ;; Src may be nil. (if (and src (<= beg end)) (setq range (cons (cons beg end) range))) ;; Result (if range (nreverse range) (list (cons 0 0))) )) (defun gnus-read-distributions-file () "Get distributions file from NNTP server (NNTP2 functionality)." ;; Make sure a connection to NNTP server is alive. (gnus-start-news-server) (message "Reading distributions file...") (setq gnus-distribution-list nil) (if (gnus-request-list-distributions) (save-excursion (set-buffer nntp-server-buffer) (gnus-distributions-to-gnus-format) (message "Reading distributions file... done")) ;; It's not a fatal error. ;;(error "Cannot read distributions file from NNTP server.") ) ;; Merge with user supplied default distributions. (let ((defaults (reverse gnus-local-distributions)) (dist nil)) (while defaults (setq dist (assoc (car defaults) gnus-distribution-list)) (if dist (setq gnus-distribution-list (delq dist gnus-distribution-list))) (setq gnus-distribution-list (cons (list (car defaults)) gnus-distribution-list)) (setq defaults (cdr defaults)) ))) (defun gnus-distributions-to-gnus-format () "Convert distributions file format to internal format." (setq gnus-distribution-list nil) (goto-char (point-min)) (while (re-search-forward "^\\([^ \t\n]+\\).*$" nil t) (setq gnus-distribution-list (cons (list (buffer-substring (match-beginning 1) (match-end 1))) gnus-distribution-list))) (setq gnus-distribution-list (nreverse gnus-distribution-list))) ;; Some older version of GNU Emacs does not support function ;; `file-newer-than-file-p'. (or (fboundp 'file-newer-than-file-p) (defun file-newer-than-file-p (file1 file2) "Return t if file FILE1 is newer than file FILE2. If FILE1 does not exist, the answer is nil; otherwise, if FILE2 does not exist, the answer is t." (let ((mod1 (nth 5 (file-attributes file1))) (mod2 (nth 5 (file-attributes file2)))) (cond ((not (file-exists-p file1)) nil) ((not (file-exists-p file2)) t) ((and mod2 mod1) (or (< (car mod2) (car mod1)) (and (= (car mod2) (car mod1)) (<= (nth 1 mod2) (nth 1 mod1))))) )))) ;;Local variables: ;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) ;;end: ;;; gnus.el ends here emacs-19.22/lisp/gnusmail.el100444 12120 1 16630 5375541630 14247 0ustar rmsdaemon;;; gnusmail.el --- mail reply commands for GNUS newsreader ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. ;; Author: 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: ;; Provides mail reply and mail other window command using usual mail ;; interface and mh-e interface. ;; ;; To use MAIL: set the variables gnus-mail-reply-method and ;; gnus-mail-other-window-method to gnus-mail-reply-using-mail and ;; gnus-mail-other-window-using-mail, respectively. ;; ;; To use MH-E: set the variables gnus-mail-reply-method and ;; gnus-mail-other-window-method to gnus-mail-reply-using-mhe and ;; gnus-mail-other-window-using-mhe, respectively. ;;; Code: (require 'gnus) (autoload 'news-mail-reply "rnewspost") (autoload 'news-mail-other-window "rnewspost") (autoload 'mh-send "mh-e") (autoload 'mh-send-other-window "mh-e") (autoload 'mh-find-path "mh-e") (autoload 'mh-yank-cur-msg "mh-e") ;;; Mail reply commands of GNUS Summary Mode (defun gnus-summary-reply (yank) "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-summary-select-article t t) (switch-to-buffer gnus-article-buffer) (widen) (delete-other-windows) (bury-buffer gnus-article-buffer) (funcall gnus-mail-reply-method yank)) (defun gnus-summary-reply-with-original () "Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer." (interactive) (gnus-summary-reply t)) (defun gnus-summary-mail-forward () "Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer." (interactive) (gnus-summary-select-article) (switch-to-buffer gnus-article-buffer) (widen) (delete-other-windows) (bury-buffer gnus-article-buffer) (funcall gnus-mail-forward-method)) (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-summary-select-article) (switch-to-buffer gnus-article-buffer) (widen) (delete-other-windows) (bury-buffer gnus-article-buffer) (funcall gnus-mail-other-window-method)) ;;; Send mail using sendmail mail mode. (defun gnus-mail-reply-using-mail (&optional yank) "Compose reply mail using mail. Optional argument YANK means yank original article." (news-mail-reply) (gnus-overload-functions) (if yank (let ((last (point))) (goto-char (point-max)) (mail-yank-original nil) (goto-char last) ))) (defun gnus-mail-forward-using-mail () "Forward the current message to another user using mail." ;; This is almost a carbon copy of rmail-forward in rmail.el. (let ((forward-buffer (current-buffer)) (subject (concat "[" gnus-newsgroup-name "] " ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " (or (gnus-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 (if (one-window-p t) (mail nil nil subject) (mail-other-window nil nil subject)) (save-excursion (goto-char (point-max)) (insert "------- Start of forwarded message -------\n") (insert-buffer forward-buffer) (goto-char (point-max)) (insert "------- End of forwarded message -------\n") ;; 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." (news-mail-other-window) (gnus-overload-functions)) ;;; 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). (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." ;; First of all, prepare mhe mail buffer. (let (from cc subject date to reply-to (buffer (current-buffer))) (save-restriction (gnus-article-show-all-headers) ;I don't think this is really needed. (setq from (gnus-fetch-field "from") subject (let ((subject (gnus-fetch-field "subject"))) (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") date (gnus-fetch-field "date")) (setq mh-show-buffer buffer) (setq to (or reply-to from)) (mh-find-path) (mh-send to (or cc "") subject) (save-excursion (mh-insert-fields "In-reply-to:" (concat (substring from 0 (string-match " *at \\| *@ \\| *(\\| *<" from)) "'s message of " date))) (setq mh-sent-from-folder buffer) (setq mh-sent-from-msg 1) )) ;; Then, yank original article if requested. (if yank (let ((last (point))) (mh-yank-cur-msg) (goto-char last) ))) ;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh ;; (defun gnus-mail-forward-using-mhe () "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 (current-buffer)) subject) ;;(gnus-article-show-all-headers) (setq subject (concat "[" gnus-newsgroup-name "] " ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " (or (gnus-fetch-field "subject") ""))) (setq mh-show-buffer buffer) (mh-find-path) (mh-send to (or cc "") subject) (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)))) (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-fetch-field "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))) (provide 'gnusmail) ;;; gnusmail.el ends here emacs-19.22/lisp/gnusmisc.el100444 13437 1 23670 5405344054 14411 0ustar jimbdaemon;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader ;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc. ;; Author: 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. ;;; Code: (require 'gnus) ;;; ;;; GNUS Browse-Killed Mode ;;; ;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath). ;; I'd like to thank him very much. (defvar gnus-browse-killed-mode-hook nil "*A hook for GNUS Browse-Killed Mode.") (defvar gnus-browse-killed-buffer "*Killed Newsgroup*") (defvar gnus-browse-killed-mode-map nil) (defvar gnus-winconf-browse-killed nil) (autoload 'timezone-make-date-arpa-standard "timezone") (put 'gnus-browse-killed-mode 'mode-class 'special) ;;; ;;; GNUS Browse-Killed Mode ;;; ;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath). ;; I'd like to thank him very much. ;; Make the buffer to be managed by GNUS. (or (memq gnus-browse-killed-buffer gnus-buffer-list) (setq gnus-buffer-list (cons gnus-browse-killed-buffer gnus-buffer-list))) (if gnus-browse-killed-mode-map nil (setq gnus-browse-killed-mode-map (make-keymap)) (suppress-keymap gnus-browse-killed-mode-map t) (define-key gnus-browse-killed-mode-map " " 'gnus-group-next-group) (define-key gnus-browse-killed-mode-map "\177" 'gnus-group-prev-group) (define-key gnus-browse-killed-mode-map "\C-n" 'gnus-group-next-group) (define-key gnus-browse-killed-mode-map "\C-p" 'gnus-group-prev-group) (define-key gnus-browse-killed-mode-map "n" 'gnus-group-next-group) (define-key gnus-browse-killed-mode-map "p" 'gnus-group-prev-group) (define-key gnus-browse-killed-mode-map "y" 'gnus-browse-killed-yank) (define-key gnus-browse-killed-mode-map "\C-y" 'gnus-browse-killed-yank) (define-key gnus-browse-killed-mode-map "l" 'gnus-list-killed-groups) (define-key gnus-browse-killed-mode-map "q" 'gnus-browse-killed-exit) (define-key gnus-browse-killed-mode-map "\C-c\C-c" 'gnus-browse-killed-exit) (define-key gnus-browse-killed-mode-map "\C-c\C-i" 'gnus-info-find-node)) (defun gnus-browse-killed-mode () "Major mode for browsing the killed newsgroups. All normal editing commands are turned off. Instead, these commands are available: \\{gnus-browse-killed-mode-map} The killed newsgroups are saved in the quick startup file (.newsrc.el) unless it against the options line in the startup file (.newsrc). Entry to this mode calls gnus-browse-killed-mode-hook with no arguments, if that value is non-nil." (interactive) (kill-all-local-variables) ;; Gee. Why don't you upgrade? (cond ((boundp 'mode-line-modified) (setq mode-line-modified "--- ")) ((listp (default-value 'mode-line-format)) (setq mode-line-format (cons "--- " (cdr (default-value 'mode-line-format))))) (t (setq mode-line-format "--- GNUS: Killed Newsgroups %[(%m)%]----%3p-%-"))) (setq major-mode 'gnus-browse-killed-mode) (setq mode-name "Browse-Killed") (setq mode-line-buffer-identification "GNUS: Killed Newsgroups") (use-local-map gnus-browse-killed-mode-map) (buffer-flush-undo (current-buffer)) (setq buffer-read-only t) ;Disable modification (run-hooks 'gnus-browse-killed-mode-hook)) (defun gnus-list-killed-groups () "List the killed newsgroups. The keys y and C-y yank the newsgroup on the current line into the Newsgroups buffer." (interactive) (or gnus-killed-assoc (error "No killed newsgroups")) ;; Save current window configuration if this is first invocation.. (or (get-buffer-window gnus-browse-killed-buffer) (setq gnus-winconf-browse-killed (current-window-configuration))) ;; Prepare browsing buffer. (pop-to-buffer (get-buffer-create gnus-browse-killed-buffer)) (gnus-browse-killed-mode) (let ((buffer-read-only nil) (killed-assoc gnus-killed-assoc)) (erase-buffer) (while killed-assoc (insert (gnus-group-prepare-line (car killed-assoc))) (setq killed-assoc (cdr killed-assoc))) (goto-char (point-min)) )) (defun gnus-browse-killed-yank () "Yank current newsgroup to Newsgroup buffer." (interactive) (let ((group (gnus-group-group-name))) (if group (let* ((buffer-read-only nil) (killed (gnus-gethash group gnus-killed-hashtb))) (pop-to-buffer gnus-group-buffer) ;Needed to adjust point. (if killed (gnus-group-insert-group killed)) (pop-to-buffer gnus-browse-killed-buffer) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) ))) (gnus-browse-killed-check-buffer)) (defun gnus-browse-killed-check-buffer () "Exit if the buffer is empty by deleting the window and killing the buffer." (and (null gnus-killed-assoc) (get-buffer gnus-browse-killed-buffer) (gnus-browse-killed-exit))) (defun gnus-browse-killed-exit () "Exit this mode by deleting the window and killing the buffer." (interactive) (and (get-buffer-window gnus-browse-killed-buffer) (delete-window (get-buffer-window gnus-browse-killed-buffer))) (kill-buffer gnus-browse-killed-buffer) ;; Restore previous window configuration if available. (and gnus-winconf-browse-killed (set-window-configuration gnus-winconf-browse-killed)) (setq gnus-winconf-browse-killed nil)) ;;; ;;; kill/yank newsgroup commands of GNUS Group Mode ;;; (defun gnus-group-transpose-groups (arg) "Exchange current newsgroup and previous newsgroup. With argument ARG, takes previous newsgroup and moves it past ARG newsgroup." (interactive "p") ;; BUG: last newsgroup and the last but one cannot be transposed ;; since gnus-group-search-forward does not move forward beyond the ;; last. If we instead use forward-line, no problem, but I don't ;; want to use it for later extension. (while (> arg 0) (gnus-group-search-forward t t) (gnus-group-kill-group 1) (gnus-group-search-forward nil t) (gnus-group-yank-group) (gnus-group-search-forward nil t) (setq arg (1- arg)) )) (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 ;; Exclude a line where current point is on. (1- ;; Count lines. (save-excursion (count-lines (progn (goto-char begin) (beginning-of-line) (point)) (progn (goto-char end) (end-of-line) (point))))))) (goto-char begin) (beginning-of-line) ;Important when LINES < 1 (gnus-group-kill-group lines))) (defun gnus-group-kill-group (n) "Kill newsgroup on current line, repeated prefix argument N times. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." (interactive "p") (let ((buffer-read-only nil) (group nil)) (while (> n 0) (setq group (gnus-group-group-name)) (or group (signal 'end-of-buffer nil)) (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) (gnus-kill-newsgroup group) (setq n (1- n)) ;; Add to killed newsgroups in the buffer if exists. (if (get-buffer gnus-browse-killed-buffer) (save-excursion (set-buffer gnus-browse-killed-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) (insert (gnus-group-prepare-line (car gnus-killed-assoc))) ))) ) (search-forward ":" nil t) )) (defun gnus-group-yank-group () "Yank the last newsgroup killed with \\[gnus-group-kill-group], inserting it before the newsgroup on the line containing point." (interactive) (gnus-group-insert-group (car gnus-killed-assoc)) ;; Remove killed newsgroups from the buffer if exists. (if (get-buffer gnus-browse-killed-buffer) (save-excursion (set-buffer gnus-browse-killed-buffer) (let ((buffer-read-only nil)) (goto-char (point-min)) (delete-region (point-min) (progn (forward-line 1) (point))) ))) (gnus-browse-killed-check-buffer)) (defun gnus-group-insert-group (info) "Insert newsgroup at current line using gnus-newsrc-assoc INFO." (if (null gnus-killed-assoc) (error "No killed newsgroups")) ;; Huuum. It this right? ;;(if (not gnus-have-all-newsgroups) ;; (error ;; (substitute-command-keys ;; "Not all newsgroups are displayed. Type \\[gnus-group-list-all-groups] to display all newsgroups."))) (let ((buffer-read-only nil) (group (gnus-group-group-name))) (gnus-insert-newsgroup info group) (beginning-of-line) (insert (gnus-group-prepare-line info)) (forward-line -1) (search-forward ":" nil t) )) ;;; Rewrite Date: field in GMT to local (defun gnus-gmt-to-local () "Rewrite Date: field described in GMT to local in current buffer. The variable gnus-local-timezone is used for local time zone. 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 (match-beginning 1) (match-end 1)))) (delete-region (match-beginning 1) (match-end 1)) (insert (timezone-make-date-arpa-standard date nil gnus-local-timezone)) )) ))) (provide 'gnusmisc) ;;; gnusmisc.el ends here emacs-19.22/lisp/gnuspost.el100444 12120 1 71054 5474057676 14327 0ustar rmsdaemon;;; gnuspost.el --- post news commands for GNUS newsreader ;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/gnuspost.el,v 1.16 1993/11/22 06:44:12 rms Exp $ ;; 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: (require 'gnus) (defvar gnus-organization-file "/usr/lib/news/organization" "*Local news organization file.") (defvar gnus-post-news-buffer "*post-news*") (defvar gnus-winconf-post-news nil) (autoload 'news-reply-mode "rnewspost") (autoload 'timezone-make-date-arpa-standard "timezone") ;;; Post news commands of GNUS Group Mode and Summary Mode (defun gnus-group-post-news () "Post an article." (interactive) ;; Save window configuration. (setq gnus-winconf-post-news (current-window-configuration)) (unwind-protect (gnus-post-news) (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) (not (zerop (buffer-size)))) ;; Restore last window configuration. (set-window-configuration gnus-winconf-post-news))) ;; We don't want to return to Summary buffer nor Article buffer later. (if (get-buffer gnus-summary-buffer) (bury-buffer gnus-summary-buffer)) (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer))) (defun gnus-summary-post-news () "Post an article." (interactive) (gnus-summary-select-article t nil) ;; Save window configuration. (setq gnus-winconf-post-news (current-window-configuration)) (unwind-protect (progn (switch-to-buffer gnus-article-buffer) (widen) (delete-other-windows) (gnus-post-news)) (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) (not (zerop (buffer-size)))) ;; Restore last window configuration. (set-window-configuration gnus-winconf-post-news))) ;; We don't want to return to Article buffer later. (bury-buffer gnus-article-buffer)) (defun gnus-summary-followup (yank) "Post a reply article. If prefix argument YANK is non-nil, original article is yanked automatically." (interactive "P") (gnus-summary-select-article t nil) ;; 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 (eq gnus-use-followup-to t)) (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? ")))) ;; Mail to the poster. GNUS is now RFC1036 compliant. (gnus-summary-reply yank) ;; Save window configuration. (setq gnus-winconf-post-news (current-window-configuration)) (unwind-protect (progn (switch-to-buffer gnus-article-buffer) (widen) (delete-other-windows) (gnus-news-reply yank)) (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) (not (zerop (buffer-size)))) ;; Restore last window configuration. (set-window-configuration gnus-winconf-post-news))) ;; We don't want to return to Article buffer later. (bury-buffer gnus-article-buffer))) (defun gnus-summary-followup-with-original () "Post a reply article with original article." (interactive) (gnus-summary-followup t)) (defun gnus-summary-cancel-article () "Cancel an article you posted." (interactive) (gnus-summary-select-article t nil) (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))) ;;; Post a News using NNTP ;;;###autoload (fset 'sendnews 'gnus-post-news) ;;;###autoload (fset 'postnews 'gnus-post-news) ;;;###autoload (defun gnus-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 (or (not gnus-novice-user) (y-or-n-p "Are you sure you want to post to all of USENET? ")) (let ((artbuf (current-buffer)) (newsgroups ;Default newsgroup. (if (eq major-mode 'gnus-article-mode) gnus-newsgroup-name)) (subject nil) ;; Get default distribution. (distribution (car gnus-local-distributions))) ;; Connect to NNTP server if not connected yet, and get ;; several information. (if (not (gnus-server-opened)) (progn (gnus-start-news-server t) ;Confirm server. (gnus-setup-news))) ;; Get current article information. (save-restriction (and (not (zerop (buffer-size))) ;;(equal major-mode 'news-mode) (equal major-mode 'gnus-article-mode) (progn ;;(news-show-all-headers) (gnus-article-show-all-headers) (narrow-to-region (point-min) (progn (goto-char (point-min)) (search-forward "\n\n") (point))))) (setq news-reply-yank-from (mail-fetch-field "from")) (setq news-reply-yank-message-id (mail-fetch-field "message-id"))) (pop-to-buffer gnus-post-news-buffer) (news-reply-mode) (gnus-overload-functions) (if (and (buffer-modified-p) (> (buffer-size) 0) (not (y-or-n-p "Unsent article being composed; erase it? "))) ;; Continue composition. ;; Make news-reply-yank-original work on the current article. (setq mail-reply-buffer artbuf) (erase-buffer) (if gnus-interactive-post ;; Newsgroups, subject and distribution are asked for. ;; Suggested by yuki@flab.fujitsu.junet. (progn ;; Subscribed newsgroup names are required for ;; completing read of newsgroup. (or gnus-newsrc-assoc (gnus-read-newsrc-file)) ;; Which do you like? (UMERIN) ;; (setq newsgroups (read-string "Newsgroups: " "general")) (or newsgroups ;Use the default newsgroup. (setq newsgroups (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match newsgroups ;Default newsgroup. ))) (setq subject (read-string "Subject: ")) ;; Choose a distribution from gnus-distribution-list. ;; completing-read should not be used with ;; 'require-match functionality in order to allow use ;; of unknow distribution. (setq distribution (if (consp gnus-distribution-list) (completing-read "Distribution: " gnus-distribution-list nil nil ;Never 'require-match distribution ;Default distribution. ) (read-string "Distribution: "))) ;; Empty string is okay. ;;(if (string-equal distribution "") ;; (setq distribution nil)) )) (news-setup () subject () newsgroups artbuf) ;; Make sure the article is posted by GNUS. ;;(mail-position-on-field "Posting-Software") ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") ;; Insert Distribution: field. ;; Suggested by ichikawa@flab.fujitsu.junet. (mail-position-on-field "Distribution") (insert (or distribution "")) ;; Handle author copy using FCC field. (if gnus-author-copy (progn (mail-position-on-field "FCC") (insert gnus-author-copy))) (if gnus-interactive-post ;; All fields are filled in. (goto-char (point-max)) ;; Move point to Newsgroup: field. (goto-char (point-min)) (end-of-line)) )) (message ""))) (defun gnus-news-reply (&optional yank) "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 (or (not gnus-novice-user) (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 (artbuf (current-buffer))) (save-restriction (and (not (zerop (buffer-size))) ;;(equal major-mode 'news-mode) (equal major-mode 'gnus-article-mode) (progn ;; (news-show-all-headers) (gnus-article-show-all-headers) (narrow-to-region (point-min) (progn (goto-char (point-min)) (search-forward "\n\n") (point))))) (setq from (mail-fetch-field "from")) (setq news-reply-yank-from from) (setq subject (mail-fetch-field "subject")) (setq date (mail-fetch-field "date")) (setq followup-to (mail-fetch-field "followup-to")) ;; Ignore Followup-To: poster. (if (or (null gnus-use-followup-to) ;Ignore followup-to: field. (string-equal "" followup-to) ;Bogus header. (string-equal "poster" followup-to)) (setq followup-to nil)) (setq newsgroups (or followup-to (mail-fetch-field "newsgroups"))) (setq references (mail-fetch-field "references")) (setq distribution (mail-fetch-field "distribution")) (setq message-id (mail-fetch-field "message-id")) (setq news-reply-yank-message-id message-id)) (pop-to-buffer gnus-post-news-buffer) (news-reply-mode) (gnus-overload-functions) (if (and (buffer-modified-p) (> (buffer-size) 0) (not (y-or-n-p "Unsent article being composed; erase it? "))) ;; Continue composition. ;; Make news-reply-yank-original work on current article. (setq mail-reply-buffer artbuf) (erase-buffer) (and subject (setq subject (concat "Re: " (gnus-simplify-subject subject 're-only)))) (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 artbuf) (if followup-to (progn (news-reply-followup-to) (insert followup-to))) ;; Fold long references line to follow RFC1036. (mail-position-on-field "References") (let ((begin (point)) (fill-column 79) (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)))) ;; Make sure the article is posted by GNUS. ;;(mail-position-on-field "Posting-Software") ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") ;; Distribution must be the same as original article. (mail-position-on-field "Distribution") (insert (or distribution "")) ;; Handle author copy using FCC field. (if gnus-author-copy (progn (mail-position-on-field "FCC") (insert gnus-author-copy))) ;; Insert To: FROM field, which is expected to mail the ;; message to the author of the article too. (if (and gnus-auto-mail-to-author from) (progn (goto-char (point-min)) (insert "To: " from "\n"))) (goto-char (point-max))) ;; Yank original article automatically. (if yank (let ((last (point))) ;;(goto-char (point-max)) ;; Insert at current point. (news-reply-yank-original nil) (goto-char last))) ) (message ""))) (defun gnus-inews-news () "Send a news message." (interactive) (let* ((case-fold-search nil) (server-running (gnus-server-opened))) (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) ;; Mail the message too if To: or Cc: exists. (if (save-restriction (narrow-to-region (point-min) (progn (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n")) (point))) (or (mail-fetch-field "to" nil t) (mail-fetch-field "cc" nil t))) (if gnus-mail-send-method (progn (message "Sending via mail...") (funcall gnus-mail-send-method) (message "Sending via mail... done")) (ding) (message "No mailer defined. To: and/or Cc: fields ignored.") (sit-for 1))) ;; Send to NNTP server. (message "Posting to USENET...") (if (gnus-inews-article) (message "Posting to USENET... done") ;; We cannot signal an error. (ding) (message "Article rejected: %s" (gnus-status-message))) (set-buffer-modified-p nil)) ;; If NNTP server is opened by gnus-inews-news, close it by myself. (or server-running (gnus-close-server)) (and (fboundp 'bury-buffer) (bury-buffer)) ;; Restore last window configuration. (and gnus-winconf-post-news (set-window-configuration gnus-winconf-post-news)) (setq gnus-winconf-post-news nil) )) (defun gnus-cancel-news () "Cancel an article you posted." (interactive) (if (yes-or-no-p "Do you really want to cancel this article? ") (let ((from nil) (newsgroups nil) (message-id nil) (distribution nil)) (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) (message "This article is not yours.")) ;; Make control article. (set-buffer (get-buffer-create " *GNUS-canceling*")) (buffer-flush-undo (current-buffer)) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "Subject: cancel " message-id "\n" "Control: cancel " message-id "\n" ;; We should not use the first value of ;; `gnus-distribution-list' as default value, ;; because distribution must be as same as original ;; article. "Distribution: " (or distribution "") "\n" mail-header-separator "\n" ) ;; Send the control article to NNTP server. (message "Canceling your article...") (if (gnus-inews-article) (message "Canceling your article... done") (ding) (message "Failed to cancel your article")) ;; Kill the article buffer. (kill-buffer (current-buffer)) ))) )) ;;; Lowlevel inews interface (defun gnus-inews-article () "Post an article in current buffer using NNTP protocol." (let ((artbuf (current-buffer)) (tmpbuf (get-buffer-create " *GNUS-posting*"))) (save-excursion (set-buffer tmpbuf) (buffer-flush-undo (current-buffer)) (erase-buffer) (insert-buffer-substring artbuf) ;; Remove the header separator. (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)) ;; This hook may insert a signature. (run-hooks 'gnus-prepare-article-hook) ;; Prepare article headers. All message body such as signature ;; must be inserted before Lines: field is prepared. (save-restriction (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (gnus-inews-insert-headers)) ;; 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) (kill-buffer (current-buffer))) ))) (defun gnus-inews-insert-headers () "Prepare article headers. Fields already prepared in the buffer are not modified. Fields in gnus-required-headers will be generated." (save-excursion (let ((date (gnus-inews-date)) (message-id (gnus-inews-message-id)) (organization (gnus-inews-organization))) (goto-char (point-min)) (or (mail-fetch-field "path") (and (memq 'Path gnus-required-headers) (insert "Path: " (gnus-inews-path) "\n"))) (or (mail-fetch-field "from") (and (memq 'From gnus-required-headers) (insert "From: " (gnus-inews-user-name) "\n"))) ;; If there is no subject, make Subject: field. (or (mail-fetch-field "subject") (and (memq 'Subject gnus-required-headers) (insert "Subject: \n"))) ;; If there is no newsgroups, make Newsgroups: field. (or (mail-fetch-field "newsgroups") (and (memq 'Newsgroups gnus-required-headers) (insert "Newsgroups: \n"))) (or (mail-fetch-field "message-id") (and message-id (memq 'Message-ID gnus-required-headers) (insert "Message-ID: " message-id "\n"))) (or (mail-fetch-field "date") (and date (memq 'Date gnus-required-headers) (insert "Date: " date "\n"))) ;; Optional fields in RFC977 and RFC1036 (or (mail-fetch-field "organization") (and organization (memq 'Organization gnus-required-headers) (let ((begin (point)) (fill-column 79) (fill-prefix "\t")) (insert "Organization: " organization "\n") (fill-region-as-paragraph begin (point))))) (or (mail-fetch-field "distribution") (and (memq 'Distribution gnus-required-headers) (insert "Distribution: \n"))) (or (mail-fetch-field "lines") (and (memq 'Lines gnus-required-headers) (insert "Lines: " (gnus-inews-lines) "\n"))) ))) ;; Utility functions. (defun gnus-inews-insert-signature () "Insert signature file in current article buffer. If there is a file named .signature-DISTRIBUTION, it is used instead of usual .signature when the distribution of the article is DISTRIBUTION. Set the variable to nil to prevent appending the signature file automatically. Signature file is specified by the variable gnus-signature-file." (save-excursion (save-restriction ;; Change signature file by distribution. ;; Suggested by hyoko@flab.fujitsu.co.jp. (let ((signature (if gnus-signature-file (expand-file-name gnus-signature-file nil))) (distribution nil)) (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (setq distribution (mail-fetch-field "distribution")) (widen) (if signature (progn (if (file-exists-p (concat signature "-" distribution)) (setq signature (concat signature "-" distribution))) ;; Insert signature. (if (file-exists-p signature) (progn (goto-char (point-max)) (insert "--\n") (insert-file-contents signature))) )))))) (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. (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) (rmail-file-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 gnus-nntp-server "!" 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 ((login-name (gnus-inews-login-name)) (full-name (gnus-inews-full-name))) (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from) ;; User's full name. (cond ((string-equal full-name "") "") ((string-equal full-name "&") ;Unix hack. (concat " (" login-name ")")) (t (concat " (" full-name ")"))) ))) (defun gnus-inews-login-name () "Return user login name. Got from the variable gnus-user-login-name, the environment variables USER and LOGNAME, and the function user-login-name." (or gnus-user-login-name (getenv "USER") (getenv "LOGNAME") (user-login-name))) (defun gnus-inews-full-name () "Return user full name. Got from the variable gnus-user-full-name, the environment variable NAME, and the function user-full-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 of 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." ;; Note: compatibility hack. This will be removed in the next version. (and (null gnus-local-domain) (boundp 'gnus-your-domain) (setq gnus-local-domain gnus-your-domain)) ;; End of compatibility hack. (let ((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))) (if (null gnus-local-domain) (setq gnus-local-domain domain)) ;; 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)) )) (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-domain-name) ">")) (defun gnus-inews-unique-id () "Generate unique ID from user name and current time." (let ((date (current-time-string)) (name (gnus-inews-login-name))) (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)" date) (concat (upcase name) "." (substring date (match-beginning 6) (match-end 6)) ;Year (substring date (match-beginning 1) (match-end 1)) ;Month (substring date (match-beginning 2) (match-end 2)) ;Day (substring date (match-beginning 3) (match-end 3)) ;Hour (substring date (match-beginning 4) (match-end 4)) ;Minute (substring date (match-beginning 5) (match-end 5)) ;Second ) (error "Cannot understand current-time-string: %s." date)) )) (defun gnus-current-time-zone (time) "The local time zone in effect at TIME, or nil if not known." (let ((z (and (fboundp 'current-time-zone) (current-time-zone time)))) (if (and z (car z)) z gnus-local-timezone))) (defun gnus-inews-date () "Date string of today. If `current-time-zone' works, or if `gnus-local-timezone' is set correctly, this yields a date that conforms to RFC 822. Otherwise a buggy date will be generated; this might work with some older news servers." (let* ((now (and (fboundp 'current-time) (current-time))) (zone (gnus-current-time-zone now))) (if zone (gnus-inews-valid-date now zone) ;; No timezone info. (gnus-inews-buggy-date now)))) (defun gnus-inews-valid-date (&optional time zone) "A date string that represents TIME and conforms to the Usenet standard. TIME is optional and defaults to the current time. Some older versions of Emacs always act as if TIME is nil. The optional argument ZONE specifies the local time zone (default GMT)." (timezone-make-date-arpa-standard (if (fboundp 'current-time) (current-time-string time) (current-time-string)) zone "GMT")) (defun gnus-inews-buggy-date (&optional time) "A buggy date string that represents TIME. TIME is optional and defaults to the current time. Some older versions of Emacs always act as if TIME is nil." (let ((date (if (fboundp 'current-time) (current-time-string time) (current-time-string)))) (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" date) (concat (substring date (match-beginning 2) (match-end 2)) ;Day " " (substring date (match-beginning 1) (match-end 1)) ;Month " " (substring date (match-beginning 4) (match-end 4)) ;Year " " (substring date (match-beginning 3) (match-end 3))) ;Time (error "Cannot understand current-time-string: %s." date)) )) (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 the value begins with a slash, it is taken as the name of a file containing the organization." ;; The organization must be got in this order since the ORGANIZATION ;; environment variable is intended for user specific while ;; gnus-local-organization is for machine or organization specific. ;; Note: compatibility hack. This will be removed in the next version. (and (null gnus-local-organization) (boundp 'gnus-your-organization) (setq gnus-local-organization gnus-your-organization)) ;; End of compatibility hack. (let* ((private-file (expand-file-name "~/.organization" nil)) (organization (or (getenv "ORGANIZATION") gnus-local-organization private-file))) (and (stringp organization) (> (length organization) 0) (string-equal (substring organization 0 1) "/") ;; Get it from the user and system file. ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath). (let ((dist (mail-fetch-field "distribution"))) (setq organization (cond ((file-exists-p (concat organization "-" dist)) (concat organization "-" dist)) ((file-exists-p organization) organization) ((file-exists-p gnus-organization-file) gnus-organization-file) (t organization))) )) (cond ((not (stringp organization)) nil) ((and (string-equal (substring organization 0 1) "/") (file-exists-p organization)) ;; If the first character is `/', assume it is the name of ;; a file containing the organization. (save-excursion (let ((tmpbuf (get-buffer-create " *GNUS organization*"))) (set-buffer tmpbuf) (erase-buffer) (insert-file-contents organization) (prog1 (buffer-string) (kill-buffer tmpbuf)) ))) ((string-equal organization private-file) nil) ;No such file (t organization)) )) (defun gnus-inews-lines () "Count the number of lines and return numeric string." (save-excursion (save-restriction (widen) (goto-char (point-min)) (search-forward "\n\n" nil 'move) (int-to-string (count-lines (point) (point-max)))))) (provide 'gnuspost) ;;; gnuspost.el ends here emacs-19.22/lisp/gomoku.el100444 74720 14 122236 5427026177 14355 0ustar eggertguest;;; gomoku.el --- Gomoku game between you and Emacs ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Phillippe 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-cp" 'gomoku-human-plays) ; C-C P (define-key gomoku-mode-map "\C-cb" 'gomoku-human-takes-back) ; C-C B (define-key gomoku-mode-map "\C-cr" 'gomoku-human-resigns) ; C-C R (define-key gomoku-mode-map "\C-ce" 'gomoku-emacs-plays) ; 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 [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-wins 0 "Number of games already won in this session.") (defvar gomoku-number-of-losses 0 "Number of games already lost 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-wins (1+ gomoku-number-of-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-losses) (zerop gomoku-number-of-draws) (> gomoku-number-of-wins 1)) "I'm becoming tired of winning...") (t "I won.")))) ((eq result 'human-won) (setq gomoku-number-of-losses (1+ gomoku-number-of-losses)) (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-wins (1+ gomoku-number-of-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-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." (if buffer-read-only (toggle-read-only)) (insert char) (delete-char 1) (backward-char 1) (toggle-read-only)) (defun gomoku-init-display (n m) "Display an N by M Gomoku board." (buffer-disable-undo (current-buffer)) (if buffer-read-only (toggle-read-only)) (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)) (toggle-read-only) (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-wins gomoku-number-of-losses gomoku-number-of-draws)) ((not (zerop gomoku-number-of-losses)) (format ": Won %d, lost %d" gomoku-number-of-wins gomoku-number-of-losses)) ((zerop gomoku-number-of-wins) "") ((= 1 gomoku-number-of-wins) ": Already won one") (t (format ": Won %d in a row" gomoku-number-of-wins)))) ;; Then a (standard) kludgy line will force update of mode line. (set-buffer-modified-p (buffer-modified-p))) (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.22/lisp/gosmacs.el100444 12120 1 7432 5355424044 14041 0ustar rmsdaemon;;; gosmacs.el --- rebindings to imitate Gosmacs. ;; Copyright (C) 1986 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: ;; Make GNU Emacs look like Gosling Emacs. `M-x set-gosmacs-bindings' ;; does this change; `M-x set-gnu-bindings' undoes it. ;;; Code: (require 'mlsupport) (defvar non-gosmacs-binding-alist nil) ;;;###autoload (defun set-gosmacs-bindings () "Rebind some keys globally to make GNU Emacs resemble Gosling Emacs. Use \\[set-gnu-bindings] to restore previous global bindings." (interactive) (setq non-gosmacs-binding-alist (rebind-and-record '(("\C-x\C-e" compile) ("\C-x\C-f" save-buffers-kill-emacs) ("\C-x\C-i" insert-file) ("\C-x\C-m" save-some-buffers) ("\C-x\C-n" next-error) ("\C-x\C-o" switch-to-buffer) ("\C-x\C-r" insert-file) ("\C-x\C-u" undo) ("\C-x\C-v" find-file-other-window) ("\C-x\C-z" shrink-window) ("\C-x!" shell-command) ("\C-xd" delete-window) ("\C-xn" gosmacs-next-window) ("\C-xp" gosmacs-previous-window) ("\C-xz" enlarge-window) ("\C-z" scroll-one-line-up) ("\e\C-c" save-buffers-kill-emacs) ("\e!" line-to-top-of-window) ("\e(" backward-paragraph) ("\e)" forward-paragraph) ("\e?" apropos) ("\eh" delete-previous-word) ("\ej" indent-sexp) ("\eq" query-replace) ("\er" replace-string) ("\ez" scroll-one-line-down) ("\C-_" suspend-emacs))))) (defun rebind-and-record (bindings) "Establish many new global bindings and record the bindings replaced. Arg BINDINGS is an alist whose elements are (KEY DEFINITION). Returns a similar alist whose elements describe the same KEYs but each with the old definition that was replaced," (let (old) (while bindings (let* ((this (car bindings)) (key (car this)) (newdef (nth 1 this))) (setq old (cons (list key (lookup-key global-map key)) old)) (global-set-key key newdef)) (setq bindings (cdr bindings))) (nreverse old))) (defun set-gnu-bindings () "Restore the global bindings that were changed by \\[set-gosmacs-bindings]." (interactive) (rebind-and-record non-gosmacs-binding-alist)) (defun gosmacs-previous-window () "Select the window above or to the left of the window now selected. From the window at the upper left corner, select the one at the lower right." (interactive) (select-window (previous-window))) (defun gosmacs-next-window () "Select the window below or to the right of the window now selected. From the window at the lower right corner, select the one at the upper left." (interactive) (select-window (next-window))) (defun scroll-one-line-up (&optional arg) "Scroll the selected window up (forward in the text) one line (or N lines)." (interactive "p") (scroll-up (or arg 1))) (defun scroll-one-line-down (&optional arg) "Scroll the selected window down (backward in the text) one line (or N)." (interactive "p") (scroll-down (or arg 1))) (defun line-to-top-of-window () "Scroll the selected window up so that the current line is at the top." (interactive) (recenter 0)) ;;; gosmacs.el ends here emacs-19.22/lisp/grow-vers.el100444 12120 1 2475 5257321734 14345 0ustar rmsdaemon;;; grow-vers.el --- increment Emacs version number ;; Copyright (C) 1985 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: ;; Load this file to add a new level (starting at zero) ;; to the Emacs version number recorded in version.el. ;;; Code: (insert-file-contents "lisp/version.el") (re-search-forward "emacs-version \"[0-9.]*") (insert ".0") ;; Delete the share-link with the current version ;; so that we do not alter the current version. (delete-file "lisp/version.el") (write-region (point-min) (point-max) "lisp/version.el" nil 'nomsg) ;;; grow-vers.el ends here emacs-19.22/lisp/gud.el100444 12120 1 116730 5453163322 13224 0ustar rmsdaemon;;; gud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb ;;; under Emacs ;; Author: Eric S. Raymond ;; Maintainer: FSF ;; Version: 1.3 ;; Keywords: unix, tools ;; 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: ;; 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). ;;; 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) (global-set-key "\C-x " 'gud-break) ;; backward compatibility hack ;; ====================================================================== ;; the overloading mechanism (defun gud-overload-functions (gud-overload-alist) "Overload functions defined in GUD-OVERLOAD-ALIST. This association list has elements of the form (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)" (mapcar (function (lambda (p) (fset (car p) (symbol-function (cdr p))))) gud-overload-alist)) (defun gud-massage-args (file args) (error "GUD not properly entered.")) (defun gud-marker-filter (str) (error "GUD not properly entered.")) (defun gud-find-file (f) (error "GUD not properly entered.")) ;; ====================================================================== ;; 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. ;; ====================================================================== ;; gdb functions ;;; History of argument lists passed to gdb. (defvar gud-gdb-history nil) (defun gud-gdb-massage-args (file args) (cons "-fullname" (cons file args))) ;; There's no guarantee that Emacs will hand the filter the entire ;; marker at once; it could be broken up across several strings. We ;; might even receive a big chunk with several markers in it. If we ;; receive a chunk of text which looks like it might contain the ;; beginning of a marker, we save it here between calls to the ;; filter. (defvar gud-gdb-marker-acc "") (defun gud-gdb-marker-filter (string) (save-match-data (setq gud-gdb-marker-acc (concat gud-gdb-marker-acc string)) (let ((output "")) ;; Process all the complete markers in this chunk. (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" gud-gdb-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (substring gud-gdb-marker-acc (match-beginning 1) (match-end 1)) (string-to-int (substring gud-gdb-marker-acc (match-beginning 2) (match-end 2)))) ;; Append any text before the marker to the output we're going ;; to return - we don't include the marker in this text. output (concat output (substring gud-gdb-marker-acc 0 (match-beginning 0))) ;; Set the accumulator to the remaining text. gud-gdb-marker-acc (substring gud-gdb-marker-acc (match-end 0)))) ;; Does the remaining text look like it might end with the ;; beginning of another marker? If it does, then keep it in ;; gud-gdb-marker-acc until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. (if (string-match "^\032.*\\'" gud-gdb-marker-acc) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring gud-gdb-marker-acc 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq gud-gdb-marker-acc (substring gud-gdb-marker-acc (match-beginning 0)))) (setq output (concat output gud-gdb-marker-acc) gud-gdb-marker-acc "")) output))) (defun gud-gdb-find-file (f) (find-file-noselect f)) ;;;###autoload (defun gdb (command-line) "Run gdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive (list (read-from-minibuffer "Run gdb (like this): " (if (consp gud-gdb-history) (car gud-gdb-history) "gdb ") nil nil '(gud-gdb-history . 1)))) (gud-overload-functions '((gud-massage-args . gud-gdb-massage-args) (gud-marker-filter . gud-gdb-marker-filter) (gud-find-file . gud-gdb-find-file) )) (gud-common-init command-line) (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "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 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.") (setq comint-prompt-regexp "^(.*gdb[+]?) *") (run-hooks 'gdb-mode-hook) ) ;; ====================================================================== ;; 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) (cons file args)) (defun gud-sdb-marker-filter (string) (cond ;; System V Release 3.2 uses this format ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" string) (setq gud-last-frame (cons (substring string (match-beginning 2) (match-end 2)) (string-to-int (substring string (match-beginning 3) (match-end 3)))))) ;; System V Release 4.0 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" string) (setq gud-sdb-lastfile (substring string (match-beginning 2) (match-end 2)))) ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):" string)) (setq gud-last-frame (cons gud-sdb-lastfile (string-to-int (substring string (match-beginning 1) (match-end 1)))))) (t (setq gud-sdb-lastfile nil))) string) (defun gud-sdb-find-file (f) (if gud-sdb-needs-tags (find-tag-noselect f) (find-file-noselect f))) ;;;###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) (file-exists-p tags-file-name)))) (error "The sdb support requires a valid tags table to work.")) (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args) (gud-marker-filter . gud-sdb-marker-filter) (gud-find-file . gud-sdb-find-file) )) (gud-common-init command-line) (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") (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\\)\\*") (run-hooks 'sdb-mode-hook) ) ;; ====================================================================== ;; dbx functions ;;; History of argument lists passed to dbx. (defvar gud-dbx-history nil) (defun gud-dbx-massage-args (file args) (cons file args)) (defun gud-dbx-marker-filter (string) (if (or (string-match "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" string) (string-match "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" string)) (setq gud-last-frame (cons (substring string (match-beginning 2) (match-end 2)) (string-to-int (substring string (match-beginning 1) (match-end 1)))))) string) (defun gud-dbx-find-file (f) (find-file-noselect f)) ;;;###autoload (defun dbx (command-line) "Run dbx on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive (list (read-from-minibuffer "Run dbx (like this): " (if (consp gud-dbx-history) (car gud-dbx-history) "dbx ") nil nil '(gud-dbx-history . 1)))) (gud-overload-functions '((gud-massage-args . gud-dbx-massage-args) (gud-marker-filter . gud-dbx-marker-filter) (gud-find-file . gud-dbx-find-file) )) (gud-common-init command-line) (gud-def gud-break "file \"%d%f\"\nstop at %l" "\C-b" "Set breakpoint at current line.") ;; (gud-def gud-break "stop at \"%f\":%l" ;; "\C-b" "Set breakpoint at current line.") (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "step %p" "\C-s" "Step one line with display.") (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-up "up %p" "<" "Up (numeric arg) stack frames.") (gud-def gud-down "down %p" ">" "Down (numeric arg) stack frames.") (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") (setq comint-prompt-regexp "^[^)]*dbx) *") (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 (cons file 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 (defvar gud-xdb-accumulation "") (defun gud-xdb-marker-filter (string) (let (result) (if (or (string-match comint-prompt-regexp string) (string-match ".*\012" string)) (setq result (concat gud-xdb-accumulation string) gud-xdb-accumulation "") (setq gud-xdb-accumulation (concat gud-xdb-accumulation 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) (let ((realf (gud-xdb-file-name f))) (if realf (find-file-noselect realf)))) ;;;###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-overload-functions '((gud-massage-args . gud-xdb-massage-args) (gud-marker-filter . gud-xdb-marker-filter) (gud-find-file . gud-xdb-find-file))) (gud-common-init command-line) (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") (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 "^>") (make-local-variable 'gud-xdb-accumulation) (setq gud-xdb-accumulation "") (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 file (cons "-emacs" 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) (save-match-data (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string)) (let ((output "")) ;; Process all the complete markers in this chunk. (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" gud-perldb-marker-acc) (setq ;; Extract the frame position from the marker. gud-last-frame (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1)) (string-to-int (substring gud-perldb-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-perldb-marker-acc 0 (match-beginning 0))) ;; Set the accumulator to the remaining text. gud-perldb-marker-acc (substring gud-perldb-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-perldb-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-perldb-marker-acc) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring gud-perldb-marker-acc 0 (match-beginning 0)))) ;; Everything after, we save, to combine with later input. (setq gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-beginning 0)))) (setq output (concat output gud-perldb-marker-acc) gud-perldb-marker-acc "")) output))) (defun gud-perldb-find-file (f) (find-file-noselect f)) ;;;###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-overload-functions '((gud-massage-args . gud-perldb-massage-args) (gud-marker-filter . gud-perldb-marker-filter) (gud-find-file . gud-perldb-find-file) )) (gud-common-init command-line) (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]+> ") (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 (copy-keymap comint-mode-map)) (make-local-variable 'gud-last-frame) (setq gud-last-frame nil) (make-local-variable 'comint-prompt-regexp) (make-local-variable 'gud-delete-prompt-marker) (setq gud-delete-prompt-marker (make-marker)) (run-hooks 'gud-mode-hook) ) (defvar gud-comint-buffer nil) ;; Chop STRING into words separated by SPC or TAB and return a list of them. (defun gud-chop-words (string) (let ((i 0) (beg 0) (len (length string)) (words nil)) (while (< i len) (if (memq (aref string i) '(?\t ? )) (progn (setq words (cons (substring string beg i) words) beg (1+ i)) (while (and (< beg len) (memq (aref string beg) '(?\t ? ))) (setq beg (1+ beg))) (setq i (1+ beg))) (setq i (1+ i)))) (if (< beg len) (setq words (cons (substring string beg) words))) (nreverse words))) ;; Perform initializations common to all debuggers. (defun gud-common-init (command-line) (let* ((words (gud-chop-words command-line)) (program (car words)) (file-word (let ((w (cdr words))) (while (and w (= ?- (aref (car w) 0))) (setq w (cdr w))) (car w))) (args (delq file-word (cdr words))) (file (expand-file-name file-word)) (filepart (file-name-nondirectory file))) (switch-to-buffer (concat "*gud-" filepart "*")) (setq default-directory (file-name-directory file)) (or (bolp) (newline)) (insert "Current directory is " default-directory "\n") (apply 'make-comint (concat "gud-" filepart) program nil (gud-massage-args file args))) (gud-mode) (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) (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))))) ;; 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 ((inhibit-quit t)) (save-excursion (set-buffer (process-buffer proc)) (let (moving output-after-point) (save-excursion (goto-char (process-mark proc)) ;; If we have been so requested, delete the debugger prompt. (if (marker-buffer gud-delete-prompt-marker) (progn (delete-region (point) gud-delete-prompt-marker) (set-marker gud-delete-prompt-marker nil))) (insert-before-markers (gud-marker-filter string)) (setq moving (= (point) (process-mark proc))) (setq output-after-point (< (point) (process-mark proc))) ;; 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. (if (and gud-last-frame (not output-after-point) (get-buffer-window (current-buffer))) (gud-display-frame))) (if moving (goto-char (process-mark 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 redisplay soon (set-buffer-modified-p (buffer-modified-p)) (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* ((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)))) (if (string-match "\\(.*\\)%f\\(.*\\)" str) (setq str (concat (substring str (match-beginning 1) (match-end 1)) (file-name-nondirectory (if insource (buffer-file-name) (car gud-last-frame))) (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%d\\(.*\\)" str) (setq str (concat (substring str (match-beginning 1) (match-end 1)) (file-name-directory (if insource (buffer-file-name) (car gud-last-frame))) (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%l\\(.*\\)" str) (setq str (concat (substring str (match-beginning 1) (match-end 1)) (if insource (save-excursion (beginning-of-line) (save-restriction (widen) (1+ (count-lines 1 (point))))) (cdr gud-last-frame)) (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%e\\(.*\\)" str) (setq str (concat (substring str (match-beginning 1) (match-end 1)) (find-c-expr) (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%a\\(.*\\)" str) (setq str (concat (substring str (match-beginning 1) (match-end 1)) (gud-read-address) (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%p\\(.*\\)" str) (setq str (concat (substring str (match-beginning 1) (match-end 1)) (if arg (int-to-string arg) "") (substring str (match-beginning 2) (match-end 2))))) ) str ) (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))) ;; 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.22/lisp/hanoi.el100444 12241 1 17100 5417070045 14173 0ustar rolanddaemon;;; 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) (set-buffer-modified-p (buffer-modified-p)) (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.22/lisp/help-macro.el100444 12120 1 11164 5400740353 14444 0ustar rmsdaemon;;; help-macro.el --- Makes command line help such as help-for-help ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Lynn Slater ;; Created: : Mon Oct 1 11:42:39 1990 ;; Adapted-By: ESR ;; Last Modified By: Lynn Slater x2048 ;; Last Modified On: Mon Sep 23 14:40:19 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. ;; You should have received a copy of the GNU General Public License ;; 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) (defmacro make-help-screen (fname help-line help-text helped-map) "Constructs function FNAME that when invoked shows HELP-LINE and if a help character is requested, shows HELP-TEXT. The user is prompted for a character from the HELPED-MAP and the corresponding interactive function is executed." (` (defun (, fname) () (, help-text) (interactive) (let ((line-prompt (substitute-command-keys (, help-line)))) (message line-prompt) (let ((char (read-event)) config) (unwind-protect (progn (if (or (eq char ??) (eq char help-char)) (progn (setq config (current-window-configuration)) (switch-to-buffer-other-window "*Help*") (erase-buffer) (insert (documentation (quote (, fname)))) (goto-char (point-min)) (while (memq char (cons help-char '(?? ?\C-v ?\ ?\177 ?\M-v))) (if (memq char '(?\C-v ?\ )) (scroll-up)) (if (memq char '(?\177 ?\M-v)) (scroll-down)) (message "%s%s: " line-prompt (if (pos-visible-in-window-p (point-max)) "" " or Space to scroll")) (let ((cursor-in-echo-area t)) (setq char (read-event)))))) (let ((defn (cdr (assq (if (integerp char) (downcase char) char) (, helped-map))))) (if defn (if (keymapp defn) (error "sorry, this command cannot be run from the help screen. Start over.") (if config (progn (set-window-configuration config) (setq config nil))) (call-interactively defn)) (if (listp char) (setq unread-command-events (cons char unread-command-events) config nil) (ding))))) (if config (set-window-configuration config)))))) )) ;;; help-macro.el emacs-19.22/lisp/help.el100444 12120 1 37107 5471644655 13372 0ustar rmsdaemon;;; help.el --- help commands for Emacs ;; Copyright (C) 1985, 1986, 1993 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.") (define-key global-map (char-to-string help-char) 'help-command) (fset 'help-command help-map) (define-key help-map (char-to-string help-char) '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 "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") (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) (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))) (newline (- (window-height (selected-window)) (count-lines (point-min) (point)) 6)) (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))) (let ((defn (key-binding key))) (if (or (null defn) (integerp defn)) (message "%s is undefined" (key-description key)) (message "%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)) (funcall (or function 'message) (concat (substitute-command-keys (if (one-window-p t) (if pop-up-windows "Type \\[delete-other-windows] to remove help window." "Type \\[switch-to-buffer] RET to remove help window.") "Type \\[switch-to-buffer-other-window] RET to restore the 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))) (let ((defn (key-binding key))) (if (or (null defn) (integerp defn)) (message "%s is undefined" (key-description key)) (with-output-to-temp-buffer "*Help*" (prin1 defn) (princ ":\n") (if (documentation defn) (princ (documentation defn)) (princ "not documented")) (print-help-return-message))))) (defun describe-mode (&optional minor) "Display documentation of current major mode. If optional 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)))) (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)) (prefix (make-vector (1- (length key)) nil)) i) (setq i 0) (while (< i (length prefix)) (aset prefix i (aref key i)) (setq i (1+ i))) (describe-bindings 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-lossage () "Display last 100 input keystrokes." (interactive) (with-output-to-temp-buffer "*Help*" (princ (key-description (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"))) (print-help-return-message))) (make-help-screen help-for-help "a b c f C-f i k C-k l m n p s t v w C-c C-d C-n C-w. Type \\[help-command] again for more help: " "You have typed \\[help-command], the help character. Type a Help option: a command-apropos. Give a substring, and see a list of commands (functions interactively callable) that contain that substring. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; it prints the function name that sequence runs. f describe-function. Type a function name and get documentation of it. C-f Info-goto-emacs-command-node. Type a function name; it takes you to the Info node for that command. i info. The info documentation reader. k describe-key. Type a command key sequence; it displays the full documentation. C-k Info-goto-emacs-key-command-node. Type a command key sequence; it takes you to the Info node for the command bound to that key. l view-lossage. Shows last 100 characters you typed. m describe-mode. Print documentation of current major mode, which describes the commands peculiar to it. n view-emacs-news. Shows emacs news file. p finder-by-keyword. Find packages matching a given topic keyword. 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 () (save-excursion (forward-sexp -1) (skip-chars-forward "'") (let ((obj (read (current-buffer)))) (and (symbolp obj) (fboundp obj) obj))) (error nil)))) (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)) (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) (format "%s autoloaded Lisp %s." (if (commandp def) "an interactive" "an") (if (nth 4 def) "macro" "function") ;;; Including the file name made this line too long. ;;; (nth 1 def) )) (t ""))) (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)))) (if (documentation function) (progn (terpri) (princ (documentation function))) (princ "not documented")) ) (print-help-return-message) ;; Return the text we displayed. (save-excursion (set-buffer standard-output) (buffer-string)))) (defun variable-at-point () (condition-case () (save-excursion (forward-sexp -1) (skip-chars-forward "'") (let ((obj (read (current-buffer)))) (and (symbolp obj) (boundp obj) obj))) (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) (princ "'s value is ") (if (not (boundp variable)) (princ "void.") (prin1 (symbol-value variable))) (terpri) (terpri) (princ "Documentation:") (terpri) (let ((doc (documentation-property variable 'variable-documentation))) (if doc (princ (substitute-command-keys doc)) (princ "not documented as a variable."))) (print-help-return-message) ;; Return the text we displayed. (save-excursion (set-buffer standard-output) (buffer-string)))) (defun command-apropos (string) "Like apropos but lists only symbols that are names of commands \(interactively callable functions). Argument REGEXP is a regular expression that is matched against command symbol names. Returns list of symbols and documentation found." (interactive "sCommand apropos (regexp): ") (let ((message (let ((standard-output (get-buffer-create "*Help*"))) (print-help-return-message 'identity)))) (if (apropos string t 'commandp) (and message (message message))))) (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.22/lisp/helper.el100444 12120 1 11630 5257322654 13704 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))) (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 (char-to-string (downcase (read-char)))) (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.22/lisp/hexl.el100444 12120 1 60303 5474463115 13365 0ustar rmsdaemon;;; hexl.el --- edit a file in a hex dump format using the hexl filter. ;; Copyright (C) 1989 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) ;; 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) (let ((modified (buffer-modified-p)) (read-only buffer-read-only) (original-point (1- (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 buffer-read-only nil) (setq hexl-max-address (1- (buffer-size))) (hexlify-buffer) (set-buffer-modified-p modified) (setq buffer-read-only read-only) (hexl-goto-address original-point))))) (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)) (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: ") (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)) (read-only buffer-read-only) (original-point (1+ (hexl-current-address)))) (setq buffer-read-only nil) (dehexlify-buffer) (remove-hook 'write-contents-hook 'hexl-save-buffer) (set-buffer-modified-p modified) (setq buffer-read-only read-only) (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) ;; Kludge to update mode-line (switch-to-buffer (current-buffer)) ) (defun hexl-current-address () "Return current hexl-address." (interactive) (let ((current-column (- (% (point) 68) 11)) (hexl-address 0)) (setq hexl-address (+ (* (/ (point) 68) 16) (/ (- 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) (shell-command-on-region (point-min) (point-max) hexlify-command t)) (defun dehexlify-buffer () "Convert a hexl format buffer to binary." (interactive) (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))) (while (> num 0) (delete-char 2) (insert (format "%02x" ch)) (goto-char (+ (* (/ address 16) 68) 52 (% address 16))) (delete-char 1) (insert (hexl-printable-character ch)) (if (eq address hexl-max-address) (hexl-goto-address address) (hexl-goto-address (1+ address))) (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 "\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 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.22/lisp/hideif.el100444 13437 1 100330 5405344072 14016 0ustar jimbdaemon;;; hide-ifdef-mode.el --- hides selected code within ifdef. ;;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Dan LaLiberte ;; 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: ;;; 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. ;;; Change Log: ;;; ;;; Revision 1.7 88/02/16 03:12:58 liberte ;;; Fixed comments and doc strings. ;;; Added optional prefix arg for ifdef motion commands. ;;; ;;; Revision 1.6 88/02/05 00:36:18 liberte ;;; Bug fixes. ;;; 1. A multi-line comment that starts on an #ifdef line ;;; now ends on that line. ;;; 2. Fix bad function name: hide-hif-ifdef-toggle-read-only ;;; 3. Make ifdef-block hiding work outside of ifdefs. ;;; ;;; Revision 1.5 88/01/31 23:19:31 liberte ;;; Major clean up. ;;; Prefix internal names with "hif-". ;;; ;;; Revision 1.4 88/01/30 14:09:38 liberte ;;; Add hide-ifdef-hiding and hide-ifdef-mode to minor-mode-alist. ;;; ;;; Revision 1.3 88/01/29 00:38:19 liberte ;;; Fix three bugs. ;;; 1. Function "defined" is just like lookup. ;;; 2. Skip to newline or cr in case text is hidden. ;;; 3. Use car of token list if just one symbol. ;;; ;;; Revision 1.2 88/01/28 23:32:46 liberte ;;; Use hide-ifdef-mode-prefix-key. ;;; Copy current-local-map so other buffers do not get ;;; hide-ifdef-mode bindings. ;;; ;;; Code: (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.") (defvar hide-ifdef-mode-map-before nil "Buffer-local variable to store a copy of the local keymap before `hide-ifdef-mode' modifies it.") (defun define-hide-ifdef-mode-map () (if hide-ifdef-mode-map () ; dont redefine it. (setq hide-ifdef-mode-map (make-sparse-keymap)) (define-key hide-ifdef-mode-map "\ed" 'hide-ifdef-define) (define-key hide-ifdef-mode-map "\eu" 'hide-ifdef-undef) (define-key hide-ifdef-mode-map "\eD" 'hide-ifdef-set-define-alist) (define-key hide-ifdef-mode-map "\eU" 'hide-ifdef-use-define-alist) (define-key hide-ifdef-mode-map "\eh" 'hide-ifdefs) (define-key hide-ifdef-mode-map "\es" 'show-ifdefs) (define-key hide-ifdef-mode-map "\C-h" 'hide-ifdef-block) (define-key hide-ifdef-mode-map "\C-s" 'show-ifdef-block) (define-key hide-ifdef-mode-map "\C-f" 'forward-ifdef) (define-key hide-ifdef-mode-map "\C-b" 'backward-ifdef) (define-key hide-ifdef-mode-map "\C-d" 'down-ifdef) (define-key hide-ifdef-mode-map "\C-u" 'up-ifdef) (define-key hide-ifdef-mode-map "\C-n" 'next-ifdef) (define-key hide-ifdef-mode-map "\C-p" 'previous-ifdef) (define-key hide-ifdef-mode-map "\C-q" 'hide-ifdef-toggle-read-only) (let ((where (where-is-internal 'toggle-read-only nil nil t))) (if where (define-key hide-ifdef-mode-map where 'hide-ifdef-toggle-outside-read-only))) ) (fset 'hide-ifdef-mode-map hide-ifdef-mode-map) ; the function is the map ) (defun hif-update-mode-line () "Update mode-line by setting buffer-modified to itself." (set-buffer-modified-p (buffer-modified-p))) (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.") (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))) ;;;###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))) (hif-update-mode-line) (if hide-ifdef-mode (progn ; fix c-mode syntax table so we can recognize whole symbols. (modify-syntax-entry ?_ "w") (modify-syntax-entry ?& ".") (modify-syntax-entry ?\| ".") ; 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) (make-local-variable 'hide-ifdef-mode-map-before) (setq hide-ifdef-mode-map-before (current-local-map)) (use-local-map (copy-keymap (current-local-map))) (local-unset-key hide-ifdef-mode-prefix-key) (local-set-key hide-ifdef-mode-prefix-key 'hide-ifdef-mode-map) (define-hide-ifdef-mode-map) (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)) (use-local-map hide-ifdef-mode-map-before) (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 ). (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))) (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 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 "!") 'not) ((string-equal token "defined") 'hif-defined) ((string-equal token "(") 'lparen) ((string-equal token ")") 'rparen) (t (intern token))) token-list)) )) (t (error "Bad #if expression: %s" expr-string)) )) (nreverse token-list) )) ;;;----------------------------------------------------------------- ;;; Translate C preprocessor #if expressions using recursive descent. ;;; This parser is limited to the operators &&, ||, !, and "defined". (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 : factor | term '&&' factor." (let ((result (hif-factor))) (while (eq token 'and) (hif-nexttoken) (setq result (list 'and 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)))) )) )) ;;;----------- 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.") (defvar hide-ifdef-hiding nil "Non-nil if text might be hidden.") ;;;###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))) (hif-update-mode-line)) (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) ) (hif-update-mode-line)) (defun hide-ifdef-define (var) "Define a VAR so that #ifdef VAR would be included." (interactive "SDefine what? ") (hif-set-var var t) (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-ifdef'." (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. (if buffer-read-only (toggle-read-only)) ; make it writable temporarily (setq selective-display t) (setq hide-ifdef-hiding t) (hide-ifdef-guts) (if (or hide-ifdef-read-only hif-outside-read-only) (toggle-read-only)) ; make it read only (message "Hiding done")) (defun show-ifdefs () "Cancel the effects of `hide-ifdef'. The contents of all #ifdefs is shown." (interactive) (if buffer-read-only (toggle-read-only)) ; make it writable temporarily (setq selective-display nil) ; defaults (hif-show-all) (if hif-outside-read-only (toggle-read-only)) ; make it read only (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)) (if buffer-read-only (toggle-read-only)) (setq selective-display t) (let (top bottom) (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)) (if (or hide-ifdef-read-only hif-outside-read-only) (toggle-read-only))) (defun show-ifdef-block () "Show the ifdef block (true or false part) enclosing or before the cursor." (interactive) (let ((old-read-only buffer-read-only)) (if old-read-only (toggle-read-only)) (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)) ) ; restore read only status since we dont know if all is shown. (if old-read-only (toggle-read-only)))) ;;; 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)))) ;;; hideif.el ends here emacs-19.22/lisp/hilit19.el100444 11732 1 172222 5447526122 14077 0ustar bfoxdaemon;; hilit19.el (Release 2.19) -- customizable highlighting for Emacs19. ;; Copyright (c) 1993 Free Software Foundation, Inc. ;; ;; Author: Jonathan Stigelman ;; Keywords: faces ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;; ;;; Commentary: ;; Hilit19.el is a customizable highlighting package for Emacs19. It supports ;; not only source code highlighting, but also Info, RMAIL, VM, gnus... ;; Hilit19 knows (or thinks it knows) how to highlight emacs buffers in ;; about 25 different modes. ;; ;; WHERE TO GET THE LATEST VERSIONS OF HILIT19.EL (beta and release), ;; PLUS LOTS OF OTHER *WAY COOL* STUFF VIA ANONYMOUS FTP: ;; ;; netcom.com:/pub/stig/src/{Beta,Release}/hilit19.el.gz ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; TO SUBMIT BUG REPORTS (or feedback of any sort)... ;; ;; M-x hilit-submit-feedback RET ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; hilit19.el,v 2.19 1993/09/08 18:44:10 stig Release ;; ;; LCD Archive Entry: ;; hilit19|Jonathan Stigelman|Stig@netcom.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 ;; ;; * When more than one size of font is used in different frames, only one ;; font size can have bold & italic properties. ;; ;; * 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@netcom.com" (interactive) (require 'reporter) (and (y-or-n-p "Do you really want to submit a report on hilit19? ") (reporter-submit-bug-report "Jonathan Stigelman " "hilit19.el (Release 2.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 netcom.com:/pub/stig/src/Beta/hilit19.el.gz\n" " for a newer release that fixes the problem.\n" " >> I HAVE ALSO CHECKED netcom.com:/pub/stig/src/Beta/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 elisp 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) (progn ;; first, fix up this frame's face (make-face-bold face frame 'noerr) ;; now, fix up the face from the global list (set-face-font face (face-font face frame) t))) (if (string-match ".*italic" fn) (progn ;; first, fix up this frame's face (make-face-italic face frame 'noerr) ;; now, fix up the face from the global list (set-face-font face (face-font face frame) t))) )) ))) face) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Region Highlight/Unhighlight code (Both overlay and text-property versions) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defsubst hilit-region-set-face (start end face-name &optional prio prop) "Highlight region from START to END using FACE and, optionally, PRIO. The optional 5th arg, PROP is a property to set instead of 'hilit." (let ((overlay (make-overlay start end))) (overlay-put overlay 'face face-name) (overlay-put overlay (or prop 'hilit) t) (and prio (overlay-put overlay 'priority prio)))) (defun hilit-unhighlight-region (start end &optional quietly) "Unhighlights the region from START to END, optionally in a QUIET way" (interactive "r") (or quietly hilit-quietly (message "Unhighlighting")) (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 (hilit-rehighlight-buffer) (set-buffer-modified-p nil))))) (defun hilit-repaint-command (arg) "Rehighlights according to the value of hilit-auto-rehighlight, or the prefix argument if that is specified. \t\\[hilit-repaint-command]\t\trepaint according to hilit-auto-rehighlight \t^U \\[hilit-repaint-command]\trepaint entire buffer \t^U - \\[hilit-repaint-command]\trepaint visible portion of buffer \t^U n \\[hilit-repaint-command]\trepaint n lines to either side of point" (interactive "P") (let (st en quietly) (or arg (setq arg hilit-auto-rehighlight)) (cond ((or (eq arg 'visible) (eq arg '-)) (setq st (window-start) en (window-end) quietly t)) ((numberp arg) (setq st (save-excursion (forward-line (- arg)) (point)) en (save-excursion (forward-line arg) (point)))) (arg (hilit-rehighlight-buffer))) (if st (hilit-rehighlight-region st en quietly)))) (defun hilit-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 gnus-article-prepare-hook gnus-summary-prepare-hook gnus-group-prepare-hook rmail-show-message-hook mail-setup-hook mh-show-mode-hook dired-after-readin-hook )) ;; rehighlight only visible part of summary buffer for speed. (add-hook 'gnus-mark-article-hook (function (lambda () (or (memq gnus-current-article gnus-newsgroup-marked) (gnus-summary-mark-as-read gnus-current-article)) (gnus-summary-set-current-mark) (save-excursion (set-buffer gnus-summary-buffer) (hilit-rehighlight-region (window-start) (window-end) t) )))) ;; only need prepare article hook ;; ;; (add-hook 'gnus-select-article-hook ;; '(lambda () (save-excursion ;; (set-buffer gnus-article-buffer) ;; (hilit-rehighlight-buffer)))) ) (error (message "Error loading highlight hooks: %s" c) (ding) (sit-for 1)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Default patterns for various modes. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; do I need this? I changed the defconst to a defvar because defconst is ;;; inappropriate, but I don't know why I wanted hilit-patterns-alist to be ;;; reset on every reload... (setq hilit-patterns-alist nil) (defun hilit-associate (alist key val) "creates, or destructively replaces, the pair (key . val) in alist" (let ((oldentry (assq key (eval alist)))) (if oldentry (setcdr oldentry val) (set alist (cons (cons key val) (eval alist)))))) (defun hilit-set-mode-patterns (modelist patterns &optional parse-fn 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 '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 'gnus-summary-mode '(("^D +[0-9]+: \\[.*$" nil summary-seen) ("^K +[0-9]+: \\[.*$" nil summary-killed) ("^X +[0-9]+: \\[.*$" nil summary-Xed) ("^- +[0-9]+: \\[.*$" nil summary-unread) ("^. +[0-9]+:\\+\\[.*$" nil summary-current) ("^ +[0-9]+: \\[.*$" nil summary-new) )) (hilit-set-mode-patterns 'vm-summary-mode '(("^ .*$" nil summary-seen) ("^->.*$" nil summary-current) ("^ D.*$" nil summary-deleted) ("^ U.*$" nil summary-unread) ("^ N.*$" nil summary-new))) ;;; 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\\)\\|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 ("[0-9]+\\*" nil defun) ; holidays ("[0-9]+\\+" nil comment) ; diary days )) (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. ;; __________________________________________________________________________ ;; Stig@netcom.com netcom.com:/pub/stig/00-PGP-KEY ;; It's hard to be cutting-edge at your own pace... 32 DF B9 19 AE 28 D1 7A ;; Bullet-proof code cannot stand up to teflon bugs. A3 9D 0B 1A 33 13 4D 7F emacs-19.22/lisp/hippie-exp.el100444 13437 1 75525 5422163545 14642 0ustar jimbdaemon;;; hippie-exp.el --- expand text trying various ways to find its expansion. ;; Author: Anders Holst ;; Last change: 22 June 1993 ;; Version: 1.2 ;; Keywords: extensions ;; 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". ;; 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-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'), and add its own tried expansions to it. ;; ;; 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-try-table'. Anyway this seems to occur seldom enough not ;; to be too disturbing. Also it should NOT bee 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. ;; ;;; 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-bw ()) (defvar he-search-bufs ()) (defvar he-searched-n-bufs ()) ;;;###autoload (defvar hippie-expand-try-functions-list '(try-complete-file-name try-expand-all-abbrevs try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-complete-lisp-symbol) "The list of expansion functions tried in order by `hippie-expand'. To change the behavior of `hippie-expand', remove, change the order of, or insert functions in this list.") ;;;###autoload (defvar hippie-expand-verbose t "*Non-nil makes `hippie-expand' output which function it is trying.") ;;;###autoload (defvar hippie-expand-max-buffers () "*The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched.") ;;;###autoload (defun hippie-expand (arg) "Try to expand text before point, using multiple methods. 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 (>= he-num 0) (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))) (delete-region he-string-beg he-string-end) (goto-char he-string-beg) (insert he-search-string) (set-marker he-string-end (point)) (if (= newpos he-string-beg) (goto-char he-string-end) (goto-char newpos)))) ;; Substitutes an expansion STR into the correct region (the region ;; 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 (he-transfer-case-ok str he-search-string))) (newpos (point-marker))) (he-reset-string) (goto-char he-string-beg) (search-forward he-search-string) (replace-match (if trans-case (downcase str) str) (not trans-case) 'literal) (set-marker he-string-end (point)) (if (= newpos he-string-beg) (goto-char he-string-end) (goto-char newpos)))) (defun he-ordinary-case-p (str) (or (string= str (downcase str)) (string= str (upcase str)) (string= str (capitalize str)))) (defun he-transfer-case-ok (to-str from-str) (and (not (string= from-str (substring to-str 0 (min (length from-str) (length to-str))))) ;; otherwise transfer is not needed (and this also solves ;; some obscure situations) (he-ordinary-case-p to-str) ;; otherwise case may be significant (he-ordinary-case-p from-str) ;; otherwise replace-match wont know what to do )) ;; Check if STR is a member of LST. ;; Ignore case if `case-replace' and `case-fold-search' are both t. (defun he-string-member (str lst) (while (and lst (not (if (and case-fold-search case-replace) (string= (downcase (car lst)) (downcase str)) (string= (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 (file-name-nondirectory he-search-string)) (dir-part (expand-file-name (or (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 "")) (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 (concat (file-name-directory he-search-string) (car he-expand-list)))) (he-substitute-string filename) (setq he-tried-table (cons (car he-expand-list) 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 (file-name-nondirectory he-search-string)) (dir-part (expand-file-name (or (file-name-directory he-search-string) "")))) (if (and (not (equal he-search-string "")) (file-directory-p dir-part)) (setq expansion (file-name-completion name-part dir-part))) (if (or (eq expansion t) (string= expansion name-part)) (setq expansion ()))))) (if (not expansion) (progn (if old (he-reset-string)) ()) (let ((filename (concat (file-name-directory he-search-string) expansion))) (he-substitute-string filename) (setq he-tried-table (cons expansion he-tried-table)) t)))) (defun he-file-name-beg () (let ((skips "-a-zA-Z0-9_./~^#$")) (save-excursion (skip-chars-backward skips) (point)))) (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-tried-table (cons (car he-expand-list) he-tried-table)) (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)) (setq expansion ())))) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion) (setq he-tried-table (cons expansion he-tried-table)) 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) (setq he-tried-table (cons expansion he-tried-table)) 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))) (if (not old) (progn (he-init-string (he-line-beg strip-prompt) (point)) (setq he-search-bufs (buffer-list)) (setq he-searched-n-bufs 0) (set-marker he-search-loc 1 (car he-search-bufs)))) (if (not (equal he-search-string "")) (while (and he-search-bufs (not expansion) (or (not hippie-expand-max-buffers) (< he-searched-n-bufs hippie-expand-max-buffers))) (set-buffer (car he-search-bufs)) (if (and (not (eq (current-buffer) buf)) (not (string-match " \\*Minibuf-[0-9]+\\*" (buffer-name (current-buffer)))) (not (eq major-mode 'dired-mode))) ;; Dont search minibuffers nor dired buffers (save-excursion (goto-char he-search-loc) (setq strip-prompt (and (get-buffer-process (current-buffer)) comint-prompt-regexp)) (setq expansion (he-line-search he-search-string strip-prompt nil)) (set-marker he-search-loc (point)) (if expansion (setq he-tried-table (cons expansion he-tried-table)) (setq he-search-bufs (cdr he-search-bufs)) (setq he-searched-n-bufs (1+ he-searched-n-bufs)) (set-marker he-search-loc 1 (car he-search-bufs)))) (setq he-search-bufs (cdr he-search-bufs)) (set-marker he-search-loc 1 (car he-search-bufs))))) (set-buffer buf) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (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) (setq result nil))) ; if already in table, ignore result)) (defun he-line-beg (strip-prompt) (save-excursion (end-of-line) (if (re-search-backward (he-line-search-regexp "" strip-prompt) (save-excursion (beginning-of-line) (point)) t) (match-beginning 2) (beginning-of-line) (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) (setq he-tried-table (cons expansion he-tried-table)) t)))) (defun try-expand-list-all-buffers (old) "Try to complete the current list, searching all other buffers. The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible completions of the same string). It returns t if a new completion is found, nil otherwise." (let ((expansion ()) (buf (current-buffer))) (if (not old) (progn (he-init-string (he-list-beg) (point)) (setq he-search-bufs (buffer-list)) (setq he-searched-n-bufs 0) (set-marker he-search-loc 1 (car he-search-bufs)))) (if (not (equal he-search-string "")) (while (and he-search-bufs (not expansion) (or (not hippie-expand-max-buffers) (< he-searched-n-bufs hippie-expand-max-buffers))) (set-buffer (car he-search-bufs)) (if (and (not (eq (current-buffer) buf)) (not (string-match " \\*Minibuf-[0-9]+\\*" (buffer-name (current-buffer)))) (not (eq major-mode 'dired-mode))) ;; Dont search minibuffers nor dired buffers (save-excursion (goto-char he-search-loc) (setq expansion (he-list-search he-search-string nil)) (set-marker he-search-loc (point)) (if expansion (setq he-tried-table (cons expansion he-tried-table)) (setq he-search-bufs (cdr he-search-bufs)) (setq he-searched-n-bufs (1+ he-searched-n-bufs)) (set-marker he-search-loc 1 (car he-search-bufs)))) (setq he-search-bufs (cdr he-search-bufs)) (set-marker he-search-loc 1 (car he-search-bufs))))) (set-buffer buf) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion t) t)))) (defun he-list-search (str reverse) (let ((result ()) beg pos err) (while (and (not result) (if reverse (search-backward str nil t) (search-forward str nil t))) (setq pos (point)) (setq beg (match-beginning 0)) (goto-char beg) (setq err ()) (condition-case () (forward-list 1) (error (setq err t))) (if (not err) (progn (setq result (buffer-substring beg (point))) (if (he-string-member result he-tried-table) (setq result nil)))) ; if already in table, ignore (goto-char pos)) result)) (defun he-list-beg () (save-excursion (condition-case () (backward-up-list 1) (error ())) (point))) (defun try-expand-all-abbrevs (old) "Try to expand word before point according to all abbrev tables. 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) (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))) (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-tried-table (cons (car he-expand-list) he-tried-table)) (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-dab-search he-search-string t)) (set-marker he-search-loc (point)) (if (not expansion) (progn (set-marker he-search-loc he-string-end) (setq he-search-bw ()))))) (if (not expansion) ; Then look forward. (progn (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string nil)) (set-marker he-search-loc (point)))))) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion t) (setq he-tried-table (cons expansion he-tried-table)) 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))) (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 (string-match " \\*Minibuf-[0-9]+\\*" (buffer-name (current-buffer)))) (not (eq major-mode 'dired-mode))) ;; Dont search minibuffers nor dired buffers (save-excursion (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string nil)) (set-marker he-search-loc (point)) (if expansion (setq he-tried-table (cons expansion he-tried-table)) (setq he-search-bufs (cdr he-search-bufs)) (setq he-searched-n-bufs (1+ he-searched-n-bufs)) (set-marker he-search-loc 1 (car he-search-bufs)))) (setq he-search-bufs (cdr he-search-bufs)) (set-marker he-search-loc 1 (car he-search-bufs))))) (set-buffer buf) (if (not expansion) (progn (if old (he-reset-string)) ()) (progn (he-substitute-string expansion t) t)))) (defun he-dab-search-regexp (pat) (concat "\\b" (regexp-quote pat) "\\(\\sw\\|\\s_\\)+")) (defun he-dab-search (pattern reverse) (let ((result ())) (while (and (not result) (if reverse (re-search-backward (he-dab-search-regexp pattern) nil t) (re-search-forward (he-dab-search-regexp pattern) nil t))) (setq result (buffer-substring (match-beginning 0) (match-end 0))) (if (he-string-member result he-tried-table) (setq result nil))) ; if already in table, ignore result)) (defun he-dabbrev-beg () (save-excursion (skip-syntax-backward "w_") (skip-syntax-forward "_") (point))) (provide 'hippie-exp) ;;; hippie-exp.el ends here emacs-19.22/lisp/holidays.el100444 12120 1 67555 5461150243 14250 0ustar rmsdaemon;;; holidays.el --- holiday functions for the calendar package ;;; Copyright (C) 1989, 1990, 1992 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: holidays, calendar ;; 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. ;;; 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 '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 (calendar-current-date)) (displayed-month (if arg (cdr (assoc (capitalize (completing-read "Month name: " (mapcar 'list (append calendar-month-name-array nil)) nil t)) (calendar-make-alist calendar-month-name-array))) (extract-calendar-month date))) (displayed-year (if arg (calendar-read "Year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-current-date)))) (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 (or (calendar-cursor-to-date) (error "Cursor is not on a date!"))) (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 (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-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 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 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-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 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 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.22/lisp/icomplete.el100444 12120 1 24176 5474526211 14413 0ustar rmsdaemon;;; icomplete.el - minibuffer completion incremental feedback ;;; This package is in the publid domain. ;;; Author: Ken Manheimer ;;; Maintainer: Ken Manheimer ;;; Version: icomplete.el,v 3.2 1993/11/19 18:42:52 klm Exp klm ;;; Created: Mar 1993 klm@nist.gov - first release to usenet ;;; Keywords: help, abbrev ;;; Commentary: ;;; Loading this package implements a more finely-grained completion ;;; feedback scheme, indicating, within the minibuffer, the ;;; prospective minibuffer completion candidates, as you type. See ;;; the documentation string for 'icomplete-prompt' for a specific ;;; description of icompletion. ;;; This will not work on Emacs 18 versions - there may be a version ;;; for v18 in the elisp archives, at archive.cis.ohio-state.edu, in ;;; /pub/gnu/emacs/elisp-archive. ;;; Code: ;;;_ + Provide (provide 'icomplete) ;;;_ + User Customization variables ;;;_ = icomplete-inhibit (defvar icomplete-inhibit nil "*Set this variable to t at any time to inhibit icomplete.") ;;;_ + Setup ;;;_ - Internal Variables ;;;_ = icomplete-eoinput 1 (defvar icomplete-eoinput 1 "Point where minibuffer input ends and completion info begins.") (make-variable-buffer-local 'icomplete-eoinput) ;;;_ > icomplete-prime-session () (defun icomplete-prime-session () "Prep emacs v 19 for icompletion. For emacs v19.18 and later revs, icomplete is installed in 'minibuffer-setup-hook'. Global pre- and post-command-hook functions are used in v19.17 and earlier revs." (let* ((v19-rev (and (string-match "^19\\.\\([0-9]+\\)" emacs-version) (string-to-int (substring emacs-version (match-beginning 1) (match-end 1)))))) (cond ((and v19-rev ; emacs v 19, some rev, (> v19-rev 17)) ;; Post v19rev17, has minibuffer-setup-hook, use it: (add-hook 'minibuffer-setup-hook 'icomplete-prime-minibuffer)) (v19-rev ;; v19rev17 and prior (including lucid): use global ;; pre- and post-command-hooks, instead: (add-hook 'pre-command-hook 'icomplete-pre-command-hook 'append) (add-hook 'post-command-hook 'icomplete-post-command-hook 'append)) ((format "icomplete: non v19 emacs, %s - %s" emacs-version "try elisp-archive icomplete"))))) ;;;_ > icomplete-prime-minibuffer () (defun icomplete-prime-minibuffer () "Prep emacs, v 19.18 or later, for icomplete. \(icomplete-prime- session establishes global hooks, instead, in emacs 19 versions 19.17 and prior.\) Run via minibuffer-setup-hook \(emacs 19.18 or later\), adds icomplete pre- and post-command hooks to do icomplete display management." ;; We append the hooks because preliminary version of blink-paren ;; post-command-hook i have interferes with proper operation of ;; minibuffer quit. (make-local-variable 'pre-command-hook) (make-local-variable 'post-command-hook) (add-hook 'pre-command-hook 'icomplete-pre-command-hook) (add-hook 'post-command-hook 'icomplete-post-command-hook)) ;;;_ > icomplete-window-minibuffer-p () (defmacro icomplete-window-minibuffer-p () "Returns non-nil if current window is a minibuffer window. Trivially equates to '(window-minibuffer-p nil)', with the nil provided in case the argument is not optional in Lucid emacs (which some net correspondance seems to indicate)." '(window-minibuffer-p nil)) ;;;_ + Completion ;;;_ - Completion feedback hooks ;;;_ > icomplete-pre-command-hook () (defun icomplete-pre-command-hook () "Cleanup completions exhibit before user's new input (or whatever) is dealt with." (if (and (icomplete-window-minibuffer-p) (not (symbolp minibuffer-completion-table)) (not icomplete-inhibit)) (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)))) (make-local-variable 'icomplete-eoinput) (setq icomplete-eoinput 1)))) ;;;_ > icomplete-post-command-hook () (defun icomplete-post-command-hook () "Exhibit completions, leaving icomplete-eoinput with position where user input leaves off and exhibit begins, so icomplete-pre-command-hook can subsequently cleanup." (if (and (icomplete-window-minibuffer-p) ; ... in a minibuffer. (not icomplete-inhibit) ; ... not specifically inhibited. ;(sit-for 0) ; ... redisplay and if there's input ; waiting, then don't icomplete ; (stigs suggestion) (too jumpy!) ;; Inhibit for file-name and other custom-func completions: (not (symbolp minibuffer-completion-table)) ) (let ((buffer-undo-list buffer-undo-list )) ; prevent entry (icomplete-exhibit)))) ;;;_ > icomplete-window-setup-hook () (defun icomplete-window-setup-hook () "Exhibit completions, leaving icomplete-eoinput with position where user input leaves off and exhibit begins, so icomplete-pre-command-hook can subsequently cleanup." (if (and (icomplete-window-minibuffer-p) ; ... in a minibuffer. ) (message "ic ws doing")(sit-for 1))) ;;;_ > icomplete-exhibit () (defun icomplete-exhibit () "Exhibit completions, leaving icomplete-eoinput with position where user input leaves off and exhibit begins, so icomplete-pre-command-hook can subsequently cleanup." (if (not (symbolp minibuffer-completion-table)) (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-prompt contents minibuffer-completion-table minibuffer-completion-predicate (not minibuffer-completion-confirm)))))))) ;;;_ - Completion feedback producer ;;;_ > icomplete-prompt (name candidates predicate require-match) (defun icomplete-prompt (name candidates predicate require-match) "Identify prospective candidates for minibuffer completion. The display is updated with each minibuffer keystroke when icomplete is enabled \(by loading the 'icomplete' elisp package\) and doing 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 'concat (cdr (apply 'append (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 (icomplete-prime-session) ;;;_* Local emacs vars. '( Local variables: eval: (save-excursion (if (not (condition-case err (outline-mode t) (wrong-number-of-arguments nil))) (progn (message "Allout outline-mode not loaded, not adjusting buffer exposure") (sit-for 1)) (message "Adjusting '%s' visibility" (buffer-name)) (outline-lead-with-comment-string ";;;_") (goto-char 0) (outline-exposure -1 0))) End:) ;;; icomplete.el ends here emacs-19.22/lisp/icon.el100444 74777 1 47644 5353350052 13534 0ustar ericdaemon;;; 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. ;; ;; Note: use ;; (autoload 'icon-mode "icon" nil t) ;; (setq auto-mode-alist (cons '("\\.icn$" . icon-mode) auto-mode-alist)) ;; if not permanently installed in your emacs ;;; 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)) (defconst icon-indent-level 4 "*Indentation of Icon statements with respect to containing block.") (defconst icon-brace-imaginary-offset 0 "*Imagined indentation of a Icon open brace that actually follows a statement.") (defconst icon-brace-offset 0 "*Extra indentation for braces, compared with other text in same context.") (defconst icon-continued-statement-offset 4 "*Extra indent for lines not starting new statements.") (defconst icon-continued-brace-offset 0 "*Extra indent for substatements that start with open-braces. This is in addition to icon-continued-statement-offset.") (defconst icon-auto-newline nil "*Non-nil means automatically newline before and after braces inserted in Icon code.") (defconst 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.") (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.22/lisp/inc-vers.el100444 12120 1 3337 5423340044 14124 0ustar rmsdaemon;;; inc-vers.el --- load this to increment the recorded Emacs version number. ;; 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. ;;; Code: (insert-file-contents "../lisp/version.el") (re-search-forward "emacs-version \"[^\"]*[0-9]+\"") (forward-char -1) (save-excursion (save-restriction (narrow-to-region (point) (progn (skip-chars-backward "0-9") (point))) (goto-char (point-min)) (let ((version (read (current-buffer)))) (delete-region (point-min) (point-max)) (prin1 (1+ version) (current-buffer))))) (skip-chars-backward "^\"") (message "New Emacs version will be %s" (buffer-substring (point) (progn (skip-chars-forward "^\"") (point)))) (if (and (file-accessible-directory-p "../lisp/") (null (file-writable-p "../lisp/version.el"))) (delete-file "../lisp/version.el")) (write-region (point-min) (point-max) "../lisp/version.el" nil 'nomsg) (erase-buffer) (set-buffer-modified-p nil) (kill-emacs) ;;; inc-vers.el ends here emacs-19.22/lisp/indent.el100444 12120 1 20565 5430553766 13720 0ustar rmsdaemon;;; indent.el --- indentation 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: ;; Commands for making and changing indentation in text. These are ;; described in the Emacs manual. ;;; Code: (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 () "Indent line in proper way for current major mode." (interactive) (if (eq indent-line-function 'indent-to-left-margin) (insert-tab) (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))) (delete-region (point) (progn (skip-chars-forward " \t") (point))) (or (eolp) (indent-to (max 0 (+ indent arg)) 0))) (forward-line 1)) (move-marker end nil))) ;; This is the default indent-line-function, ;; used in Fundamental Mode, Text Mode, etc. (defun indent-to-left-margin () (or (= (current-indentation) left-margin) (let (epos) (save-excursion (beginning-of-line) (delete-region (point) (progn (skip-chars-forward " \t") (point))) (indent-to left-margin) (setq epos (point))) (if (< (point) epos) (goto-char epos))))) (defvar indent-region-function nil "Function which is short cut 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'.") (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) (if abbrev-mode (expand-abbrev)) (let ((tabs tab-stop-list)) (while (and tabs (>= (current-column) (car tabs))) (setq tabs (cdr tabs))) (if tabs (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 (move-to-column (car tabs) t)))) (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.22/lisp/inf-lisp.el100444 12120 1 62554 5474004621 14151 0ustar rmsdaemon;;; inf-lisp.el --- an inferior-lisp mode ;;; Copyright (C) 1988, 1993 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 (full-copy-sparse-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 "^[^> ]*>+:? *" "Regexp to recognise prompts in the Inferior Lisp mode. Defaults to \"^[^> ]*>+:? *\", 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*") (switch-to-buffer "*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.22/lisp/info.el100444 12120 1 150400 5474524216 13376 0ustar rmsdaemon;;; info.el --- info package for Emacs. ;; Copyright (C) 1985, 1986, 1992, 1993 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-default-directory-list nil "List of default directories to search for Info documentation files. This value is used as the default for `Info-directory-list'. It is set in paths.el.") (defvar Info-fontify t "*Non-nil enables highlighting and fonts in Info nodes.") (defvar Info-directory-list (let ((path (getenv "INFOPATH"))) (if path (let ((list nil) idx) (while (> (length path) 0) (setq idx (or (string-match ":" path) (length path)) list (cons (substring path 0 idx) list) path (substring path (min (1+ idx) (length path))))) (nreverse list)) 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.") (defvar Info-current-file nil "Info file that Info is now looking at, or nil.") (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 '( (".info" . nil) ("" . nil) (".Z" . "uncompress") (".Y" . "unyabba") (".gz" . "gunzip") (".z" . "gunzip") (".info.Z" . "uncompress") (".info.Y" . "unyabba") (".info.gz" . "gunzip") (".info.z" . "gunzip")) "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.") (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." (if (null (catch 'ok (mapcar (function (lambda (x) (let ((compressed (concat filename (car x)))) (if (file-exists-p compressed) (progn (insert-file-contents compressed visit) (if (cdr x) (let ((buffer-read-only nil)) (shell-command-on-region (point-min) (point-max) (cdr x) t))) (throw 'ok t)))))) Info-suffix-list) nil)) (error "Can't find %s or any compressed version of it!" filename))) ;;;###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*") (switch-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. '("./") 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. (catch 'foundit (mapcar (function (lambda (x) (if (file-exists-p (concat temp (car x))) (progn (setq found temp) (throw 'foundit nil))) (if (file-exists-p (concat temp-downcase (car x))) (progn (setq found temp-downcase) (throw 'foundit nil))))) Info-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) (or (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" (file-name-sans-versions buffer-file-name))))) (if (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 (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) (equal (cdr elt) (file-attributes (car elt)))) Info-dir-file-attributes)))) (insert Info-dir-contents) (let ((dirs Info-directory-list) buffers buffer others nodes dirs-done) ;; Search the directory list for the directory file. (while dirs (or (member (file-truename (expand-file-name (car dirs))) dirs-done) (member (directory-file-name (file-truename (expand-file-name (car dirs)))) dirs-done) ;; Try several variants of specified name. ;; Try upcasing, appending `.info', or both. (let* (temp (buffer (cond ((progn (setq temp (expand-file-name "DIR" (car dirs))) (file-exists-p temp)) (find-file-noselect temp)) ((progn (setq temp (expand-file-name "dir" (car dirs))) (file-exists-p temp)) (find-file-noselect temp)) ((progn (setq temp (expand-file-name "DIR.INFO" (car dirs))) (file-exists-p temp)) (find-file-noselect temp)) ((progn (setq temp (expand-file-name "dir.info" (car dirs))) (file-exists-p temp)) (find-file-noselect temp))))) (setq dirs-done (cons (file-truename (expand-file-name (car dirs))) (cons (directory-file-name (file-truename (expand-file-name (car dirs)))) dirs-done))) (if buffer (setq buffers (cons buffer buffers) Info-dir-file-attributes (cons (cons (buffer-file-name buffer) (file-attributes (buffer-file-name buffer))) Info-dir-file-attributes))))) (setq dirs (cdr dirs))) ;; 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)))) (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)) ;; 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))) (insert "\n")) (setq nodes (cdr nodes))) ;; Kill all the buffers we just made. (while buffers (kill-buffer (car buffers)) (setq buffers (cdr buffers)))) (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 (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)))) (Info-find-node (if (equal filename "") nil filename) (if (equal nodename "") "Top" nodename)))) (defun Info-read-node-name (prompt &optional default) (let* ((completion-ignore-case t) (nodename (completing-read prompt (Info-build-node-completions)))) (if (equal nodename "") (or default (Info-read-node-name prompt)) nodename))) (defun Info-build-node-completions () (or Info-current-file-completions (let ((compl nil)) (save-excursion (save-restriction (if (marker-buffer Info-tag-table-marker) (progn (set-buffer (marker-buffer Info-tag-table-marker)) (goto-char Info-tag-table-marker) (while (re-search-forward "\nNode: \\(.*\\)\177" nil t) (setq compl (cons (list (buffer-substring (match-beginning 1) (match-end 1))) compl)))) (widen) (goto-char (point-min)) (while (search-forward "\n\^_" nil t) (forward-line 1) (let ((beg (point))) (forward-line 1) (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]" beg t) (setq compl (cons (list (buffer-substring (match-beginning 1) (match-end 1))) compl)))))))) (setq Info-current-file-completions compl)))) (defun Info-restore-point (hl) "If this node has been visited, restore the point value when we left." (if hl (if (and (equal (nth 0 (car hl)) Info-current-file) (equal (nth 1 (car hl)) Info-current-node)) (goto-char (nth 2 (car hl))) (Info-restore-point (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 (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) (or (and (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 (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 (start-point (point)) str i) (save-excursion (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)) (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)) (setq completions (cons (cons str nil) 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 " 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 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 ?\ )) str)) ;; No one calls this and Info-menu-item doesn't exist. ;;(defun Info-menu-item-sequence (list) ;; (while list ;; (Info-menu-item (car list)) ;; (setq list (cdr list)))) (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)) (last nil)) (save-excursion (goto-char (point-min)) (if (not (search-forward "\n* menu:" nil t)) (error "No menu in this node")) (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t) (if (and (null default) (prog1 (if last (< last p) nil) (setq last (match-beginning 0))) (<= p last)) (setq default (car (car completions)))) (setq completions (cons (cons (buffer-substring (match-beginning 1) (match-end 1)) (match-beginning 1)) completions))) (if (and (null default) last (< last p) (<= p (progn (end-of-line) (point)))) (setq default (car (car completions))))) (let ((item nil)) (while (null item) (setq item (let ((completion-ignore-case t)) (completing-read (if default (format "Menu item (default %s): " default) "Menu item: ") completions 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)) (not (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) (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) (search-backward "\n* menu:" nil t) (or (search-backward "\n* " nil t) (error "No previous items in menu")) (Info-goto-node (Info-extract-menu-node-name)))) (defmacro Info-no-error (&rest body) (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil))) (defun Info-next-preorder () "Go to the next node, popping up a level if there is none." (interactive) (cond ((looking-at "\\*note[ \n]*\\([^:]*\\):") (Info-follow-reference (buffer-substring (match-beginning 1) (match-end 1)))) ((Info-no-error (Info-next-menu-item)) ) ((Info-no-error (Info-up)) (forward-line 1)) (t (error "No more nodes")))) (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)) ) ((Info-no-error (Info-up)) (forward-line -1)) (t (error "No previous nodes")))) (defun Info-scroll-up () "Read the next screen. If end of buffer is visible, go to next entry." (interactive) (if (pos-visible-in-window-p (point-max)) (Info-next-preorder) (scroll-up)) ) (defun Info-scroll-down () "Read the previous screen. If start of buffer is visible, go to last entry." (interactive) (if (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)) (let ((Info-keeping-history nil)) (Info-goto-node (Info-extract-menu-node-name))) (or (equal topic "") (let ((matches nil) (exact nil) (Info-keeping-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)) (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-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." (interactive "e") (let* ((start (event-start click)) (window (car start)) (pos (car (cdr start)))) (select-window window) (goto-char pos)) (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)) ((save-excursion (forward-line 1) (eobp)) (Info-next))) )) (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-next-preorder) (define-key Info-mode-map "\t" 'Info-next-reference) (define-key Info-mode-map "\e\t" 'Info-prev-reference) (define-key Info-mode-map "1" 'Info-nth-menu-item) (define-key Info-mode-map "2" 'Info-nth-menu-item) (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) (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-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-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-preorder] Next-preorder; that is, try to go to the next menu item, and if that fails try to move up, and if that fails, tell user he/she is done reading. \\[Info-next-reference] Move cursor to next cross-reference or menu item. \\[Info-prev-reference] Move cursor to previous cross-reference or menu item." (kill-all-local-variables) (setq major-mode 'Info-mode) (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 (fboundp 'make-face) (progn (make-face 'info-node) (make-face 'info-menu-5) (make-face 'info-xref) (or (face-differs-from-default-p 'info-node) (if (face-differs-from-default-p 'bold-italic) (copy-face 'bold-italic 'info-node) (copy-face 'bold 'info-node))) (or (face-differs-from-default-p 'info-menu-5) (set-face-underline-p 'info-menu-5 t)) (or (face-differs-from-default-p 'info-xref) (copy-face 'bold 'info-xref))) (setq Info-fontify nil)) (Info-set-mode-line) (run-hooks 'Info-mode-hook)) (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}" ) (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")) (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) ;; Make mode line update. (set-buffer-modified-p (buffer-modified-p)) (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) ;; Make mode line update. (set-buffer-modified-p (buffer-modified-p)) (and (marker-position Info-tag-table-marker) (buffer-modified-p) (message "Tags may have changed. Use Info-tagify if necessary"))) (defun Info-find-emacs-command-nodes (command) "Return a list of locations documenting COMMAND in the Emacs Info manual. The locations are of the format used in Info-history, i.e. \(FILENAME NODENAME BUFFERPOS\)." (require 'info) (let ((where '()) (cmd-desc (concat "^\\* " (regexp-quote (symbol-name command)) ":\\s *\\(.*\\)\\.$"))) (save-excursion (Info-find-node "emacs" "Command 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." (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%. 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." (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))))) (defun Info-fontify-node () (save-excursion (let ((buffer-read-only nil)) (goto-char (point-min)) (if (looking-at "^File: [^,: \t]+,?[ \t]+") (progn (goto-char (match-end 0)) (while (looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?") (goto-char (match-end 0)) (put-text-property (match-beginning 1) (match-end 1) 'face 'info-xref)))) (goto-char (point-min)) (while (re-search-forward "\\*Note[ \n\t]*\\([^:]*\\):" nil t) (if (= (char-after (1- (match-beginning 0))) ?\") ; hack nil (put-text-property (match-beginning 1) (match-end 1) 'face 'info-xref))) (goto-char (point-min)) (if (and (search-forward "\n* Menu:" nil t) (not (string-match "\\" Info-current-node)) ;; Don't take time to annotate huge menus (< (- (point-max) (point)) 10000)) (let ((n 0)) (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t) (setq n (1+ n)) (if (memq n '(5 9)) ; visual aids to help with 1-9 keys (put-text-property (match-beginning 0) (1+ (match-beginning 0)) 'face 'info-menu-5)) (put-text-property (match-beginning 1) (match-end 1) 'face 'info-node)))) (set-buffer-modified-p nil)))) (provide 'info) ;;; info.el ends here emacs-19.22/lisp/informat.el100444 13437 1 33025 5340031607 14366 0ustar jimbdaemon;;; 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) (forward-line 1) (let ((beg (point))) (forward-line 1) (if (re-search-backward regexp beg t) (setq list (cons (list (buffer-substring (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" (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 (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 (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 (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 (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)) (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 (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.22/lisp/isearch.el100444 12241 1 142232 5475500465 14550 0ustar rolanddaemon;;; isearch.el --- incremental search minor mode. ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte ;; |$Date: 1993/11/26 22:20:23 $|$Revision: 1.55 $ ;; 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. ;;; 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: ;;;========================================================================= ;;; Emacs features ;; isearch-mode takes advantage of the features provided by several ;; different versions of emacs. Rather than testing the version of ;; emacs, several constants are defined, one for each of the features. ;; Each of the tests below must work on any version of emacs. ;; (Perhaps provide and featurep could be used for this purpose.) (defconst isearch-gnu-emacs-events (fboundp 'set-frame-height)) ;; emacs 19 (defconst isearch-pre-command-hook-exists (boundp 'pre-command-hook)) ;; lemacs (defconst isearch-event-data-type nil) ;; lemacs (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.") ;;;======================================================================== ;;; Some additional options and constants. (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.") ;; I removed the * from the doc string because highlighting is not ;; currently a clean thing to do. Once highlighting is made clean, ;; this feature can be re-enabled and advertised. (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))) ;; 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) (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-key map [mouse-2] 'isearch-yank-kill) ;; This overrides the default binding for t. (define-key map [down-mouse-2] 'nil) ;; Bind the ASCII-equivalent "function keys" explicitly ;; if we bind their equivalents, ;; since otherwise the default binding would override. ;; We bind [escape] below. (define-key map [tab] 'isearch-printing-char) (define-key map [delete] 'isearch-delete-char) (define-key map [backspace] 'isearch-delete-char) (define-key map [return] 'isearch-exit) (define-key map [newline] 'isearch-printing-char) ;; 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) ;; 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) (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) ;; For emacs 19, switching frames should terminate isearch-mode (if isearch-gnu-emacs-events (define-key map [switch-frame] 'isearch-switch-frame-handler)) (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-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-other-end nil) ; Start (end) of match if forward (backward). (defvar isearch-wrapped nil) ; Searching restarted from the top (bottom). (defvar isearch-barrier 0) (defvar isearch-case-fold-search nil) ; case-fold-search while searching. (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) (defvar isearch-old-local-map 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'). 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." ;; 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 ;; Use (baud-rate) for now, for sake of other versions. 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) isearch-old-local-map (current-local-map) search-ring-yank-pointer nil regexp-search-ring-yank-pointer nil) (if isearch-slow-terminal-mode (setq isearch-window-configuration (current-window-configuration))) ;; This was for Lucid Emacs. But now that we have pre-command-hook, ;; it causes trouble. ;; (if isearch-pre-command-hook-exists ;; (add-hook 'pre-command-hook 'isearch-pre-command-hook)) (setq isearch-mode " Isearch") ;; forward? regexp? (set-buffer-modified-p (buffer-modified-p)) ; update modeline ;; It is ugly to show region highlighting while the search ;; is going on. And we don't want the mark active at the end either. (setq deactivate-mark t) (isearch-push-state) (use-local-map isearch-mode-map) (isearch-update) (run-hooks 'isearch-mode-hook) ;; 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))) ) ;;;==================================================== ;; Some high level utilities. Others below. (defun isearch-update () ;; Called after each command to update the display. (if (if isearch-event-data-type (null unread-command-event) (if isearch-gnu-emacs-events (null unread-command-events) (< unread-command-char 0))) (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))) )) (setq ;; quit-flag nil not for isearch-mode isearch-adjusted nil isearch-yank-flag nil) ) (defun isearch-done (&optional nopush) ;; Called by all commands that terminate isearch-mode. ;; If NOPUSH is non-nil, we don't push the string on the search ring. (use-local-map isearch-old-local-map) ;; (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) (progn (push-mark isearch-opoint t) (deactivate-mark) (or executing-macro (> (minibuffer-depth) 0) (message "Mark saved where search started"))) ;; (message "") why is this needed? ) (setq isearch-mode nil) (set-buffer-modified-p (buffer-modified-p)) ;; update modeline (if (and (> (length isearch-string) 0) (not nopush)) ;; Update the ring data. (if isearch-regexp (if (or (null regexp-search-ring) (not (string= isearch-string (car regexp-search-ring)))) (progn (setq regexp-search-ring (cons isearch-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= isearch-string (car search-ring)))) (progn (setq search-ring (cons isearch-string search-ring)) (if (> (length search-ring) search-ring-max) (setcdr (nthcdr (1- search-ring-max) search-ring) nil)))))) (run-hooks 'isearch-mode-end-hook) (if isearch-recursive-edit (exit-recursive-edit))) ;;;======================================================= ;;; 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-backward-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-other-end isearch-other-end) (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) (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)) ;; 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) isearch-string minibuffer-local-isearch-map nil 'junk-ring)) isearch-new-message (mapconcat 'text-char-description isearch-new-string ""))) ;; Always resume isearching by restarting it. (isearch-mode isearch-forward isearch-regexp isearch-op-fun isearch-recursive-edit 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-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) (isearch-done t) ; exit isearch (signal 'quit nil)) ; and pass on quit signal ;; If search is failing, rub out until it is once more successful. (while (not isearch-success) (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. (setq isearch-success t) (or (equal isearch-string "") (progn ;; If repeating a search that found ;; an empty string, ensure we advance. (if (equal (match-end 0) (match-beginning 0)) (forward-char (if isearch-forward 1 -1))) (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-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-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) (cond ((eq search-exit-option 'edit) (let ((key (this-command-keys))) (apply 'isearch-unread (listify-key-sequence key))) (isearch-edit-string)) (search-exit-option (let ((key (this-command-keys)) (index 0) window) (apply 'isearch-unread (listify-key-sequence key)) ;; 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)) ;; These events now have a symbol; they used to have a list. ;; Accept either one. Other events have a number here. (not (numberp (posn-point (event-start (aref key 1))))) (setq index 1)) ;; 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 (aref key index)) (setq window (posn-window (event-start (aref key index)))) (windowp window)) (save-excursion (set-buffer (window-buffer window)) (isearch-done)) (isearch-done)))) (t;; otherwise nil (isearch-process-search-string (this-command-keys) (this-command-keys))))) (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 search-whitespace-regexp (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)) (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-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 (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)) (error nil))) ;; If currently failing, display no ellipsis. (or isearch-success (setq ellipsis nil)) (let ((m (concat (if isearch-success "" "failing ") (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 isearch-case-fold-search 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-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))) (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 (null search-highlight) 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) (if (integerp c) (make-string 1 c) (if (and (symbolp c) (get c 'ascii-character)) (make-string 1 (get c 'ascii-character)) (make-string 1 (event-to-character c))))) (defun isearch-text-char-description (c) (isearch-char-to-string c)) (defun isearch-unread (&rest char-or-events) ;; General function to unread characters or events. (if isearch-gnu-emacs-events (setq unread-command-events (append char-or-events unread-command-events)) (let ((char (if (cdr char-or-events) (progn (while (cdr char-or-events) (setq char-or-events (cdr char-or-events))) (+ 128 (car char-or-events))) (car char-or-events)))) (if isearch-event-data-type (setq unread-command-event char) (setq unread-command-char char))))) (defun isearch-last-command-char () ;; General function to return the last command character. (if isearch-event-data-type last-command-event last-command-char)) ;;; isearch.el ends here emacs-19.22/lisp/iso-acc.el100444 12120 1 20233 5473770601 13741 0ustar rmsdaemon;;; iso-acc.el -- minor mode providing electric accent keys ;;; Copyright (C) 1993 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 ;; (`iso-accents-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-minor-mode', pseudo accent characters are used to ;; introduce accented keys. The pseudo-accent characterss 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-accents-list '(((?' ?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) ((?` ? ) ?`) ((?` ?`) ?`) ; no special code? ((?^ ?A) ?\302) ((?^ ?E) ?\312) ((?^ ?I) ?\316) ((?^ ?O) ?\324) ((?^ ?U) ?\333) ((?^ ?a) ?\342) ((?^ ?e) ?\352) ((?^ ?i) ?\356) ((?^ ?o) ?\364) ((?^ ?u) ?\373) ((?^ ? ) ?^) ((?^ ?^) ?^) ; no special code? ((?\" ?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) ((?\~ ?a) ?\343) ((?\~ ?c) ?\347) ((?\~ ?d) ?\360) ((?\~ ?n) ?\361) ((?\~ ?o) ?\365) ((?\~ ?>) ?\273) ((?\~ ?<) ?\253) ((?\/ ?A) ?\305) ;; A-with-ring (Norwegian and Danish) ((?\/ ?E) ?\306) ;; AE-ligature (Norwegian and Danish) ((?\/ ?O) ?\330) ((?\/ ?a) ?\345) ;; a-with-ring (Norwegian and Danish) ((?\/ ?e) ?\346) ;; ae-ligature (Norwegian and Danish) ((?\/ ?o) ?\370) ) "Association list for ISO accent combinations.") (defvar iso-accents-minor-mode nil "*Non-nil enables ISO Accents mode. Setting this variable makes it local to the current buffer. See `iso-accents-mode'.") (make-variable-buffer-local 'iso-accents-minor-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-minor-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))) (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 '(?' ?` ?^ ?\" ?~ ?/) "*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.") (or key-translation-map (setq key-translation-map (make-sparse-keymap))) ;; For sequences starting with an accent character, ;; use a function that tests iso-accents-minor-mode. (if (memq ?' iso-accents-enable) (define-key key-translation-map "'" 'iso-accents-accent-key)) (if (memq ?` iso-accents-enable) (define-key key-translation-map "`" 'iso-accents-accent-key)) (if (memq ?^ iso-accents-enable) (define-key key-translation-map "^" 'iso-accents-accent-key)) (if (memq ?\" iso-accents-enable) (define-key key-translation-map "\"" 'iso-accents-accent-key)) (if (memq ?~ iso-accents-enable) (define-key key-translation-map "~" 'iso-accents-accent-key)) (if (memq ?/ iso-accents-enable) (define-key key-translation-map "/" 'iso-accents-accent-key)) ;; 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-minor-mode minor-mode-map-alist) ;; (setq minor-mode-alist ;; (append minor-mode-alist ;; '((iso-accents-minor-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 a d with dash. \"s gives German sharp s. /a gives a with ring. /e gives an a-e ligature. ~< and ~> give guillemets. 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-minor-mode) (setq iso-accents-minor-mode nil) ;; Enable electric accents. (setq iso-accents-minor-mode t))) ;;; iso-acc.el ends here emacs-19.22/lisp/iso-ascii.el100444 12120 1 15373 5401144240 14275 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.22/lisp/iso-insert.el100444 12120 1 32636 5401144327 14520 0ustar rmsdaemon;;; iso-insert.el --- insert functions for ISO 8859/1. ;; 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: (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" (make-sparse-keymap)) (define-key 8859-1-map "AA" 'insert-A-ring) (define-key 8859-1-map "AE" '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" (make-sparse-keymap)) (define-key 8859-1-map "aa" 'insert-a-ring) (define-key 8859-1-map "ae" '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.22/lisp/iso-swed.el100444 12120 1 16371 5401144260 14150 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.22/lisp/iso-syntax.el100444 13437 1 12070 5400414571 14664 0ustar jimbdaemon;;; 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 (concat (car (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 (set-standard-case-table (list downcase nil nil nil))) (provide 'iso-syntax) ;;; iso-syntax.el ends here emacs-19.22/lisp/iso-transl.el100666 12120 1 11640 5467146324 14530 0ustar rmsdaemon;;; iso-transl.el --- keyboard input definitions for ISO 8859/1. ;; Copyright (C) 1987, 1993 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: (let ((map (make-sparse-keymap))) (define-key map " " [160]) (define-key map "!" [161]) (define-key map "\"" (make-sparse-keymap)) (define-key map "\"\"" [168]) (define-key map "\"A" [196]) (define-key map "\"E" [203]) (define-key map "\"I" [207]) (define-key map "\"O" [214]) (define-key map "\"U" [220]) (define-key map "\"a" [228]) (define-key map "\"e" [235]) (define-key map "\"i" [239]) (define-key map "\"o" [246]) (define-key map "\"u" [252]) (define-key map "\"y" [255]) (define-key map "'" (make-sparse-keymap)) (define-key map "''" [180]) (define-key map "'A" [193]) (define-key map "'E" [201]) (define-key map "'I" [205]) (define-key map "'O" [211]) (define-key map "'U" [218]) (define-key map "'Y" [221]) (define-key map "'a" [225]) (define-key map "'e" [233]) (define-key map "'i" [237]) (define-key map "'o" [243]) (define-key map "'u" [250]) (define-key map "'y" [253]) (define-key map "$" [164]) (define-key map "+" [177]) (define-key map "," (make-sparse-keymap)) (define-key map ",," [184]) (define-key map ",C" [199]) (define-key map ",c" [231]) (define-key map "-" [173]) (define-key map "." [183]) (define-key map "/" (make-sparse-keymap)) (define-key map "//" [247]) (define-key map "/O" [216]) (define-key map "/o" [248]) (define-key map "1" (make-sparse-keymap)) (define-key map "1/" (make-sparse-keymap)) (define-key map "1/2" [189]) (define-key map "1/4" [188]) (define-key map "3" (make-sparse-keymap)) (define-key map "3/" (make-sparse-keymap)) (define-key map "3/4" [190]) (define-key map "<" [171]) (define-key map "=" [175]) (define-key map ">" [187]) (define-key map "?" [191]) (define-key map "A" (make-sparse-keymap)) (define-key map "AA" [197]) (define-key map "AE" [198]) (define-key map "C" [169]) (define-key map "D" [208]) (define-key map "L" [163]) (define-key map "P" [182]) (define-key map "R" [174]) (define-key map "S" [167]) (define-key map "T" [222]) (define-key map "Y" [165]) (define-key map "^" (make-sparse-keymap)) (define-key map "^1" [185]) (define-key map "^2" [178]) (define-key map "^3" [179]) (define-key map "^A" [194]) (define-key map "^E" [202]) (define-key map "^I" [206]) (define-key map "^O" [212]) (define-key map "^U" [219]) (define-key map "^a" [226]) (define-key map "^e" [234]) (define-key map "^i" [238]) (define-key map "^o" [244]) (define-key map "^u" [251]) (define-key map "_" (make-sparse-keymap)) (define-key map "_a" [170]) (define-key map "_o" [186]) (define-key map "`" (make-sparse-keymap)) (define-key map "`A" [192]) (define-key map "`E" [200]) (define-key map "`I" [204]) (define-key map "`O" [210]) (define-key map "`U" [217]) (define-key map "`a" [224]) (define-key map "`e" [232]) (define-key map "`i" [236]) (define-key map "`o" [242]) (define-key map "`u" [249]) (define-key map "a" (make-sparse-keymap)) (define-key map "aa" [229]) (define-key map "ae" [230]) (define-key map "c" [162]) (define-key map "d" [240]) (define-key map "o" [176]) (define-key map "s" [223]) (define-key map "t" [254]) (define-key map "u" [181]) (define-key map "x" [215]) (define-key map "|" [166]) (define-key map "~" (make-sparse-keymap)) (define-key map "~A" [195]) (define-key map "~N" [209]) (define-key map "~O" [213]) (define-key map "~a" [227]) (define-key map "~n" [241]) (define-key map "~o" [245]) (define-key map "~~" [172]) (or key-translation-map (setq key-translation-map (make-sparse-keymap))) (define-key key-translation-map "\C-x8" 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.22/lisp/ispell.el100444 12120 1 107135 5467444254 13747 0ustar rmsdaemon;;; 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 use this to specify the name of your private dictionary. 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 `~/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))) (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-region] '("Check Region" . ispell-region)) (define-key ispell-menu-map [ispell-buffer] '("Check Buffer" . ispell)) (define-key ispell-menu-map [ispell-word] '("Check Word" . ispell-word)) ;;;###autoload (defun ispell (&optional buf start end) "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 (kept in `$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)) (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) (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 (catch 'ispell-quit (save-window-excursion (ispell-point (point) "at point.")) (ispell-dump)) (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 "'"))) (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")) ;;;; 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...still. Please move on.") (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.") ;;;###autoload (defun ispell-message () "Check the spelling of a mail message or news post. Don't check spelling of message headers 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)) (while (and (not (eobp)) continue) ;; Skip across text cited from other messages. (while (and (looking-at (concat "^[ \t]*$\\|" cite-regexp)) (not (eobp))) (forward-line 1)) (if (not (eobp)) ;; Check the next batch of lines that *aren't* cited. (let ((start (point))) (if (re-search-forward (concat "^\\(" cite-regexp "\\)") nil 'end) (beginning-of-line)) (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.22/lisp/kermit.el100444 13437 1 14575 5405344122 14054 0ustar jimbdaemon;;; 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.22/lisp/ledit.el100444 74777 1 11541 5353350060 13667 0ustar ericdaemon;;; 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.22/lisp/levents.el100444 12120 1 21607 5377506034 14111 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)) (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 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.22/lisp/life.el100444 74720 14 24063 5427026177 13752 0ustar eggertguest;;; 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]")) ;; try to optimize the (goto-char (point-min)) & (goto-char (point-max)) ;; idioms. This depends on goto-char's not griping if we undershoot ;; or overshoot beginning or end of buffer. (defmacro goto-beginning-of-buffer () '(goto-char 1)) (defmacro maxint () (lsh (lsh (lognot 0) 1) -1)) (defmacro goto-end-of-buffer () '(goto-char (maxint))) (defmacro 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) (defun abs (n) (if (< n 0) (- n) n)) ;;;###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 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) (random t) (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-beginning-of-buffer) (while (re-search-forward (life-not-void-regexp) nil t) (replace-match (life-life-string) t t)) ;; center the pattern horizontally (goto-beginning-of-buffer) (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-beginning-of-buffer) (newline n) (goto-end-of-buffer) (newline n) ;; pad lines out to fill-column (goto-beginning-of-buffer) (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 () (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-beginning-of-buffer) ;; 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)) (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-beginning-of-buffer) (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-beginning-of-buffer) (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-beginning-of-buffer) ;; 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-beginning-of-buffer) (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-end-of-buffer) ;; 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-end-of-buffer) (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.22/lisp/lisp-mnt.el100444 12120 1 32655 5425022405 14166 0ustar rmsdaemon;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Maintainer: Eric S. Raymond ;; Created: 14 Jul 1992 ;; Version: $Id: lisp-mnt.el,v 1.4 1993/07/26 18:40:03 rms Exp $ ;; Keywords: docs ;; Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; 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 elisp code related to a topic. ;; ;; * Bogus-Bureaucratic-Cruft line --- this is a joke. I figured I should ;; satirize this design before someone else did. Also, it illustrates the ;; possibility that other headers may be added in the future for new purposes. ;; ;; * 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 elisp 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 ":$") 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 (or addr bug-gnu-emacs) topic) (goto-char (point-max)) (insert "\nIn " package (and 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.22/lisp/lisp-mode.el100444 12120 1 64626 5474005221 14320 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. ;;; Code: ;;; 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) (modify-syntax-entry ?\f "> " 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 ()) (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 '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 '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)) (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 "\M-q" 'lisp-fill-paragraph) (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify) (define-key shared-lisp-mode-map "\t" 'lisp-indent-line)) (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 () (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)) (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))) (prin1 (eval (save-excursion (end-of-defun) (beginning-of-defun) (read (current-buffer))))))) (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))))) (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) 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 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 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 retry nil ;; Innermost containing sexp found (goto-char (1+ containing-sexp)) (if (not 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) 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)) last-sexp) ;; This is the first line to start within the containing sexp. ;; It's almost certainly a function call. (if (= (point) 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) 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))))) ;; 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) 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)) last-sexp)) (progn (goto-char last-sexp) (beginning-of-line) (parse-partial-sexp (point) last-sexp 0 t))) ;; Indent under the list or under the first sexp on the ;; same line as 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-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) (starting-point (point)) (last-point (point)) last-depth bol outer-loop-done inner-loop-done state this-indent) ;; 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 (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 (goto-char start) (and (bolp) (not (eolp)) (lisp-indent-line)) (let ((endmark (copy-marker end))) (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)))))) (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.22/lisp/lisp.el100444 12120 1 22251 5407672606 13377 0ustar rmsdaemon;;; lisp.el --- Lisp editing commands for Emacs ;; Copyright (C) 1985, 1986 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: (defvar defun-prompt-regexp nil "Non-nil => regexp to ignore, before the `(' that starts a defun.") (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." (interactive "p") (and arg (< arg 0) (forward-char 1)) (and (re-search-backward (if defun-prompt-regexp (concat "^\\s(\\|" "\\(" defun-prompt-regexp "\\)\\s(") "^\\s(") nil 'move (or arg 1)) (progn (beginning-of-line) 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 (forward-char 1) (beginning-of-defun 1))) nil (or (bobp) (forward-char -1)) (beginning-of-defun -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 1) (forward-sexp 1) (forward-line 1) (if (>= (point) pos) (if (beginning-of-defun 2) (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-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. This command also sometimes 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 (memq (char-syntax (preceding-char)) '(?w ?_ ?\) )) (insert " ")) (insert ?\() (save-excursion (or (eq arg 0) (forward-sexp arg)) (insert ?\)) (and parens-require-spaces (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. 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 (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))) (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.22/lisp/lmenu.el100444 12120 1 34174 5374267077 13564 0ustar rmsdaemon;;; lmenu.el --- emulate Lucid's menubar support ;; Keywords: emulations ;; 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. ;;; Code: ;; First, emulate the Lucid menubar support in GNU Emacs 19. ;; Arrange to use current-menubar to set up part of the menu bar. (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) ;; 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)) (callback (if (vectorp item) (aref item 1))) command enabler name) (cond ((stringp item) (setq command nil) (setq name 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))) (setq enabler (make-symbol (format "menu-function-%d-enabler" add-menu-item-count))) (setq add-menu-item-count (1+ add-menu-item-count)) (put command 'menu-enable enabler) (set enabler (aref item 2)) (setq name (aref item 0)) (if (symbolp callback) (fset command callback) (fset command (list 'lambda () '(interactive) callback))))) (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 of three or four elements: - the name of the menu item (a string); - the `callback' of that item; - whether this item is active (selectable); - and an optional string to append to the name. 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'. The fourth element of a menu item is a convenient way of adding the name of a command's ``argument'' to the menu, like ``Kill Buffer NAME''. 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 := argument := menu-item := '[' name callback active-p [ argument ] ']' menu := '(' name [ menu-item | menu | text ]+ ')' " (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc))) (pos (mouse-position)) answer) (setq answer (x-popup-menu (list (list (nth 1 pos) (nthcdr 2 pos)) (car pos)) menu)) (setq cmd (lookup-key menu (vector answer))) (if cmd (call-interactively cmd)))) ;; 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)) (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 t or nil, 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) (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 'menubar) ;;; lmenu.el ends here emacs-19.22/lisp/loaddefs.el100666 12120 1 742703 5475513514 14247 0ustar rmsdaemon;;; loaddefs.el --- define standard autoloads and keys of other files ;; Copyright (C) 1985, 1986, 1987, 1992, 1993 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 '("Emacs: %12b")) "Mode-line control for identifying the buffer being displayed. Its default value is \"Emacs: %12b\". Major modes that edit things other than ordinary files may change this (e.g. Info, Dired,...)") (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 'minor-mode-alist "%n" 'mode-line-process (purecopy ")%]--") (purecopy '(line-number-mode "L%l--")) (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 (if (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") '(".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)) ;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) ;; This key sequence might cause a certain amount of trouble with function ;; keys. Namely, it means you can't bind ESC followed by a function key. ;; However, people might not mind that too terribly much. ;; So I will leave this alone for now. (define-key esc-map "\e" '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) (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 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.")) ;; Apparently some terminals have a labeled help key. (define-key function-key-map [help] "\C-h") (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 [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 [M-next] 'scroll-other-window) (define-key global-map [end] 'end-of-buffer) (define-key global-map [begin] 'beginning-of-buffer) ;; (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 [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) (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) (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 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 "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) (define-key ctl-x-map "/" 'point-to-register) (define-key ctl-x-map "j" 'jump-to-register) (define-key ctl-x-map "x" 'copy-to-register) (define-key ctl-x-map "g" 'insert-register) ;; (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 (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" (11496 28641)) ;;; 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 is a name to try first. If FILE-NAME is nil, use the value of `change-log-default-name' if non-nil. Failing that, use \"ChangeLog\" in the current directory. If the file does not exist in the named directory, successive parent directories are tried. 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) ;;;*** ;;;### (autoloads (ad-start-advice defadvice ad-add-advice) "advice" "advice.el" (11335 1783)) ;;; Generated autoloads from advice.el (defvar ad-start-advice-on-load t "\ *Non-NIL will start advice magic when this file gets loaded. Also see function `ad-start-advice'.") (defvar ad-activate-on-definition nil "\ *Non-NIL means automatic advice activation at function definition. Set this variable to t if you want to enable forward advice (which is automatic advice activation of a previously undefined function at the point the function gets defined/loaded/autoloaded). The value of this variable takes effect only during the execution of `ad-start-advice'. If non-NIL it will enable definition hooks regardless of the value of `ad-enable-definition-hooks'.") (defvar ad-redefinition-action (quote warn) "\ *Defines what to do with redefinitions during 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-definition-hooks nil "\ *List of hooks to be run after a function definition. The variable `ad-defined-function' will be bound to the name of the currently defined function when the hook function is run.") (defvar ad-enable-definition-hooks nil "\ *Non-NIL will enable hooks to be run on function definition. Setting this variable is a noop unless the value of `ad-activate-on-definition' (which see) is NIL.") (defvar ad-use-jwz-byte-compiler (fboundp (quote eval-when-compile)) "\ *Non-NIL means Jamie Zawinski's v19 byte-compiler will be used. If you use a v18 Emacs and don't use jwz's optimizing byte-compiler (the normal case) then this variable should be NIL, because otherwise enabling definition hooks (e.g., for forward advice) will redefine the `byte-code' subr which will lead to some performance degradation for byte-compiled code.") (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). (defadvice ( [] [] {}*) [ [] [] ] {}* ) ::= name of the function to be advised ::= before | around | after | activation | deactivation ::= non-NIL symbol that names this piece of advice ::= first | last | (optional, defaults to `first', see also `ad-add-advice') ::= 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. ::= protect | disable | activate | compile | preactivate All flags can be specified with unambiguous initial substrings. ::= optional documentation for this piece of advice ::= optional interactive form to be used for the advised function. The first one found in before/around/after advices will be used. ::= 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 the 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 (with a v18 byte-compiler put the defadvice into the body of a defun). Look at the file advice.el for comprehensive documentation." nil (quote macro)) (autoload (quote ad-start-advice) "advice" "\ Redefines some primitives to start the advice magic. If `ad-activate-on-definition' is t then advice information will automatically get activated whenever an advised function gets defined or redefined. This will enable goodies such as forward advice and automatically enable function definition hooks. If its value is nil but the value of `ad-enable-definition-hooks' is t then definition hooks will be enabled without having automatic advice activation, otherwise function definition hooks will be disabled too. If definition hooks are enabled then functions stored in `ad-definition-hooks' are run whenever a function gets defined or redefined." t nil) ;;;*** ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (11365 55979)) ;;; 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" (10941 42374)) ;;; 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 10 "\ *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 5 "\ *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 (super-apropos apropos) "apropos" "apropos.el" (11283 60450)) ;;; Generated autoloads from apropos.el (autoload (quote apropos) "apropos" "\ Show all symbols whose names contain matches for REGEXP. If optional argument DO-ALL is non-nil, does more (time-consuming) work such as showing key bindings. Optional argument PRED is called with each symbol, and if it returns nil, the symbol is not shown. Returns list of symbols and documentation found." t nil) (autoload (quote super-apropos) "apropos" "\ Show symbols whose names/documentation contain matches for REGEXP. If optional argument DO-ALL is non-nil, does more (time-consuming) work such as showing key bindings and documentation that is not stored in the documentation file. Returns list of symbols and documentation found." t nil) ;;;*** ;;;### (autoloads (asm-mode) "asm-mode" "asm-mode.el" (11240 17420)) ;;; 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-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 (batch-update-autoloads update-directory-autoloads update-autoloads-here update-file-autoloads) "autoload" "autoload.el" (11341 50340)) ;;; 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 (awk-mode) "awk-mode" "awk-mode.el" (11181 53242)) ;;; 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.el" (11285 49676)) ;;; Generated autoloads from backquote.el (autoload (quote \`) "backquote" "\ (` FORM) is a macro that expands to code to construct FORM. Note that this is very slow in interpreted code, but fast if you compile. FORM is one or more nested lists, which are `almost quoted': They are copied recursively, with non-lists used unchanged in the copy. (` a b) == (list 'a 'b) constructs a new list with two elements, `a' and `b'. (` a (b c)) == (list 'a (list 'b 'c)) constructs two nested new lists. However, certain special lists are not copied. They specify substitution. Lists that look like (, EXP) are evaluated and the result is substituted. (` a (, (+ x 5))) == (list 'a (+ x 5)) Elements of the form (,@ EXP) are evaluated and then all the elements of the result are substituted. This result must be a list; it may be `nil'. As an example, a simple macro `push' could be written: (defmacro push (v l) (` (setq (, l) (cons (,@ (list v l)))))) or as (defmacro push (v l) (` (setq (, l) (cons (, v) (, l))))) LIMITATIONS: \"dotted lists\" are not allowed in FORM. The ultimate cdr of each list scanned by ` must be `nil'. (This does not apply to constants inside expressions to be substituted.) Substitution elements are not allowed as the cdr of a cons cell. For example, (` (A . (, B))) does not work. Instead, write (` (A (,@ B))). You cannot construct vectors, only lists. Vectors are treated as constants. BEWARE BEWARE BEWARE Inclusion of (,ATOM) rather than (, ATOM) or of (,@ATOM) rather than (,@ ATOM) will result in errors that will show up very late." nil (quote macro)) ;;;*** ;;;### (autoloads (bibtex-mode) "bibtex" "bibtex.el" (11287 29229)) ;;; 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] removes the double-quotes around the text of the current field. \\[bibtex-empty-field] replaces the text of the current field with the default \"\". The command \\[bibtex-clean-entry] cleans the current entry, i.e. (i) removes double-quotes 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 dot 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: find-bibtex-duplicates find-bibtex-entry-location hide-bibtex-entry-bodies sort-bibtex-entries validate-bibtex-buffer Variables: bibtex-clean-entry-zap-empty-opts bibtex-entry-field-alist bibtex-include-OPTannote bibtex-include-OPTcrossref bibtex-include-OPTkey bibtex-maintain-sorted-entries bibtex-mode-user-optional-fields Fields: address Publisher's address annote Long annotation used for annotated bibliographies (begins sentence) author Name(s) of author(s), in BibTeX name format booktitle Book title when the thing being referenced isn't the whole book. For book entries, the title field should be used instead. chapter Chapter number crossref The database key of the entry being cross referenced. edition Edition of a book (e.g., \"second\") editor Name(s) of editor(s), in BibTeX name format. If there is also an author field, then the editor field should be for the book or collection that the work appears in howpublished How something strange has been published (begins sentence) institution Sponsoring institution journal Journal name (macros are provided for many) key Alphabetizing and labeling key (needed when no author or editor) month Month (macros are provided) note To help the reader find a reference (begins sentence) number Number of a journal or technical report organization Organization (sponsoring a conference) pages Page number or numbers (use `--' to separate a range) publisher Publisher name school School name (for theses) series The name of a series or set of books. An individual book will will also have it's own title title The title of the thing being referenced type Type of a technical report (e.g., \"Research Note\") to be used instead of the default \"Technical Report\" volume Volume of a journal or multivolume work year Year---should contain only numerals --------------------------------------------------------- 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 (list-bookmarks bookmark-load bookmark-save bookmark-write bookmark-delete bookmark-insert bookmark-rename bookmark-locate bookmark-relocate bookmark-jump bookmark-set) "bookmark" "bookmark.el" (11468 39303)) ;;; 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 list-bookmarks)))) (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-locate)) (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. 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-v inserts the name of the current file being visited. 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 behaves like C-v and 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-locate) "bookmark" "\ Insert the name of the file associated with BOOKMARK. Optional second arg NO-INSERTION means merely return the filename as a string." t nil) (autoload (quote bookmark-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, and C-v inserts the name of the file." 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 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)." 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-file'. With a prefix arg, save it in file FILE. 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-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-bkmrks', is maintained automatically by Emacs; you shouldn't need to load it explicitly." t nil) (defalias (quote edit-bookmarks) (quote list-bookmarks)) (autoload (quote list-bookmarks) "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) (autoload 'menu-bar-bookmark-map "bookmark" nil t 'keymap) ;;;*** ;;;### (autoloads (batch-byte-compile display-call-tree byte-compile compile-defun byte-compile-file byte-recompile-directory) "bytecomp" "bytecomp.el" (11367 8231)) ;;; Generated autoloads from bytecomp.el (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." 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) ;;;*** ;;;### (autoloads (list-yahrzeit-dates calendar) "calendar" "calendar.el" (11494 46605)) ;;; 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 view-diary-entries-initially nil "\ *If t, the diary entries for the current date will be displayed 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 will cause no diary entries to be displayed on Sunday, the current date's and the next day's diary entries to be displayed Monday through Thursday, Friday through Monday's entries to be displayed on Friday, and only Saturday's entries to be displayed 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 "\ *If t, dates with diary entries will be marked in the calendar window. The marking symbol is specified by the variable `diary-entry-marker'.") (defvar diary-entry-marker "+" "\ *The symbol used to mark dates that have diary entries.") (defvar view-calendar-holidays-initially nil "\ *If t, holidays for current three month period will be displayed on entry. The holidays are displayed in another window when the calendar is first displayed.") (defvar mark-holidays-in-calendar nil "\ *If t, dates of holidays will be marked in the calendar window. The marking symbol is specified by the variable `calendar-holiday-marker'.") (defvar calendar-holiday-marker "*" "\ *The symbol used to mark notable dates in the calendar.") (defvar all-hebrew-calendar-holidays nil "\ *If nil, show only major holidays from the Hebrew calendar. If nil, the only holidays from the Hebrew calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Hebrew calendar.") (defvar all-christian-calendar-holidays nil "\ *If nil, show only major holidays from the Christian calendar. If nil, the only holidays from the Christian calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Christian calendar.") (defvar all-islamic-calendar-holidays nil "\ *If nil, show only major holidays from the Islamic calendar. If nil, the only holidays from the Islamic calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Islamic calendar.") (defvar calendar-load-hook nil "\ *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 could also be used to mark the current date with `='; 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 a 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 will not be displayed in the diary window; only the continuation lines will be 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-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 the 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' will be 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 the 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 "\ *If t, the holidays will be indicated in the diary display. The holidays will be given in the mode line of the diary buffer, or in the fancy diary buffer next to the date. This slows down the diary functions somewhat; setting it to nil will make the diary display faster.") (defvar general-holidays (quote ((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Ground Hog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fool's Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\ *General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details.") (defvar local-holidays nil "\ *Local holidays. See the documentation for `calendar-holidays' for details.") (defvar other-holidays nil "\ *User defined holidays. See the documentation for `calendar-holidays' for details.") (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)"))))) (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"))))) (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"))))) (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))))) (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.") (defvar christian-holidays (quote ((if all-christian-calendar-holidays (holiday-fixed 1 6 "Epiphany")) (holiday-easter-etc) (if all-christian-calendar-holidays (holiday-greek-orthodox-easter)) (if all-christian-calendar-holidays (holiday-fixed 8 15 "Assumption")) (if all-christian-calendar-holidays (holiday-advent)) (holiday-fixed 12 25 "Christmas") (if all-christian-calendar-holidays (holiday-julian 12 25 "Eastern Orthodox Christmas")))) "\ *Christian holidays. See the documentation for `calendar-holidays' for details.") (defvar islamic-holidays (quote ((holiday-islamic 1 1 (format "Islamic New Year %d" (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (extract-calendar-year (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))))) (if all-islamic-calendar-holidays (holiday-islamic 1 10 "Ashura")) (if all-islamic-calendar-holidays (holiday-islamic 3 12 "Mulad-al-Nabi")) (if all-islamic-calendar-holidays (holiday-islamic 7 26 "Shab-e-Mi'raj")) (if all-islamic-calendar-holidays (holiday-islamic 8 15 "Shab-e-Bara't")) (holiday-islamic 9 1 "Ramadan Begins") (if all-islamic-calendar-holidays (holiday-islamic 9 27 "Shab-e Qadr")) (if all-islamic-calendar-holidays (holiday-islamic 10 1 "Id-al-Fitr")) (if all-islamic-calendar-holidays (holiday-islamic 12 10 "Id-al-Adha")))) "\ *Islamic holidays. See the documentation for `calendar-holidays' for details.") (defvar solar-holidays (quote ((if (fboundp (quote atan)) (solar-equinoxes-solstices)) (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)) date (quote standard)) ""))))) (funcall (quote holiday-sexp) calendar-daylight-savings-ends (quote (format "Daylight Savings Time Ends %s" (if (fboundp (quote atan)) (solar-time-string (/ (- calendar-daylight-savings-ends-time calendar-daylight-time-offset) (float 60)) date (quote daylight)) "")))))) "\ *Sun-related holidays. See the documentation for `calendar-holidays' for details.") (autoload (quote calendar) "calendar" "\ Display a three-month calendar in another window. 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 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." t nil) (autoload (quote list-yahrzeit-dates) "calendar" "\ List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR. When called interactively from the calendar window, the date of death is taken from the cursor position." t nil) ;;;*** ;;;### (autoloads (set-case-syntax set-case-syntax-pair set-case-syntax-delims describe-buffer-case-table) "case-table" "case-table.el" (11283 37570)) ;;; 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 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', and `text-mode-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' and `text-mode-syntax-table' to indicate an (uppercase, lowercase) pair of letters." 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' and `text-mode-syntax-table'. SYNTAX should be \" \", \"w\", \".\" or \"_\"." nil nil) ;;;*** ;;;### (autoloads (command-history-mode list-command-history repeat-matching-complex-command) "chistory" "chistory.el" (11196 27803)) ;;; 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 (make-comint) "comint" "comint.el" (11367 8243)) ;;; 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. 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) ;;;*** ;;;### (autoloads (compare-windows) "compare-w" "compare-w.el" (11330 25785)) ;;; 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. 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" (11358 55857)) ;;; Generated autoloads from compile.el (defvar compilation-mode-hook nil "\ *List of hook functions run by `compilation-mode' (see `run-hooks').") (defconst 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. 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 "`" (quote next-error)) ;;;*** ;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie) "cookie1" "cookie1.el" (11356 11391)) ;;; Generated autoloads from cookie1.el (autoload (quote cookie) "cookie1" "\ Return a random phrase from PHRASE-FILE. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end." nil nil) (autoload (quote cookie-insert) "cookie1" "\ Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file is read in, display STARTMSG at beginning of load, ENDMSG at end." nil nil) (autoload (quote cookie-snarf) "cookie1" "\ Reads in the PHRASE-FILE, returns it as a vector of strings. Emit STARTMSG and ENDMSG before and after. Caches the result; second and subsequent calls on the same file won't go to disk." nil nil) (autoload (quote shuffle-vector) "cookie1" "\ Randomly permute the elements of VECTOR (all permutations equally likely)" nil nil) ;;;*** ;;;### (autoloads (c++-mode) "cplus-md" "cplus-md.el" (11349 24039)) ;;; Generated autoloads from cplus-md.el (autoload (quote c++-mode) "cplus-md" "\ 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 class 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." t nil) ;;;*** ;;;### (autoloads (dabbrev-expand) "dabbrev" "dabbrev.el" (11292 51554)) ;;; Generated autoloads from dabbrev.el (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 `case-fold-search' and `case-replace' are non-nil (usually true) then the substituted word may be case-adjusted to match the abbreviation that you had typed. This takes place if the substituted word, as found, is all lower case, or if it is at the beginning of a sentence and only its first letter was upper case. A positive prefix arg N says to take the Nth backward DISTINCT possibility. A negative argument says search forward. The variable `dabbrev-backward-only' may be used to limit the direction of search to backward if set non-nil. 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." t nil) (define-key esc-map "/" (quote dabbrev-expand)) ;;;*** ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" "debug.el" (11181 53262)) ;;; Generated autoloads from debug.el (setq debugger (quote debug)) (autoload (quote debug) "debug" "\ Enter debugger. Returns if user says \"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." nil nil) (autoload (quote debug-on-entry) "debug" "\ 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." 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" (11259 36696)) ;;; 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 (diary) "diary" "diary.el" (11360 16265)) ;;; Generated autoloads from diary.el (autoload (quote diary) "diary" "\ 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" (11302 33003)) ;;; 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 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-hide-all dired-hide-subdir dired-tree-down dired-tree-up dired-kill-subdir dired-mark-subdir-files dired-goto-subdir dired-prev-subdir dired-maybe-insert-subdir dired-downcase dired-upcase dired-do-symlink-regexp dired-do-hardlink-regexp dired-do-copy-regexp dired-do-rename-regexp dired-do-rename dired-do-hardlink dired-do-symlink dired-do-copy dired-create-directory dired-string-replace-match dired-do-redisplay dired-do-load dired-do-byte-compile dired-do-compress dired-do-kill-lines dired-do-shell-command dired-do-print dired-do-chown dired-do-chgrp dired-do-chmod dired-backup-diff dired-diff) "dired-aux" "dired-aux.el" (11364 34565)) ;;; 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-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-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." 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 symbolic links 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) ;;;*** ;;;### (autoloads (dired-noselect dired-other-frame dired-other-window dired) "dired" "dired.el" (11355 44777)) ;;; 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'.") (defvar dired-chown-program (if (memq system-type (quote (hpux dgux usg-unix-v irix))) "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 (disassemble) "disass" "disass.el" (11295 37242)) ;;; 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 make-display-table describe-current-display-table) "disp-table" "disp-table.el" (11265 29044)) ;;; Generated autoloads from disp-table.el (autoload (quote describe-current-display-table) "disp-table" "\ Describe the display table in use in the selected window and buffer." t nil) (autoload (quote make-display-table) "disp-table" "\ Return a new, empty display table." nil 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 string S." nil nil) (autoload (quote standard-display-g1) "disp-table" "\ Display character C as character SC in the g1 character set." nil nil) (autoload (quote standard-display-graphic) "disp-table" "\ Display character C as character GC in graphics character set." 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" (11356 11391)) ;;; 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 (doctor) "doctor" "doctor.el" (11344 11919)) ;;; Generated autoloads from doctor.el (autoload (quote doctor) "doctor" "\ Switch to *doctor* buffer and start giving psychotherapy." t nil) ;;;*** ;;;### (autoloads (dunnet) "dunnet" "dunnet.el" (11356 11391)) ;;; Generated autoloads from dunnet.el (autoload (quote dunnet) "dunnet" "\ Switch to *dungeon* buffer and start game." t nil) ;;;*** ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" (11189 17403)) ;;; Generated autoloads from ebuff-menu.el (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" (11288 43486)) ;;; 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-debug edebug-defun) "edebug" "edebug.el" (11285 51182)) ;;; Generated autoloads from edebug.el (autoload (quote edebug-defun) "edebug" "\ Evaluate defun or defmacro, like eval-defun, but with edebug calls. Print its name in the minibuffer and leave point after any error it finds, with mark at the original point." t nil) (defvar global-edebug-prefix "X" "\ 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 "d" (quote edebug-defun)) (define-key global-edebug-map " " (quote edebug-step-through)) (define-key global-edebug-map "g" (quote edebug-go)) (define-key global-edebug-map "G" (quote edebug-Go-nonstop)) (define-key global-edebug-map "t" (quote edebug-trace)) (define-key global-edebug-map "T" (quote edebug-Trace-fast)) (define-key global-edebug-map "c" (quote edebug-continue)) (define-key global-edebug-map "C" (quote edebug-Continue-fast)) (define-key global-edebug-map "b" (quote edebug-set-breakpoint)) (define-key global-edebug-map "x" (quote edebug-set-conditional-breakpoint)) (define-key global-edebug-map "u" (quote edebug-unset-breakpoint)) (define-key global-edebug-map "w" (quote edebug-where)) (define-key global-edebug-map "q" (quote top-level))) (autoload (quote edebug-debug) "edebug" "\ Replacement for debug. If an error or quit occurred and we are running an edebugged function, show where we last were. Otherwise call debug normally." nil nil) ;;;*** ;;;### (autoloads (read-kbd-macro edit-kbd-macro edit-last-kbd-macro) "edmacro" "edmacro.el" (11176 61364)) ;;; Generated autoloads from edmacro.el (autoload (quote edit-last-kbd-macro) "edmacro" "\ Edit the most recently defined keyboard macro." t nil) (autoload (quote edit-kbd-macro) "edmacro" "\ Edit a keyboard macro which has been given a name by `name-last-kbd-macro'. (See also `edit-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\". The resulting macro is installed as the \"current\" keyboard macro. Symbols: RET, SPC, TAB, DEL, LFD, NUL; C-key; M-key. (Must be uppercase.) REM marks the rest of a line as a comment. Whitespace is ignored; other characters are copied into the macro." t nil) ;;;*** ;;;### (autoloads (edt-emulation-on) "edt" "edt.el" (11344 10928)) ;;; Generated autoloads from edt.el (autoload (quote edt-emulation-on) "edt" "\ Emulate DEC's EDT editor. Note that many keys are rebound; including nearly all keypad keys. Use \\[edt-emulation-off] to undo all rebindings except the keypad keys." t nil) ;;;*** ;;;### (autoloads (report-emacs-bug) "emacsbug" "emacsbug.el" (11185 3426)) ;;; 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-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" (11356 11307)) ;;; Generated autoloads from emerge.el (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) ;;;*** ;;;### (autoloads (setenv) "env" "env.el" (11288 64005)) ;;; 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. 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" (11487 17108)) ;;; 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 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.") (defvar default-tags-table-function nil "\ *If non-nil, a function of no arguments to choose a default tags file for a particular buffer.") (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) (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 execute to operate on an interesting file If the latter returns non-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" "\ Display list of tags in file FILE. FILE should not contain a directory specification." 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-file-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 (find-grep-dired find-name-dired find-dired) "find-dired" "find-dired.el" (11269 25506)) ;;; Generated autoloads from find-dired.el (defvar find-ls-option (if (eq system-type (quote berkeley-unix)) "-ls" "-exec ls -ldi {} \\;") "\ *Option to `find' to produce an `ls -l'-type listing.") (defvar find-grep-options (if (eq system-type (quote berkeley-unix)) "-s" "-l") "\ *Option to grep to be as silent as possible. On Berkeley systems, this is `-s', for others it seems impossible to suppress all output, so `-l' is used to print nothing more than the file name.") (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 (enable-flow-control-on enable-flow-control) "flow-ctrl" "flow-ctrl.el" (11288 50957)) ;;; Generated autoloads from flow-ctrl.el (autoload (quote enable-flow-control) "flow-ctrl" "\ Enable use of flow control; let user type C-s as C-\\ and C-q as C-^." 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-mode) "font-lock" "font-lock.el" (11361 29125)) ;;; Generated autoloads from font-lock.el (defvar font-lock-mode-hook nil "\ Function or functions to run on entry to Font Lock mode.") (autoload (quote font-lock-mode) "font-lock" "\ Toggle Font Lock mode. With arg, turn Font Lock mode on if and only if arg is positive. When Font Lock mode is enabled, text is fontified as you type it: - comments are displayed in `font-lock-comment-face'; (That is a variable whose value should be a face name.) - strings are displayed in `font-lock-string-face'; - documentation strings are displayed in `font-lock-doc-string-face'; - function and variable names in their defining forms are displayed in `font-lock-function-name-face'; - and certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. When you turn Font Lock mode on/off, the buffer is fontified/defontified. To fontify a buffer without having newly typed text become fontified, you can use \\[font-lock-fontify-buffer]." t nil) ;;;*** ;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode) "forms" "forms.el" (11336 20307)) ;;; Generated autoloads from forms.el (autoload (quote forms-mode) "forms" "\ Major mode to visit files in a field-structured manner using a form. Commands (prefix with C-c if not in read-only mode): \\{forms-mode-map}" t nil) (autoload (quote forms-find-file) "forms" "\ Visit a file in Forms mode." t nil) (autoload (quote forms-find-file-other-window) "forms" "\ Visit a file in Forms mode in other window." t nil) ;;;*** ;;;### (autoloads (fortran-mode) "fortran" "fortran.el" (11285 51227)) ;;; Generated autoloads from fortran.el (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 and map 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 From a Fortran ENDIF statement, blink the matching IF 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-do-auto-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) "gnus" "gnus.el" (11367 8636)) ;;; Generated autoloads from gnus.el (autoload (quote gnus) "gnus" "\ Read network news. If optional argument CONFIRM is non-nil, ask NNTP server." t nil) ;;;*** ;;;### (autoloads (gnus-post-news) "gnuspost" "gnuspost.el" (11339 29602)) ;;; Generated autoloads from gnuspost.el (fset (quote sendnews) (quote gnus-post-news)) (fset (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" (11356 11391)) ;;; 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 (set-gosmacs-bindings) "gosmacs" "gosmacs.el" (11190 10276)) ;;; Generated autoloads from gosmacs.el (autoload (quote set-gosmacs-bindings) "gosmacs" "\ Rebind some keys globally to make GNU Emacs resemble Gosling Emacs. Use \\[set-gnu-bindings] to restore previous global bindings." t nil) ;;;*** ;;;### (autoloads (perldb xdb dbx sdb gdb) "gud" "gud.el" (11436 59090)) ;;; 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" (11324 28709)) ;;; Generated autoloads from hanoi.el (autoload (quote hanoi) "hanoi" "\ Towers of Hanoi diversion. Argument is number of rings." t nil) ;;;*** ;;;### (autoloads (Helper-help Helper-describe-bindings) "helper" "helper.el" (10941 42412)) ;;; 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" (11500 60646)) ;;; 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" (11285 51258)) ;;; 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 (make-hippie-expand-function hippie-expand) "hippie-exp" "hippie-exp.el" (11336 59237)) ;;; Generated autoloads from hippie-exp.el (defvar hippie-expand-try-functions-list (quote (try-complete-file-name try-expand-all-abbrevs try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-complete-lisp-symbol)) "\ The list of expansion functions tried in order by `hippie-expand'. To change the behavior of `hippie-expand', remove, change the order of, or insert functions in this list.") (defvar hippie-expand-verbose t "\ *Non-nil makes `hippie-expand' output which function it is trying.") (defvar hippie-expand-max-buffers nil "\ *The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched.") (autoload (quote hippie-expand) "hippie-exp" "\ Try to expand text before point, using multiple methods. The expansion functions in `hippie-expand-try-functions-list' are tried in order, until a possible expansion is found. Repeated application of `hippie-expand' inserts successively possible expansions. With a positive numeric argument, jumps directly to the ARG next function in this list. With a negative argument or just \\[universal-argument], undoes the expansion." t nil) (autoload (quote make-hippie-expand-function) "hippie-exp" "\ Construct a function similar to `hippie-expand'. Make it use the expansion functions in TRY-LIST. An optional second argument VERBOSE non-nil makes the function verbose." nil (quote macro)) ;;;*** ;;;### (autoloads (inferior-lisp) "inf-lisp" "inf-lisp.el" (11294 14427)) ;;; 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 "^[^> ]*>+:? *" "\ Regexp to recognise prompts in the Inferior Lisp mode. Defaults to \"^[^> ]*>+:? *\", 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) (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" (11362 48870)) ;;; Generated autoloads from info.el (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." 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." t nil) ;;;*** ;;;### (autoloads (batch-info-validate Info-validate Info-split Info-tagify) "informat" "informat.el" (11136 13191)) ;;; 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" (11467 25993)) ;;; Generated autoloads from iso-acc.el (autoload (quote iso-accents-mode) "iso-acc" "\ Toggle a minor 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. With an argument, a positive argument enables ISO-accents mode, and a negative argument disables it." t nil) ;;;*** ;;;### (autoloads (ispell-message ispell-complete-word-interior-frag ispell-complete-word ispell-region ispell-word ispell) "ispell" "ispell.el" (11485 39692)) ;;; Generated autoloads from ispell.el (autoload (quote ispell) "ispell" "\ 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 (kept in `$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]." t nil) (defalias (quote ispell-buffer) (quote ispell)) (autoload (quote ispell-word) "ispell" "\ 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." t nil) (define-key esc-map "$" (quote ispell-word)) (autoload (quote ispell-region) "ispell" "\ Check the spelling for all of the words in the region." t nil) (autoload (quote ispell-complete-word) "ispell" "\ 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'." t nil) (autoload (quote ispell-complete-word-interior-frag) "ispell" "\ 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." t nil) (autoload (quote ispell-message) "ispell" "\ Check the spelling of a mail message or news post. Don't check spelling of message headers 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)))))" 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" (11356 11391)) ;;; 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" (11215 17597)) ;;; 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" (11359 12171)) ;;; 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-unix hpux irix))) "lp" "lpr") "\ *Shell command 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" (11367 8268)) ;;; 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" (11351 17266)) ;;; 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" (quote kbd-macro-query)) ;;;*** ;;;### (autoloads nil "mail-utils" "mail-utils.el" (11323 3305)) ;;; 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.") ;;;*** ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup) "mailabbrev" "mailabbrev.el" (11349 45422)) ;;; Generated autoloads from mailabbrev.el (autoload (quote mail-abbrevs-setup) "mailabbrev" nil nil nil) (autoload (quote build-mail-abbrevs) "mailabbrev" "\ Read mail aliases from `~/.mailrc' file and set `mail-abbrevs'." nil nil) (autoload (quote define-mail-abbrev) "mailabbrev" "\ Define NAME as a mail-abbrev that translates to DEFINITION. If DEFINITION contains multiple addresses, separate them with commas." t nil) ;;;*** ;;;### (autoloads (define-mail-alias) "mailalias" "mailalias.el" (11294 13866)) ;;; 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. DEFINITION can be one or more mail addresses separated by commas." t nil) ;;;*** ;;;### (autoloads (makefile-mode) "makefile" "makefile.el" (11285 53103)) ;;; Generated autoloads from makefile.el (autoload (quote makefile-mode) "makefile" "\ Major mode for editing Makefiles. Calling this function invokes the function(s) \"makefile-mode-hook\" before doing anything else. \\{makefile-mode-map} In the browser, use the following keys: \\{makefile-browser-map} makefile-mode can be configured by modifying the following variables: makefile-mode-name: The \"pretty name\" of makefile-mode, as it appears in the modeline. 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 (manual-entry) "man" "man.el" (11358 46030)) ;;; Generated autoloads from man.el (defalias (quote man) (quote manual-entry)) (autoload (quote manual-entry) "man" "\ Get a Un*x manual page and put it in a buffer. This command is the top-level command in the man package. It runs a Un*x command to retrieve and clean a manpage in the background and places the results in a Man mode (manpage browsing) buffer. See variable `Man-notify' for what happens when the buffer is ready. Universal argument ARG, is passed to `Man-getpage-in-background'." t nil) ;;;*** ;;;### (autoloads (map-y-or-n-p) "map-ynp" "map-ynp.el" (11449 65482)) ;;; 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 is eval'd to get the answer; it may be nil to ignore the object, t to act on the object without asking the user, or a form to do a more complex prompt. 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-smail mh-rmail) "mh-e" "mh-e.el" (11365 38303)) ;;; Generated autoloads from mh-e.el (autoload (quote mh-rmail) "mh-e" "\ Inc(orporate) new mail (no arg) or scan a MH mail box (arg given). This front end uses the MH mail system, which uses different conventions from the usual mail system." t nil) (autoload (quote mh-smail) "mh-e" "\ Compose and send mail with the MH mail system." t nil) ;;;*** ;;;### (autoloads (convert-mocklisp-buffer) "mlconvert" "mlconvert.el" (11339 6975)) ;;; 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" (11181 53306)) ;;; 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" (11356 11391)) ;;; Generated autoloads from mpuz.el (autoload (quote mpuz) "mpuz" "\ Multiplication puzzle with GNU Emacs." t nil) ;;;*** ;;;### (autoloads (disable-command enable-command disabled-command-hook) "novice" "novice.el" (11261 24403)) ;;; 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" (11267 60509)) ;;; 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" (11181 53232)) ;;; 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" (11340 12742)) ;;; 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 M-x hide-body make all text invisible (not headings). M-x 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. M-x hide-entry make immediately following body invisible. M-x show-entry make it visible. M-x hide-leaves make body under heading and under its subheadings invisible. The subheadings remain visible. M-x 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 (perl-mode) "perl-mode" "perl-mode.el" (11360 25587)) ;;; Generated autoloads from perl-mode.el (autoload (quote perl-mode) "perl-mode" "\ Major mode for editing Perl code. Expression and list commands understand all Perl brackets. Tab indents for Perl code. Comments are delimited with # ... \\n. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{perl-mode-map} Variables controlling indentation style: perl-tab-always-indent Non-nil means TAB in Perl mode should always indent the current line, regardless of where in the line point is when the TAB command is used. perl-tab-to-comment Non-nil means that for lines which don't need indenting, TAB will either delete an empty comment, indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment. perl-nochange Lines starting with this regular expression will not be auto-indented. perl-indent-level Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. perl-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. perl-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to perl-continued-statement-offset. perl-brace-offset Extra indentation for line if it starts with an open brace. perl-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. perl-label-offset Extra indentation for line that is a label. Various indentation styles: K&R BSD BLK GNU LW perl-indent-level 5 8 0 2 4 perl-continued-statement-offset 5 8 4 2 4 perl-continued-brace-offset 0 0 0 0 -4 perl-brace-offset -5 -8 0 0 0 perl-brace-imaginary-offset 0 0 4 0 0 perl-label-offset -5 -8 -2 -2 -2 Turning on Perl mode calls the value of the variable perl-mode-hook with no args, if that value is non-nil." t nil) ;;;*** ;;;### (autoloads (picture-mode) "picture" "picture.el" (11292 51488)) ;;; Generated autoloads from picture.el (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 (run-prolog prolog-mode) "prolog" "prolog.el" (11181 53308)) ;;; 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 (clear-rectangle string-rectangle open-rectangle insert-rectangle yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle delete-rectangle) "rect" "rect.el" (11237 13138)) ;;; 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 (reposition-window) "reposition" "reposition.el" (11339 34632)) ;;; 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 " " (quote reposition-window)) ;;;*** ;;;### (autoloads (resume-suspend-hook) "resume" "resume.el" (11236 37830)) ;;; 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" (11367 8270)) ;;; 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-delchar-or-send-Ctrl-D rlogin-send-Ctrl-backslash rlogin-send-Ctrl-Z rlogin-send-Ctrl-C rlogin-mode rlogin-password rlogin-with-args rlogin) "rlogin" "rlogin.el" (11261 49048)) ;;; Generated autoloads from rlogin.el (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-password-paranoia nil "\ *If non-`nil', query user for a password in the minibuffer when a Password: prompt appears. It's also possible to selectively enter passwords without echoing them in the minibuffer using the command `rlogin-password' explicitly.") (defvar rlogin-mode-map (quote nil)) (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 HOST is recorded in a buffer *rlogin-HOST*. If a prefix argument is given and the buffer *rlogin-HOST* already exists, a new buffer with a different connection will be made. 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." t nil) (autoload (quote rlogin-with-args) "rlogin" "\ Open a new rlogin connection to HOST, even if one already exists. String ARGS is given as arguments to the `rlogin' program, overriding the value of `rlogin-explicit-args'." t nil) (autoload (quote rlogin-password) "rlogin" "\ Read a password and send it to an rlogin session. For each character typed, a `*' is echoed in the minibuffer. End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts attempt to read and send password. Optional argument PROC is the process to which the password should be sent. If not provided, send to the process in the current buffer. This argument is intended primarily for use by `rlogin-filter'." t nil) (autoload (quote rlogin-mode) "rlogin" "\ Set major-mode for rlogin sessions. If `rlogin-mode-hook' is set, run it." t nil) (autoload (quote rlogin-send-Ctrl-C) "rlogin" nil t nil) (autoload (quote rlogin-send-Ctrl-Z) "rlogin" nil t nil) (autoload (quote rlogin-send-Ctrl-backslash) "rlogin" nil t nil) (autoload (quote rlogin-delchar-or-send-Ctrl-D) "rlogin" "\ Delete ARG characters forward, or send a C-d to process if at end of buffer." t nil) ;;;*** ;;;### (autoloads (rmail-input rmail-mode rmail) "rmail" "rmail.el" (11360 11262)) ;;; 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:\\|^message-id:\\|^summary-line:" "\ *Gubbish headers one would rather not see.") (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.") (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 filename as argument; then performs rmail editing on that file, but does not copy any new mail into the 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 (rmail-file-p) "rmailout" "rmailout.el" (11496 44723)) ;;; Generated autoloads from rmailout.el (autoload (quote rmail-file-p) "rmailout" nil nil nil) ;;;*** ;;;### (autoloads (rot13-other-window) "rot13" "rot13.el" (11295 37709)) ;;; Generated autoloads from rot13.el (autoload (quote rot13-other-window) "rot13" "\ Display current buffer in rot 13 in another window." t nil) ;;;*** ;;;### (autoloads (sc-cite-original) "sc" "sc.el" (11350 50069)) ;;; Generated autoloads from sc.el (autoload (quote sc-cite-original) "sc" "\ Hook version of sc-cite. 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." nil nil) ;;;*** ;;;### (autoloads (scheme-mode) "scheme" "scheme.el" (11285 51473)) ;;; 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" (11185 15625)) ;;; 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" (11356 48606)) ;;; Generated autoloads from sendmail.el (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 are be delimited by a line which is `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. Do not use an rmail file here! Instead, use its inbox file.") (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 `~/.signature'.") (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 Subj: C-c C-f C-b move to BCC: C-c C-f C-c move to CC: C-c C-t move to message text. 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. By default, the signature file `~/.signature' is 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. If `mail-setup-hook' is bound, its value is called with no arguments after the message is initialized. It can add more default fields. When calling from a program, 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) ;;;*** ;;;### (autoloads (server-start) "server" "server.el" (11365 58935)) ;;; 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 `etc/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" (11274 32251)) ;;; 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 (shell) "shell" "shell.el" (11336 59243)) ;;; 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) ;;;*** ;;;### (autoloads (solar-equinoxes-solstices sunrise-sunset) "solar" "solar.el" (11494 46887)) ;;; Generated autoloads from solar.el (defvar calendar-time-display-form (quote (12-hours ":" minutes am-pm (if time-zone " (") time-zone (if time-zone ")"))) "\ *The pseudo-pattern that governs the way a time of day is formatted. A pseudo-pattern is a list of expressions that can involve the keywords `12-hours', `24-hours', and `minutes', all numbers in string form, and `am-pm' and `time-zone', both alphabetic strings. For example, the form '(24-hours \":\" minutes (if time-zone \" (\") time-zone (if time-zone \")\")) would give military-style times like `21:07 (UTC)'.") (defvar calendar-latitude nil "\ *Latitude of `calendar-location-name' in degrees, + north, - south. For example, 40.7 for New York City. It may not be a good idea to set this in advance for your site; if there may be users running Emacs at your site who are physically located elsewhere, they would get the wrong value and might not know how to override it.") (defvar calendar-longitude nil "\ *Longitude of `calendar-location-name' in degrees, + east, - west. For example, -74.0 for New York City. It may not be a good idea to set this in advance for your site; if there may be users running Emacs at your site who are physically located elsewhere, they would get the wrong value and might not know how to override it.") (defvar calendar-location-name (quote (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (abs calendar-latitude) (if (> calendar-latitude 0) "N" "S") (abs calendar-longitude) (if (> calendar-longitude 0) "E" "W")))) "\ *Expression evaluating to name of `calendar-longitude', calendar-latitude'. Default value is just the latitude, longitude pair.") (autoload (quote sunrise-sunset) "solar" "\ Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. If called with an optional prefix argument, prompts for date. If called with an optional double prefix argument, prompts for longitude, latitude, time zone, and date. 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 (reverse-region sort-columns sort-regexp-fields sort-fields sort-float-fields sort-numeric-fields sort-pages sort-paragraphs sort-lines) "sort" "sort.el" (11344 9594)) ;;; Generated autoloads from sort.el (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. If you want to sort floating-point numbers, try `sort-float-fields'." t nil) (autoload (quote sort-float-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 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." 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" (11285 51501)) ;;; Generated autoloads from spell.el (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 (tabify untabify) "tabify" "tabify.el" (11202 22548)) ;;; 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 (tar-mode) "tar-mode" "tar-mode.el" (11354 62228)) ;;; 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. 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 (rsh telnet) "telnet" "telnet.el" (11357 58585)) ;;; Generated autoloads from telnet.el (autoload (quote telnet) "telnet" "\ Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-telnet*. Normally input is edited in Emacs and sent a line at a time." t nil) (autoload (quote rsh) "telnet" "\ Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-rsh*. Normally input is edited in Emacs and sent a line at a time." t nil) ;;;*** ;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (11285 51534)) ;;; 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. Presently with `termcap' only; if somebody sends us code to make this work with `terminfo' we will try to use it." t nil) ;;;*** ;;;### (autoloads (latex-mode plain-tex-mode tex-mode) "tex-mode" "tex-mode.el" (11354 8216)) ;;; Generated autoloads from tex-mode.el (defvar tex-shell-file-name nil "\ *If non-nil, is file name to use for the subshell in which TeX is run.") (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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (defvar latex-run-command "latex" "\ *Command used to run LaTeX subjob. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (defvar tex-bibtex-command "bibtex" "\ *Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (defvar tex-dvi-print-command "lpr -d" "\ *Command used by \\[tex-print] to print a .dvi file. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string. If two printers are not enough of a choice, you can define the value of tex-alt-dvi-print-command to be 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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string. 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] 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 is used." 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 calls the value of `text-mode-hook', then the value of `tex-mode-hook', and then the value of `plain-tex-mode-hook'. When the special subshell is initiated, the value of `tex-shell-hook' is called." 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 calls the value of text-mode-hook, then the value of tex-mode-hook, and then the value of latex-mode-hook. When the special subshell is initiated, the value of tex-shell-hook is called." t nil) ;;;*** ;;;### (autoloads (texinfo-format-region texinfo-format-buffer) "texinfmt" "texinfmt.el" (11462 52384)) ;;; 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" (11367 23334)) ;;; 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" (11488 11824)) ;;; 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 (display-time) "time" "time.el" (11322 20891)) ;;; 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) "time-stamp" "time-stamp.el" (11351 4303)) ;;; Generated autoloads from time-stamp.el (autoload (quote time-stamp) "time-stamp" "\ Update the time stamp string in the buffer. 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 first time-stamp-line-limit lines of the buffer (normally 8) are searched for the time stamp template, and if it is found, a new time stamp is written into it." t nil) ;;;*** ;;;### (autoloads (run-at-time) "timer" "timer.el" (11285 51562)) ;;; 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, 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 (tpu-edt-on) "tpu-edt" "tpu-edt.el" (11368 32024)) ;;; 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 (tq-create) "tq" "tq.el" (10941 58296)) ;;; 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" (11256 21938)) ;;; 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 (tc-recenter tc-scroll-down tc-scroll-up tc-scroll-line tc-associated-buffer tc-merge tc-dissociate tc-split tc-associate-buffer tc-two-columns) "two-column" "two-column.el" (11223 37223)) ;;; Generated autoloads from two-column.el (defvar tc-mode-map nil "\ Keymap for commands for two-column mode.") (if tc-mode-map nil (setq tc-mode-map (make-sparse-keymap)) (define-key tc-mode-map "1" (quote tc-merge)) (define-key tc-mode-map "2" (quote tc-two-columns)) (define-key tc-mode-map "b" (quote tc-associate-buffer)) (define-key tc-mode-map "e" (quote tc-dissociate)) (define-key tc-mode-map " " (quote tc-recenter)) (define-key tc-mode-map "o" (quote tc-associated-buffer)) (define-key tc-mode-map "s" (quote tc-split)) (define-key tc-mode-map "{" (quote shrink-window-horizontally)) (define-key tc-mode-map "}" (quote enlarge-window-horizontally)) (define-key tc-mode-map " " (quote tc-scroll-up)) (define-key tc-mode-map "" (quote tc-scroll-down)) (define-key tc-mode-map " " (quote tc-scroll-line))) (global-set-key "6" tc-mode-map) (autoload (quote tc-two-columns) "two-column" "\ Split current window vertically for two-column editing. When called the first time, associates a buffer with the current buffer. Both buffers are put in two-column minor mode and tc-mode-hook gets called on both. These buffers remember about one another, even when renamed. When called again, restores the screen layout with the current buffer first and the associated buffer to it's right. 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. You have the following commands at your disposal: \\[tc-two-columns] Rearrange screen \\[tc-associate-buffer] Reassociate buffer after changing major mode \\[tc-scroll-up] Scroll both buffers up by a screenfull \\[tc-scroll-down] Scroll both buffers down by a screenful \\[tc-scroll-line] Scroll both buffers up by one or more lines \\[tc-recenter] Recenter and realign other buffer \\[shrink-window-horizontally], \\[enlarge-window-horizontally] Shrink, enlarge current column \\[tc-associated-buffer] Switch to associated buffer \\[tc-merge] Merge both buffers These keybindings can be customized in your ~/.emacs by `tc-prefix' and `tc-mode-map'. The appearance of the screen can be customized by the variables `tc-window-width', `tc-beyond-fill-column', `tc-mode-line-format' and `truncate-partial-width-windows'." t nil) (autoload (quote tc-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 \\[tc-two-columns] and `lisp/two-column.el' for further details." t nil) (autoload (quote tc-split) "two-column" "\ Unmerge a two-column text into two buffers in two-column minor mode. The text is unmerged at the cursor's column which becomes the local value of `tc-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 `tc-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 as you like them. You write the first line of each column with the separator you like and then unmerge that line. E.g.: First column's text sSs Second columns text \\___/\\ / \\ 5 character Separator You type M-5 \\[tc-split] with the point here See \\[tc-two-columns] and `lisp/two-column.el' for further details." t nil) (autoload (quote tc-dissociate) "two-column" "\ Turn off two-column minor mode in current and associated buffer. If the associated buffer is unmodified and empty, it is killed." t nil) (autoload (quote tc-merge) "two-column" "\ Merges the associated buffer with the current buffer. They get merged at the column, which is the value of `tc-window-width', i.e. usually at the vertical window separator. This separator gets replaced with white space. Beyond that the value of 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 `tc-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" t nil) (autoload (quote tc-associated-buffer) "two-column" "\ Switch to associated buffer." t nil) (autoload (quote tc-scroll-line) "two-column" "\ Scroll current window upward by ARG lines. The associated window gets scrolled to the same line." t nil) (autoload (quote tc-scroll-up) "two-column" "\ Scroll current window upward by ARG screens. The associated window gets scrolled to the same line." t nil) (autoload (quote tc-scroll-down) "two-column" "\ Scroll current window downward by ARG screens. The associated window gets scrolled to the same line." t nil) (autoload (quote tc-recenter) "two-column" "\ Center point in window. With ARG, put point on line ARG. This counts from bottom if ARG is negative. The associated window gets scrolled to the same line." t nil) ;;;*** ;;;### (autoloads (ununderline-region underline-region) "underline" "underline.el" (11185 16923)) ;;; 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" (11345 60792)) ;;; Generated autoloads from unrmail.el (autoload (quote batch-unrmail) "unrmail" "\ Convert Rmail files to mailbox files. 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 mailbox-format file TO-FILE." t nil) ;;;*** ;;;### (autoloads (ask-to-update-copyright update-copyright) "upd-copyr" "upd-copyr.el" (11086 5246)) ;;; Generated autoloads from upd-copyr.el (defvar replace-copying-with nil "\ *If non-nil, replace copying notices with this file.") (autoload (quote update-copyright) "upd-copyr" "\ 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) "upd-copyr" "\ 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" (10941 47202)) ;;; 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-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" (11495 462)) ;;; 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 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. 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." 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 all files under the current directory." 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." 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-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" (11285 51569)) ;;; 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" (11336 19791)) ;;; Generated autoloads from view.el (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-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-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-hook'." t nil) (autoload (quote view-buffer-other-window) "view" "\ View BUFFER in View mode in another window, returning to original buffer when done *only* if prefix argument NOT-RETURN is nil (which is the default). The usual Emacs commands are not available in View mode; instead, a special set of commands (mostly letters and punctuation) are defined for moving around in the buffer. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-hook'." t nil) (autoload (quote view-mode) "view" "\ Major mode for viewing text but not editing it. 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). \\[Helper-help] 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 or C-c exit view-mode and return to previous buffer. Entry to this mode runs the normal hook `view-hook'. \\{view-mode-map}" nil nil) ;;;*** ;;;### (autoloads (vip-mode) "vip" "vip.el" (11285 51578)) ;;; Generated autoloads from vip.el (autoload (quote vip-mode) "vip" "\ Turn on VIP emulation of VI." t nil) ;;;*** ;;;### (autoloads (wordstar-mode) "ws-mode" "ws-mode.el" (11486 24343)) ;;; 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 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 (run-scheme) "xscheme" "xscheme.el" (11185 17047)) ;;; Generated autoloads from xscheme.el (autoload (quote run-scheme) "xscheme" "\ Run an inferior Scheme process. Output goes to the buffer `*scheme*'. With argument, asks for a command line." t nil) ;;;*** ;;;### (autoloads (psychoanalyze-pinhead yow) "yow" "yow.el" (11285 51586)) ;;; Generated autoloads from yow.el (autoload (quote yow) "yow" "\ Return or display a random Zippy quotation." 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.22/lisp/loadhist.el100444 12120 1 6606 5363642275 14225 0ustar rmsdaemon;;; loadhist.el --- lisp functions for working with feature groups ;; Author: Eric S. Raymond ;; Version: 1.0 ;; Keywords: internal ;;; 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 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. (let ((provides (file-provides file)) (dependents nil)) (mapcar (function (lambda (x) (if (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 (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) ((boundp x) (makunbound x)) ((fboundp x) (fmakunbound x) (let ((aload (get x 'autoload))) (if aload (fset x aload)))))) ) (cdr flist)))) (provide 'loadhist) ;;; loadhist.el ends here emacs-19.22/lisp/loadup.el100444 12120 1 13043 5374300472 13703 0ustar rmsdaemon;;; loadup.el --- load up standardly loaded Lisp files for Emacs. ;; Copyright (C) 1985, 1986, 1992 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) (sleep-for 1) ;;; We don't want to have any undo records in the dumped Emacs. (buffer-disable-undo "*scratch*") (load "subr") (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 "indent") (garbage-collect) (load "window") (garbage-collect) (if (fboundp 'delete-frame) (progn (load "frame") (load "mouse") (garbage-collect) (load "scroll-bar") (load "select"))) (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 "c-mode") (garbage-collect) (load "isearch") (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 (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") ;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/ymakefile. (if (load "site-load" t) (garbage-collect)) (load "version.el") ;Don't get confused if someone compiled version.el by mistake. ;; 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 (fboundp 'dump-emacs) (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))))) (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) (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))))) (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") ;; Recompute NAME now, so that it isn't set when we dump. (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 (fboundp 'dump-emacs) (eval top-level)) ;;; loadup.el ends here emacs-19.22/lisp/lpr.el100444 12120 1 10515 5471272557 13227 0ustar rmsdaemon;;; lpr.el --- print Emacs buffer on line printer. ;; Copyright (C) 1985, 1988, 1992 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.") ;;;###autoload (defvar lpr-command (if (memq system-type '(usg-unix-v dgux-unix hpux irix)) "lp" "lpr") "*Shell command for printing a file") (defvar print-region-function nil "Function to call to print the region on a printer. See definition of `print-region-1' for calling conventions.") ;;;###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) (let ((name (concat (buffer-name) " Emacs buffer")) (width tab-width)) (save-excursion (message "Spooling...") (if (/= tab-width 8) (progn (print-region-new-buffer start end) (setq tab-width width) (save-excursion (goto-char end) (setq end (point-marker))) (untabify (point-min) (point-max)))) (if page-headers (if (eq system-type 'usg-unix-v) (progn (print-region-new-buffer start end) (call-process-region start end "pr" t t nil)) ;; On BSD, use an option to get page headers. (setq switches (cons "-p" switches)))) (apply (or print-region-function 'call-process-region) (nconc (list start end lpr-command nil nil nil) (nconc (and (eq system-type 'berkeley-unix) (list "-J" name "-T" name)) switches))) (if (markerp end) (set-marker end nil)) (message "Spooling...done")))) ;; This function copies the text between start and end ;; into a new buffer, makes that buffer current, ;; and sets start and end to the buffer bounds. ;; start and end are used free. (defun print-region-new-buffer (start end) (or (string= (buffer-name) " *spool temp*") (let ((oldbuf (current-buffer))) (set-buffer (get-buffer-create " *spool temp*")) (widen) (erase-buffer) (insert-buffer-substring oldbuf start end) (setq start (point-min) end (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))))))) ;;; lpr.el ends here emacs-19.22/lisp/ls-lisp.el100444 12120 1 20576 5414073346 14015 0ustar rmsdaemon;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp ;; Author: Sebastian Kremer ;; Keywords: unix ;; Copyright (C) 1992 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 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. ;; 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))) (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) short (car elt) attr (cdr elt) file-alist (cdr file-alist) fil (concat dir short) 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 %-8d %-8d %8d " (nth 1 file-attr) ; no. of links (if (= (user-uid) (nth 2 file-attr)) (user-login-name) (nth 2 file-attr)) ; uid (if (eq system-type 'ms-dos) "root" ; everything is root on MSDOS. (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.22/lisp/lselect.el100444 74777 1 20616 5365710442 14233 0ustar ericdaemon;;; 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.22/lisp/lucid.el100444 12120 1 15126 5471114375 13526 0ustar rmsdaemon;;; lucid.el --- Emulate some Lucid Emacs 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. (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 (cdr 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 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 (1+ 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) ;; 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 'new-frame) (provide 'lucid) ;;; end of lucid.el emacs-19.22/lisp/lunar.el100444 74720 14 25623 5431620114 14141 0ustar eggertguest;;; lunar.el --- calendar functions for phases of the moon. ;; Copyright (C) 1992 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 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. ;;; 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. ;; ;; 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 (% 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 (- (/ (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)))) (list date (solar-time-string time date) 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) (lunar-phases-buffer "*Phases of Moon*")) (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 (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* ((completion-ignore-case t) (date (calendar-current-date)) (displayed-month (if arg (cdr (assoc (capitalize (completing-read "Month name: " (mapcar 'list (append calendar-month-name-array nil)) nil t)) (calendar-make-alist calendar-month-name-array))) (extract-calendar-month date))) (displayed-year (if arg (calendar-read "Year (>0): " '(lambda (x) (> x 0)) (int-to-string (extract-calendar-year (calendar-current-date)))) (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)))))) (provide 'lunar) ;;; lunar.el ends here emacs-19.22/lisp/macros.el100444 12120 1 17725 5425641562 13723 0ustar rmsdaemon;;; macros.el --- non-primitive commands for keyboard macros. ;; Copyright (C) 1985, 1986, 1987, 1992 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 ") (let ((beg (point)) end) (prin1 definition (current-buffer)) (setq end (point-marker)) (goto-char beg) (while (< (point) end) (let ((char (following-char))) (cond ((< char 32) (delete-region (point) (1+ (point))) (insert "\\C-" (+ 96 char))) ((< char 127) (forward-char 1)) ((= char 127) (delete-region (point) (1+ (point))) (insert "\\C-?")) ((< char 160) (delete-region (point) (1+ (point))) (insert "\\M-C-" (- char 32))) ((< char 255) (delete-region (point) (1+ (point))) (insert "\\M-" (- char 128))) ((= char 255) (delete-region (point) (1+ (point))) (insert "\\M-C-?")))))) (insert ")\n") (if keys (let ((keys (where-is-internal macroname nil))) (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.")))) ))))))) ;;;###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.22/lisp/mail-extr.el100444 12120 1 136072 5257360202 14346 0ustar rmsdaemon;;; mail-extr.el --- extract full name and address from RFC 822 mail header. ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Joe Wells ;; Version: 1.0 ;; Adapted-By: ESR ;; 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Here is `mail-extr', a package for extracting full names and canonical ;; addresses from RFC 822 mail headers. It is intended to be hooked into ;; other Emacs Lisp packages that deal with RFC 822 format messages, such as ;; Gnews, GNUS, RMAIL, MH-E, BBDB, VM, Supercite, etc. Thus, this release is ;; mainly for Emacs Lisp developers. ;; There are two main benefits: ;; 1. Higher probability of getting the correct full name for a human than ;; any other package I 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 me suggestions. ;; I 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. I'm not posting the ;; test-cases because they take over 100K. ;; If you find an address that mail-extr fails on, please send it to me along ;; with what you think the correct results should be. I do not consider it a ;; bug if mail-extr mangles a comment that does not correspond to a real ;; human full name, although I 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 %. ;; * put mail-variant-method back into mail-extract-address-components. ;; * insert documentation strings! ;; * handle X.400-gatewayed addresses according to RFC 1148. ;;; Change Log: ;; ;; 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: ;; Variable definitions. (defvar mail-@-binds-tighter-than-! nil) ;;---------------------------------------------------------------------- ;; 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. ;;---------------------------------------------------------------------- (defconst mail-space-char 32) (defconst mail-whitespace " \t\n") ;; Any character that can occur in a name in an RFC822 address. ;; Yes, there are weird people with digits in their names. (defconst mail-all-letters "A-Za-z---{|}'~0-9`.") ;; Any character that can occur in a name, not counting characters that ;; separate parts of a multipart name. (defconst mail-all-letters-but-separators "A-Za-z{|}'~0-9`") ;; Any character that can start a name (defconst mail-first-letters "A-Za-z") ;; Any character that can end a name. (defconst mail-last-letters "A-Za-z`'.") ;; Matches an initial not followed by both a period and a space. (defconst mail-bad-initials-pattern (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)" mail-all-letters mail-first-letters mail-all-letters)) (defconst mail-non-name-chars (concat "^" mail-all-letters ".")) (defconst mail-non-begin-name-chars (concat "^" mail-first-letters)) (defconst mail-non-end-name-chars (concat "^" mail-last-letters)) ;; Matches periods used instead of spaces. Must not match the period ;; following an initial. (defconst mail-bad-\.-pattern (format "\\([%s][%s]\\)\\.+\\([%s]\\)" mail-all-letters mail-last-letters mail-first-letters)) ;; Matches an embedded or leading nickname that should be removed. (defconst mail-nickname-pattern (format "\\([ .]\\|\\`\\)[\"'`\[\(]\\([ .%s]+\\)[\]\"'\)] " mail-all-letters)) ;; Matches a leading title that is not part of the name (does not ;; contribute to uniquely identifying the person). (defconst mail-full-name-prefixes '"\\` *\\(Prof\\|Dr\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.? ") ;; Matches the occurrence of a generational name suffix, and the last ;; character of the preceding name. (defconst mail-full-name-suffix-pattern (format "\\(,? ?\\([JjSs]r\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)" mail-all-letters mail-all-letters)) (defconst mail-roman-numeral-pattern "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-weird-acronym-pattern "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)") ;; Matches a mixed-case or lowercase name (not an initial). (defconst mail-mixed-case-name-pattern (format "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)" mail-all-letters mail-last-letters mail-first-letters mail-all-letters mail-all-letters mail-last-letters mail-first-letters mail-all-letters)) ;; Matches a trailing alternative address. (defconst mail-alternative-address-pattern "[a-zA-Z.]+[!@][a-zA-Z.]") ;; Matches a variety of trailing comments not including comma-delimited ;; comments. (defconst mail-trailing-comment-start-pattern " [-{]\\|--\\|[+@#> ".") (?@ ".") (?, ".") (?\; ".") (?: ".") (?\\ "\\") (?\" "\"") (?. ".") (?\[ ".") (?\] ".") ;; % and ! aren't RFC822 characters, but it is convenient to pretend (?% ".") (?! ".") ) (address-comment-syntax-table (0 255 "w") (?\( "\(\)") (?\) "\)\(") (?\\ "\\")) (address-domain-literal-syntax-table (0 255 "w") (?\[ "\(\]") ;?????? (?\] "\)\[") ;?????? (?\\ "\\")) (address-text-comment-syntax-table (0 255 "w") (?\( "\(\)") (?\) "\)\(") (?\[ "\(\]") (?\] "\)\[") (?\{ "\(\}") (?\} "\)\{") (?\\ "\\") (?\" "\"") ;; (?\' "\)\`") ;; (?\` "\(\'") ) (address-text-syntax-table (0 255 ".") (?A ?Z "w") (?a ?z "w") (?- "w") (?\} "w") (?\{ "w") (?| "w") (?\' "w") (?~ "w") (?0 ?9 "w")) )) ;; Utility functions and macros. (defmacro mail-undo-backslash-quoting (beg end) (`(save-excursion (save-restriction (narrow-to-region (, beg) (, end)) (goto-char (point-min)) ;; undo \ quoting (while (re-search-forward "\\\\\\(.\\)" nil t) (replace-match "\\1") ;; CHECK: does this leave point after the replacement? ))))) (defmacro mail-nuke-char-at (pos) (` (save-excursion (goto-char (, pos)) (delete-char 1) (insert mail-space-char)))) (defmacro mail-nuke-elements-outside-range (list-symbol beg-symbol end-symbol &optional no-replace) (` (progn (setq temp (, list-symbol)) (while temp (cond ((or (> (car temp) (, end-symbol)) (< (car temp) (, beg-symbol))) (, (or no-replace (` (mail-nuke-char-at (car temp))))) (setcar temp nil))) (setq temp (cdr temp))) (setq (, list-symbol) (delq nil (, list-symbol)))))) (defun mail-demarkerize (marker) (and marker (if (markerp marker) (let ((temp (marker-position marker))) (set-marker marker nil) temp) marker))) (defun mail-markerize (pos) (and pos (if (markerp pos) pos (copy-marker pos)))) (defmacro mail-last-element (list) "Return last element of LIST." (` (let ((list (, list))) (while (not (null (cdr list))) (setq list (cdr list))) (car list)))) (defmacro mail-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 (if (string-equal (nth 1 error) "Unbalanced parentheses") nil (while t (signal (car error) (cdr error)))))))) ;; The main function to grind addresses (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)." (let ((canonicalization-buffer (get-buffer-create "*canonical address*")) (extraction-buffer (get-buffer-create "*extract address components*")) (foo 'bar) 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 comment-beg comment-end quote-beg quote-end atom-beg atom-end mbox-beg mbox-end \.-ends-name temp name-suffix saved-point fi mi li saved-%-pos saved-!-pos saved-@-pos domain-pos \.-pos insert-point) (save-excursion (set-buffer extraction-buffer) (buffer-disable-undo extraction-buffer) (set-syntax-table 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 mail-space-char 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 (skip-chars-forward mail-whitespace) (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 address-comment-syntax-table) ;; only record the first non-empty comment's position (if (and (not comment-beg) (save-excursion (forward-char 1) (skip-chars-forward mail-whitespace) (not (eq ?\) (char-after (point)))))) (setq comment-beg (point))) ;; TODO: don't record if unbalanced (or (mail-safe-move-sexp 1) (forward-char 1)) (set-syntax-table address-syntax-table) (if (and comment-beg (not comment-end)) (setq comment-end (point)))) ;; quoted text ((eq char ?\") ;; only record the first non-empty quote's position (if (and (not quote-beg) (save-excursion (forward-char 1) (skip-chars-forward mail-whitespace) (not (eq ?\" (char-after (point)))))) (setq quote-beg (point))) ;; TODO: don't record if unbalanced (or (mail-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 address-domain-literal-syntax-table) (or (mail-safe-move-sexp 1) (forward-char 1)) (set-syntax-table address-syntax-table)) ;; commas delimit addresses when outside < > pairs. ((and (eq char ?,) (or (null <-pos) (and >-pos ;; handle weird munged addresses (> (mail-last-element <-pos) (car >-pos))))) (setq multiple-addresses t) (delete-char 1) (narrow-to-region (point-min) (point))) ;; 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-nuke-char-at (point)) (forward-char 1)) (t (forward-word 1))) (or (eq char ?\() (setq last-real-pos (point)))) ;; Use only the leftmost <, if any. Replace all others with spaces. (while (cdr <-pos) (mail-nuke-char-at (car <-pos)) (setq <-pos (cdr <-pos))) ;; Use only the rightmost >, if any. Replace all others with spaces. (while (cdr >-pos) (mail-nuke-char-at (nth 1 >-pos)) (setcdr >-pos (nthcdr 2 >-pos))) ;; If multiple @s and a :, but no < and >, insert around buffer. ;; This commonly happens on the UUCP "From " line. Ugh. (cond ((and (> (length @-pos) 1) :-pos ;TODO: check if between @s (not <-pos)) (goto-char (point-min)) (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-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-nuke-elements-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-nuke-elements-outside-range !-pos <-pos >-pos t) (mail-nuke-elements-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-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-nuke-char-at temp)) ((and (or (not group-:-pos) (> temp group-:-pos)) (not group-\;-pos)) (setq group-\;-pos temp)))) ;; Handle junk like ";@host.company.dom" that sendmail adds. ;; **** should I remember comment positions? (and group-\;-pos ;; this is fine for now (mail-nuke-elements-outside-range !-pos group-:-pos group-\;-pos t) (mail-nuke-elements-outside-range @-pos group-:-pos group-\;-pos t) (mail-nuke-elements-outside-range %-pos group-:-pos group-\;-pos t) (mail-nuke-elements-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))) (and comment-end (> comment-end group-\;-pos) (setq comment-end nil comment-beg nil)) (and quote-end (> quote-end group-\;-pos) (setq quote-end nil quote-beg nil)) (narrow-to-region (point-min) group-\;-pos)) ;; 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-nuke-elements-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) (skip-chars-backward mail-whitespace) (setq phrase-end (point)) (goto-char (or ;;group-:-pos (point-min))) (skip-chars-forward mail-whitespace) (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)) (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) (delete-char -1) (mail-nuke-char-at route-addr-:-pos) (mail-demarkerize route-addr-:-pos) (setq route-addr-:-pos nil >-pos (mail-demarkerize >-pos) %-pos (mapcar 'mail-demarkerize %-pos)))) ;; de-listify @-pos (setq @-pos (car @-pos)) ;; TODO: remove comments in the middle of an address (set-buffer canonicalization-buffer) (buffer-disable-undo canonicalization-buffer) (set-syntax-table 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)) (skip-chars-forward mail-whitespace) (point)) >-pos) ;; ****** Oh no! What if the address is completely empty! (narrow-to-region first-real-pos last-real-pos)) (and @-pos %-pos (mail-nuke-elements-outside-range %-pos (point-min) @-pos)) (and %-pos !-pos (mail-nuke-elements-outside-range !-pos (point-min) (car %-pos))) (and @-pos !-pos (not %-pos) (mail-nuke-elements-outside-range !-pos (point-min) @-pos)) ;; Error condition:?? (and %-pos (not @-pos)) (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-@-binds-tighter-than-!) (goto-char @-pos) (setq %-pos (cons (point) %-pos) @-pos nil) (delete-char 1) (insert "%") (setq insert-point (point-max))) (mail-@-binds-tighter-than-! (setq insert-point (point-max))) (%-pos (setq insert-point (mail-last-element %-pos) saved-%-pos (mapcar 'mail-markerize %-pos) %-pos nil @-pos (mail-markerize @-pos))) (@-pos (setq insert-point @-pos) (setq @-pos (mail-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)) (delete-char 1) (or (save-excursion (mail-safe-move-sexp -1) (skip-chars-backward mail-whitespace) (eq ?. (preceding-char))) (insert-before-markers (if (save-excursion (skip-chars-backward mail-whitespace) (eq ?. (preceding-char))) "" ".") "uucp")) (setq !-pos (cdr !-pos)))) (and saved-%-pos (setq %-pos (append (mapcar 'mail-demarkerize saved-%-pos) %-pos))) (setq @-pos (mail-demarkerize @-pos)) (narrow-to-region (1+ saved-!-pos) (point-max)))) (cond ((and %-pos (not @-pos)) (goto-char (car %-pos)) (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)) (skip-chars-backward mail-whitespace) (save-excursion (mail-safe-move-sexp -1) (setq domain-pos (point)) (skip-chars-backward mail-whitespace) (setq \.-pos (eq ?. (preceding-char)))) (cond ((and \.-pos (get (intern (buffer-substring domain-pos (point))) 'domain-name)) (narrow-to-region (point-min) (point)) (goto-char (car temp)) (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) ;; Find the full name (cond ((and phrase-beg (eq quote-beg phrase-beg) (<= quote-end phrase-end)) (narrow-to-region (1+ quote-beg) (1- quote-end)) (mail-undo-backslash-quoting (point-min) (point-max))) (phrase-beg (narrow-to-region phrase-beg phrase-end)) (comment-beg (narrow-to-region (1+ comment-beg) (1- comment-end)) (mail-undo-backslash-quoting (point-min) (point-max))) (t ;; *** Work in canon buffer instead? No, can't. Hmm. (delete-region (point-min) (point-max)) (insert-buffer-substring canonicalization-buffer mbox-beg mbox-end) (goto-char (point-min)) (setq \.-ends-name (search-forward "_" nil t)) (goto-char (point-min)) (while (progn (skip-chars-forward mail-whitespace) (not (eobp))) (setq char (char-after (point))) (cond ((eq char ?\") (setq quote-beg (point)) (or (mail-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) (delete-char 1) (goto-char quote-beg) (delete-char 1)) (mail-undo-backslash-quoting quote-beg quote-end) (or (eq mail-space-char (char-after (point))) (insert " ")) (setq \.-ends-name t)) ((eq char ?.) (if (eq (char-after (1+ (point))) ?_) (progn (forward-char 1) (delete-char 1) (insert mail-space-char)) (if \.-ends-name (narrow-to-region (point-min) (point)) (delete-char 1) (insert " ")))) ((memq (char-syntax char) '(?. ?\\)) (delete-char 1) (insert " ")) (t (setq atom-beg (point)) (forward-word 1) (setq atom-end (point)) (save-restriction (narrow-to-region atom-beg atom-end) (goto-char (point-min)) (while (re-search-forward "\\([^_]+\\)_" nil t) (replace-match "\\1 ")) (goto-char (point-max)))))))) (set-syntax-table address-text-syntax-table) (setq xxx (mail-variant-method (buffer-string))) (delete-region (point-min) (point-max)) (insert xxx) (goto-char (point-min)) ;; ;; Compress whitespace ;; (goto-char (point-min)) ;; (while (re-search-forward "[ \t\n]+" nil t) ;; (replace-match " ")) ;; ;; ;; Fix . used as space ;; (goto-char (point-min)) ;; (while (re-search-forward mail-bad-\.-pattern nil t) ;; (replace-match "\\1 \\2")) ;; ;; ;; Delete trailing parenthesized comment ;; (goto-char (point-max)) ;; (skip-chars-backward mail-whitespace) ;; (cond ((memq (char-after (1- (point))) '(?\) ?\} ?\])) ;; (setq comment-end (point)) ;; (set-syntax-table address-text-comment-syntax-table) ;; (or (mail-safe-move-sexp -1) ;; (backward-char 1)) ;; (set-syntax-table address-text-syntax-table) ;; (setq comment-beg (point)) ;; (skip-chars-backward mail-whitespace) ;; (if (bobp) ;; (narrow-to-region (1+ comment-beg) (1- comment-end)) ;; (narrow-to-region (point-min) (point))))) ;; ;; ;; Find, save, and delete any name suffix ;; ;; *** Broken! ;; (goto-char (point-min)) ;; (cond ((re-search-forward mail-full-name-suffix-pattern nil t) ;; (setq name-suffix (buffer-substring (match-beginning 3) ;; (match-end 3))) ;; (replace-match "\\1 \\4"))) ;; ;; ;; Delete ALL CAPS words and after, if preceded by mixed-case or ;; ;; lowercase words. Eg. XT-DEM. ;; (goto-char (point-min)) ;; ;; ## This will lose on something like "SMITH MAX". ;; ;; ## maybe it should be ;; ;; ## " \\([A-Z]+[-_/][A-Z]+\\|[A-Z][A-Z][A-Z]\\)\\b.*[^A-Z \t]" ;; ;; ## that is, three-letter-upper-case-word with non-upper-case ;; ;; ## characters following it. ;; (if (re-search-forward mail-mixed-case-name-pattern nil t) ;; (if (re-search-forward mail-weird-acronym-pattern nil t) ;; (narrow-to-region (point-min) (match-beginning 0)))) ;; ;; ;; Delete trailing alternative address ;; (goto-char (point-min)) ;; (if (re-search-forward mail-alternative-address-pattern nil t) ;; (narrow-to-region (point-min) (match-beginning 0))) ;; ;; ;; Delete trailing comment ;; (goto-char (point-min)) ;; (if (re-search-forward mail-trailing-comment-start-pattern nil t) ;; (or (progn ;; (goto-char (match-beginning 0)) ;; (skip-chars-backward mail-whitespace) ;; (bobp)) ;; (narrow-to-region (point-min) (match-beginning 0)))) ;; ;; ;; Delete trailing comma-separated comment ;; (goto-char (point-min)) ;; ;; ## doesn't this break "Smith, John"? Yes. ;; (re-search-forward mail-last-name-first-pattern nil t) ;; (while (search-forward "," nil t) ;; (or (save-excursion ;; (backward-char 2) ;; (looking-at mail-full-name-suffix-pattern)) ;; (narrow-to-region (point-min) (1- (point))))) ;; ;; ;; Delete telephone numbers and ham radio call signs ;; (goto-char (point-min)) ;; (if (re-search-forward mail-telephone-extension-pattern nil t) ;; (narrow-to-region (point-min) (match-beginning 0))) ;; (goto-char (point-min)) ;; (if (re-search-forward mail-ham-call-sign-pattern nil t) ;; (if (eq (match-beginning 0) (point-min)) ;; (narrow-to-region (match-end 0) (point-max)) ;; (narrow-to-region (point-min) (match-beginning 0)))) ;; ;; ;; Delete trailing word followed immediately by . ;; (goto-char (point-min)) ;; ;; ## what's this for? doesn't it mess up "Public, Harry Q."? No. ;; (if (re-search-forward "\\b[A-Za-z][A-Za-z]+\\. *\\'" nil t) ;; (narrow-to-region (point-min) (match-beginning 0))) ;; ;; ;; Handle & substitution ;; ;; TODO: remember to disable middle initial guessing ;; (goto-char (point-min)) ;; (cond ((re-search-forward "\\( \\|\\`\\)&\\( \\|\\'\\)" nil t) ;; (goto-char (match-end 1)) ;; (delete-char 1) ;; (capitalize-region ;; (point) ;; (progn ;; (insert-buffer-substring canonicalization-buffer ;; mbox-beg mbox-end) ;; (point))))) ;; ;; ;; Delete nickname ;; (goto-char (point-min)) ;; (if (re-search-forward mail-nickname-pattern nil t) ;; (replace-match (if (eq (match-beginning 2) (1- (match-end 2))) ;; " \\2 " ;; " "))) ;; ;; ;; Fixup initials ;; (while (progn ;; (goto-char (point-min)) ;; (re-search-forward mail-bad-initials-pattern nil t)) ;; (replace-match ;; (if (match-beginning 4) ;; "\\1. \\4" ;; (if (match-beginning 5) ;; "\\1. \\5" ;; "\\1. ")))) ;; ;; ;; Delete title ;; (goto-char (point-min)) ;; (if (re-search-forward mail-full-name-prefixes nil t) ;; (narrow-to-region (point) (point-max))) ;; ;; ;; Delete trailing and preceding non-name characters ;; (goto-char (point-min)) ;; (skip-chars-forward mail-non-begin-name-chars) ;; (narrow-to-region (point) (point-max)) ;; (goto-char (point-max)) ;; (skip-chars-backward mail-non-end-name-chars) ;; (narrow-to-region (point-min) (point)) ;; If name is "First Last" and userid is "F?L", then assume ;; the middle initial is the second letter in the userid. ;; initially by Jamie Zawinski (cond ((and (eq 3 (- mbox-end mbox-beg)) (progn (goto-char (point-min)) (looking-at mail-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) ". "))))) ;; ;; Restore suffix ;; (cond (name-suffix ;; (goto-char (point-max)) ;; (insert ", " name-suffix) ;; (backward-word 1) ;; (cond ((memq (following-char) '(?j ?J ?s ?S)) ;; (capitalize-word 1) ;; (or (eq (following-char) ?.) ;; (insert ?.))) ;; (t ;; (upcase-word 1))))) ;; Result (list (buffer-string) (progn (set-buffer canonicalization-buffer) (buffer-string))) ))) ;; TODO: put this back in the above function now that it's proven: (defun mail-variant-method (string) (let ((variant-buffer (get-buffer-create "*variant method buffer*")) (word-count 0) mixed-case-flag lower-case-flag upper-case-flag suffix-flag last-name-comma-flag comment-beg comment-end initial beg end ) (save-excursion (set-buffer variant-buffer) (buffer-disable-undo variant-buffer) (set-syntax-table address-text-syntax-table) (widen) (erase-buffer) (setq case-fold-search nil) (insert string) ;; Fix . used as space (goto-char (point-min)) (while (re-search-forward mail-bad-\.-pattern nil t) (replace-match "\\1 \\2")) ;; Skip any initial garbage. (goto-char (point-min)) (skip-chars-forward mail-non-begin-name-chars) (skip-chars-backward "& \"") (narrow-to-region (point) (point-max)) (catch 'stop (while t (skip-chars-forward mail-whitespace) (cond ;; Delete title ((and (eq word-count 0) (looking-at mail-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-full-name-suffix-pattern)) (skip-chars-backward mail-whitespace) (setq suffix-flag (point)) (if (eq ?, (following-char)) (forward-char 1) (insert ?,)) ;; Enforce at least one space after comma (or (eq mail-space-char (following-char)) (insert mail-space-char)) (skip-chars-forward mail-whitespace) (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-count (1+ word-count)) (throw 'stop t)) ;; Handle SCA names ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" (setq word-count 0) (goto-char (match-beginning 1)) (narrow-to-region (point) (point-max))) ;; Various stopping points ((or ;; Stop before ALL CAPS acronyms, if preceded by mixed-case or ;; lowercase words. Eg. XT-DEM. (and (>= word-count 2) (or mixed-case-flag lower-case-flag) (looking-at mail-weird-acronym-pattern) (not (looking-at mail-roman-numeral-pattern))) ;; Stop before 4-or-more letter lowercase words preceded by ;; mixed case or uppercase words. (and (>= word-count 2) (or upper-case-flag mixed-case-flag) (looking-at "[a-z][a-z][a-z][a-z]+\\b")) ;; Stop before trailing alternative address (looking-at mail-alternative-address-pattern) ;; Stop before trailing comment not introduced by comma (looking-at mail-trailing-comment-start-pattern) ;; Stop before telephone numbers (looking-at mail-telephone-extension-pattern)) (throw 'stop 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 mail-space-char (following-char)) (insert mail-space-char))) ;; Stop before trailing comma-separated comment ((eq ?, (following-char)) (throw 'stop t)) ;; Delete parenthesized/quoted comment/nickname ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) (setq comment-beg (point)) (set-syntax-table address-text-comment-syntax-table) (cond ((memq (following-char) '(?\' ?\`)) (if (eq ?\' (following-char)) (forward-char 1)) (or (search-forward "'" nil t) (delete-char 1))) (t (or (mail-safe-move-sexp 1) (goto-char (point-max))))) (set-syntax-table address-text-syntax-table) (setq comment-end (point)) (cond ;; Handle case of entire name being quoted ((and (eq word-count 0) (looking-at " *\\'") (>= (- comment-end comment-beg) 2)) (narrow-to-region (1+ comment-beg) (1- comment-end)) (goto-char (point-min))) (t ;; Handle case of quoted initial (if (and (or (= 3 (- comment-end comment-beg)) (and (= 4 (- comment-end comment-beg)) (eq ?. (char-after (+ 2 comment-beg))))) (not (looking-at " *\\'"))) (setq initial (char-after (1+ comment-beg))) (setq initial nil)) (delete-region comment-beg comment-end) (if initial (insert initial ". "))))) ;; Delete ham radio call signs ((looking-at mail-ham-call-sign-pattern) (delete-region (match-beginning 0) (match-end 0))) ;; Handle & substitution ;; TODO: remember to disable middle initial guessing ((and (or (bobp) (eq mail-space-char (preceding-char))) (looking-at "&\\( \\|\\'\\)")) (delete-char 1) (capitalize-region (point) (progn (insert-buffer-substring canonicalization-buffer mbox-beg mbox-end) (point)))) ;; Fixup initials ((looking-at mail-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 mail-space-char (following-char)) (insert mail-space-char)) (setq word-count (1+ word-count))) ;; Regular name words ((looking-at mail-name-pattern) (setq beg (point)) (setq end (match-end 0)) (set (if (re-search-forward "[a-z]" end t) (if (progn (goto-char beg) (re-search-forward "[A-Z]" end t)) 'mixed-case-flag 'lower-case-flag) 'upper-case-flag) t) (goto-char end) (setq word-count (1+ word-count))) (t (throw 'stop t))))) (narrow-to-region (point-min) (point)) ;; Delete trailing word followed immediately by . (cond ((not suffix-flag) (goto-char (point-min)) (if (re-search-forward "\\b[A-Za-z][A-Za-z]+\\. *\\'" nil t) (narrow-to-region (point-min) (match-beginning 0))))) ;; If last name first put it at end (but before suffix) (cond (last-name-comma-flag (goto-char (point-min)) (search-forward ",") (setq end (1- (point))) (goto-char (or suffix-flag (point-max))) (or (eq mail-space-char (preceding-char)) (insert mail-space-char)) (insert-buffer-substring (current-buffer) (point-min) end) (narrow-to-region (1+ end) (point-max)))) (goto-char (point-max)) (skip-chars-backward mail-non-end-name-chars) (if (eq ?. (following-char)) (forward-char 1)) (narrow-to-region (point) (progn (goto-char (point-min)) (skip-chars-forward mail-non-begin-name-chars) (point))) ;; Compress whitespace (goto-char (point-min)) (while (re-search-forward "[ \t\n]+" nil t) (replace-match " ")) (buffer-substring (point-min) (point-max)) ))) ;; The country names are just in there for show right now, and because ;; Jamie thought it would be neat. They aren't used yet. ;; 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. ;; TODO: put this in its own obarray, instead of cluttering up the main ;; symbol table with junk. (mapcar (function (lambda (x) (if (symbolp x) (put x 'domain-name t) (put (car x) 'domain-name (nth 1 x))))) '((ag "Antigua") (ar "Argentina") ; Argentine Republic arpa ; Advanced Projects Research Agency (at "Austria") ; The Republic of _ (au "Australia") (bb "Barbados") (be "Belgium") ; The Kingdom of _ (bg "Bulgaria") bitnet ; Because It's Time NET (bo "Bolivia") ; Republic of _ (br "Brazil") ; The Federative Republic of _ (bs "Bahamas") (bz "Belize") (ca "Canada") (ch "Switzerland") ; The Swiss Confederation (cl "Chile") ; The Republic of _ (cn "China") ; The People's Republic of _ (co "Columbia") com ; Commercial (cr "Costa Rica") ; The Republic of _ (cs "Czechoslovakia") (de "Germany") (dk "Denmark") (dm "Dominica") (do "Dominican Republic") ; The _ (ec "Ecuador") ; The Republic of _ edu ; Educational (eg "Egypt") ; The Arab Republic of _ (es "Spain") ; The Kingdom of _ (fi "Finland") ; The Republic of _ (fj "Fiji") (fr "France") gov ; Government (U.S.A.) (gr "Greece") ; The Hellenic Republic (hk "Hong Kong") (hu "Hungary") ; The Hungarian People's Republic (???) (ie "Ireland") (il "Israel") ; The State of _ (in "India") ; The Republic of _ int ; something British, don't know what (is "Iceland") ; The Republic of _ (it "Italy") ; The Italian Republic (jm "Jamaica") (jp "Japan") (kn "St. Kitts and Nevis") (kr "South Korea") (lc "St. Lucia") (lk "Sri Lanka") ; The Democratic Socialist Republic of _ mil ; Military (U.S.A.) (mx "Mexico") ; The United Mexican States (my "Malaysia") ; changed to Myanmar???? (na "Namibia") nato ; North Atlantic Treaty Organization net ; Network (ni "Nicaragua") ; The Republic of _ (nl "Netherlands") ; The Kingdom of the _ (no "Norway") ; The Kingdom of _ (nz "New Zealand") org ; Organization (pe "Peru") (pg "Papua New Guinea") (ph "Philippines") ; The Republic of the _ (pl "Poland") (pr "Puerto Rico") (pt "Portugal") ; The Portugese Republic (py "Paraguay") (se "Sweden") ; The Kingdom of _ (sg "Singapore") ; The Republic of _ (sr "Suriname") (su "Soviet Union") (th "Thailand") ; The Kingdom of _ (tn "Tunisia") (tr "Turkey") ; The Republic of _ (tt "Trinidad and Tobago") (tw "Taiwan") (uk "United Kingdom") ; The _ of Great Britain unter-dom ; something German (us "U.S.A.") ; The United States of America uucp ; Unix to Unix CoPy (uy "Uruguay") ; The Eastern Republic of _ (vc "St. Vincent and the Grenadines") (ve "Venezuela") ; The Republic of _ (yu "Yugoslavia") ; The Socialist Federal Republic of _ ;; Also said to be Zambia ... (za "South Africa") ; The Republic of _ (why not Zaire???) (zw "Zimbabwe") ; Republic of _ )) ;; fipnet ;; Code for testing. (defun time-extract () (let (times list) (setq times (cons (current-time-string) times) list problem-address-alist) (while list (mail-extract-address-components (car (car list))) (setq list (cdr list))) (setq times (cons (current-time-string) times)) (nreverse times))) (defun test-extract (&optional starting-point) (interactive) (set-buffer (get-buffer-create "*Testing*")) (erase-buffer) (sit-for 0) (mapcar 'test-extract-internal (if starting-point (memq starting-point problem-address-alist) problem-address-alist))) (defvar failed-item) (defun test-extract-internal (item) (setq failed-item item) (let* ((address (car item)) (correct-name (nth 1 item)) (correct-canon (nth 2 item)) (result (mail-extract-address-components address)) (name (car result)) (canon (nth 1 result)) (name-correct (or (null correct-name) (string-equal (downcase correct-name) (downcase name)))) (canon-correct (or (null correct-canon) (string-equal correct-canon canon)))) (cond ((not (and name-correct canon-correct)) (pop-to-buffer "*Testing*") (select-window (get-buffer-window (current-buffer))) (goto-char (point-max)) (insert "Address: " address "\n") (if (not name-correct) (insert " Correct Name: [" correct-name "]\; Result: [" name "]\n")) (if (not canon-correct) (insert " Correct Canon: [" correct-canon "]\; Result: [" canon "]\n")) (insert "\n") (sit-for 0)))) (setq failed-item nil)) (defun test-continue-extract () (interactive) (test-extract failed-item)) ;; Assorted junk. ;; warsaw@nlm.nih.gov (A Bad Dude -- Barry Warsaw) ;;'(from ;; reply-to ;; return-path ;; x-uucp-from ;; sender ;; resent-from ;; resent-sender ;; resent-reply-to) ;;; mail-extr.el ends here emacs-19.22/lisp/mail-utils.el100444 12120 1 20577 5473636427 14525 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 maol 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.") (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 "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)" 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-original-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 (1+ pos))) (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))) (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 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 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.22/lisp/mailabbrev.el100444 12120 1 54742 5453130713 14533 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) (defvar mail-abbrev-mailrc-file nil "Name of file with mail aliases. If nil, ~/.mailrc is used.") (defmacro mail-abbrev-mailrc-file () '(or mail-abbrev-mailrc-file (setq mail-abbrev-mailrc-file (or (getenv "MAILRC") "~/.mailrc")))) ;; 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-abbrev-mailrc-file))) (build-mail-abbrevs)) (make-local-variable 'pre-abbrev-expand-hook) (setq pre-abbrev-expand-hook (cond ((and (listp pre-abbrev-expand-hook) (not (eq 'lambda (car pre-abbrev-expand-hook)))) (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)) (t (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)))) (abbrev-mode 1)) ;;;###autoload (defun build-mail-abbrevs (&optional file recursivep) "Read mail aliases from `~/.mailrc' file and set `mail-abbrevs'." (setq file (expand-file-name (or file (mail-abbrev-mailrc-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))))) (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-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-abbrev-mailrc-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 '()) (start 0) (L (length definition)) 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 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 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\\):" "*Regexp to select mail-headers in which mail-abbrevs should be expanded. This string it will be handed to `looking-at' with the 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-syntax-table (copy-syntax-table text-mode-syntax-table) "The syntax table which is used in send-mail mode message bodies.") (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)) (i (1- (length tab))) (_ (aref (standard-syntax-table) ?_)) (w (aref (standard-syntax-table) ?w))) (while (>= i 0) (if (= (aref tab i) _) (aset tab i w)) (setq i (1- i))) 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) ; 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-abbrev-mailrc-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 (file) "Rebuild all the mail aliases from the given file." (interactive (list (let ((insert-default-directory t) (default-directory (expand-file-name "~/")) (def (mail-abbrev-mailrc-file))) (read-file-name (format "Read mail aliases from file: (default %s) " def) default-directory (expand-file-name def default-directory) t)))) (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))) ""))) (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.22/lisp/mailalias.el100444 12120 1 16044 5407433052 14355 0ustar rmsdaemon;;; 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: (defvar mail-aliases t "Alias of mail address aliases, or t meaning should be initialized from `~/.mailrc'.") ;; 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', `Cc' and `Bcc' and their `Resent-' variants. Optional second arg EXCLUDE may be a regular expression defining text to be removed from alias expansions." (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 "^\\(to\\|cc\\|bcc\\|resent-to\\|resent-cc\\|resent-bcc\\):" 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 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 ~/.mailrc exists. (defun build-mail-aliases (&optional file) "Read mail aliases from `~/.mailrc' and set `mail-aliases'." (setq file (expand-file-name (or file "~/.mailrc"))) (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)) ;; 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 (or (re-search-forward "^a\\(lias\\|\\)[ \t]+" nil t) (re-search-forward "^g\\(roup\\|\\)[ \t]+" nil t)) (re-search-forward "[^ \t]+") (let* ((name (buffer-substring (match-beginning 0) (match-end 0))) (start (progn (skip-chars-forward " \t") (point)))) (end-of-line) (define-mail-alias name (buffer-substring start (point))))) 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) "Define NAME as a mail alias that translates to DEFINITION. This means that sending a message to NAME will actually send to DEFINITION. DEFINITION can be one or more mail addresses separated by commas." (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") ;; Read the defaults first, if we have not done so. (if (eq mail-aliases t) (progn (setq mail-aliases nil) (if (file-exists-p "~/.mailrc") (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 ((first (aref definition 0)) (last (aref definition (1- (length definition)))) tem) (if (and (= first last) (memq first '(?\' ?\"))) ;; Strip quotation marks. (setq definition (substring definition 1 (1- (length definition)))) ;; ~/.mailrc contains addresses separated by spaces. ;; mailers should expect addresses separated by commas. (while (setq tem (string-match "[^ \t,][ \t,]+" definition tem)) (if (= (match-end 0) (length definition)) (setq definition (substring definition 0 (1+ tem))) (setq definition (concat (substring definition 0 (1+ tem)) ", " (substring definition (match-end 0)))) (setq tem (+ 3 tem))))) (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.22/lisp/man.el100444 12120 1 67766 5474056410 13220 0ustar rmsdaemon;;; man.el --- browse UNIX manual pages ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw ;; Last-Modified: 31-Jul-1991 ;; Version: 1.1 ;; Keywords: help ;; 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 code provides a function, manual-entry, 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 encorporate 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. ;; ========== 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. ;;; Code: (require 'assoc) ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; user variables (defvar Man-notify 'friendly "*Selects the behavior when manpage is ready. This variable may have one of the following values: newframe -- put the manpage in its own frame (see `Man-frame-parameters') bully -- make the manpage the current buffer and only window aggressive -- make the manpage the current buffer in the other window friendly -- display manpage in other window but don't make current polite -- don't display manpage, but prints message when ready (beeps) quiet -- like `polite', but don't beep meek -- make no indication that manpage is ready Any other value of `Man-notify' is equivalent to `meek'.") (defvar Man-frame-parameters nil "*Frame parameter list for creating a new frame for a manual page.") (defvar Man-reuse-okay-p t "*Reuse a manpage buffer if possible. When t, and a manpage buffer already exists with the same invocation, man just indicates the manpage is ready according to the value of `Man-notify'. When nil, it always fires off a background process, putting the results in a uniquely named buffer.") (defvar Man-downcase-section-letters-p 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-p t "*If t, the manpage list is treated as circular for traversal.") ;; I changed this to nil because it is a bad idea ;; to fail to recognize things in other sections. (defvar Man-auto-section-alist nil ;; '((c-mode . ("2" "3")) ;; (c++-mode . ("2" "3")) ;; (c++-c-mode . ("2" "3")) ;; (shell-mode . ("1" "8")) ;; (cmushell-mode . ("1" "8")) ;; (text-mode . "1") ;; ) "*Association list of major modes and their default section numbers. List is of the form: (MAJOR-MODE . [SECTION | (SECTION*)]). If current major mode is not in list, then the default is to check for manpages in all sections.") (defvar Man-section-translations-alist '(("3C++" . "3") ("3X" . "3") ; Xlib man pages ("3X11" . "3") ("1-UCB" . "")) "*Association list of bogus sections to real section numbers. 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-filter-list '(("sed " (;;"-e 's/.\010//g'" "-e '/[Nn]o such file or directory/d'" "-e '/Reformatting page. Wait... done/d'" "-e '/^\\([A-Z][A-Z.]*([0-9A-Za-z][-0-9A-Za-z+]*)\\).*\\1$/d'" "-e '/^[ \\t]*Hewlett-Packard Company[ \\t]*- [0-9]* -.*$/d'" "-e '/^[ \\t]*Hewlett-Packard[ \\t]*- [0-9]* -.*$/d'" "-e '/^ *Page [0-9]*.*(printed [0-9\\/]*)$/d'" "-e '/^Printed [0-9].*[0-9]$/d'" "-e '/^[ \\t]*X Version 1[01].*Release [0-9]/d'" "-e '/^[A-za-z].*Last change:/d'" "-e '/^Sun Release [0-9].*[0-9]$/d'" "-e '/^\\n$/D'" )) ("awk '\n" ("BEGIN { blankline=0; anonblank=0; }\n" "/^$/ { if (anonblank==0) next; }\n" "{ anonblank=1; }\n" "/^$/ { blankline++; next; }\n" "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" "'" )) ) "*Manpage cleaning filter command phrases. This variable contains an association 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.") (defvar Man-mode-line-format '("" mode-line-modified mode-line-buffer-identification " " global-mode-string " " Man-page-mode-string " %[(" mode-name minor-mode-alist mode-line-process ")%]----" (-3 . "%p") "-%-") "*Mode line format for manual mode buffer.") (defvar Man-mode-map nil "*Keymap for Man mode.") (defvar Man-mode-hooks nil "*Hooks for Man mode.") (defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]" "*Regular expression describing a manpage section within parentheses.") (defvar Man-heading-regexp "^ ?[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 "^ ?NAME$\\|^ ?No manual entry for .*$" "*Regular expression describing first heading on a manpage. This regular expression should start with a `^' character.") (defvar Man-reference-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*\\(([0-9][a-zA-Z+]*)\\)?" "*Regular expression describing a reference in the SEE ALSO section.") (defvar Man-switches "" "*Switches passed to the man command, as a single string.") ;; Would someone like to provide a good test for being on Solaris? ;; We could give it its own value of system-type, but that has drawbacks; ;; it would require changes in lots of places that test system-type. (defvar Man-specified-section-option "" "*Option that indicates a specified a manual section name. On most Unix systems, no option is needed for this. On Solaris, you need to set this to \"-s \".") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; 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) (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)") (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 "," 'beginning-of-buffer) (define-key Man-mode-map "." 'end-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 "q" 'Man-quit) (define-key Man-mode-map "m" 'manual-entry) (define-key Man-mode-map "?" 'describe-mode) ) ;; ====================================================================== ;; utilities (defun Man-page-mode-string () "Formats part of the mode line for manual mode." (format "%d (of %d)" Man-current-page (length Man-page-list))) (defun Man-delete-trailing-newline (str) (if (string= (substring str (1- (length str))) "\n") (substring str 0 (1- (length str))) str)) (defun Man-build-man-command () "Builds the entire background manpage and cleaning command." (let ((command (concat "man " Man-switches " %s 2>&1")) (flist Man-filter-list)) (while flist (let ((pcom (car (car flist))) (pargs (car (cdr (car flist))))) (setq flist (cdr flist)) (if (or (not (stringp pcom)) (not (listp pargs))) (error "malformed Man-filter-list.")) (setq command (concat command " | " pcom (mapconcat '(lambda (phrase) phrase) pargs " "))))) command)) (defun Man-downcase (man-args) "Downcases section letters in MAN-ARGS." (let ((newargs "") (s 0) mstart mend (len (length man-args))) (while (and (< s len) (setq mstart (string-match Man-section-regexp man-args s))) (setq mend (match-end 0) newargs (concat newargs (substring man-args s mstart))) (setq newargs (concat newargs (downcase (substring man-args mstart mend))) s mend)) (concat newargs (substring man-args s len)))) (defun Man-translate-references (ref) "Translates REF from \"chmod(2V)\" to \"2v chmod\" style." (if (string-match (concat "(" Man-section-regexp ")$") ref) (let* ((word (progn (string-match "(" ref) (substring ref 0 (1- (match-end 0))))) (section-re (concat "(\\(" Man-section-regexp "\\))")) (section (if (string-match section-re ref) (substring ref (match-beginning 1) (match-end 1)) "")) (slist Man-section-translations-alist) ) (if Man-downcase-section-letters-p (setq section (Man-downcase section))) (while slist (let ((s1 (car (car slist))) (s2 (cdr (car slist)))) (setq slist (cdr slist)) (if Man-downcase-section-letters-p (setq s1 (Man-downcase s1))) (if (not (string= s1 section)) nil (setq section (if Man-downcase-section-letters-p (Man-downcase s2) s2) slist nil)))) (concat Man-specified-section-option section " " word)) ref)) (defun Man-linepos (&optional position col-p) "Return the character position at various line/buffer positions. Preserves the state of point, mark, etc. Optional arg POSITION can be one of the following symbols: bol == beginning of line boi == beginning of indentation eol == end of line [default] bob == beginning of buffer eob == end of buffer Optional arg COL-P, if non-nil, means to return the current column instead of character position." (let ((tpnt (point)) rval) (cond ((eq position 'bol) (beginning-of-line)) ((eq position 'boi) (back-to-indentation)) ((eq position 'bob) (goto-char (point-min))) ((eq position 'eob) (goto-char (point-max))) (t (end-of-line))) (setq rval (if col-p (current-column) (point))) (goto-char tpnt) rval)) ;; ====================================================================== ;; default man entry and get word under point (defun Man-default-man-args (manword) "Build the default man args from MANWORD and buffer's major mode." (let ((sections (cdr (assq major-mode Man-auto-section-alist)))) (cond ((null sections) manword) ((consp sections) (mapconcat (lambda (n) (concat n " " manword)) sections " ")) (t (concat sections " " manword))))) (defun 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. (and (not (looking-at "[a-zA-Z_]")) (skip-chars-backward "^a-zA-Z_")) (skip-chars-backward "(a-zA-Z_0-9") (and (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 ;; section number in default-entry (if (looking-at "[ \t]*([ \t]*[0-9][a-zA-Z]?[ \t]*)") (progn (skip-chars-forward "^0-9") (setq default-title (concat (buffer-substring (point) (progn (skip-chars-forward "0-9a-zA-Z") (point))) " " default-title))) (setq default-title (Man-default-man-args default-title))) default-title))) ;; ====================================================================== ;; top level command and background process sentinel ;;; This alias makes completion more predictable if ignoring case. ;;;###autoload (defalias 'man 'manual-entry) ;;;###autoload (defun manual-entry (arg) "Get a Un*x manual page and put it in a buffer. This command is the top-level command in the man package. It runs a Un*x command to retrieve and clean a manpage in the background and places the results in a Man mode (manpage browsing) buffer. See variable `Man-notify' for what happens when the buffer is ready. Universal argument ARG, is passed to `Man-getpage-in-background'." (interactive "P") (let* ((default-entry (Man-default-man-entry)) (man-args (read-string (format "Manual-entry: %s" (if (string= default-entry "") "" (format "(default: %s) " default-entry)))))) (and (string= man-args "") (if (string= default-entry "") (error "No man args given.") (setq man-args default-entry))) ;; Recognize the subject(section) syntax. (setq man-args (Man-translate-references man-args)) ;; This is apparently already done correctly via Man-translate-references. ;; (if Man-downcase-section-letters-p ;; (setq man-args (Man-downcase man-args))) (Man-getpage-in-background man-args (consp arg)) )) (defun Man-getpage-in-background (TOPIC &optional override-reuse-p) "Uses TOPIC to build and fire off the manpage and cleaning command. Optional OVERRIDE-REUSE-P, when non-nil, means to start a background process even if a buffer already exists and `Man-reuse-okay-p' is non-nil." (let* ((man-args TOPIC) (bufname (concat "*man " man-args "*")) (buffer (get-buffer bufname))) (if (and Man-reuse-okay-p (not override-reuse-p) buffer) (Man-notify-when-ready buffer) (message "Invoking man %s in background..." man-args) (setq buffer (generate-new-buffer bufname)) (let ((process-environment (copy-sequence process-environment))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") (set-process-sentinel (start-process "man" 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' for the different notification behaviors." (cond ((eq Man-notify 'newframe) (set-buffer man-buffer) (new-frame Man-frame-parameters)) ((eq Man-notify 'bully) (pop-to-buffer man-buffer) (delete-other-windows)) ((eq Man-notify 'aggressive) (pop-to-buffer man-buffer)) ((eq Man-notify 'friendly) (display-buffer man-buffer 'not-this-window)) ((eq Man-notify 'polite) (beep) (message "Manual buffer %s is ready." (buffer-name man-buffer))) ((eq Man-notify 'quiet) (message "Manual buffer %s is ready." (buffer-name man-buffer))) ((or (eq Man-notify 'meek) t) (message "")) )) (defun Man-set-fonts () (goto-char (point-min)) (while (re-search-forward "\\(.\b\\)+" nil t) (let ((st (match-beginning 0)) (en (match-end 0))) (goto-char st) (if window-system (put-text-property st (if (= en (point-max)) en (1+ en)) 'face (if (looking-at "_") 'underline 'bold))) (while (and (< (point) en) (looking-at ".\b")) (replace-match ""))))) (defun Man-bgproc-sentinel (process msg) "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) (goto-char (point-min)) (cond ((or (looking-at "No \\(manual \\)*entry for") (looking-at "[^\n]*: nothing appropriate$")) (setq err-mess (buffer-substring (point) (Man-linepos 'eol)) 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) (save-window-excursion (save-excursion (set-buffer Man-buffer) (Man-set-fonts) (Man-mode) (set-buffer-modified-p nil))) (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: \\[manual-entry] 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, its buffer, and window. \\[describe-mode] Prints this help text. The following variables may be of some use. Try \"\\[describe-variable] RET\" for more information: Man-notify What happens when manpage formatting is done. Man-reuse-okay-p Okay to reuse already formatted buffer? Man-downcase-section-letters-p Force section letters to lower case? Man-circular-pages-p Multiple manpage list treated 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-hooks Hooks for 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) (goto-char (point-min)) (Man-build-page-list) (Man-goto-page 1) (run-hooks 'Man-mode-hook)) (defun Man-build-section-alist () "Build the association list of manpage sections." (setq Man-sections-alist nil) (goto-char (point-min)) (while (re-search-forward Man-heading-regexp (point-max) t) (aput 'Man-sections-alist (buffer-substring (Man-linepos 'bol) (Man-linepos))) (forward-line 1) )) (defun 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)) (narrow-to-region start end) (goto-char (point-min)) (back-to-indentation) (while (and (not (eobp)) (/= (point) runningpoint)) (setq runningpoint (point)) (let* ((eow (re-search-forward Man-reference-regexp end t)) (word (buffer-substring (match-beginning 0) (match-end 0))) (len (1- (length word)))) (if (not eow) nil (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) (save-excursion (let ((page-start (Man-linepos 'bob)) (page-end (Man-linepos 'eob)) (regexp Man-first-heading-regexp)) (goto-char (point-min)) (re-search-forward regexp (point-max) t) (while (not (eobp)) (if (re-search-forward regexp (point-max) t) (progn (setq page-end (Man-linepos 'bol)) (end-of-line)) (goto-char (point-max)) (setq page-end (point))) (setq Man-page-list (append Man-page-list (list (cons page-start page-end))) page-start page-end) )))) ;; ====================================================================== ;; Man-mode commands (defun Man-next-section (n) "Move point to Nth next section (default 1)." (interactive "p") (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") (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))) (goto-char (point-min)) (if (re-search-forward (concat "^\\s-?" 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 current manpage.")))) (defun Man-follow-manual-reference (arg) "Get one of the manpages referred to in the \"SEE ALSO\" section. Queries you for the page to retrieve. Of course it does this in the background. Universal argument ARG is passed to `Man-getpage-in-background'." (interactive "P") (if (not Man-refpages-alist) (error (concat "No references found in current manpage.")) (aput 'Man-refpages-alist (let* ((default (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))) (Man-getpage-in-background (Man-translate-references (aheadsym Man-refpages-alist)) (consp arg)))) (defun Man-quit () "Kill the buffer containing the manpage." (interactive) (let ((buff (current-buffer))) (delete-windows-on buff) (kill-buffer buff))) (defun Man-goto-page (page) "Go to the manual page on page PAGE." (interactive (if (not Man-page-list) (error "You're looking at the only manpage in the buffer.") (format "nGo to manpage [1-%d]: " (length Man-page-list)))) (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 (cdr page-range))) (setq Man-current-page page Man-page-mode-string (Man-page-mode-string)) (widen) (goto-char page-start) (narrow-to-region page-start page-end) (Man-build-section-alist) ;; Don't let bugs in Man-build-references-alist ;; interfere with ordinary use of this package. (condition-case nil (Man-build-references-alist) (error)) (widen) (narrow-to-region page-start page-end) (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-p (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-p (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.22/lisp/mailpost.el100444 12120 1 6127 5257330730 14234 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.22/lisp/makefile.el100444 13437 1 113370 5405347557 14366 0ustar jimbdaemon;;; makefile.el --- makefile editing commands for Emacs ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Thomas Neumann ;; Eric S. Raymond ;; Adapted-By: ESR ;; Keywords: unix, tools ;; RMS: ;; This needs work. The electric characters are too obnoxious. ;; It should not define C-c LETTER. ;; It should support knowing the list of existing macros and targets ;; via M-TAB completion, not by preempting insertion of references. ;; 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 `...'. ;; The Mode names is written as makefile-mode instead of Makefile mode. ;; So, for the meantime, this is not the default mode for makefiles. ;; $Id: makefile.el,v 1.9 1993/06/09 11:54:21 jimb 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; 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 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 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. ;;; Code: (provide 'makefile) ;;; ------------------------------------------------------------ ;;; Configurable stuff ;;; ------------------------------------------------------------ (defconst makefile-mode-name "makefile" "The \"pretty name\" of makefile-mode, as it appears in the modeline.") (defvar makefile-browser-buffer-name "*Macros and Targets*" "Name of the macro- and target browser buffer.") (defvar makefile-target-colon ":" "The string that gets appended to all target names inserted by makefile-insert-target. \":\" or \"::\" are quite common values.") (defvar 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 \" := \" .") (defvar makefile-use-curly-braces-for-macros-p nil "Controls the style of generated macro references. Set this variable to a non-nil value if you prefer curly braces in macro-references, so it looks like ${this}. A value of nil will cause makefile-mode to use parentheses, making macro references look like $(this) .") (defvar makefile-tab-after-target-colon t "If you want a TAB (instead of a space) to be appended after the target colon, then set this to a non-nil value.") (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-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, the cursor will automagically advance to the next line after an item has been selected in the browser.") (defvar makefile-pickup-everything-picks-up-filenames-p nil "If non-nil, makefile-pickup-everything also 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, 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\'.") (defvar 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.") ;; ;; 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 ( ).") (defconst makefile-dependency-regex "^[^ \t#:]+\\([ \t]+[^ \t#:]+\\)*[ \t]*:\\([ \t]*$\\|\\([^=\n].*$\\)\\)" "Regex used to find dependency lines in a makefile.") (defconst makefile-macroassign-regex "^[^ \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.") ;;; ------------------------------------------------------------ ;;; 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 "A function symbol [one that can be used as the first argument to funcall] that provides a function that must conform to the following interface: * 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 "$" 'makefile-insert-macro-ref) (define-key makefile-mode-map "\C-c:" 'makefile-insert-target-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 "\M-p" 'makefile-previous-dependency) (define-key makefile-mode-map "\M-n" '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 "The syntax-table used in makefile mode.") (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 ?\n "> " makefile-mode-syntax-table)) ;;; ------------------------------------------------------------ ;;; Internal variables. ;;; You don't need to configure below this line. ;;; ------------------------------------------------------------ (defvar makefile-target-table nil "Table of all targets that have been inserted in this Makefile buffer using makefile-insert-target or picked up using makefile-pickup-targets.") (defvar makefile-macro-table nil "Table of all macros that have been iserted in this Makefile buffer using makefile-insert-macro or picked up using makefile-pickup-macros.") (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 '()) (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")) "A list of GNU make 3.62 function names associated with the prompts for each function. This is used in the function makefile-insert-gmake-function .") ;;; ------------------------------------------------------------ ;;; The mode function itself. ;;; ------------------------------------------------------------ ;;;###autoload (defun makefile-mode () "Major mode for editing Makefiles. Calling this function invokes the function(s) \"makefile-mode-hook\" before doing anything else. \\{makefile-mode-map} In the browser, use the following keys: \\{makefile-browser-map} makefile-mode can be configured by modifying the following variables: makefile-mode-name: The \"pretty name\" of makefile-mode, as it appears in the modeline. 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) (if (not (memq 'makefile-cleanup-continuations write-file-hooks)) (setq write-file-hooks (append write-file-hooks (list 'makefile-cleanup-continuations)))) (make-variable-buffer-local 'makefile-target-table) (make-variable-buffer-local 'makefile-macro-table) (make-variable-buffer-local 'makefile-has-prereqs) (make-variable-buffer-local 'makefile-need-target-pickup) (make-variable-buffer-local 'makefile-need-macro-pickup) (setq comment-start "#") (setq comment-end "") (setq comment-start-skip "#[ \t]*") ;; become the current major mode (setq major-mode 'makefile-mode) (setq mode-name makefile-mode-name) ;; activate keymap (use-local-map makefile-mode-map) (set-syntax-table makefile-mode-syntax-table) (run-hooks 'makefile-mode-hook)) (defun makefile-next-dependency () "Move (point) to the beginning of the next dependency line below (point)." (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 next dependency line above (point)." (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))) ;;; Stuff below here depends on the pickup state (defun makefile-electric-dot () "At (bol), offer completion on makefile-special-targets-list. Anywhere else just insert a dot." (interactive) (if (bolp) (makefile-insert-special-target) (insert "."))) (defun makefile-insert-special-target () "Complete on makefile-special-targets-list, insert result at (point)." (interactive) (makefile-pickup-targets) (let ((special-target (completing-read "Special target: " makefile-special-targets-list nil nil nil))) (if (zerop (length special-target)) () (insert (format ".%s:" special-target)) (makefile-forward-after-target-colon)))) (defun makefile-electric-equal () "At (bol) do makefile-insert-macro. Anywhere else just self-insert." (interactive) (makefile-pickup-macros) (if (bolp) (call-interactively 'makefile-insert-macro) (insert "="))) (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 (format "%s%s" 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)))) (if (not (zerop (length macro-name))) (if (assoc macro-name makefile-runtime-macros-list) (insert (format "$%s " macro-name)) (insert (makefile-format-macro-ref 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 (format "%s%s" 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 (pogn (makefile-pickup-targets) (completing-read "Refer to target: " makefile-target-table nil nil nil)))) (if (not (zerop (length target-name))) (progn (insert (format "%s " target-name))))) (defun makefile-electric-colon () "At (bol) defines a new target, anywhere else just self-insert ." (interactive) (if (bolp) (call-interactively 'makefile-insert-target) (insert ":"))) ;;; ------------------------------------------------------------ ;;; Extracting targets and macros from an existing makefile ;;; ------------------------------------------------------------ (defun makefile-pickup-targets () "Scan a buffer that contains a makefile for target definitions (dependencies) and add them to the list of known targets." (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 () "Scan a buffer that contains a makefile for macro definitions and add them to the list of known macros." (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 () "Calls makefile-pickup-targets and makefile-pickup-macros. See their documentation for what they do." (interactive) (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, check each filename against makefile-ignored-files-in-pickup-regex and add 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))) ;;; ------------------------------------------------------------ ;;; The browser window ;;; ------------------------------------------------------------ (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) (setq buffer-read-only nil) (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) (setq buffer-read-only t)) ;;; ;;; 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 makefile-browser-buffer and return to the buffer from that it has been entered." (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) (setq buffer-read-only nil) (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))))) (setq buffer-read-only t) (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 browser\'s client 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 browser-selected targets and/or macros in the browser\'s client 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) "This function fills the up-to-date-overview-buffer. It 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)))))) ;;; ------------------------------------------------------------ ;;; GNU make function support ;;; ------------------------------------------------------------ (defun makefile-insert-gmake-function () "This function is intended to help you using the numerous macro-like \'function calls\' of GNU make. It will ask you for the name of the function you wish to use (with completion), then, after you selected the function, it will prompt you for all required parameters. This function \'knows\' about the required parameters of every GNU make function and will use meaningfull prompts for the various args, making it much easier to take advantage of this powerful GNU make feature." (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-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 the terminating colon of a target has been inserted. This accts 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 according to the value of the configuration variable makefile-use-curly-braces-for-macros-p ." (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))) ;; makefile.el ends here emacs-19.22/lisp/makeinfo.el100444 13437 1 21376 5422200166 14345 0ustar jimbdaemon;;;; 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 texinfo-start-of-header search-end t) (beginning-of-line) ;; Mark beginning of header. (setq filename-or-header-beginning (point))) (prog1 (search-forward texinfo-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.22/lisp/makesum.el100444 74777 1 7165 5353350070 14220 0ustar ericdaemon;;; 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.22/lisp/map-ynp.el100444 12120 1 17431 5470341117 14003 0ustar rmsdaemon;;; map-ynp.el --- General-purpose boolean question-asker. ;;; Copyright (C) 1991, 1992, 1993 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 is eval'd to get the answer; it may be nil to ignore the object, t to act on the object without asking the user, or a form to do a more complex prompt. 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* ((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))) (actions 0) 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)))))) (unwind-protect (progn (if (stringp prompter) (setq prompter (` (lambda (object) (format (, prompter) object))))) (while (funcall next) (setq prompt (funcall prompter elt)) (if (stringp prompt) (progn (setq quit-flag nil) ;; Prompt the user about this object. (let ((cursor-in-echo-area (not no-cursor-in-echo-area))) (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)))) ((eq def 'quit) (setq quit-flag t) (setq next (` (lambda () (setq next '(, next)) '(, elt))))) ((eq def 'automatic) ;; Act on this and all following objects. (if (eval (funcall prompter elt)) (progn (funcall actor elt) (setq actions (1+ actions)))) (while (funcall next) (if (eval (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))))) (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))))))) (if (eval prompt) (progn (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. (message "") ;; Return the number of actions that were taken. actions)) ;;; map-ynp.el ends here emacs-19.22/lisp/medit.el100444 12120 1 7636 5257331725 13521 0ustar rmsdaemon;;; medit.el --- front-end to the MEDIT package for editing MDL ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; 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 depends on two MDL packages: MEDIT and FORKS which ;; >> can be obtained from the public (network) library at mit-ajax. ;;; Code: (require 'mim-mode) (defconst medit-zap-file (concat "/tmp/" (user-login-name) ".medit.mud") "File name for data sent to MDL by Medit.") (defconst medit-buffer "*MEDIT*" "Name of buffer in which Medit accumulates data to send to MDL.") (defconst medit-save-files t "If non-nil, Medit offers to save files on return to MDL.") (defun medit-save-define () "Mark the previous or surrounding toplevel object to be sent back to MDL." (interactive) (save-excursion (beginning-of-DEFINE) (let ((start (point))) (forward-mim-object 1) (append-to-buffer medit-buffer start (point)) (goto-char start) (message (buffer-substring start (progn (end-of-line) (point))))))) (defun medit-save-region (start end) "Mark the current region to be sent to back to MDL." (interactive "r") (append-to-buffer medit-buffer start end) (message "Current region saved for MDL.")) (defun medit-save-buffer () "Mark the current buffer to be sent back to MDL." (interactive) (append-to-buffer medit-buffer (point-min) (point-max)) (message "Current buffer saved for MDL.")) (defun medit-zap-define-to-mdl () "Return to MDL with surrounding or previous toplevel MDL object." (interactive) (medit-save-define) (medit-goto-mdl)) (defun medit-zap-region-mdl (start end) "Return to MDL with current region." (interactive) (medit-save-region start end) (medit-goto-mdl)) (defun medit-zap-buffer () "Return to MDL with current buffer." (interactive) (medit-save-buffer) (medit-goto-mdl)) (defun medit-goto-mdl () "Return from Emacs to superior MDL, sending saved code. Optionally, offers to save changed files." (interactive) (let ((buffer (get-buffer medit-buffer))) (if buffer (save-excursion (set-buffer buffer) (if (buffer-modified-p buffer) (write-region (point-min) (point-max) medit-zap-file)) (set-buffer-modified-p nil) (erase-buffer))) (if medit-save-files (save-some-buffers)) ;; Note could handle parallel fork by giving argument "%xmdl". Then ;; mdl would have to invoke with "%emacs". (suspend-emacs))) (defconst medit-mode-map nil) (if (not medit-mode-map) (progn (setq medit-mode-map (copy-keymap mim-mode-map)) (define-key medit-mode-map "\e\z" 'medit-save-define) (define-key medit-mode-map "\e\^z" 'medit-save-buffer) (define-key medit-mode-map "\^xz" 'medit-goto-mdl) (define-key medit-mode-map "\^xs" 'medit-zap-buffer))) (defconst medit-mode-hook (and (boundp 'mim-mode-hook) mim-mode-hook) "") (setq mim-mode-hook '(lambda () (medit-mode))) (defun medit-mode (&optional state) "Major mode for editing text and returning it to a superior MDL. Like Mim mode, plus these special commands: \\{medit-mode-map}" (interactive) (use-local-map medit-mode-map) (run-hooks 'medit-mode-hook) (setq major-mode 'medit-mode) (setq mode-name "Medit")) (mim-mode) ;;; medit.el ends here emacs-19.22/lisp/meese.el100444 74777 1 1530 5351652672 13655 0ustar ericdaemon;;; 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 () (if (and (equal (file-name-nondirectory buffer-file-name) "sex.6") (not (y-or-n-p "Are you over 18? "))) (progn (clear-visited-file-modtime) (setq buffer-file-name (concat (file-name-directory buffer-file-name) "celibacy.1")) (let (buffer-read-only) ; otherwise (erase-buffer) may bomb. (erase-buffer) (insert-file-contents buffer-file-name t)) (rename-buffer (file-name-nondirectory buffer-file-name))))) (or (memq 'protect-innocence-hook find-file-hooks) (setq find-file-hooks (cons 'protect-innocence-hook find-file-hooks))) ;;; meese.el ends here emacs-19.22/lisp/menu-bar.el100444 12120 1 27736 5474461541 14151 0ustar rmsdaemon;;; menu-bar.el --- define a default menu bar. ;; Author: RMS ;; Keywords: internal ;; 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. ;;; 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")) ;; Put Help item last. (setq menu-bar-final-items '(help)) (define-key global-map [menu-bar help] (cons "Help" menu-bar-help-menu)) (defvar menu-bar-edit-menu (make-sparse-keymap "Edit")) (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) (defvar menu-bar-file-menu (make-sparse-keymap "File")) (define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) (define-key menu-bar-file-menu [exit-emacs] '("Exit Emacs" . save-buffers-kill-emacs)) (define-key menu-bar-file-menu [kill-buffer] '("Kill Buffer" . kill-this-buffer)) (define-key menu-bar-file-menu [delete-frame] '("Delete Frame" . delete-frame)) (define-key menu-bar-file-menu [bookmark] '("Bookmarks..." . menu-bar-bookmark-map)) (define-key menu-bar-file-menu [print-buffer] '("Print Buffer" . print-buffer)) (define-key menu-bar-file-menu [revert-buffer] '("Revert Buffer" . revert-buffer)) (define-key menu-bar-file-menu [write-file] '("Save Buffer As..." . write-file)) (define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer)) (define-key menu-bar-file-menu [dired] '("Open Directory..." . dired)) (define-key menu-bar-file-menu [open-file] '("Open File..." . find-file)) (define-key menu-bar-file-menu [new-frame] '("New Frame" . new-frame)) (define-key menu-bar-edit-menu [spell] '("Spell..." . ispell-menu-map)) (define-key menu-bar-edit-menu [fill] '("Fill" . fill-region)) (define-key menu-bar-edit-menu [clear] '("Clear" . delete-region)) (define-key menu-bar-edit-menu [re-search-back] '("Regexp Search Backwards" . re-search-backward)) (define-key menu-bar-edit-menu [search-back] '("Search Backwards" . search-backward)) (define-key menu-bar-edit-menu [re-search-fwd] '("Regexp Search" . re-search-forward)) (define-key menu-bar-edit-menu [search-fwd] '("Search" . search-forward)) (define-key menu-bar-edit-menu [choose-next-paste] '("Choose Next Paste" . mouse-menu-choose-yank)) (define-key menu-bar-edit-menu [paste] '("Paste" . yank)) (define-key menu-bar-edit-menu [copy] '("Copy" . kill-ring-save)) (define-key menu-bar-edit-menu [cut] '("Cut" . kill-region)) (define-key menu-bar-edit-menu [undo] '("Undo" . undo)) (put 'fill-region 'menu-enable 'mark-active) (put 'kill-region 'menu-enable 'mark-active) (put 'kill-ring-save 'menu-enable 'mark-active) (put 'yank 'menu-enable '(x-selection-exists-p)) (put 'delete-region 'menu-enable 'mark-active) (put 'undo 'menu-enable '(if (eq last-command 'undo) pending-undo-list (consp buffer-undo-list))) (autoload 'ispell-menu-map "ispell" nil t 'keymap) (define-key menu-bar-help-menu [emacs-tutorial] '("Emacs Tutorial" . help-with-tutorial)) (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] '("Info" . info)) (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))) (> count 1))) (put 'save-buffer 'menu-enable '(buffer-modified-p)) (put 'revert-buffer 'menu-enable '(or revert-buffer-function revert-buffer-insert-file-contents-function (and (buffer-file-name) (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 '(let ((frames (frame-list)) (count 0)) (while frames (if (cdr (assq 'visibility (frame-parameters (car frames)))) (setq count (1+ count))) (setq frames (cdr frames))) (> count 1))) (put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p)) (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 100 "*Maximum length of an item in the menu for \ \\[mouse-menu-choose-yank].") (defun mouse-menu-choose-yank (event) "Pop up a menu of the kill-ring for selection with the mouse. The kill-ring-yank-pointer is moved to the selected element. A subsequent \\[yank] yanks the choice just selected." (interactive "e") (let* ((count 0) (menu (mapcar (lambda (string) (if (> (length string) yank-menu-length) (setq string (substring string 0 yank-menu-length))) (prog1 (cons string count) (setq count (1+ count)))) kill-ring)) (arg (x-popup-menu event (list "Yank Menu" (cons "Choose Next Yank" menu))))) ;; A mouse click outside the menu returns nil. ;; Avoid a confusing error from passing nil to rotate-yank-pointer. ;; XXX should this perhaps do something other than simply return? -rm (if arg (progn (rotate-yank-pointer arg) (if (interactive-p) (message "The next yank will insert the selected text.") (current-kill 0)))))) (put 'mouse-menu-choose-yank 'menu-enable 'kill-ring) (define-key global-map [menu-bar buffer] '("Buffers" . mouse-menu-bar-buffers)) (defvar complex-buffers-menu-p nil "*Non-nil says, offer a choice of actions after you pick a buffer. This applies to the Buffers menu from the menu bar.") (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) (defun mouse-menu-bar-buffers (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") (let ((buffers (buffer-list)) 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))) (setq menu (cons "Select Buffer" (let ((tail buffers) (maxbuf 0) (maxlen 0) head) (while tail (or (eq ?\ (aref (buffer-name (car tail)) 0)) (setq maxbuf (max maxbuf (length (buffer-name (car tail)))))) (setq tail (cdr tail))) (setq tail buffers) (while tail (let ((elt (car tail))) (if (not (string-match "^ " (buffer-name elt))) (setq head (cons (cons (format (format "%%%ds %%s%%s %%s" maxbuf) (buffer-name elt) (if (buffer-modified-p elt) "*" " ") (save-excursion (set-buffer elt) (if buffer-read-only "%" " ")) (or (buffer-file-name elt) (save-excursion (set-buffer elt) list-buffers-directory) "")) elt) head))) (and head (> (length (car (car head))) maxlen) (setq maxlen (length (car (car head)))))) (setq tail (cdr tail))) (nconc (nreverse head) (list (cons (concat (make-string (max (- (/ maxlen 2) 8) 0) ?\ ) "List All Buffers") 'list-buffers)))))) (setq menu (list menu)) (if (cdr (frame-list)) (setq menu (cons (cons "Select Frame" (mapcar (lambda (frame) (cons (cdr (assq 'name (frame-parameters frame))) frame)) (frame-list))) menu))) (setq menu (cons "Buffer and Frame Menu" menu)) (let ((buf (x-popup-menu (if (listp event) event (cons '(0 0) (selected-frame))) menu)) (window (and (listp event) (posn-window (event-start event))))) (cond ((framep buf) (make-frame-visible buf) (raise-frame buf) (select-frame buf)) ((eq buf 'list-buffers) (list-buffers)) (buf (if complex-buffers-menu-p (let ((action (x-popup-menu (if (listp event) event (cons '(0 0) (selected-frame))) '("Buffer Action" ("" ("Save Buffer" . save-buffer) ("Kill Buffer" . kill-buffer) ("Select Buffer" . switch-to-buffer)))))) (if (eq action 'save-buffer) (save-excursion (set-buffer buf) (save-buffer)) (funcall action buf))) (and (windowp window) (select-window window)) (switch-to-buffer buf))))))) ;; this version is too slow ;;;(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) "")))))) (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") (if flag (setq flag (prefix-numeric-value flag))) ;; Obtain the current setting by looking at default-frame-alist. (let ((menu-bar-mode (not (zerop (let ((assq (assq 'menu-bar-lines default-frame-alist))) (if assq (cdr assq) 0)))))) ;; Tweedle it according to the argument. (setq menu-bar-mode (if (null flag) (not menu-bar-mode) (or (not (numberp flag)) (>= flag 0)))) ;; Apply it to default-frame-alist. (let ((parameter (assq 'menu-bar-lines default-frame-alist))) (if (consp parameter) (setcdr parameter (if menu-bar-mode 1 0)) (setq default-frame-alist (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) default-frame-alist)))) ;; Apply it to existing frames. (let ((frames (frame-list))) (while frames (modify-frame-parameters (car frames) (list (cons 'menu-bar-lines (if menu-bar-mode 1 0)))) (setq frames (cdr frames)))))) ;; Make frames created from now on have a menu bar. (if window-system (menu-bar-mode t)) (provide 'menu-bar) ;;; menu-bar.el ends here emacs-19.22/lisp/metamail.el100444 12120 1 10722 5433337030 14205 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.22/lisp/mh-e.el100444 12120 1 306043 5431312637 13272 0ustar rmsdaemon;;; mh-e.el --- GNU Emacs interface to the MH mail system ;;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93 Free Software Foundation (defconst mh-e-time-stamp "Time-stamp: <93/05/30 18:37:43 gildea>") ;; Maintainer: Stephen Gildea ;; Version: 3.8.2 ;; Keywords: mail ;; 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. ;; Everyone is granted permission to copy, modify and redistribute ;; GNU Emacs, but only under the conditions described in the ;; document "GNU Emacs copying permission notice". An exact copy ;; of the document is supposed to have been given to you along with ;; GNU Emacs so that you can know how you may redistribute it all. ;; It should be in a file named COPYING. Among other things, the ;; copyright notice and this notice must be preserved on all copies. ;;; Commentary: ;;; mh-e works with Emacs 18 or 19, and MH 5 or 6. ;;; 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. ;;; Your .emacs might benefit from these bindings: ;;; (global-set-key "\C-xm" 'mh-smail) ;;; (global-set-key "\C-x4m" 'mh-smail-other-window) ;;; (global-set-key "\C-cr" 'mh-rmail) ;;; 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. ;;; NB. MH must have been compiled with the MHE compiler flag or several ;;; features necessary mh-e will be missing from MH commands, specifically ;;; the -build switch to repl and forw. ;;; 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@bbn.com (defconst mh-e-RCS-id "$Header: /home/fsf/rms/e19/lisp/RCS/mh-e.el,v 1.16 1993/08/09 00:08:55 rms Exp $") ;;; Code: ;;; Constants: ;;; Set for local environment: ;;;* These are now in paths.el. ;;;(defvar mh-progs "/usr/new/mh/" "Directory containing MH commands.") ;;;(defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library.") (defvar mh-redist-full-contents nil "Non-nil if the `dist' command needs whole letter for redistribution. This is the case when `send' is compiled with the BERK option.") ;;; Hooks: (defvar mh-folder-mode-hook nil "Invoked in `mh-folder mode' on a new folder.") (defvar mh-letter-mode-hook nil "Invoked in `mh-letter-mode' on a new letter.") (defvar mh-compose-letter-function nil "Invoked in `mh-compose-and-send-mail' on a draft letter. 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-inc-folder-hook nil "Invoked after incorporating mail into a folder with \\[mh-inc-folder].") (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 quitting mh-e by \\[mh-quit]. See also mh-before-quit-hook") (defvar mh-ins-string nil "Temporarily set by `mh-insert-prefix' prior to running `mh-yank-hooks'.") (defvar mh-yank-hooks '(lambda () (save-excursion (goto-char (point)) (or (bolp) (forward-line 1)) (while (< (point) (mark t)) (insert mh-ins-string) (forward-line 1)))) "Hook to run citation function. Expects POINT and MARK to be set to the region to cite.") ;;; Personal preferences: (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 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.") (defvar mh-lpr-command-format "lpr -p -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 message text is piped to this command.") (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-summary-height 4 "*Number of lines in summary window (including the mode line).") (defvar mh-recenter-summary-p nil "*Recenter summary window when the show window is toggled off if non-nil.") (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 in an outgoing letter.") (defvar mh-do-not-confirm nil "*Non-nil means do not prompt for confirmation before some commands. Only affects certain innocuous commands.") (defvar mh-bury-show-buffer t "*Non-nil means that the displayed show buffer for a folder is buried.") (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-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\", or \"cc\".") (defvar mh-recursive-folders nil "*If non-nil, then commands which operate on folders do so recursively.") (defvar mh-unshar-default-directory "" "*Default for directory name prompted for by mh-unshar-msg.") (defvar mh-signature-file-name "~/.signature" "*Name of file containing the user's signature. Inserted into message by \\\\[mh-insert-signature].") ;;; Parameterize mh-e to work with different scan formats. The defaults work ;;; with the standard MH scan listings. (defvar mh-cmd-note 4 "Offset to insert notation.") (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-good-msg-regexp "^....[^D^]" "Regexp specifying 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-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 mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%" "Regexp matching flagged scan lines. Matches lines marked as deleted, refiled, in a sequence, or the cur message.") (defvar mh-cur-scan-msg-regexp "^....\\+" "Regexp matching scan line for the cur message.") (defvar mh-show-buffer-mode-line-buffer-id "{%%b} %s/%d" "Format string to produce `mode-line-buffer-id' for show buffers. First argument is folder name. Second is message number.") (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.") ;;; Real constants: (defvar mh-invisible-headers "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^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-rejected-letter-start (concat "^ ----- Unsent message follows -----$" ;from mail system "\\|^------- Unsent Draft$" ;from MH itself "\\|^ --- The unsent message follows ---$") ;from AIX mail system "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-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:") (?b . "Bcc:") (?f . "Fcc:")) "A-list of (character . field name) strings for mh-to-field.") ;;; Global variables: (defvar mh-user-path "" "User's mail folder.") (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-letter-mode-map (copy-keymap text-mode-map) "Keymap for composing mail.") (defvar mh-pick-mode-map (make-sparse-keymap) "Keymap for searching folder.") (defvar mh-searching-folder nil "Folder this pick is searching.") (defvar mh-letter-mode-syntax-table nil "Syntax table used while in mh-e letter mode.") (if mh-letter-mode-syntax-table () (setq mh-letter-mode-syntax-table (make-syntax-table text-mode-syntax-table)) (set-syntax-table mh-letter-mode-syntax-table) (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) (defvar mh-folder-list nil "List of folder names for completion.") (defvar mh-draft-folder nil "Name of folder containing draft messages. NIL means do not use draft folder.") (defvar mh-unseen-seq nil "Name of the unseen sequence.") (defvar mh-previous-window-config nil "Window configuration before mh-e command.") (defvar mh-previous-seq nil "Name of the sequence to which a message was last added.") ;;; Macros and generic functions: (defmacro mh-push (v l) (list 'setq l (list 'cons v l))) (defmacro mh-when (pred &rest body) (list 'cond (cons pred body))) (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 (` (let ((folder-updating-mod-flag (buffer-modified-p))) (prog1 (let ((buffer-read-only nil) (buffer-file-name nil)) ; don't let the buffer get locked (,@ body)) (, (if save-modification-flag-p '(mh-set-folder-modified-p folder-updating-mod-flag) '(mh-set-folder-modified-p nil))))))) (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 (no arg) or scan a MH mail box (arg given). This front end uses the MH mail system, which uses different conventions from the usual mail system." (interactive "P") (mh-find-path) (if arg (call-interactively 'mh-visit-folder) (mh-inc-folder))) ;;;###autoload (defun mh-smail () "Compose and send mail with the MH mail system." (interactive) (mh-find-path) (call-interactively 'mh-send)) (defun mh-smail-other-window () "Compose and send mail in other window with the MH mail system." (interactive) (mh-find-path) (call-interactively 'mh-send-other-window)) ;;; User executable mh-e commands: (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 letters 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") (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num)) (message "Bursting digest...done"))) (defun mh-copy-msg (prefix-provided msg-or-seq dest) "Copy 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 current-prefix-arg (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 dest) (if prefix-provided (mh-notate-seq msg-or-seq ?C mh-cmd-note) (mh-notate msg-or-seq ?C mh-cmd-note))) (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)))) (if (numberp msg-or-seq) (mh-delete-a-msg msg-or-seq) (mh-map-to-seq-msgs 'mh-delete-a-msg 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-delete-msg-from-seq (prefix-provided msg-or-seq &optional from-seq) "Delete MESSAGE (default: displayed message) from SEQUENCE. If optional prefix argument provided, then delete all messages from a sequence." (interactive (let ((argp current-prefix-arg)) (list argp (if argp (mh-read-seq-default "Delete" t) (mh-get-msg-num t)) (if (not argp) (mh-read-seq-default "Delete from" t))))) (if prefix-provided (mh-remove-seq msg-or-seq) (mh-remove-msg-from-seq msg-or-seq from-seq))) (defun mh-edit-again (msg) "Clean-up a draft or a message previously sent and make it resendable." (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) "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Delivery-Date:" nil) (goto-char (point-min)) (set-buffer-modified-p nil) (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil config))) (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 write-file-hooks (defun mh-extract-rejected-mail (msg) "Extract a letter returned by the mail system and make it resendable. Default is the displayed message." (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) (forward-char 1) (delete-region (point-min) (point)) (mh-clean-msg-header (point-min) "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Return-Path:" nil)) (t (message "Does not appear to be a rejected letter."))) (goto-char (point-min)) (set-buffer-modified-p nil) (mh-compose-and-send-mail draft "" from-folder msg (mh-get-field "To") (mh-get-field "From") (mh-get-field "cc") nil nil config))) (defun mh-first-msg () "Move to the first message." (interactive) (goto-char (point-min))) (defun mh-forward (prefix-provided msg-or-seq to cc) "Forward MESSAGE(s) (default: displayed message). If optional prefix argument provided, then prompt for the message sequence." (interactive (list current-prefix-arg (if current-prefix-arg (mh-read-seq-default "Forward" t) (mh-get-msg-num t)) (read-string "To: ") (read-string "Cc: "))) (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) (set-buffer-modified-p nil))) (t (mh-read-draft "" draft-name nil))))) (goto-char (point-min)) (re-search-forward "^------- Forwarded Message") (forward-line -1) (narrow-to-region (point) (point-max)) (let* ((subject (save-excursion (mh-get-field "From:"))) (trim (string-match "<" subject)) (forw-subject (save-excursion (mh-get-field "Subject:")))) (if trim (setq subject (substring subject 0 (1- trim)))) (widen) (save-excursion (mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject))) (delete-other-windows) (if prefix-provided (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t) (mh-add-msgs-to-seq msg-or-seq 'forwarded t)) (mh-compose-and-send-mail draft "" folder msg-or-seq to subject cc mh-note-forw "Forwarded:" config)))) (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) "Position the cursor at message NUMBER. Non-nil second argument means do not signal an error if message does not exist. Non-nil third argument means not to show the message. Return non-nil if cursor is at message." (interactive "NGoto message: ") (let ((cur-msg (mh-get-msg-num nil)) (starting-place (point)) (msg-pattern (mh-msg-search-pat number))) (cond ((cond ((and cur-msg (= cur-msg number)) t) ((and cur-msg (< cur-msg number) (re-search-forward msg-pattern nil t)) t) ((and cur-msg (> cur-msg number) (re-search-backward msg-pattern nil t)) t) (t ; Do thorough search of buffer (goto-char (point-max)) (re-search-backward msg-pattern nil t))) (beginning-of-line) (if (not dont-show) (mh-maybe-show number)) t) (t (goto-char starting-place) (if (not no-error-if-no-message) (error "No message %d" number)) nil)))) (defun mh-inc-folder (&optional maildrop-name) "Inc(orporate) new mail into +inbox. Optional prefix argument specifies an alternate maildrop from the default. If this is given, incorporate mail into the current folder, rather than +inbox. Run `mh-inc-folder-hook' after incorporating new mail." (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 "+inbox")) (mh-make-folder "+inbox") (setq mh-previous-window-config config)) ((not (eq (current-buffer) (get-buffer "+inbox"))) (switch-to-buffer "+inbox") (setq mh-previous-window-config config))))) (mh-get-new-mail maildrop-name) (run-hooks 'mh-inc-folder-hook)) (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)) (mh-set-folder-modified-p t) ; lock folder to kill it (mh-exec-cmd-daemon "rmf" folder) (mh-remove-folder-from-folder-list folder) (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-last-msg () "Move to the last message." (interactive) (goto-char (point-max)) (while (and (not (bobp)) (looking-at "^$")) (forward-line -1))) (defun mh-list-folders () "List mail folders." (interactive) (with-output-to-temp-buffer " *mh-temp*" (save-excursion (switch-to-buffer " *mh-temp*") (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-msg-is-in-seq (msg) "Display the sequences that contain MESSAGE (default: displayed message)." (interactive (list (mh-get-msg-num t))) (message "Message %d is in sequences: %s" msg (mapconcat 'concat (mh-list-to-string (mh-seq-containing-msg msg)) " "))) (defun mh-narrow-to-seq (seq) "Restrict display of this folder to just messages in a sequence. Reads which sequence. Use \\[mh-widen] to undo this command." (interactive (list (mh-read-seq "Narrow to" t))) (let ((eob (point-max))) (with-mh-folder-updating (t) (cond ((mh-seq-to-msgs seq) (mh-copy-seq-to-point seq eob) (narrow-to-region eob (point-max)) (mh-make-folder-mode-line (symbol-name seq)) (mh-recenter nil) (setq mh-narrowed-to-seq seq)) (t (error "No messages in sequence `%s'" (symbol-name seq))))))) (defun mh-next-undeleted-msg (&optional arg) "Move to next undeleted message in window." (interactive "P") (forward-line (prefix-numeric-value arg)) (setq mh-next-direction 'forward) (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-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-pipe-msg (prefix-provided command) "Pipe the current message through the given shell COMMAND. If optional prefix argument is provided, send the entire message. Otherwise just send the message's body." (interactive (list current-prefix-arg (read-string "Shell command on message: "))) (save-excursion (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer (goto-char (point-min)) (if (not prefix-provided) (search-forward "\n\n")) (shell-command-on-region (point) (point-max) command nil))) (defun mh-refile-msg (prefix-provided msg-or-seq dest) "Refile MESSAGE(s) (default: displayed message) in FOLDER. If optional prefix argument provided, then prompt for message sequence." (interactive (list current-prefix-arg (if current-prefix-arg (mh-read-seq-default "Refile" t) (mh-get-msg-num t)) (intern (mh-prompt-for-folder "Destination" (if (eq 'refile (car mh-last-destination)) (symbol-name (cdr mh-last-destination)) "") t)))) (setq mh-last-destination (cons 'refile dest)) (if prefix-provided (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest) (mh-refile-a-msg msg-or-seq dest)) (mh-next-msg)) (defun mh-refile-or-write-again (msg) "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 msg (cdr mh-last-destination)) (message "Destination folder: %s" (cdr mh-last-destination))) (t (mh-write-msg-to-file msg (cdr mh-last-destination)) (message "Destination: %s" (cdr mh-last-destination)))) (mh-next-msg)) (defun mh-reply (prefix-provided msg) "Reply to a MESSAGE (default: displayed message). If optional prefix argument provided, then include the message in the reply using filter mhl.reply in your MH directory." (interactive (list current-prefix-arg (mh-get-msg-num t))) (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...") (cond ((or (equal reply-to "from") (equal reply-to "")) (apply 'mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" mh-current-folder msg "-nocc" "all" (if prefix-provided (list "-filter" "mhl.reply")))) ((equal reply-to "to") (apply 'mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" mh-current-folder msg "-cc" "to" (if prefix-provided (list "-filter" "mhl.reply")))) ((or (equal reply-to "cc") (equal reply-to "all")) (apply 'mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" mh-current-folder msg "-cc" "all" "-nocc" "me" (if prefix-provided (list "-filter" "mhl.reply"))))) (let ((draft (mh-read-draft "reply" (expand-file-name "reply" mh-user-path) t))) (delete-other-windows) (set-buffer-modified-p nil) (let ((to (mh-get-field "To:")) (subject (mh-get-field "Subject:")) (cc (mh-get-field "Cc:"))) (goto-char (point-min)) (mh-goto-header-end 1) (if (not prefix-provided) (mh-display-msg msg folder)) (mh-add-msgs-to-seq msg 'answered t) (message "Composing a reply...done") (mh-compose-and-send-mail draft "" folder msg to subject cc mh-note-repl "Replied:" config)))))) (defun mh-quit () "Quit mh-e. 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) (if mh-previous-window-config (set-window-configuration mh-previous-window-config)) (run-hooks 'mh-quit-hook)) (defun mh-page-digest () "Advance displayed message to next digested message." (interactive) (save-excursion (mh-show-message-in-other-window) ;; 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: (mh-when (not (and (search-forward "\n\n" nil t) (search-forward "From:" nil t))) (other-window -1) (error "No more messages"))) ;; 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) (other-window -1))) (defun mh-page-digest-backwards () "Back up displayed message to previous digested message." (interactive) (save-excursion (mh-show-message-in-other-window) ;; Go to top of screen (in case user moved point). (move-to-window-line 0) (let ((case-fold-search nil)) (beginning-of-line) (mh-when (not (and (search-backward "\n\n" nil t) (search-backward "From:" nil t))) (other-window -1) (error "No more messages"))) ;; 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) (other-window -1))) (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") (save-excursion (mh-show-message-in-other-window) (unwind-protect (scroll-down arg) (other-window -1)))) (defun mh-previous-undeleted-msg (&optional arg) "Move to 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-print-msg (prefix-provided msg-or-seq) "Print MESSAGE(s) (default: displayed message) on a line printer. If optional prefix argument provided, then prompt for the message sequence." (interactive (list current-prefix-arg (if current-prefix-arg (reverse (mh-seq-to-msgs (mh-read-seq-default "Print" t))) (mh-get-msg-num t)))) (if prefix-provided (message "Printing sequence...") (message "Printing message...")) (let ((print-command (if prefix-provided (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 prefix-provided (format "Sequence from %s" mh-current-folder) (format "%s/%d" mh-current-folder 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 prefix-provided (format "Sequence from %s" mh-current-folder) (format "%s/%d" mh-current-folder msg-or-seq))))))) (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 prefix-provided (mh-notate-seq msg-or-seq ?P mh-cmd-note) (mh-notate msg-or-seq ?P mh-cmd-note)) (mh-add-msgs-to-seq msg-or-seq 'printed t) (if prefix-provided (message "Printing sequence...done") (message "Printing message...done")))) (defun mh-put-msg-in-seq (prefix-provided from to) "Add MESSAGE(s) (default: displayed message) to SEQUENCE. If optional prefix argument provided, then prompt for the message sequence." (interactive (list current-prefix-arg (if current-prefix-arg (mh-seq-to-msgs (mh-read-seq-default "Add messages from" t)) (mh-get-msg-num t)) (mh-read-seq-default "Add to" nil))) (setq mh-previous-seq to) (mh-add-msgs-to-seq from to)) (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-redistribute (to cc 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 (read-string "Redist-To: ") (read-string "Redist-Cc: ") (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 "send" 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 "send" 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-write-msg-to-file (msg file) "Append MESSAGE to the end of a FILE." (interactive (list (mh-get-msg-num t) (let ((default-dir (if (eq 'write (car mh-last-destination)) (file-name-directory (cdr mh-last-destination)) default-directory))) (read-file-name "Save message in file: " default-dir (expand-file-name "mail.out" default-dir))))) (let ((file-name (mh-msg-filename msg)) (output-file (mh-expand-file-name file))) (setq mh-last-destination (cons 'write file)) (save-excursion (set-buffer (get-buffer-create " *mh-temp*")) (erase-buffer) (insert-file-contents file-name) (append-to-file (point-min) (point-max) output-file)))) (defun mh-search-folder (folder) "Search FOLDER for messages matching a pattern." (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-send (to cc subject) "Compose and send a letter. 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 "sTo: \nsCc: \nsSubject: ") (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.." (interactive "sTo: \nsCc: \nsSubject: ") (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" (if (file-exists-p (expand-file-name "components" mh-user-path)) (expand-file-name "components" mh-user-path) (if (file-exists-p (expand-file-name "components" mh-lib)) (expand-file-name "components" mh-lib) (error "Can't find components file"))) nil))) (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) (set-buffer-modified-p nil) (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-show (&optional msg) "Show MESSAGE (default: displayed message). Forces a two-window display with the folder window on top (size mh-summary-height) and the show buffer below it." (interactive) (if (not msg) (setq msg (mh-get-msg-num t))) (setq mh-showing t) (mh-set-mode-name "mh-e show") (if (not (eql (next-window (minibuffer-window)) (selected-window))) (delete-other-windows)) ; force ourself to the top window (let ((folder mh-current-folder)) (mh-show-message-in-other-window) (mh-display-msg msg folder)) (other-window -1) (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)) (mh-push msg mh-seen-list))) (defun mh-sort-folder () "Sort the messages in the current folder by date." (interactive) (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) (message "Sorting folder...done") (mh-scan-folder mh-current-folder "all")) (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 (prefix-provided msg-or-seq) "Undo the 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 current-prefix-arg (if current-prefix-arg (mh-read-seq-default "Undo" t) (mh-get-msg-num t)))) (cond (prefix-provided (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq))) (t (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"))))) ;; 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))) (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-remove-msg-from-seq msg 'deleted t)) (t (mh-mapc (function (lambda (dest) (mh-remove-msg-from-seq msg dest t))) mh-refile-list))) (mh-notate msg ? mh-cmd-note)) (defun mh-undo-folder (&rest ignore) "Undo all commands 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-unshar-msg (dir) "Unpack the shar file contained in the current message into directory DIR." (interactive (list (read-file-name "Unshar message in directory: " mh-unshar-default-directory mh-unshar-default-directory nil))) (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer (mh-unshar-buffer dir)) (defun mh-unshar-buffer (dir) ;; Unpack the shar file contained in the current buffer into directory DIR. (goto-char (point-min)) (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t) (and (re-search-forward "^[^a-z0-9\"]*cut here\b" nil t) (forward-line 1)) (re-search-forward "^#" nil t) (re-search-forward "^: " nil t)) (let ((default-directory (expand-file-name dir)) (start (progn (beginning-of-line) (point))) (log-buffer (get-buffer-create "*Unshar Output*"))) (save-excursion (set-buffer log-buffer) (setq default-directory (expand-file-name dir)) (erase-buffer) (if (file-directory-p default-directory) (insert "cd " dir "\n") (insert "mkdir " dir "\n") (call-process "mkdir" nil log-buffer t default-directory))) (set-window-start (display-buffer log-buffer) 0) ;so can watch progress (call-process-region start (point-max) "sh" nil log-buffer t)) (error "Cannot find start of shar."))) (defun mh-visit-folder (folder &optional range) "Visit FOLDER and display RANGE of messages. Assumes mh-e has already been initialized." (interactive (list (mh-prompt-for-folder "Visit" "+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-widen () "Remove restrictions from the current folder, thereby showing all messages." (interactive) (if mh-narrowed-to-seq (with-mh-folder-updating (t) (delete-region (point-min) (point-max)) (widen) (mh-make-folder-mode-line))) (setq mh-narrowed-to-seq nil)) ;;; 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) (mh-push msg mh-delete-list) (mh-add-msgs-to-seq msg 'deleted t) (mh-notate msg ?D mh-cmd-note)))) (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)) (mh-push 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-cmd-note))))) (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) (folder mh-current-folder)) (if (not (file-exists-p msg-filename)) (error "Message %d does not exist" msg-num)) (switch-to-buffer show-buffer) (if mh-bury-show-buffer (bury-buffer (current-buffer))) (mh-when (not (equal msg-filename buffer-file-name)) ;; Buffer does not yet contain message. (clear-visited-file-modtime) (unlock-buffer) (setq buffer-file-name nil) ; no locking during setup (erase-buffer) (if formfile (if (stringp formfile) (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" "-form" formfile msg-filename) (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" 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 (let ((case-fold-search t)) (re-search-forward "^To:\\|^From:\\|^Subject:\\|^Date:" nil t) (beginning-of-line) (mh-recenter 0)))) (set-buffer-modified-p nil) (setq buffer-file-name msg-filename) (set-mark nil) (setq mode-line-buffer-identification (list (format mh-show-buffer-mode-line-buffer-id folder msg-num)))))) (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) (setq buffer-file-name nil)))) (defun mh-show-message-in-other-window () (switch-to-buffer-other-window mh-show-buffer) (if mh-bury-show-buffer (bury-buffer (current-buffer)))) (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 t) (backward-char 1)) (narrow-to-region start (point)) (goto-char (point-min)) (if visible-headers (while (< (point) (point-max)) (beginning-of-line) (cond ((looking-at visible-headers) (forward-line 1) (while (looking-at "^[ \t]+") (forward-line 1))) (t (mh-delete-line 1) (while (looking-at "^[ \t]+") (beginning-of-line) (mh-delete-line 1))))) (while (re-search-forward invisible-headers nil t) (beginning-of-line) (mh-delete-line 1) (while (looking-at "^[ \t]+") (beginning-of-line) (mh-delete-line 1)))) (unlock-buffer)))) (defun mh-delete-line (lines) ;; Delete version of kill-line. (delete-region (point) (save-excursion (forward-line lines) (point)))) (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)) (pop-to-buffer (find-file-noselect (mh-new-draft-name)) t) (rename-buffer (format "draft-%s" (buffer-name))) (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) (mh-when (and (file-exists-p draft-name) (not (equal draft-name initial-contents))) (insert-file-contents draft-name) (delete-file draft-name))))) (mh-when (and initial-contents (or (zerop (buffer-size)) (not (y-or-n-p (format "A draft exists. Use for %s? " use))))) (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 (set-buffer (get-buffer-create " *mh-temp*")) (erase-buffer) (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new") (buffer-substring (point) (1- (mark t))))) (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)) (mh-set-mode-name "mh-e scan") (setq mh-showing nil) (if mh-recenter-summary-p (mh-recenter nil))) (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-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 redisplay of all buffers' mode lines to be considered. (save-excursion (set-buffer (other-buffer))) (set-buffer-modified-p (buffer-modified-p))) ;;; The folder data abstraction. (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-showing nil "If non-nil, show the message in a separate window.") (defvar mh-next-seq-num nil "Index of free sequence id.") (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-seq-list nil "Alist of (seq . msgs) numbers.") (defvar mh-seen-list nil "List of displayed messages.") (defvar mh-next-direction 'forward "Direction to move to next message.") (defvar mh-narrowed-to-seq nil "Sequence display is narrowed to.") (defvar mh-first-msg-num nil "Number of first msg in buffer.") (defvar mh-last-msg-num nil "Number of last msg in buffer.") (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-set-mode-name "mh-e scan")) ;;; Don't use this mode when creating buffers if default-major-mode is nil. (put 'mh-folder-mode 'mode-class 'special) (defun mh-folder-mode () "Major mode for \"editing\" an MH folder scan listing. Messages can be marked for refiling and deletion. However, both actions are deferred until you request execution with \\[mh-execute-commands]. \\{mh-folder-mode-map} A prefix argument (\\[universal-argument]) to delete, refile, list, or undo applies the action to a message sequence. Variables controlling mh-e operation are (defaults in parentheses): 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-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. mh-ins-buf-prefix (\"> \") String to insert before each non-blank line of a message as it is inserted in a draft letter. 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-e folder") (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-next-seq-num 0 ; Index of free sequence id '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-previous-window-config nil) ; Previous window configuration (setq truncate-lines t) (auto-save-mode -1) (setq buffer-offer-save t) (make-local-variable 'write-file-hooks) (setq write-file-hooks '(mh-execute-commands)) (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'mh-undo-folder) (run-hooks 'mh-folder-mode-hook)) (defun make-local-vars (&rest pairs) ;; Take VARIABLE-VALUE pairs and makes 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) (mh-when (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) ;; Replace buffer with scan of its contents over range RANGE. (let ((folder mh-current-folder)) (message "Scanning %s..." folder) (with-mh-folder-updating (nil) (erase-buffer) (mh-exec-cmd-output "scan" nil "-noclear" "-noheader" "-width" (window-width) folder range) (goto-char (point-min)) (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 (mh-delete-seq-locally 'cur) ; To pick up new one (setq mh-seq-list (mh-read-folder-sequences folder nil)) (mh-notate-user-sequences) (mh-make-folder-mode-line (if (equal range "all") nil mh-partial-folder-mode-line-annotation))) (message "Scanning %s...done" folder))) (defun mh-get-new-mail (maildrop-name) ;; Read new mail from a maildrop into the current buffer. ;; Return T if there was new mail, NIL otherwise. Return in the current ;; buffer. (let ((point-before-inc (point)) (folder mh-current-folder) (return-value t)) (with-mh-folder-updating (t) (message (if maildrop-name (format "inc %s -file %s..." folder maildrop-name) (format "inc %s..." folder))) (mh-unmark-all-headers nil) (setq mh-next-direction 'forward) (goto-char (point-max)) (let ((start-of-inc (point))) (if maildrop-name (mh-exec-cmd-output "inc" nil folder "-file" (expand-file-name maildrop-name) "-width" (window-width) "-truncate") (mh-exec-cmd-output "inc" 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 ((looking-at "inc: no mail") (keep-lines mh-valid-scan-line) ; Flush random scan lines (goto-char point-before-inc) (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-delete-seq-locally 'cur) ; To pick up new one (setq mh-seq-list (mh-read-folder-sequences folder t)) (mh-notate-user-sequences) (keep-lines mh-valid-scan-line) (mh-make-folder-mode-line) (mh-goto-cur-msg) (setq return-value t)))) return-value))) (defun mh-make-folder-mode-line (&optional annotation) ;; Set the fields of the mode line for a folder buffer. ;; The optional ANNOTATION string is displayed after the folder's name. (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)) (let ((lines (count-lines (point-min) (point-max)))) (setq mode-line-buffer-identification (list (format "{%%b%s} %d msg%s" (if annotation (format "/%s" annotation) "") lines (if (zerop lines) "s" (if (> lines 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 (- (point-max) mh-cmd-note)) 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 ?D) (eql char ?^) (eql char ?%))) (eql char ?+)) (progn (delete-char 1) (insert " "))) (forward-line))))) (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 nil)) (mh-notate nil ?+ mh-cmd-note) (mh-recenter 0) (mh-maybe-show cur-msg)) (t (mh-last-msg) (message "No current message"))))) (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 " *mh-temp*" "folder" mh-current-folder "-pack")) (mh-regenerate-headers range)) (defun mh-process-or-undo-commands (folder) ;; If FOLDER has outstanding commands, then either process or discard them. (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-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 (if (and mh-seen-list (mh-seq-to-msgs mh-unseen-seq)) (mh-undefine-sequence mh-unseen-seq mh-seen-list)) ;; Then refile messages (mh-mapc (function (lambda (dest) (let ((msgs (mh-seq-to-msgs dest))) (mh-when msgs (apply 'mh-exec-cmd "refile" "-src" folder (symbol-name dest) msgs) (mh-delete-scan-msgs msgs))))) mh-refile-list) ;; Now delete messages (mh-when mh-delete-list (apply 'mh-exec-cmd "rmm" folder mh-delete-list) (mh-delete-scan-msgs mh-delete-list)) ;; 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")))) (mh-invalidate-show-buffer) (setq mh-delete-list nil mh-refile-list nil mh-seq-list (mh-read-folder-sequences mh-current-folder nil) mh-seen-list nil) (mh-unmark-all-headers t) (mh-notate-user-sequences) (message "Processing deletes and refiles for %s...done" folder))) (defun mh-delete-scan-msgs (msgs) ;; Delete the scan listing lines for each of the msgs in the LIST. ;; Optimized for speed (i.e., no regular expressions). (setq msgs (sort msgs (function <))) ;okay to clobber msgs (save-excursion (mh-first-msg) (while (and msgs (< (point) (point-max))) (cond ((equal (mh-get-msg-num nil) (car msgs)) (delete-region (point) (save-excursion (forward-line) (point))) (setq msgs (cdr msgs))) (t (forward-line)))))) (defun mh-set-folder-modified-p (flag) "Mark current folder as modified or unmodified according to FLAG." (set-buffer-modified-p flag)) (defun mh-outstanding-commands-p () ;; Returns non-nil if there are outstanding deletes or refiles. (or mh-delete-list mh-refile-list)) ;;; Mode for composing and sending a draft message. (defvar mh-sent-from-folder nil "Folder of msg associated with this letter.") (defvar mh-sent-from-msg nil "Number of msg associated with this letter.") (defvar mh-send-args nil "Extra arguments 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.") (defun mh-letter-mode () "Mode for composing letters in mh-e. When you have finished composing, type \\[mh-send-letter] to send the letter. 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-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. \\{mh-letter-mode-map}" (interactive) (kill-all-local-variables) (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) (use-local-map mh-letter-mode-map) (setq major-mode 'mh-letter-mode) (mh-set-mode-name "mh-e letter") (set-syntax-table mh-letter-mode-syntax-table) (run-hooks 'text-mode-hook 'mh-letter-mode-hook) (mh-when (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)) (mh-when (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))) (defun mh-auto-fill-for-letter () ;; Auto-fill in letters treats the header specially by inserting a tab ;; before continuation line. (do-auto-fill) (if (mh-in-header-p) (save-excursion (beginning-of-line nil) (insert-char ?\t 1)))) (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. Create the field if it does not exist. Set the mark to point before moving." (interactive) (expand-abbrev) (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices))) (case-fold-search t)) (cond ((mh-position-on-field target t) (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 (goto-char (point-min)) (re-search-forward "^To:") (forward-line 1) (while (looking-at "^[ \t]") (forward-line 1)) (insert (format "%s \n" target)) (backward-char 1))))) (defun mh-to-fcc () "Insert an Fcc: field in the current message. Prompt for the field name with a completion list of the current folders." (interactive) (let ((last-input-char ?\C-f) (folder (mh-prompt-for-folder "Fcc" "" t))) (expand-abbrev) (save-excursion (mh-to-field) (insert (substring folder 1 nil))))) (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) (set-buffer-modified-p (buffer-modified-p))) ; force mode line update (defun mh-check-whom () "Verify recipients of the current letter." (interactive) (let ((file-name (buffer-file-name))) (set-buffer-modified-p t) ; Force writing of contents (save-buffer) (message "Checking recipients...") (switch-to-buffer-other-window "*Mail Recipients*") (bury-buffer (current-buffer)) (erase-buffer) (mh-exec-cmd-output "whom" t file-name) (other-window -1) (message "Checking recipients...done"))) ;;; Routines to make a search pattern and search for a message. (defvar mh-searching-folder nil "Folder this pick is searching.") (defun mh-make-pick-template () ;; Initialize the current buffer with a template for a pick pattern. (erase-buffer) (kill-all-local-variables) (make-local-variable 'mh-searching-folder) (insert "From: \n" "To: \n" "Cc: \n" "Date: \n" "Subject: \n" "---------\n") (mh-letter-mode) (use-local-map mh-pick-mode-map) (goto-char (point-min)) (end-of-line)) (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. Put messages found in a sequence named `search'." (interactive) (let ((pattern-buffer (buffer-name)) (searching-buffer mh-searching-folder) range msgs (pattern nil) (new-buffer nil)) (save-excursion (cond ((get-buffer searching-buffer) (set-buffer searching-buffer) (setq range (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 (setq pattern (mh-next-pick-field pattern-buffer)) (setq msgs (mh-seq-from-command searching-buffer 'search (nconc (cons "pick" pattern) (list searching-buffer range "-sequence" "search" "-list")))) (setq range "search")) (message "Searching...done") (if new-buffer (mh-scan-folder searching-buffer msgs) (switch-to-buffer searching-buffer)) (delete-other-windows) (mh-notate-seq 'search ?% (1+ mh-cmd-note)))) (defun mh-next-pick-field (buffer) ;; Return the next piece of a pick argument that can be extracted from the ;; BUFFER. Returns nil if no pieces remain. (set-buffer buffer) (let ((case-fold-search t)) (cond ((eobp) nil) ((re-search-forward "^\\([a-z].*\\):[ \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)))) ;;; 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) (symbol-value 'mh-compose-letter-function)) ;; run-hooks will not pass arguments. (let ((value (symbol-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) (set-buffer-modified-p t) ; Make sure buffer is written (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) (if mh-send-args (mh-exec-cmd-output "send" t "-watch" "-nopush" "-nodraftfolder" mh-send-args file-name) (mh-exec-cmd-output "send" t "-watch" "-nopush" "-nodraftfolder" file-name)) (goto-char (point-max)) ; show the interesting part (recenter -1) (set-buffer draft-buffer)) ; for annotation below (mh-send-args (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose" mh-send-args file-name)) (t (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose" 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-field "To:") (mh-get-field "Cc:")))) (mh-when (or (not arg) (y-or-n-p "Kill draft buffer? ")) (kill-buffer draft-buffer) (if config (set-window-configuration config))) (message "Sending...done"))) (defun mh-insert-letter (prefix-provided folder msg) "Insert a message from any folder into the current letter. Removes the message's headers using mh-invisible-headers. Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \"). If optional prefix argument provided, do not indent and do not delete headers. Leaves the mark before the letter and point after it." (interactive (list current-prefix-arg (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) ""))))) (save-restriction (narrow-to-region (point) (point)) (let ((start (point-min))) (if (equal msg "") (setq msg (int-to-string mh-sent-from-msg))) (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" (expand-file-name msg (mh-expand-file-name folder))) (mh-when (not prefix-provided) (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 (mark-active (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) (narrow-to-region to-point to-point) (push-mark) (insert mh-ins-str) (mh-insert-prefix-string mh-ins-buf-prefix) (insert "\n") (widen))) (error "There is no current message"))) (defun mh-insert-prefix-string (mh-ins-string) ;; Run MH-YANK-HOOK to insert a prefix string before each line in the buffer. ;; Generality for supercite users. (save-excursion (set-mark (point-max)) (goto-char (point-min)) (run-hooks 'mh-yank-hooks))) (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"))) (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))))) ;;; Commands to manipulate sequences. Sequences are stored in an alist ;;; of the form: ;;; ((seq-name msgs ...) (seq-name msgs ...) ...) (defun mh-make-seq (name msgs) (cons name msgs)) (defmacro mh-seq-name (pair) (list 'car pair)) (defmacro mh-seq-msgs (pair) (list 'cdr pair)) (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-seq-containing-msg (msg) ;; Return a list of the sequences containing MESSAGE. (let ((l mh-seq-list) (seqs ())) (while l (if (memq msg (mh-seq-msgs (car l))) (mh-push (mh-seq-name (car l)) seqs)) (setq l (cdr l))) seqs)) (defun mh-msg-to-seq (msg) ;; Given a MESSAGE number, return the first sequence in which it occurs. (car (mh-seq-containing-msg msg))) (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-previous-seq))) (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 "%") (mh-msg-to-seq (mh-get-msg-num t))) ((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-read-folder-sequences (folder define-sequences) ;; Read and return the predefined sequences for a FOLDER. If ;; DEFINE-SEQUENCES is non-nil, then define mh-e's sequences before ;; reading MH's sequences. (let ((seqs ())) (mh-when define-sequences (mh-define-sequences mh-seq-list) (mh-mapc (function (lambda (seq) ; Save the internal sequences (if (mh-folder-name-p (mh-seq-name seq)) (mh-push seq seqs)))) mh-seq-list)) (save-excursion (mh-exec-cmd-quiet " *mh-temp*" "mark" folder "-list") (goto-char (point-min)) ;; look for name in line of form "cur: 4" or "myseq (private): 23" (while (re-search-forward "^[^: ]+" nil t) (mh-push (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-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-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 (apply 'mh-exec-cmd-quiet " *mh-temp*" seq-command) (goto-char (point-min)) (while (setq msg (car (mh-read-msg-list))) (mh-push msg msgs) (forward-line 1))) (set-buffer folder) (setq msgs (nreverse msgs)) ; Put in ascending order (mh-push (mh-make-seq seq msgs) mh-seq-list) msgs))) (defun mh-read-msg-list () ;; Return a list of message numbers from the current point to the end of ;; the line. (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) (mh-push num msgs) (setq num (1+ num))))) ((not (zerop num)) (mh-push num msgs)))) msgs)) (defun mh-remove-seq (seq) ;; Delete the SEQUENCE. (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ? (1+ mh-cmd-note) seq) (mh-undefine-sequence seq (list "all")) (mh-delete-seq-locally seq)) (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-remove-msg-from-seq (msg seq &optional internal-flag) ;; Remove MESSAGE from the SEQUENCE. If optional FLAG is non-nil, do not ;; inform MH of the change. (let ((entry (mh-find-seq seq))) (mh-when entry (mh-notate-if-in-one-seq msg ? (1+ mh-cmd-note) (mh-seq-name entry)) (if (not internal-flag) (mh-undefine-sequence seq (list msg))) (setcdr entry (delq msg (mh-seq-msgs entry)))))) (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) (mh-push (mh-make-seq seq msgs) mh-seq-list) (if msgs (setcdr entry (append msgs (cdr entry))))) (mh-when (not internal-flag) (mh-add-to-sequence seq msgs) (mh-notate-seq seq ?% (1+ mh-cmd-note))))) (defun mh-rename-seq (seq new-name) "Rename a SEQUENCE to have a new NAME." (interactive "SOld sequence name: \nSNew name: ") (let ((old-seq (mh-find-seq seq))) (if old-seq (rplaca old-seq new-name) (error "Sequence %s does not exists" seq)) (mh-undefine-sequence seq (mh-seq-msgs old-seq)) (mh-define-sequence new-name (mh-seq-msgs old-seq)))) (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 ?% (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) (mh-folder-name-p name))) (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) ?+) (eql (aref name 0) ?+))) (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-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))) (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) (mh-notate msg notation offset)))) (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-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-define-sequences (seq-list) ;; Define the sequences in SEQ-LIST. (mh-map-over-seqs 'mh-define-sequence seq-list)) (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 "-sequence" (symbol-name seq) "-add" msgs)))) (defun mh-define-sequence (seq msgs) ;; Define the SEQUENCE to contain the list of MSGS. Do not mark ;; pseudo-sequences or empty sequences. (if (and msgs (not (mh-folder-name-p seq))) (save-excursion (apply 'mh-exec-cmd "mark" mh-current-folder "-sequence" (symbol-name seq) "-add" "-zero" (mh-list-to-string msgs))))) (defun mh-undefine-sequence (seq msgs) ;; Remove from the SEQUENCE the list of MSGS. (apply 'mh-exec-cmd "mark" mh-current-folder "-sequence" (symbol-name seq) "-delete" 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) (let ((beginning-of-line (point))) (forward-line 1) (copy-region-as-kill beginning-of-line (point)) (goto-char location) (yank) (goto-char beginning-of-line))) ;;; Issue commands to MH. (defun mh-exec-cmd (command &rest args) ;; Execute MH command COMMAND with ARGS. ;; Any output is assumed to be an error and is shown to the user. (save-excursion (set-buffer " *mh-temp*") (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*") (sit-for 5))))) (defun mh-exec-cmd-quiet (buffer command &rest args) ;; In BUFFER, execute MH command COMMAND with ARGS. ;; ARGS is a list of strings. Return in BUFFER, if one exists. (mh-when (stringp buffer) (set-buffer buffer) (erase-buffer)) (apply 'call-process (expand-file-name command mh-progs) nil buffer nil args)) (defun mh-exec-cmd-output (command display &rest args) ;; Execute MH command COMMAND with DISPLAY flag and ARGS putting the output ;; into buffer after point. Set mark after inserted text. (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-cmd-daemon (command &rest args) ;; Execute MH command COMMAND with ARGS. Any output from command is ;; displayed in an asynchronous pop-up window. (save-excursion (set-buffer (get-buffer-create " *mh-temp*")) (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*")) (insert-before-markers output) (display-buffer " *mh-temp*")) (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. (push-mark (point) t) (apply 'call-process (expand-file-name command mh-lib) nil t nil (mh-list-to-string args)) (exchange-point-and-mark)) (defun mh-list-to-string (l) ;; Flattens the list L and makes every element of the new list into a string. (let ((new-list nil)) (while l (cond ((null (car l))) ((symbolp (car l)) (mh-push (symbol-name (car l)) new-list)) ((numberp (car l)) (mh-push (int-to-string (car l)) new-list)) ((equal (car l) "")) ((stringp (car l)) (mh-push (car l) new-list)) ((listp (car l)) (setq new-list (nconc (nreverse (mh-list-to-string (car l))) new-list))) (t (error "Bad element in mh-list-to-string: %s" (car l)))) (setq l (cdr l))) (nreverse new-list))) ;;; Commands to annotate a message. (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-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))))) ;;; User prompting commands. (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. (let* ((prompt (format "%s folder%s" prompt (if (equal "" default) "? " (format " [%s]? " default)))) name) (if (null mh-folder-list) (mh-set-folder-list)) (while (and (setq name (completing-read prompt mh-folder-list nil nil "+")) (equal name "") (equal default ""))) (cond ((or (equal name "") (equal name "+")) (setq name default)) ((not (mh-folder-name-p name)) (setq name (format "+%s" name)))) (let ((new-file-p (not (file-exists-p (mh-expand-file-name name))))) (cond ((and new-file-p (y-or-n-p (format "Folder %s does not exist. Create it? " name))) (message "Creating %s" name) (call-process "mkdir" nil nil nil (mh-expand-file-name name)) (message "Creating %s...done" name) (mh-push (list name) mh-folder-list)) (new-file-p (error "Folder %s is not created" name)) (t (mh-when (null (assoc name mh-folder-list)) (mh-push (list name) mh-folder-list))))) name)) (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." (setq mh-folder-list (mh-make-folder-list))) (defun mh-make-folder-list () "Return a list of the user's folders. Result is in a form suitable for completing read." (interactive) (message "Collecting folder names...") (save-window-excursion (mh-exec-cmd-quiet " *mh-temp*" "folders" "-fast" (if mh-recursive-folders "-recurse" "-norecurse")) (goto-char (point-min)) (let ((list nil) start) (while (not (eobp)) (setq start (point)) (forward-line 1) (mh-push (list (format "+%s" (buffer-substring start (1- (point))))) list)) (message "Collecting folder names...done") list))) (defun mh-remove-folder-from-folder-list (folder) ;; Remove FOLDER from the list of folders. (setq mh-folder-list (delq (assoc folder mh-folder-list) mh-folder-list))) (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))) (mh-push (car next) input) (setq start (cdr next)))) (nreverse input))) ;;; Misc. functions. (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-search-pat (n) ;; Return a search pattern for message N in the scan listing. (format mh-msg-search-regexp n)) (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-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-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-find-path () ;; Set mh-user-path, mh-draft-folder, and mh-unseen-seq from profile file. (save-excursion ;; Be sure profile is fully expanded before switching buffers (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) (if (not (file-exists-p profile)) (error "Cannot find MH profile %s" profile)) (set-buffer (get-buffer-create " *mh-temp*")) (erase-buffer) (insert-file-contents profile) (setq mh-draft-folder (mh-get-field "Draft-Folder:")) (cond ((equal mh-draft-folder "") (setq mh-draft-folder nil)) ((not (mh-folder-name-p mh-draft-folder)) (setq mh-draft-folder (format "+%s" mh-draft-folder)))) (setq mh-user-path (mh-get-field "Path:")) (if (equal 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 "~")))) (if (and mh-draft-folder (not (file-exists-p (mh-expand-file-name mh-draft-folder)))) (error "Draft folder %s does not exist. Create it and try again." mh-draft-folder)) (setq mh-unseen-seq (mh-get-field "Unseen-Sequence:")) (if (equal mh-unseen-seq "") (setq mh-unseen-seq 'unseen) (setq mh-unseen-seq (intern mh-unseen-seq)))))) (defun mh-get-field (field) ;; Find and return the value of field FIELD in the current buffer. ;; Returns the empty string if the field is not in the message. (let ((case-fold-search t)) (goto-char (point-min)) (cond ((not (re-search-forward (format "^%s" field) nil t)) "") ((looking-at "[\t ]*$") "") (t (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) (let ((start (match-beginning 1))) (forward-line 1) (while (looking-at "[ \t]") (forward-line 1)) (buffer-substring start (1- (point)))))))) (defun mh-insert-fields (&rest name-values) ;; Insert the NAME-VALUE pairs in the current buffer. ;; 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)))) (mh-when (not (equal value "")) (goto-char (point-min)) (cond ((not (re-search-forward (format "^%s" field-name) nil t)) (mh-goto-header-end 0) (insert field-name " " value "\n")) (t (end-of-line) (insert " " value)))) (setq name-values (cdr (cdr name-values))))))) (defun mh-position-on-field (field set-mark) ;; Set point to the end of the line beginning with FIELD. ;; Set the mark to the old value of point, if SET-MARK is non-nil. ;; Returns non-nil iff the field was found. (let ((case-fold-search t)) (if set-mark (push-mark)) (goto-char (point-min)) (mh-goto-header-end 0) (if (re-search-backward (format "^%s" field) nil t) (progn (end-of-line) t) nil))) (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))) ;;; 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-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 "\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 "\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-unshar-msg) (define-key mh-folder-mode-map "\eo" 'mh-write-msg-to-file) (define-key mh-folder-mode-map "\ep" 'mh-pack-folder) (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 ">" 'mh-write-msg-to-file) (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 "r" 'mh-redistribute) (define-key mh-folder-mode-map "f" 'mh-forward) (define-key mh-folder-mode-map "s" 'mh-send) (define-key mh-folder-mode-map "m" 'mh-send) (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 "<" 'mh-first-msg) (define-key mh-folder-mode-map "g" 'mh-goto-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 "." 'mh-show) (define-key mh-folder-mode-map "u" 'mh-undo) (define-key mh-folder-mode-map "!" 'mh-refile-or-write-again) (define-key mh-folder-mode-map "^" 'mh-refile-msg) (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) ;;; 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-f" 'mh-to-fcc) (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-ff" 'mh-to-fcc) (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-q" 'mh-fully-kill-draft) (define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom) (define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter) (define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg) (define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature) (define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter) ;;; 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-f" '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-ff" '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) (define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom) ;;; For Gnu Emacs. ;;; Local Variables: *** ;;; eval: (put 'mh-when 'lisp-indent-hook 1) *** ;;; eval: (put 'with-mh-folder-updating 'lisp-indent-hook 1) *** ;;; End: *** (provide 'mh-e) ;;; mh-e.el ends here emacs-19.22/lisp/mhspool.el100444 13437 1 35320 5405344325 14236 0ustar jimbdaemon;;; mhspool.el --- MH folder access using NNTP for GNU Emacs ;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; 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: ;; This package enables you to read mail or articles in MH folders, or ;; articles saved by GNUS. In any case, the file names of mail or ;; articles must consist of only numeric letters. ;; Before using this package, you have to create a server specific ;; startup file according to the directory which you want to read. For ;; example, if you want to read mail under the directory named ;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is ;; no way to specify hierarchical directory now.) In this case, the ;; name of the NNTP server passed to GNUS must be `:Mail'. ;;; Code: (require 'nntp) (defvar mhspool-list-folders-method (function mhspool-list-folders-using-sh) "*Function to list files in folders. The function should accept a directory as its argument, and fill the current buffer with file and directory names. The output format must be the same as that of 'ls -R1'. Two functions mhspool-list-folders-using-ls and mhspool-list-folders-using-sh are provided now. I suppose the later is faster.") (defvar mhspool-list-directory-switches '("-R") "*Switches for mhspool-list-folders-using-ls to pass to `ls' for getting file lists. One entry should appear on one line. You may need to add `-1' option.") (defconst mhspool-version "MHSPOOL 1.8" "Version numbers of this version of MHSPOOL.") (defvar mhspool-spool-directory "~/Mail" "Private mail directory.") (defvar mhspool-current-directory nil "Current news group directory.") ;;; ;;; Replacement of Extended Command for retrieving many headers. ;;; (defun mhspool-retrieve-headers (sequence) "Return list of article headers specified by SEQUENCE of article id. The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. If there is no References: field, In-Reply-To: field is used instead. Reader macros for the vector are defined as `nntp-header-FIELD'. Writer macros for the vector are defined as `nntp-set-header-FIELD'. Newsgroup must be selected before calling this." (save-excursion (set-buffer nntp-server-buffer) ;;(erase-buffer) (let ((file nil) (number (length sequence)) (count 0) (headers nil) ;Result list. (article 0) (subject nil) (message-id nil) (from nil) (xref nil) (lines 0) (date nil) (references nil)) (while sequence ;;(nntp-send-strings-to-server "HEAD" (car sequence)) (setq article (car sequence)) (setq file (concat mhspool-current-directory (prin1-to-string article))) (if (and (file-exists-p file) (not (file-directory-p file))) (progn (erase-buffer) (insert-file-contents file) ;; Make message body invisible. (goto-char (point-min)) (search-forward "\n\n" nil 'move) (narrow-to-region (point-min) (point)) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) ;; Make it possible to search for `\nFIELD'. (goto-char (point-min)) (insert "\n") ;; Extract From: (goto-char (point-min)) (if (search-forward "\nFrom: " nil t) (setq from (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq from "(Unknown User)")) ;; Extract Subject: (goto-char (point-min)) (if (search-forward "\nSubject: " nil t) (setq subject (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq subject "(None)")) ;; Extract Message-ID: (goto-char (point-min)) (if (search-forward "\nMessage-ID: " nil t) (setq message-id (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq message-id nil)) ;; Extract Date: (goto-char (point-min)) (if (search-forward "\nDate: " nil t) (setq date (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq date nil)) ;; Extract Lines: (goto-char (point-min)) (if (search-forward "\nLines: " nil t) (setq lines (string-to-int (buffer-substring (point) (save-excursion (end-of-line) (point))))) ;; Count lines since there is no lines field in most cases. (setq lines (save-restriction (goto-char (point-max)) (widen) (count-lines (point) (point-max))))) ;; Extract Xref: (goto-char (point-min)) (if (search-forward "\nXref: " nil t) (setq xref (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq xref nil)) ;; Extract References: ;; If no References: field, use In-Reply-To: field instead. ;; Suggested by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA). (goto-char (point-min)) (if (or (search-forward "\nReferences: " nil t) (search-forward "\nIn-Reply-To: " nil t)) (setq references (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq references nil)) ;; Collect valid article only. (and article message-id (setq headers (cons (vector article subject from xref lines date message-id references) headers))) )) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% count 20)) (message "MHSPOOL: Receiving headers... %d%%" (/ (* count 100) number))) ) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (message "MHSPOOL: Receiving headers... done")) (nreverse headers) ))) ;;; ;;; Replacement of NNTP Raw Interface. ;;; (defun mhspool-open-server (host &optional service) "Open news server on HOST. If HOST is nil, use value of environment variable `NNTPSERVER'. If optional argument SERVICE is non-nil, open by the service name." (let ((host (or host (getenv "NNTPSERVER"))) (status nil)) ;; Get directory name from HOST name. (if (string-match ":\\(.+\\)$" host) (progn (setq mhspool-spool-directory (file-name-as-directory (expand-file-name (substring host (match-beginning 1) (match-end 1)) (expand-file-name "~/" nil)))) (setq host (system-name))) (setq mhspool-spool-directory nil)) (setq nntp-status-string "") (cond ((and (stringp host) (stringp mhspool-spool-directory) (file-directory-p mhspool-spool-directory) (string-equal host (system-name))) (setq status (mhspool-open-server-internal host service))) ((string-equal host (system-name)) (setq nntp-status-string (format "No such directory: %s. Goodbye." mhspool-spool-directory))) ((null host) (setq nntp-status-string "NNTP server is not specified.")) (t (setq nntp-status-string (format "MHSPOOL: cannot talk to %s." host))) ) status )) (defun mhspool-close-server () "Close news server." (mhspool-close-server-internal)) (fset 'mhspool-request-quit (symbol-function 'mhspool-close-server)) (defun mhspool-server-opened () "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 mhspool-status-message () "Return server status response as string." nntp-status-string ) (defun mhspool-request-article (id) "Select article by message ID (or number)." (let ((file (concat mhspool-current-directory (prin1-to-string id)))) (if (and (stringp file) (file-exists-p file) (not (file-directory-p file))) (save-excursion (mhspool-find-file file))) )) (defun mhspool-request-body (id) "Select article body by message ID (or number)." (if (mhspool-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 mhspool-request-head (id) "Select article head by message ID (or number)." (if (mhspool-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 mhspool-request-stat (id) "Select article by message ID (or number)." (setq nntp-status-string "MHSPOOL: STAT is not implemented.") nil ) (defun mhspool-request-group (group) "Select news GROUP." (cond ((file-directory-p (mhspool-article-pathname group)) ;; Mail/NEWS.GROUP/N (setq mhspool-current-directory (mhspool-article-pathname group))) ((file-directory-p (mhspool-article-pathname (mhspool-replace-chars-in-string group ?. ?/))) ;; Mail/NEWS/GROUP/N (setq mhspool-current-directory (mhspool-article-pathname (mhspool-replace-chars-in-string group ?. ?/)))) )) (defun mhspool-request-list () "List active newsgoups." (save-excursion (let* ((newsgroup nil) (articles nil) (directory (file-name-as-directory (expand-file-name mhspool-spool-directory nil))) (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$")) (buffer (get-buffer-create " *MHSPOOL File List*"))) (set-buffer nntp-server-buffer) (erase-buffer) (set-buffer buffer) (erase-buffer) ;; (apply 'call-process ;; "ls" nil t nil ;; (append mhspool-list-directory-switches (list directory))) (funcall mhspool-list-folders-method directory) (goto-char (point-min)) (while (re-search-forward folder-regexp nil t) (setq newsgroup (mhspool-replace-chars-in-string (buffer-substring (match-beginning 1) (match-end 1)) ?/ ?.)) (setq articles nil) (forward-line 1) ;(beginning-of-line) ;; Thank nobu@flab.fujitsu.junet for his bug fixes. (while (and (not (eobp)) (not (looking-at "^$"))) (if (looking-at "^[0-9]+$") (setq articles (cons (string-to-int (buffer-substring (match-beginning 0) (match-end 0))) articles))) (forward-line 1)) (if articles (princ (format "%s %d %d n\n" newsgroup (apply (function max) articles) (apply (function min) articles)) nntp-server-buffer)) ) (kill-buffer buffer) (set-buffer nntp-server-buffer) (buffer-size) ))) (defun mhspool-request-list-newsgroups () "List newsgoups (defined in NNTP2)." (setq nntp-status-string "MHSPOOL: LIST NEWSGROUPS is not implemented.") nil ) (defun mhspool-request-list-distributions () "List distributions (defined in NNTP2)." (setq nntp-status-string "MHSPOOL: LIST DISTRIBUTIONS is not implemented.") nil ) (defun mhspool-request-last () "Set current article pointer to the previous article in the current news group." (setq nntp-status-string "MHSPOOL: LAST is not implemented.") nil ) (defun mhspool-request-next () "Advance current article pointer." (setq nntp-status-string "MHSPOOL: NEXT is not implemented.") nil ) (defun mhspool-request-post () "Post a new news in current buffer." (setq nntp-status-string "MHSPOOL: POST: what do you mean?") nil ) ;;; ;;; Replacement of Low-Level Interface to NNTP Server. ;;; (defun mhspool-open-server-internal (host &optional service) "Open connection to news server on HOST by SERVICE (default is nntp)." (save-excursion (if (not (string-equal host (system-name))) (error "MHSPOOL: cannot talk to %s." host)) ;; Initialize communication buffer. (setq nntp-server-buffer (get-buffer-create " *nntpd*")) (set-buffer nntp-server-buffer) (buffer-flush-undo (current-buffer)) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. (setq nntp-server-process nil) (setq nntp-server-name host) ;; It is possible to change kanji-fileio-code in this hook. (run-hooks 'nntp-server-hook) t )) (defun mhspool-close-server-internal () "Close connection to news server." (if nntp-server-buffer (kill-buffer nntp-server-buffer)) (setq nntp-server-buffer nil) (setq nntp-server-process nil)) (defun mhspool-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) (erase-buffer) (condition-case () (progn (insert-file-contents file) (goto-char (point-min)) ;; If there is no body, `^L' appears at end of file. Special ;; hack for MH folder. (and (search-forward "\n\n" nil t) (string-equal (buffer-substring (point) (point-max)) "\^L") (delete-char 1)) t ) (file-error nil) )) (defun mhspool-article-pathname (group) "Make pathname for GROUP." (concat (file-name-as-directory mhspool-spool-directory) group "/")) (defun mhspool-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 )) ;; Methods for listing files in folders. (defun mhspool-list-folders-using-ls (directory) "List files in folders under DIRECTORY using 'ls'." (apply 'call-process "ls" nil t nil (append mhspool-list-directory-switches (list directory)))) ;; Basic ideas by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA) (defun mhspool-list-folders-using-sh (directory) "List files in folders under DIRECTORY using '/bin/sh'." (let ((buffer (current-buffer)) (script (get-buffer-create " *MHSPOOL Shell Script Buffer*"))) (save-excursion (save-restriction (set-buffer script) (erase-buffer) ;; /bin/sh script which does 'ls -R'. (insert "PS2= ffind() { cd $1; echo $1: ls -1 echo for j in `echo *[a-zA-Z]*` do if [ -d $1/$j ]; then ffind $1/$j fi done } cd " directory "; ffind `pwd`; exit 0\n") (call-process-region (point-min) (point-max) "sh" nil buffer nil) )) (kill-buffer script) )) (provide 'mhspool) ;;; mhspool.el ends here emacs-19.22/lisp/mim-mode.el100444 13437 1 104332 5405344333 14300 0ustar jimbdaemon;;; mim-mode.el --- Mim (MDL in MDL) mode. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; 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. ;;; Code: (autoload 'fast-syntax-check-mim "mim-syntax" "Checks Mim syntax quickly. Answers correct or incorrect, cannot point out the error context." t) (autoload 'slow-syntax-check-mim "mim-syntax" "Check Mim syntax slowly. Points out the context of the error, if the syntax is incorrect." t) (defvar mim-mode-hysterical-bindings t "*Non-nil means bind list manipulation commands to Meta keys as well as Control-Meta keys for historical reasons. Otherwise, only the latter keys are bound.") (defvar mim-mode-map nil) (defvar mim-mode-syntax-table nil) (if mim-mode-syntax-table () (let ((i -1)) (setq mim-mode-syntax-table (make-syntax-table)) (while (< i ?\ ) (modify-syntax-entry (setq i (1+ i)) " " mim-mode-syntax-table)) (while (< i 127) (modify-syntax-entry (setq i (1+ i)) "_ " mim-mode-syntax-table)) (setq i (1- ?a)) (while (< i ?z) (modify-syntax-entry (setq i (1+ i)) "w " mim-mode-syntax-table)) (setq i (1- ?A)) (while (< i ?Z) (modify-syntax-entry (setq i (1+ i)) "w " mim-mode-syntax-table)) (setq i (1- ?0)) (while (< i ?9) (modify-syntax-entry (setq i (1+ i)) "w " mim-mode-syntax-table)) (modify-syntax-entry ?: " " mim-mode-syntax-table) ; make : symbol delimiter (modify-syntax-entry ?, "' " mim-mode-syntax-table) (modify-syntax-entry ?. "' " mim-mode-syntax-table) (modify-syntax-entry ?' "' " mim-mode-syntax-table) (modify-syntax-entry ?` "' " mim-mode-syntax-table) (modify-syntax-entry ?~ "' " mim-mode-syntax-table) (modify-syntax-entry ?\; "' " mim-mode-syntax-table) ; comments are prefixed objects (modify-syntax-entry ?# "' " mim-mode-syntax-table) (modify-syntax-entry ?% "' " mim-mode-syntax-table) (modify-syntax-entry ?! "' " mim-mode-syntax-table) (modify-syntax-entry ?\" "\" " mim-mode-syntax-table) (modify-syntax-entry ?\\ "\\ " mim-mode-syntax-table) (modify-syntax-entry ?\( "\() " mim-mode-syntax-table) (modify-syntax-entry ?\< "\(> " mim-mode-syntax-table) (modify-syntax-entry ?\{ "\(} " mim-mode-syntax-table) (modify-syntax-entry ?\[ "\(] " mim-mode-syntax-table) (modify-syntax-entry ?\) "\)( " mim-mode-syntax-table) (modify-syntax-entry ?\> "\)< " mim-mode-syntax-table) (modify-syntax-entry ?\} "\){ " mim-mode-syntax-table) (modify-syntax-entry ?\] "\)[ " mim-mode-syntax-table))) (defconst mim-whitespace "\000- ") (defvar mim-mode-hook nil "*User function run after mim mode initialization. Usage: \(setq mim-mode-hook '(lambda () ... your init forms ...)).") (define-abbrev-table 'mim-mode-abbrev-table nil) (defconst indent-mim-function 'indent-mim-function "Controls (via properties) indenting of special forms. \(put 'FOO 'indent-mim-function n\), integer n, means lines inside will be indented n spaces from start of form. \(put 'FOO 'indent-mim-function 'DEFINE\) is like above but means use value of mim-body-indent as offset from start of form. \(put 'FOO 'indent-mim-function \) where is a list or pointed list of integers, means indent each form in by the amount specified in . When is exhausted, indent remaining forms by `mim-body-indent' unless is a pointed list, in which case the last cdr is used. Confused? Here is an example: \(put 'FROBIT 'indent-mim-function '\(4 2 . 1\)\) ...> Finally, the property can be a function name (read the code).") (defvar indent-mim-comment t "*Non-nil means indent string comments.") (defvar mim-body-indent 2 "*Amount to indent in special forms which have DEFINE property on `indent-mim-function'.") (defvar indent-mim-arglist t "*nil means indent arglists like ordinary lists. t means strings stack under start of arglist and variables stack to right of them. Otherwise, strings stack under last string (or start of arglist if none) and variables stack to right of them. Examples (for values 'stack, t, nil): \(FOO \"OPT\" BAR \(FOO \"OPT\" BAR \(FOO \"OPT\" BAR BAZ MUMBLE BAZ MUMBLE BAZ MUMBLE \"AUX\" \"AUX\" \"AUX\" BLETCH ... BLETCH ... BLETCH ...") (put 'DEFINE 'indent-mim-function 'DEFINE) (put 'DEFMAC 'indent-mim-function 'DEFINE) (put 'BIND 'indent-mim-function 'DEFINE) (put 'PROG 'indent-mim-function 'DEFINE) (put 'REPEAT 'indent-mim-function 'DEFINE) (put 'CASE 'indent-mim-function 'DEFINE) (put 'FUNCTION 'indent-mim-function 'DEFINE) (put 'MAPF 'indent-mim-function 'DEFINE) (put 'MAPR 'indent-mim-function 'DEFINE) (put 'UNWIND 'indent-mim-function (cons (* 2 mim-body-indent) mim-body-indent)) (defvar mim-down-parens-only t "*nil means treat ADECLs and ATOM trailers like structures when moving down a level of structure.") (defvar mim-stop-for-slop t "*Non-nil means {next previous}-mim-object consider any non-whitespace character in column 0 to be a toplevel object, otherwise only open paren syntax characters will be considered.") (defalias 'mdl-mode 'mim-mode) (defun mim-mode () "Major mode for editing Mim (MDL in MDL) code. Commands: If value of `mim-mode-hysterical-bindings' is non-nil, then following commands are assigned to escape keys as well (e.g. ESC f = ESC C-f). The default action is bind the escape keys. \\{mim-mode-map} Other Commands: Use \\[describe-function] to obtain documentation. replace-in-mim-object find-mim-definition fast-syntax-check-mim slow-syntax-check-mim backward-down-mim-object forward-up-mim-object Variables: Use \\[describe-variable] to obtain documentation. mim-mode-hook indent-mim-comment indent-mim-arglist indent-mim-function mim-body-indent mim-down-parens-only mim-stop-for-slop mim-mode-hysterical-bindings Entry to this mode calls the value of mim-mode-hook if non-nil." (interactive) (kill-all-local-variables) (if (not mim-mode-map) (progn (setq mim-mode-map (make-sparse-keymap)) (define-key mim-mode-map "\e\^o" 'open-mim-line) (define-key mim-mode-map "\e\^q" 'indent-mim-object) (define-key mim-mode-map "\e\^p" 'previous-mim-object) (define-key mim-mode-map "\e\^n" 'next-mim-object) (define-key mim-mode-map "\e\^a" 'beginning-of-DEFINE) (define-key mim-mode-map "\e\^e" 'end-of-DEFINE) (define-key mim-mode-map "\e\^t" 'transpose-mim-objects) (define-key mim-mode-map "\e\^u" 'backward-up-mim-object) (define-key mim-mode-map "\e\^d" 'forward-down-mim-object) (define-key mim-mode-map "\e\^h" 'mark-mim-object) (define-key mim-mode-map "\e\^k" 'forward-kill-mim-object) (define-key mim-mode-map "\e\^f" 'forward-mim-object) (define-key mim-mode-map "\e\^b" 'backward-mim-object) (define-key mim-mode-map "\e^" 'raise-mim-line) (define-key mim-mode-map "\e\\" 'fixup-whitespace) (define-key mim-mode-map "\177" 'backward-delete-char-untabify) (define-key mim-mode-map "\e\177" 'backward-kill-mim-object) (define-key mim-mode-map "\^j" 'newline-and-mim-indent) (define-key mim-mode-map "\e;" 'begin-mim-comment) (define-key mim-mode-map "\t" 'indent-mim-line) (define-key mim-mode-map "\e\t" 'indent-mim-object) (if (not mim-mode-hysterical-bindings) nil ;; i really hate this but too many people are accustomed to these. (define-key mim-mode-map "\e!" 'line-to-top-of-window) (define-key mim-mode-map "\eo" 'open-mim-line) (define-key mim-mode-map "\ep" 'previous-mim-object) (define-key mim-mode-map "\en" 'next-mim-object) (define-key mim-mode-map "\ea" 'beginning-of-DEFINE) (define-key mim-mode-map "\ee" 'end-of-DEFINE) (define-key mim-mode-map "\et" 'transpose-mim-objects) (define-key mim-mode-map "\eu" 'backward-up-mim-object) (define-key mim-mode-map "\ed" 'forward-down-mim-object) (define-key mim-mode-map "\ek" 'forward-kill-mim-object) (define-key mim-mode-map "\ef" 'forward-mim-object) (define-key mim-mode-map "\eb" 'backward-mim-object)))) (use-local-map mim-mode-map) (set-syntax-table mim-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) ;; Most people use string comments. (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 "\"") (make-local-variable 'comment-column) (setq comment-column 40) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'indent-mim-comment) ;; tell generic indenter how to indent. (make-local-variable 'indent-line-function) (setq indent-line-function 'indent-mim-line) ;; look for that paren (make-local-variable 'blink-matching-paren-distance) (setq blink-matching-paren-distance nil) ;; so people who dont like tabs can turn them off locally in indenter. (make-local-variable 'indent-tabs-mode) (setq indent-tabs-mode t) (setq local-abbrev-table mim-mode-abbrev-table) (setq major-mode 'mim-mode) (setq mode-name "Mim") (run-hooks 'mim-mode-hook)) (defun line-to-top-of-window () "Move current line to top of window." (interactive) ; for lazy people (recenter 0)) (defun forward-mim-object (arg) "Move forward across Mim object. With ARG, move forward that many objects." (interactive "p") ;; this function is weird because it emulates the behavior of the old ;; (gosling) mim-mode - if the arg is 1 and we are `inside' an ADECL, ;; more than one character into the ATOM part and not sitting on the ;; colon, then we move to the DECL part (just past colon) instead of ;; the end of the object (the entire ADECL). otherwise, ADECL's are ;; atomic objects. likewise for ATOM trailers. (if (= (abs arg) 1) (if (inside-atom-p) ;; Move to end of ATOM or to trailer (!) or to ADECL (:). (forward-sexp arg) ;; Either scan an sexp or move over one bracket. (forward-mim-objects arg t)) ;; in the multi-object case, don't perform any magic. ;; treats ATOM trailers and ADECLs atomically, stops at unmatched ;; brackets with error. (forward-mim-objects arg))) (defun inside-atom-p () ;; Returns t iff inside an atom (takes account of trailers) (let ((c1 (preceding-char)) (c2 (following-char))) (and (or (= (char-syntax c1) ?w) (= (char-syntax c1) ?_) (= c1 ?!)) (or (= (char-syntax c2) ?w) (= (char-syntax c2) ?_) (= c2 ?!))))) (defun forward-mim-objects (arg &optional skip-bracket-p) ;; Move over arg objects ignoring ADECLs and trailers. If ;; skip-bracket-p is non-nil, then move over one bracket on error. (let ((direction (sign arg))) (condition-case conditions (while (/= arg 0) (forward-sexp direction) (if (not (inside-adecl-or-trailer-p direction)) (setq arg (- arg direction)))) (error (if (not skip-bracket-p) (signal 'error (cdr conditions)) (skip-mim-whitespace direction) (goto-char (+ (point) direction))))) ;; If we moved too far move back to first interesting character. (if (= (point) (buffer-end direction)) (skip-mim-whitespace (- direction))))) (defun backward-mim-object (&optional arg) "Move backward across Mim object. With ARG, move backward that many objects." (interactive "p") (forward-mim-object (if arg (- arg) -1))) (defun mark-mim-object (&optional arg) "Mark following Mim object. With ARG, mark that many following (preceding, ARG < 0) objects." (interactive "p") (push-mark (save-excursion (forward-mim-object (or arg 1)) (point)))) (defun forward-kill-mim-object (&optional arg) "Kill following Mim object. With ARG, kill that many objects." (interactive "*p") (kill-region (point) (progn (forward-mim-object (or arg 1)) (point)))) (defun backward-kill-mim-object (&optional arg) "Kill preceding Mim object. With ARG, kill that many objects." (interactive "*p") (forward-kill-mim-object (- (or arg 1)))) (defun raise-mim-line (&optional arg) "Raise following line, fixing up whitespace at join. With ARG raise that many following lines. A negative ARG will raise current line and previous lines." (interactive "*p") (let* ((increment (sign (or arg (setq arg 1)))) (direction (if (> arg 0) 1 0))) (save-excursion (while (/= arg 0) ;; move over eol and kill it (forward-line direction) (delete-region (point) (1- (point))) (fixup-whitespace) (setq arg (- arg increment)))))) (defun forward-down-mim-object (&optional arg) "Move down a level of Mim structure forwards. With ARG, move down that many levels forwards (backwards, ARG < 0)." (interactive "p") ;; another weirdo - going down `inside' an ADECL or ATOM trailer ;; depends on the value of mim-down-parens-only. if nil, treat ;; ADECLs and trailers as structured objects. (let ((direction (sign (or arg (setq arg 1))))) (if (and (= (abs arg) 1) (not mim-down-parens-only)) (goto-char (save-excursion (skip-mim-whitespace direction) (if (> direction 0) (re-search-forward "\\s'*")) (or (and (let ((c (next-char direction))) (or (= (char-syntax c) ?_) (= (char-syntax c) ?w))) (progn (forward-sexp direction) (if (inside-adecl-or-trailer-p direction) (point)))) (scan-lists (point) direction -1) (buffer-end direction)))) (while (/= arg 0) (goto-char (or (scan-lists (point) direction -1) (buffer-end direction))) (setq arg (- arg direction)))))) (defun backward-down-mim-object (&optional arg) "Move down a level of Mim structure backwards. With ARG, move down that many levels backwards (forwards, ARG < 0)." (interactive "p") (forward-down-mim-object (if arg (- arg) -1))) (defun forward-up-mim-object (&optional arg) "Move up a level of Mim structure forwards With ARG, move up that many levels forwards (backwards, ARG < 0)." (interactive "p") (let ((direction (sign (or arg (setq arg 1))))) (while (/= arg 0) (goto-char (or (scan-lists (point) direction 1) (buffer-end arg))) (setq arg (- arg direction))) (if (< direction 0) (backward-prefix-chars)))) (defun backward-up-mim-object (&optional arg) "Move up a level of Mim structure backwards With ARG, move up that many levels backwards (forwards, ARG > 0)." (interactive "p") (forward-up-mim-object (if arg (- arg) -1))) (defun replace-in-mim-object (old new) "Replace string in following Mim object." (interactive "*sReplace in object: \nsReplace %s with: ") (save-restriction (narrow-to-region (point) (save-excursion (forward-mim-object 1) (point))) (replace-string old new))) (defun transpose-mim-objects (&optional arg) "Transpose Mim objects around point. With ARG, transpose preceding object that many times with following objects. A negative ARG will transpose backwards." (interactive "*p") (transpose-subr 'forward-mim-object (or arg 1))) (defun beginning-of-DEFINE (&optional arg move) "Move backward to beginning of surrounding or previous toplevel Mim form. With ARG, do it that many times. Stops at last toplevel form seen if buffer end is reached." (interactive "p") (let ((direction (sign (or arg (setq arg 1))))) (if (not move) (setq move t)) (if (< direction 0) (goto-char (1+ (point)))) (while (and (/= arg 0) (re-search-backward "^<" nil move direction)) (setq arg (- arg direction))) (if (< direction 0) (goto-char (1- (point)))))) (defun end-of-DEFINE (&optional arg) "Move forward to end of surrounding or next toplevel mim form. With ARG, do it that many times. Stops at end of last toplevel form seen if buffer end is reached." (interactive "p") (if (not arg) (setq arg 1)) (if (< arg 0) (beginning-of-DEFINE (- (1- arg))) (if (not (looking-at "^<")) (setq arg (1+ arg))) (beginning-of-DEFINE (- arg) 'move) (beginning-of-DEFINE 1)) (forward-mim-object 1) (forward-line 1)) (defun next-mim-object (&optional arg) "Move to beginning of next toplevel Mim object. With ARG, do it that many times. Stops at last object seen if buffer end is reached." (interactive "p") (let ((search-string (if mim-stop-for-slop "^\\S " "^\\s(")) (direction (sign (or arg (setq arg 1))))) (if (> direction 0) (goto-char (1+ (point)))) ; no error if end of buffer (while (and (/= arg 0) (re-search-forward search-string nil t direction)) (setq arg (- arg direction))) (if (> direction 0) (goto-char (1- (point)))) ; no error if beginning of buffer ;; scroll to top of window if moving forward and end not visible. (if (not (or (< direction 0) (save-excursion (forward-mim-object 1) (pos-visible-in-window-p (point))))) (recenter 0)))) (defun previous-mim-object (&optional arg) "Move to beginning of previous toplevel Mim object. With ARG do it that many times. Stops at last object seen if buffer end is reached." (interactive "p") (next-mim-object (- (or arg 1)))) (defun calculate-mim-indent (&optional parse-start) "Calculate indentation for Mim line. Returns column." (save-excursion ; some excursion, huh, toto? (beginning-of-line) (let ((indent-point (point)) retry state containing-sexp last-sexp desired-indent start peek where paren-depth) (if parse-start (goto-char parse-start) ; should be containing environment (catch 'from-the-top ;; find a place to start parsing. going backwards is fastest. ;; forward-sexp signals error on encountering unmatched open. (setq retry t) (while retry (condition-case nil (forward-sexp -1) (error (setq retry nil))) (if (looking-at ".?[ \t]*\"") ;; cant parse backward in presence of strings, go forward. (progn (goto-char indent-point) (re-search-backward "^\\s(" nil 'move 1) ; to top of object (throw 'from-the-top nil))) (setq retry (and retry (/= (current-column) 0)))) (skip-chars-backward mim-whitespace) (if (not (bobp)) (forward-char -1)) ; onto unclosed open (backward-prefix-chars))) ;; find outermost containing sexp if we started inside an sexp. (while (< (point) indent-point) (setq state (parse-partial-sexp (point) indent-point 0))) ;; find usual column to indent under (not in string or toplevel). ;; on termination, state will correspond to containing environment ;; (if retry is nil), where will be position of character to indent ;; under normally, and desired-indent will be the column to indent to ;; except if inside form, string, or at toplevel. point will be in ;; in column to indent to unless inside string. (setq retry t) (while (and retry (setq paren-depth (car state)) (> paren-depth 0)) ;; find innermost containing sexp. (setq retry nil) (setq last-sexp (car (nthcdr 2 state))) (setq containing-sexp (car (cdr state))) (goto-char (1+ containing-sexp)) ; to last unclosed open (if (and last-sexp (> last-sexp (point))) ;; is the last sexp a containing sexp? (progn (setq peek (parse-partial-sexp last-sexp indent-point 0)) (if (setq retry (car (cdr peek))) (setq state peek)))) (if retry nil (setq where (1+ containing-sexp)) ; innermost containing sexp (goto-char where) (cond ((not last-sexp) ; indent-point after bracket (setq desired-indent (current-column))) ((= (preceding-char) ?\<) ; it's a form (cond ((> (progn (forward-sexp 1) (point)) last-sexp) (goto-char where)) ; only one frob ((> (save-excursion (forward-line 1) (point)) last-sexp) (skip-chars-forward " \t") ; last-sexp is on same line (setq where (point))) ; as containing-sexp ((progn (goto-char last-sexp) (beginning-of-line) (parse-partial-sexp (point) last-sexp 0 t) (or (= (point) last-sexp) (save-excursion (= (car (parse-partial-sexp (point) last-sexp 0)) 0)))) (backward-prefix-chars) ; last-sexp 1st on line or 1st (setq where (point))) ; frob on that line level 0 (t (goto-char where)))) ; punt, should never occur ((and indent-mim-arglist ; maybe hack arglist (= (preceding-char) ?\() ; its a list (save-excursion ; look for magic atoms (setq peek 0) ; using peek as counter (forward-char -1) ; back over containing paren (while (and (< (setq peek (1+ peek)) 6) (condition-case nil (progn (forward-sexp -1) t) (error nil)))) (and (< peek 6) (looking-at "DEFINE\\|DEFMAC\\|FUNCTION")))) ;; frobs stack under strings they belong to or under first ;; frob to right of strings they belong to unless luser has ;; frob (non-string) on preceding line with different ;; indentation. strings stack under start of arglist unless ;; mim-indent-arglist is not t, in which case they stack ;; under the last string, if any, else the start of the arglist. (let ((eol 0) last-string) (while (< (point) last-sexp) ; find out where the strings are (skip-chars-forward mim-whitespace last-sexp) (if (> (setq start (point)) eol) (progn ; simultaneously keeping track (setq where (min where start)) (end-of-line) ; of indentation of first frob (setq eol (point)) ; on each line (goto-char start))) (if (= (following-char) ?\") (progn (setq last-string (point)) (forward-sexp 1) (if (= last-string last-sexp) (setq where last-sexp) (skip-chars-forward mim-whitespace last-sexp) (setq where (point)))) (forward-sexp 1))) (goto-char indent-point) ; if string is first on (skip-chars-forward " \t" (point-max)) ; line we are indenting, it (if (= (following-char) ?\") ; goes under arglist start (if (and last-string (not (equal indent-mim-arglist t))) (setq where last-string) ; or under last string. (setq where (1+ containing-sexp))))) (goto-char where) (setq desired-indent (current-column))) (t ; plain vanilla structure (cond ((> (save-excursion (forward-line 1) (point)) last-sexp) (skip-chars-forward " \t") ; last-sexp is on same line (setq where (point))) ; as containing-sexp ((progn (goto-char last-sexp) (beginning-of-line) (parse-partial-sexp (point) last-sexp 0 t) (or (= (point) last-sexp) (save-excursion (= (car (parse-partial-sexp (point) last-sexp 0)) 0)))) (backward-prefix-chars) ; last-sexp 1st on line or 1st (setq where (point))) ; frob on that line level 0 (t (goto-char where))) ; punt, should never occur (setq desired-indent (current-column)))))) ;; state is innermost containing environment unless toplevel or string. (if (car (nthcdr 3 state)) ; inside string (progn (if last-sexp ; string must be next (progn (goto-char last-sexp) (forward-sexp 1) (search-forward "\"") (forward-char -1)) (goto-char indent-point) ; toplevel string, look for it (re-search-backward "[^\\]\"") (forward-char 1)) (setq start (point)) ; opening double quote (skip-chars-backward " \t") (backward-prefix-chars) ;; see if the string is really a comment. (if (and (looking-at ";[ \t]*\"") indent-mim-comment) ;; it's a comment, line up under the start unless disabled. (goto-char (1+ start)) ;; it's a string, dont mung the indentation. (goto-char indent-point) (skip-chars-forward " \t")) (setq desired-indent (current-column)))) ;; point is sitting in usual column to indent to and if retry is nil ;; then state corresponds to containing environment. if desired ;; indentation not determined, we are inside a form, so call hook. (or desired-indent (and indent-mim-function (not retry) (setq desired-indent (funcall indent-mim-function state indent-point))) (setq desired-indent (current-column))) (goto-char indent-point) ; back to where we started desired-indent))) ; return column to indent to (defun indent-mim-function (state indent-point) "Compute indentation for Mim special forms. Returns column or nil." (let ((containing-sexp (car (cdr state))) (current-indent (point))) (save-excursion (goto-char (1+ containing-sexp)) (backward-prefix-chars) ;; make sure we are looking at a symbol. if so, see if it is a special ;; symbol. if so, add the special indentation to the indentation of ;; the start of the special symbol, unless the property is not ;; an integer and not nil (in this case, call the property, it must ;; be a function which returns the appropriate indentation or nil and ;; does not change the buffer). (if (looking-at "\\sw\\|\\s_") (let* ((start (current-column)) (function (intern-soft (buffer-substring (point) (progn (forward-sexp 1) (point))))) (method (get function 'indent-mim-function))) (if (or (if (equal method 'DEFINE) (setq method mim-body-indent)) (integerp method)) ;; only use method if its first line after containing-sexp. ;; we could have done this in calculate-mim-indent, but someday ;; someone might want to format frobs in a special form based ;; on position instead of indenting uniformly (like lisp if), ;; so preserve right for posterity. if not first line, ;; calculate-mim-indent already knows right indentation - ;; give luser chance to change indentation manually by changing ;; 1st line after containing-sexp. (if (> (progn (forward-line 1) (point)) (car (nthcdr 2 state))) (+ method start)) (goto-char current-indent) (if (consp method) ;; list or pointed list of explicit indentations (indent-mim-offset state indent-point) (if (and (symbolp method) (fboundp method)) ;; luser function - s/he better know what's going on. ;; should take state and indent-point as arguments - for ;; description of state, see parse-partial-sexp ;; documentation the function is guaranteed the following: ;; (1) state describes the closest surrounding form, ;; (2) indent-point is the beginning of the line being ;; indented, (3) point points to char in column that would ;; normally be used for indentation, (4) function is bound ;; to the special ATOM. See indent-mim-offset for example ;; of a special function. (funcall method state indent-point))))))))) (defun indent-mim-offset (state indent-point) ;; offset forms explicitly according to list of indentations. (let ((mim-body-indent mim-body-indent) (indentations (get function 'indent-mim-function)) (containing-sexp (car (cdr state))) (last-sexp (car (nthcdr 2 state))) indentation) (goto-char (1+ containing-sexp)) ;; determine which of the indentations to use. (while (and (< (point) indent-point) (condition-case nil (progn (forward-sexp 1) (parse-partial-sexp (point) indent-point 1 t)) (error nil))) (skip-chars-backward " \t") (backward-prefix-chars) (if (= (following-char) ?\;) nil ; ignore comments (setq indentation (car indentations)) (if (integerp (setq indentations (cdr indentations))) ;; if last cdr is integer, that is indentation to use for all ;; all the rest of the forms. (progn (setq mim-body-indent indentations) (setq indentations nil))))) (goto-char (1+ containing-sexp)) (+ (current-column) (or indentation mim-body-indent)))) (defun indent-mim-comment (&optional start) "Indent a one line (string) Mim comment following object, if any." (let* ((old-point (point)) (eol (progn (end-of-line) (point))) state last-sexp) ;; this function assumes that comment indenting is enabled. it is caller's ;; responsibility to check the indent-mim-comment flag before calling. (beginning-of-line) (catch 'no-comment (setq state (parse-partial-sexp (point) eol)) ;; determine if there is an existing regular comment. a `regular' ;; comment is defined as a commented string which is the last thing ;; on the line and does not extend beyond the end of the line. (if (or (not (setq last-sexp (car (nthcdr 2 state)))) (car (nthcdr 3 state))) ;; empty line or inside string (multiple line). (throw 'no-comment nil)) ;; could be a comment, but make sure its not the only object. (beginning-of-line) (parse-partial-sexp (point) eol 0 t) (if (= (point) last-sexp) ;; only one object on line (throw 'no-comment t)) (goto-char last-sexp) (skip-chars-backward " \t") (backward-prefix-chars) (if (not (looking-at ";[ \t]*\"")) ;; aint no comment (throw 'no-comment nil)) ;; there is an existing regular comment (delete-horizontal-space) ;; move it to comment-column if possible else to tab-stop (if (< (current-column) comment-column) (indent-to comment-column) (tab-to-tab-stop))) (goto-char old-point))) (defun indent-mim-line () "Indent line of Mim code." (interactive "*") (let* ((position (- (point-max) (point))) (bol (progn (beginning-of-line) (point))) (indent (calculate-mim-indent))) (skip-chars-forward " \t") (if (/= (current-column) indent) (progn (delete-region bol (point)) (indent-to indent))) (if (> (- (point-max) position) (point)) (goto-char (- (point-max) position))))) (defun newline-and-mim-indent () "Insert newline at point and indent." (interactive "*") ;; commented code would correct indentation of line in arglist which ;; starts with string, but it would indent every line twice. luser can ;; just say tab after typing string to get same effect. ;(if indent-mim-arglist (indent-mim-line)) (newline) (indent-mim-line)) (defun open-mim-line (&optional lines) "Insert newline before point and indent. With ARG insert that many newlines." (interactive "*p") (beginning-of-line) (let ((indent (calculate-mim-indent))) (while (> lines 0) (newline) (forward-line -1) (indent-to indent) (setq lines (1- lines))))) (defun indent-mim-object (&optional dont-indent-first-line) "Indent object following point and all lines contained inside it. With ARG, idents only contained lines (skips first line)." (interactive "*P") (let (end bol indent start) (save-excursion (parse-partial-sexp (point) (point-max) 0 t) (setq start (point)) (forward-sexp 1) (setq end (- (point-max) (point)))) (save-excursion (if (not dont-indent-first-line) (indent-mim-line)) (while (progn (forward-line 1) (> (- (point-max) (point)) end)) (setq indent (calculate-mim-indent start)) (setq bol (point)) (skip-chars-forward " \t") (if (/= indent (current-column)) (progn (delete-region bol (point)) (indent-to indent))) (if indent-mim-comment (indent-mim-comment)))))) (defun find-mim-definition (name) "Search for definition of function, macro, or gfcn. You need type only enough of the name to be unambiguous." (interactive "sName: ") (let (where) (save-excursion (goto-char (point-min)) (condition-case nil (progn (re-search-forward (concat "^<\\(DEFINE\\|\\DEFMAC\\|FCN\\|GFCN\\)\\([ \t]*\\)" name)) (setq where (point))) (error (error "Can't find %s" name)))) (if where (progn (push-mark) (goto-char where) (beginning-of-line) (recenter 0))))) (defun begin-mim-comment () "Move to existing comment or insert empty comment." (interactive "*") (let* ((eol (progn (end-of-line) (point))) (bol (progn (beginning-of-line) (point)))) ;; check for existing comment first. (if (re-search-forward ";[ \t]*\"" eol t) ;; found it. indent if desired and go there. (if indent-mim-comment (let ((where (- (point-max) (point)))) (indent-mim-comment) (goto-char (- (point-max) where)))) ;; nothing there, make a comment. (let (state last-sexp) ;; skip past all the sexps on the line (goto-char bol) (while (and (equal (car (setq state (parse-partial-sexp (point) eol 0))) 0) (car (nthcdr 2 state))) (setq last-sexp (car (nthcdr 2 state)))) (if (car (nthcdr 3 state)) nil ; inside a string, punt (delete-region (point) eol) ; flush trailing whitespace (if (and (not last-sexp) (equal (car state) 0)) (indent-to (calculate-mim-indent)) ; empty, indent like code (if (> (current-column) comment-column) ; indent to comment column (tab-to-tab-stop) ; unless past it, else to (indent-to comment-column))) ; tab-stop ;; if luser changes comment-{start end} to something besides semi ;; followed by zero or more whitespace characters followed by string ;; delimiters, the code above fails to find existing comments, but as ;; taa says, `let the losers lose'. (insert comment-start) (save-excursion (insert comment-end))))))) (defun skip-mim-whitespace (direction) (if (>= direction 0) (skip-chars-forward mim-whitespace (point-max)) (skip-chars-backward mim-whitespace (point-min)))) (defun inside-adecl-or-trailer-p (direction) (if (>= direction 0) (looking-at ":\\|!-") (or (= (preceding-char) ?:) (looking-at "!-")))) (defun sign (n) "Returns -1 if N < 0, else 1." (if (>= n 0) 1 -1)) (defun abs (n) "Returns the absolute value of N." (if (>= n 0) n (- n))) (defun next-char (direction) "Returns preceding-char if DIRECTION < 0, otherwise following-char." (if (>= direction 0) (following-char) (preceding-char))) (provide 'mim-mode) ;;; mim-mode.el ends here emacs-19.22/lisp/mim-syntax.el100444 12120 1 6144 5257332620 14511 0ustar rmsdaemon;;; mim-syntax.el --- syntax checker for Mim (MDL). ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; 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. ;;; Code: (require 'mim-mode) (defun slow-syntax-check-mim () "Check Mim syntax slowly. Points out the context of the error, if the syntax is incorrect." (interactive) (message "checking syntax...") (let ((stop (point-max)) point-stack current last-bracket whoops last-point) (save-excursion (goto-char (point-min)) (while (and (not whoops) (re-search-forward "\\s(\\|\\s)\\|\"\\|[\\]" stop t)) (setq current (preceding-char)) (cond ((= current ?\") (condition-case nil (progn (re-search-forward "[^\\]\"") (setq current nil)) (error (setq whoops (point))))) ((= current ?\\) (condition-case nil (forward-char 1) (error nil))) ((= (char-syntax current) ?\)) (if (or (not last-bracket) (not (= (logand (lsh (aref (syntax-table) last-bracket) -8) ?\177) current))) (setq whoops (point)) (setq last-point (car point-stack)) (setq last-bracket (if last-point (char-after (1- last-point)))) (setq point-stack (cdr point-stack)))) (t (if last-point (setq point-stack (cons last-point point-stack))) (setq last-point (point)) (setq last-bracket current))))) (cond ((not (or whoops last-point)) (message "Syntax correct")) (whoops (goto-char whoops) (cond ((equal current ?\") (error "Unterminated string")) ((not last-point) (error "Extraneous %s" (char-to-string current))) (t (error "Mismatched %s with %s" (save-excursion (setq whoops (1- (point))) (goto-char (1- last-point)) (buffer-substring (point) (min (progn (end-of-line) (point)) whoops))) (char-to-string current))))) (t (goto-char last-point) (error "Unmatched %s" (char-to-string last-bracket)))))) (defun fast-syntax-check-mim () "Checks Mim syntax quickly. Answers correct or incorrect, cannot point out the error context." (interactive) (save-excursion (goto-char (point-min)) (let (state) (while (and (not (eobp)) (equal (car (setq state (parse-partial-sexp (point) (point-max) 0))) 0))) (if (equal (car state) 0) (message "Syntax correct") (error "Syntax incorrect"))))) ;;; mim-syntax.el ends here emacs-19.22/lisp/misc.el100444 12120 1 4022 5257332722 13332 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.22/lisp/mlconvert.el100444 12120 1 24005 5422615477 14440 0ustar rmsdaemon;;; 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 '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.22/lisp/mlsupport.el100444 74777 1 27264 5353347752 14662 0ustar ericdaemon;;; 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)))) (provide 'mlsupport) ;;; mlsupport.el ends here emacs-19.22/lisp/modula2.el100444 74777 1 31120 5353350072 14127 0ustar ericdaemon;;; 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 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*") (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.22/lisp/mouse-sel.el100444 12120 1 35777 5467453505 14363 0ustar rmsdaemon;;; mouse-sel.el --- Multi-click selection support for Emacs 19 ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Mike Williams ;; Keywords: mouse ;; Version: $Revision: 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. ;;; 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. ;; ;; * 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 pastes contents of primary selection. ;; ;; * Pressing mouse-2 while selecting or extending copies selected text ;; to the kill ring. Pressing mouse-1 or mouse-3 kills it. ;; ;; This module requires my thingatpt.el module, version 1.14 or later, which ;; it uses to find the bounds of words, lines, sexps, etc. ;; ;; Thanks to KevinB@bartley.demon.co.uk for his useful input. ;; ;; You may also want to use one 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) ;; ;;--- Customisation ------------------------------------------------------- ;; ;; * You can control the way mouse-sel binds it's 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 pastes 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. ;; ;; * 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) ;; ;; * Normally, the selection highlight will be removed when the mouse is ;; lifted. You can tell mouse-sel to retain the selection highlight ;; (useful if you don't use transient-mark-mode) with: ;; ;; (setq mouse-sel-retain-highlight t) ;; ;; * By default, mouse-select cycles the click count after 3 clicks. That ;; is, clicking mouse-1 four times has the same effect as clicking it ;; once, clicking five 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,check}-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. ;; ;;--- Hints --------------------------------------------------------------- ;; ;; * You can change the selection highlight face by altering the properties ;; of mouse-drag-overlay, eg. ;; ;; (overlay-put mouse-drag-overlay 'face 'bold) ;; ;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's ;; a two second delay). The following code will cause mouse-sel to use ;; the cut buffer rather than the primary selection. However, be aware ;; that cut buffers are OBSOLETE, and some X applications may not support ;; them. ;; ;; (setq mouse-sel-set-selection-function 'x-select-text ;; mouse-sel-get-selection-function 'x-get-cut-buffer) ;; ;;--- Warnings ------------------------------------------------------------ ;; ;; * When selecting sexps, the selection extends by sexps at the same ;; nesting level. This also means the selection cannot be extended out ;; of the enclosing nesting level. This is INTENTIONAL. ;;; Code: (provide 'mouse-sel) (require 'mouse) (require 'thingatpt) ;;=== Version ============================================================= (defconst mouse-sel-version (substring "$Revision: 1.1 $" 11 -2) "The revision number of mouse-sel (as string). The complete RCS id is: $Id: mouse-sel.el,v 1.1 1993/11/08 14:27:16 rms Exp $") ;;=== 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-retain-highlight nil "*Retain highlight on mouse-drag-overlay. If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will remain highlighted. If nil, highlighting will be turned off when the mouse is lifted.") (defvar mouse-sel-cycle-clicks t "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks. Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.") (defvar mouse-sel-default-bindings t "Set to nil before loading mouse-sel to prevent default mouse bindings.") ;;=== Selection =========================================================== (defvar mouse-sel-selection-type nil "Type of current selection") (make-variable-buffer-local 'mouse-sel-selection-type) (defvar mouse-sel-selection "" "This variable is used to store the selection value when mouse-sel is used on windowing systems other than X Windows.") (defvar mouse-sel-set-selection-function (if (eq window-system 'x) (function (lambda (s) (x-set-selection 'PRIMARY s))) (function (lambda (s) (setq mouse-sel-selection s)))) "Function to call to set selection. Called with one argument, the text to select.") (defvar mouse-sel-get-selection-function (if (eq window-system 'x) 'x-get-selection (function (lambda () mouse-sel-selection))) "Function to call to get the selection. Called with no argument, it should return the selected text.") (defvar mouse-sel-check-selection-function (if (eq window-system 'x) 'x-selection-owner-p nil) "Function to check whether emacs still owns the selection. Called with no arguments.") (defun mouse-sel-determine-selection-type (NCLICKS) "Determine what `thing' \\[mouse-select] and \\[mouse-extend] should select by. The first argument is NCLICKS, is the number of consecutive mouse clicks at the same position." (let* ((next-char (char-after (point))) (char-syntax (if next-char (char-syntax next-char))) (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS))) (cond ((= nclicks 1) nil) ((>= nclicks 3) 'line) ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp) ((memq next-char '(? ?\t ?\n)) 'whitespace) ((eq char-syntax ?_) 'symbol) ((eq char-syntax ?w) 'word)))) (defun mouse-select (EVENT) "Set region/selection using the mouse. On click, point & mark are set to click position, and mark is disabled. Dragging extends region/selection. 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. Clicking mouse-2 while selecting copies the region to the kill-ring. Clicking mouse-1 or mouse-3 kills the region. This should be bound to a down-mouse event." (interactive "e") (mouse-set-point EVENT) (setq mouse-sel-selection-type (mouse-sel-determine-selection-type (event-click-count EVENT))) (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type))) (if object-bounds (progn (setq mark-active t) (goto-char (car object-bounds)) (set-mark (cdr object-bounds))) (deactivate-mark))) (mouse-extend)) (defun mouse-extend (&optional EVENT) "Extend region/selection using the mouse. See documentation for mouse-select for more details. This should be bound to a down-mouse event." (interactive "e") (if EVENT (select-window (posn-window (event-end EVENT)))) (let* ((min (if mark-active (region-beginning) (point))) (max (if mark-active (region-end) (point))) (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))) (orig-cursor-type (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))) direction event) ;; Inhibit normal region highlight (setq mark-active nil) ;; Highlight region (forcing re-highlight) (move-overlay mouse-drag-overlay min max (current-buffer)) (overlay-put mouse-drag-overlay 'face (overlay-get mouse-drag-overlay 'face)) ;; Bar cursor (modify-frame-parameters (selected-frame) '((cursor-type . bar))) ;; Handle dragging (unwind-protect (progn (track-mouse (while (if EVENT ; Use initial event (prog1 (setq event EVENT) (setq EVENT nil)) (setq event (read-event)) (and (consp event) (memq (car event) '(mouse-movement switch-frame)))) (let ((end (event-end event))) (cond ;; Ignore any movement outside the frame ((eq (car-safe event) 'switch-frame) nil) ((and (posn-window end) (not (eq (window-frame (posn-window end)) (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 (- end-row top) mouse-drag-overlay max)) ((and end-row (not (eobp)) (>= end-row bottom)) (mouse-scroll-subr (1+ (- end-row bottom)) mouse-drag-overlay min)) ))) ;; On the mode line ((eq (posn-point end) 'mode-line) (mouse-scroll-subr 1 mouse-drag-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 mouse-sel-selection-type) 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)) last) (goto-char (if (eq 1 direction) min max)) (condition-case nil (progn (while (> (* direction (- goal (point))) 0) (setq last (point)) (forward-thing mouse-sel-selection-type direction)) (let ((end (point))) (forward-thing mouse-sel-selection-type (- direction)) (goto-char (if (> (* direction (- goal (point))) 0) end last)))) (error)))) ;; Move overlay (move-overlay mouse-drag-overlay (if (eq 1 direction) min (point)) (if (eq -1 direction) max (point)) (current-buffer)) ))) ; end track-mouse (let ((overlay-start (overlay-start mouse-drag-overlay)) (overlay-end (overlay-end mouse-drag-overlay))) ;; Set region (if (eq overlay-start overlay-end) (deactivate-mark) (if (and mouse-sel-leave-point-near-mouse (eq direction 1)) (progn (set-mark overlay-start) (goto-char overlay-end)) (set-mark overlay-end) (goto-char overlay-start))) ;; Set selection (if (and mark-active mouse-sel-set-selection-function) (funcall mouse-sel-set-selection-function (buffer-substring overlay-start overlay-end))) ;; Handle copy/kill (cond ((eq (car-safe last-input-event) 'down-mouse-2) (copy-region-as-kill overlay-start overlay-end) (read-event) (read-event)) ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3)) (kill-region overlay-start overlay-end) (deactivate-mark) (read-event) (read-event))))) ;; Restore cursor (modify-frame-parameters (selected-frame) (list (cons 'cursor-type orig-cursor-type))) ;; Remove overlay (or mouse-sel-retain-highlight (delete-overlay mouse-drag-overlay))))) (defun mouse-insert-selection (click) "Insert the contents of the selection at mouse click." (interactive "e") (mouse-set-point click) (deactivate-mark) (if mouse-sel-get-selection-function (insert (or (funcall mouse-sel-get-selection-function) "")))) (defun mouse-sel-validate-selection () "Remove selection highlight if emacs no longer owns the primary selection." (or (not mouse-sel-check-selection-function) (funcall mouse-sel-check-selection-function) (delete-overlay mouse-drag-overlay))) (add-hook 'pre-command-hook 'mouse-sel-validate-selection) ;;=== 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) (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)) ) ;; mouse-sel.el ends here. emacs-19.22/lisp/mouse.el100444 12120 1 150474 5475603376 13614 0ustar rmsdaemon;;; mouse.el --- window system-independent mouse support. ;;; Copyright (C) 1993 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) (defun mouse-delete-window (click) "Delete the window you click on. This must be bound to a mouse click." (interactive "e") (delete-window (posn-window (event-start click)))) (defun mouse-tear-off-window (click) "Delete the window clicked on, and create a new frame displaying its buffer." (interactive "e") (let* ((window (posn-window (event-start click))) (buf (window-buffer window)) (frame (new-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") (let ((start (event-start click))) (select-window (posn-window start)) (let ((new-height (if (eq (posn-point start) 'vertical-scroll-bar) (scroll-bar-scale (posn-col-row start) (1- (window-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") (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-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") ;; 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))) (and (window-minibuffer-p (posn-window posn)) (not (minibuffer-window-active-p (posn-window posn))) (error "Minibuffer window is not active")) (select-window (posn-window posn)) (if (numberp (posn-point posn)) (goto-char (posn-point posn))))) (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") (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. (or (and transient-mark-mode (eq (framep (selected-frame)) 'x)) (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. (let (this-command) (copy-region-as-kill (mark) (point))))) (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.") (defun mouse-scroll-subr (jump &optional overlay start) "Scroll the selected 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." (while (progn (goto-char (window-start)) (if (not (zerop (vertical-motion jump))) (progn (set-window-start (selected-window) (point)) (if (natnump jump) (progn (goto-char (window-end (selected-window))) ;; window-end doesn't reflect the window's new ;; start position until the next redisplay. Hurrah. (vertical-motion (1- jump))) (goto-char (window-start (selected-window)))) (if overlay (move-overlay overlay start (point))) (if (not (eobp)) (sit-for mouse-scroll-delay)))))) (point)) (defvar mouse-drag-overlay (make-overlay 1 1)) (overlay-put mouse-drag-overlay 'face 'region) (defvar mouse-selection-click-count 0) (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") (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) (mouse-set-point start-event) (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) (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 ;; Ignore switch-frame events. ((eq (car-safe event) 'switch-frame)) ;; Are we moving within the original window? ((and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) (goto-char end-point) (let ((range (mouse-start-end start-point (point) click-count))) (move-overlay mouse-drag-overlay (car range) (nth 1 range)))) ;; Are we moving on a different window on the same frame? ((and (windowp (posn-window end)) (eq (window-frame (posn-window end)) start-frame)) (let ((mouse-row (+ (nth 1 (window-edges (posn-window end))) (cdr (posn-col-row end))))) (cond ((< mouse-row top) (mouse-scroll-subr (- mouse-row top) mouse-drag-overlay start-point)) ((and (not (eobp)) (>= mouse-row bottom)) (mouse-scroll-subr (1+ (- mouse-row bottom)) mouse-drag-overlay start-point))))) (t (let ((mouse-y (cdr (cdr (mouse-position)))) (menu-bar-lines (or (cdr (assq 'menu-bar-lines (frame-parameters))) 0))) ;; Are we on the menu bar? (and (integerp mouse-y) (< mouse-y menu-bar-lines) (mouse-scroll-subr (- mouse-y menu-bar-lines) mouse-drag-overlay start-point)))))))) (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click) (eq (posn-window (event-end event)) start-window) (numberp (posn-point (event-end event)))) (let ((fun (key-binding (vector (car event))))) (if (memq fun '(mouse-set-region mouse-set-point)) (if (not (= (overlay-start mouse-drag-overlay) (overlay-end mouse-drag-overlay))) (let (this-command) (push-mark (overlay-start mouse-drag-overlay) t t) (goto-char (overlay-end mouse-drag-overlay)) (copy-region-as-kill (point) (mark t))) (goto-char (overlay-end mouse-drag-overlay)) (setq this-command 'mouse-set-point)) (if (fboundp fun) (funcall fun event))))) (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)))) (if (or (string= syntax "w") (string= syntax " ")) (if (< dir 0) (skip-syntax-backward syntax) (skip-syntax-forward syntax)) (if (< dir 0) (while (and (not (bobp)) (= (preceding-char) char)) (forward-char -1)) (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) (not (eobp)) (= (char-syntax (char-after start)) ?\()) (list start (save-excursion (forward-sexp 1) (point)))) ((and (= mode 1) (= start end) (not (eobp)) (= (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) (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") (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") (let ((click-posn (posn-point (event-start click)))) (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. Prefix arguments are interpreted as with \\[yank]." (interactive "e\nP") (mouse-set-point click) (setq this-command 'yank) (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) (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. (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! (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 ((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 (> (mod mouse-selection-click-count 3) 0) (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.) (setcar kill-ring (buffer-substring (point) (mark t))) (if interprogram-cut-function (funcall interprogram-cut-function (car kill-ring))) ;; 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 (point) (mark)) (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 (eq last-command 'mouse-drag-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))) (setcar kill-ring (buffer-substring (point) (mark t))) (if interprogram-cut-function (funcall interprogram-cut-function (car kill-ring)))) ;; We just have point, so set mark here. (mouse-set-mark-fast click) (kill-ring-save (point) (mark t)) (mouse-show-mark)) (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) ;; 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") (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") (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") (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-selection-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 ;; Ignore switch-frame events. ((eq (car-safe event) 'switch-frame)) ;; Are we moving within the original window? ((and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) (if (/= start-point end-point) (set-marker mouse-secondary-start nil)) (let ((range (mouse-start-end start-point end-point click-count))) (move-overlay mouse-secondary-overlay (car range) (nth 1 range)))) ;; Are we moving on a different window on the same frame? ((and (windowp (posn-window end)) (eq (window-frame (posn-window end)) start-frame)) (let ((mouse-row (+ (nth 1 (window-edges (posn-window end))) (cdr (posn-col-row end))))) (cond ((< mouse-row top) (mouse-scroll-subr (- mouse-row top) mouse-secondary-overlay start-point)) ((and (not (eobp)) (>= mouse-row bottom)) (mouse-scroll-subr (1+ (- mouse-row bottom)) mouse-drag-overlay start-point))))) (t (let ((mouse-y (cdr (cdr (mouse-position)))) (menu-bar-lines (or (cdr (assq 'menu-bar-lines (frame-parameters))) 0))) ;; Are we on the menu bar? (and (integerp mouse-y) (< mouse-y menu-bar-lines) (mouse-scroll-subr (- mouse-y menu-bar-lines) mouse-secondary-overlay start-point)))))))) (if (and (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 last stretch of killed text at the position clicked on. Prefix arguments are interpreted as with \\[yank]." (interactive "e") (save-excursion (set-buffer (window-buffer (posn-window (event-start click)))) (goto-char (posn-point (event-start click))) (insert (x-get-selection 'SECONDARY)))) (defun mouse-kill-secondary (click) "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 "e") (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")) (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. 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 ((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-selection-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-selection-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.) (setcar kill-ring (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))) (if interprogram-cut-function (funcall interprogram-cut-function (car kill-ring))) ;; 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-selection-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))) (setcar kill-ring (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))) (if interprogram-cut-function (funcall interprogram-cut-function (car kill-ring)))) (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)))) (x-set-selection 'SECONDARY (if (overlay-buffer mouse-secondary-overlay) (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") (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) "")) 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. ;; Delete the longest partial match for STRING ;; that can be found before POINT. (defun mouse-delete-max-match (string) (let ((len (min (length string) (- (point-max) (point-min))))) (goto-char (max (point-min) (- (point) (length string)))) (while (and (> len 0) (let ((tail (buffer-substring (point) (+ (point) len)))) (not (string= tail (substring string 0 len))))) (setq len (1- len)) (forward-char 1)) (delete-char len))) (defun mouse-choose-completion (event) "Click on an alternative in the `*Completions*' buffer to choose it." (interactive "e") (let ((buffer (window-buffer)) choice) (save-excursion (set-buffer (window-buffer (posn-window (event-start event)))) (save-excursion (goto-char (posn-point (event-start event))) (skip-chars-backward "^ \t\n") (let ((beg (point))) (skip-chars-forward "^ \t\n") (setq choice (buffer-substring beg (point)))))) (set-buffer buffer) (mouse-delete-max-match choice) (insert choice) (and (equal buffer (window-buffer (minibuffer-window))) (minibuffer-complete-and-exit)))) ;; Font selection. (defun font-menu-add-default () (let* ((default (cdr (assq 'font (frame-parameters (selected-frame))))) (font-alist x-fixed-font-alist) (elt (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" ("6x10" "-misc-fixed-medium-r-semicondensed--10-110-75-75-c-60-*-1") ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1") ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1") ("lucida 13" "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1") ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1") ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1") ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1") ("") ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1") ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1") ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1") ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1") ("") ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1") ("") ("fixed" "fixed") ("10x20" "10x20") ("11x18" "11x18") ("12x24" "12x24")) ;;; 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" ("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 (&optional font) "Select an emacs font from a list of known good fonts" (interactive (x-popup-menu last-nonmenu-event x-fixed-font-alist)) (if font (progn (modify-frame-parameters (selected-frame) (list (cons 'font font))) ;; Update some standard faces too. (set-face-font 'bold nil (selected-frame)) (make-face-bold 'bold (selected-frame) t) (set-face-font 'italic nil (selected-frame)) (make-face-italic 'italic (selected-frame) t) (set-face-font 'bold-italic nil (selected-frame)) (make-face-bold-italic 'bold-italic (selected-frame) t) ;; Update any nonstandard faces whose definition is ;; "a bold/italic/bold&italic version of the frame's font". (let ((rest global-face-data)) (while rest (condition-case nil (if (listp (face-font (cdr (car rest)))) (let ((bold (memq 'bold (face-font (cdr (car rest))))) (italic (memq 'italic (face-font (cdr (car rest)))))) (if (and bold italic) (make-face-bold-italic (car (car rest)) (selected-frame)) (if bold (make-face-bold (car (car rest)) (selected-frame)) (if italic (make-face-italic (car (car rest)) (selected-frame))))))) (error nil)) (setq rest (cdr rest)))) ))) ;;; 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) (global-set-key [C-down-mouse-3] 'mouse-set-font) ;; Replaced with dragging mouse-1 ;; (global-set-key [S-mouse-1] 'mouse-set-mark) (global-set-key [mode-line mouse-1] 'mouse-delete-other-windows) (global-set-key [mode-line mouse-3] 'mouse-delete-window) (global-set-key [mode-line S-mouse-2] 'mouse-split-window-horizontally) ;; Define the mouse help menu tree. (defvar help-menu-map '(keymap "Help")) (global-set-key [C-down-mouse-2] help-menu-map) (defvar help-apropos-map (make-sparse-keymap "Is there a command that...")) (defvar help-keys-map (make-sparse-keymap "Key Commands <==> Functions")) (defvar help-manual-map (make-sparse-keymap "Manual and tutorial")) (defvar help-misc-map (make-sparse-keymap "Odds and ends")) (defvar help-modes-map (make-sparse-keymap "Modes")) (defvar help-admin-map (make-sparse-keymap "Administrivia")) (define-key help-menu-map [apropos] (cons "@Is there a command that..." help-apropos-map)) (define-key help-menu-map [keys] (cons "@Key Commands <==> Functions" help-keys-map)) (define-key help-menu-map [manuals] (cons "@Manual and tutorial" help-manual-map)) (define-key help-menu-map [misc] (cons "@Odds and ends" help-misc-map)) (define-key help-menu-map [modes] (cons "@Modes" help-modes-map)) (define-key help-menu-map [admin] (cons "@Administrivia" help-admin-map)) (define-key help-apropos-map "c" '("Command Apropos" . command-apropos)) (define-key help-apropos-map "a" '("Apropos" . apropos)) (define-key help-keys-map "b" '("List all keystroke commands" . describe-bindings)) (define-key help-keys-map "c" '("Describe key briefly" . describe-key-briefly)) (define-key help-keys-map "k" '("Describe key verbose" . describe-key)) (define-key help-keys-map "f" '("Describe Lisp function" . describe-function)) (define-key help-keys-map "w" '("Where is this command" . where-is)) (define-key help-manual-map "i" '("Info system" . info)) (define-key help-manual-map "t" '("Invoke Emacs tutorial" . help-with-tutorial)) (define-key help-misc-map "l" '("Last 100 Keystrokes" . view-lossage)) (define-key help-misc-map "s" '("Describe syntax table" . describe-syntax)) (define-key help-modes-map "m" '("Describe current major mode" . describe-mode)) (define-key help-modes-map "b" '("List all keystroke commands" . describe-bindings)) (define-key help-admin-map "n" '("View Emacs news" . view-emacs-news)) (define-key help-admin-map "l" '("View Emacs copying conditions" . describe-copying)) (define-key help-admin-map "d" '("Describe distribution" . describe-distribution)) (define-key help-admin-map "w" '("Describe (non)warranty" . describe-no-warranty)) (provide 'mouse) ;;; mouse.el ends here emacs-19.22/lisp/mpuz.el100444 74720 14 35160 5427026177 14026 0ustar eggertguest;;; 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 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. ;;; 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.22/lisp/netunam.el100444 74777 1 13103 5353347756 14253 0ustar ericdaemon;;; netunam.el --- HP-UX RFA Commands ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Author: Chris Hanson ;; 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: ;; Use the Remote File Access (RFA) facility of HP-UX from Emacs. ;;; Code: (defconst rfa-node-directory "/net/" "Directory in which RFA network special files are stored. By HP convention, this is \"/net/\".") (defvar rfa-default-node nil "If not nil, this is the name of the default RFA network special file.") (defvar rfa-password-memoize-p t "If non-nil, remember login user's passwords after they have been entered.") (defvar rfa-password-alist '() "An association from node-name strings to password strings. Used if `rfa-password-memoize-p' is non-nil.") (defvar rfa-password-per-node-p t "If nil, login user uses same password on all machines. Has no effect if `rfa-password-memoize-p' is nil.") (defun rfa-set-password (password &optional node user) "Add PASSWORD to the RFA password database. Optional second arg NODE is a string specifying a particular nodename; if supplied and not nil, PASSWORD applies to only that node. Optional third arg USER is a string specifying the (remote) user whose password this is; if not supplied this defaults to (user-login-name)." (if (not user) (setq user (user-login-name))) (let ((node-entry (assoc node rfa-password-alist))) (if node-entry (let ((user-entry (assoc user (cdr node-entry)))) (if user-entry (rplacd user-entry password) (rplacd node-entry (nconc (cdr node-entry) (list (cons user password)))))) (setq rfa-password-alist (nconc rfa-password-alist (list (list node (cons user password)))))))) (defun rfa-open (node &optional user password) "Open a network connection to a server using remote file access. First argument NODE is the network node for the remote machine. Second optional argument USER is the user name to use on that machine. If called interactively, the user name is prompted for. Third optional argument PASSWORD is the password string for that user. If not given, this is filled in from the value of `rfa-password-alist', or prompted for. A prefix argument of - will cause the password to be prompted for even if previously memoized." (interactive (list (read-file-name "rfa-open: " rfa-node-directory rfa-default-node t) (read-string "user-name: " (user-login-name)))) (let ((node (and (or rfa-password-per-node-p (not (equal user (user-login-name)))) node))) (if (not password) (setq password (let ((password (cdr (assoc user (cdr (assoc node rfa-password-alist)))))) (or (and (not current-prefix-arg) password) (rfa-password-read (format "password for user %s%s: " user (if node (format " on node \"%s\"" node) "")) password)))))) (let ((result (sysnetunam (expand-file-name node rfa-node-directory) (concat user ":" password)))) (if (interactive-p) (if result (message "Opened network connection to %s as %s" node user) (error "Unable to open network connection"))) (if (and rfa-password-memoize-p result) (rfa-set-password password node user)) result)) (defun rfa-close (node) "Close a network connection to a server using remote file access. NODE is the network node for the remote machine." (interactive (list (read-file-name "rfa-close: " rfa-node-directory rfa-default-node t))) (let ((result (sysnetunam (expand-file-name node rfa-node-directory) ""))) (cond ((not (interactive-p)) result) ((not result) (error "Unable to close network connection")) (t (message "Closed network connection to %s" node))))) (defun rfa-password-read (prompt default) (let ((rfa-password-accumulator (or default ""))) (read-from-minibuffer prompt (and default (let ((copy (concat default)) (index 0) (length (length default))) (while (< index length) (aset copy index ?.) (setq index (1+ index))) copy)) rfa-password-map) rfa-password-accumulator)) (defvar rfa-password-map nil) (if (not rfa-password-map) (let ((char ? )) (setq rfa-password-map (make-keymap)) (while (< char 127) (define-key rfa-password-map (char-to-string char) 'rfa-password-self-insert) (setq char (1+ char))) (define-key rfa-password-map "\C-g" 'abort-recursive-edit) (define-key rfa-password-map "\177" 'rfa-password-rubout) (define-key rfa-password-map "\n" 'exit-minibuffer) (define-key rfa-password-map "\r" 'exit-minibuffer))) (defvar rfa-password-accumulator nil) (defun rfa-password-self-insert () (interactive) (setq rfa-password-accumulator (concat rfa-password-accumulator (char-to-string last-command-char))) (insert ?.)) (defun rfa-password-rubout () (interactive) (delete-char -1) (setq rfa-password-accumulator (substring rfa-password-accumulator 0 -1))) ;;; netunam.el ends here emacs-19.22/lisp/nnspool.el100444 13437 1 31071 5405344350 14242 0ustar jimbdaemon;;; nnspool.el --- spool access using NNTP for GNU Emacs ;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc. ;; Author: 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. ;;; Code: (require 'nntp) (defvar nnspool-inews-program news-inews-program "*Program to post news.") (defvar nnspool-inews-switches '("-h") "*Switches for nnspool-request-post to pass to `inews' for posting news.") (defvar nnspool-spool-directory news-path "*Local news spool directory.") (defvar nnspool-active-file "/usr/lib/news/active" "*Local news active file.") (defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups" "*Local news newsgroups file.") (defvar nnspool-distributions-file "/usr/lib/news/distributions" "*Local news distributions file.") (defvar nnspool-history-file "/usr/lib/news/history" "*Local news history file.") (defconst nnspool-version "NNSPOOL 1.12" "Version numbers of this version of NNSPOOL.") (defvar nnspool-current-directory nil "Current news group directory.") ;;; ;;; Replacement of Extended Command for retrieving many headers. ;;; (defun nnspool-retrieve-headers (sequence) "Return list of article headers specified by SEQUENCE of article id. The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. If there is no References: field, In-Reply-To: field is used instead. Reader macros for the vector are defined as `nntp-header-FIELD'. Writer macros for the vector are defined as `nntp-set-header-FIELD'. Newsgroup must be selected before calling this." (save-excursion (set-buffer nntp-server-buffer) ;;(erase-buffer) (let ((file nil) (number (length sequence)) (count 0) (headers nil) ;Result list. (article 0) (subject nil) (message-id nil) (from nil) (xref nil) (lines 0) (date nil) (references nil)) (while sequence ;;(nntp-send-strings-to-server "HEAD" (car sequence)) (setq article (car sequence)) (setq file (concat nnspool-current-directory (prin1-to-string article))) (if (and (file-exists-p file) (not (file-directory-p file))) (progn (erase-buffer) (insert-file-contents file) ;; Make message body invisible. (goto-char (point-min)) (search-forward "\n\n" nil 'move) (narrow-to-region (point-min) (point)) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) ;; Make it possible to search for `\nFIELD'. (goto-char (point-min)) (insert "\n") ;; Extract From: (goto-char (point-min)) (if (search-forward "\nFrom: " nil t) (setq from (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq from "(Unknown User)")) ;; Extract Subject: (goto-char (point-min)) (if (search-forward "\nSubject: " nil t) (setq subject (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq subject "(None)")) ;; Extract Message-ID: (goto-char (point-min)) (if (search-forward "\nMessage-ID: " nil t) (setq message-id (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq message-id nil)) ;; Extract Date: (goto-char (point-min)) (if (search-forward "\nDate: " nil t) (setq date (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq date nil)) ;; Extract Lines: (goto-char (point-min)) (if (search-forward "\nLines: " nil t) (setq lines (string-to-int (buffer-substring (point) (save-excursion (end-of-line) (point))))) (setq lines 0)) ;; Extract Xref: (goto-char (point-min)) (if (search-forward "\nXref: " nil t) (setq xref (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq xref nil)) ;; Extract References: ;; If no References: field, use In-Reply-To: field instead. (goto-char (point-min)) (if (or (search-forward "\nReferences: " nil t) (search-forward "\nIn-Reply-To: " nil t)) (setq references (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq references nil)) ;; Collect valid article only. (and article message-id (setq headers (cons (vector article subject from xref lines date message-id references) headers))) )) (setq sequence (cdr sequence)) (setq count (1+ count)) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% count 20)) (message "NNSPOOL: Receiving headers... %d%%" (/ (* count 100) number))) ) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (message "NNSPOOL: Receiving headers... done")) (nreverse headers) ))) ;;; ;;; Replacement of NNTP Raw Interface. ;;; (defun nnspool-open-server (host &optional service) "Open news server on HOST. If HOST is nil, use value of environment variable `NNTPSERVER'. If optional argument SERVICE is non-nil, open by the service name." (let ((host (or host (getenv "NNTPSERVER"))) (status nil)) (setq nntp-status-string "") (cond ((and (file-directory-p nnspool-spool-directory) (file-exists-p nnspool-active-file) (string-equal host (system-name))) (setq status (nnspool-open-server-internal host service))) ((string-equal host (system-name)) (setq nntp-status-string (format "%s has no news spool. Goodbye." host))) ((null host) (setq nntp-status-string "NNTP server is not specified.")) (t (setq nntp-status-string (format "NNSPOOL: cannot talk to %s." host))) ) status )) (defun nnspool-close-server () "Close news server." (nnspool-close-server-internal)) (fset 'nnspool-request-quit (symbol-function 'nnspool-close-server)) (defun nnspool-server-opened () "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 nnspool-status-message () "Return server status response as string." nntp-status-string ) (defun nnspool-request-article (id) "Select article by message ID (or number)." (let ((file (if (stringp id) (nnspool-find-article-by-message-id id) (concat nnspool-current-directory (prin1-to-string id))))) (if (and (stringp file) (file-exists-p file) (not (file-directory-p file))) (save-excursion (nnspool-find-file file))) )) (defun nnspool-request-body (id) "Select article body by message ID (or number)." (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) "Select article head by message ID (or number)." (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-stat (id) "Select article by message ID (or number)." (setq nntp-status-string "NNSPOOL: STAT is not implemented.") nil ) (defun nnspool-request-group (group) "Select news GROUP." (let ((pathname (nnspool-article-pathname (nnspool-replace-chars-in-string group ?. ?/)))) (if (file-directory-p pathname) (setq nnspool-current-directory pathname)) )) (defun nnspool-request-list () "List active newsgoups." (save-excursion (nnspool-find-file nnspool-active-file))) (defun nnspool-request-list-newsgroups () "List newsgroups (defined in NNTP2)." (save-excursion (nnspool-find-file nnspool-newsgroups-file))) (defun nnspool-request-list-distributions () "List distributions (defined in NNTP2)." (save-excursion (nnspool-find-file nnspool-distributions-file))) (defun nnspool-request-last () "Set current article pointer to the previous article in the current news group." (setq nntp-status-string "NNSPOOL: LAST is not implemented.") nil ) (defun nnspool-request-next () "Advance current article pointer." (setq nntp-status-string "NNSPOOL: NEXT is not implemented.") nil ) (defun nnspool-request-post () "Post a new news in current buffer." (save-excursion ;; We have to work in the server buffer because of NEmacs hack. (copy-to-buffer nntp-server-buffer (point-min) (point-max)) (set-buffer nntp-server-buffer) (apply (function call-process-region) (point-min) (point-max) nnspool-inews-program 'delete t nil nnspool-inews-switches) (prog1 (or (zerop (buffer-size)) ;; If inews returns strings, it must be error message ;; unless SPOOLNEWS is defined. ;; This condition is very weak, but there is no good rule ;; identifying errors when SPOOLNEWS is defined. ;; Suggested by ohm@kaba.junet. (string-match "spooled" (buffer-string))) ;; Make status message by unfolding lines. (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) (setq nntp-status-string (buffer-string)) (erase-buffer)) )) ;;; ;;; Replacement of Low-Level Interface to NNTP Server. ;;; (defun nnspool-open-server-internal (host &optional service) "Open connection to news server on HOST by SERVICE (default is nntp)." (save-excursion (if (not (string-equal host (system-name))) (error "NNSPOOL: cannot talk to %s." host)) ;; Initialize communication buffer. (setq nntp-server-buffer (get-buffer-create " *nntpd*")) (set-buffer nntp-server-buffer) (buffer-flush-undo (current-buffer)) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. (setq nntp-server-process nil) (setq nntp-server-name host) ;; It is possible to change kanji-fileio-code in this hook. (run-hooks 'nntp-server-hook) t )) (defun nnspool-close-server-internal () "Close connection to news server." (if (get-file-buffer nnspool-history-file) (kill-buffer (get-file-buffer nnspool-history-file))) (if nntp-server-buffer (kill-buffer nntp-server-buffer)) (setq nntp-server-buffer nil) (setq nntp-server-process nil)) (defun nnspool-find-article-by-message-id (id) "Return full pathname of an article identified by message-ID." (save-excursion (let ((buffer (get-file-buffer nnspool-history-file))) (if buffer (set-buffer buffer) ;; Finding history file may take lots of time. (message "Reading history file...") (set-buffer (find-file-noselect nnspool-history-file)) (message "Reading history file... done"))) ;; Search from end of the file. I think this is much faster than ;; do from the beginning of the file. (goto-char (point-max)) (if (re-search-backward (concat "^" (regexp-quote id) "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t) (let ((group (buffer-substring (match-beginning 1) (match-end 1))) (number (buffer-substring (match-beginning 2) (match-end 2)))) (concat (nnspool-article-pathname (nnspool-replace-chars-in-string group ?. ?/)) number)) ))) (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-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 )) (provide 'nnspool) ;;; nnspool.el ends here emacs-19.22/lisp/nntp.el100444 12120 1 55166 5472074345 13420 0ustar rmsdaemon;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993 Free Software Foundation, Inc. ;; Author: 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: ;; This implementation is tested on both 1.2a and 1.5 version of the ;; NNTP package. ;; Troubleshooting of NNTP ;; ;; (1) Select routine may signal an error or fall into infinite loop ;; while waiting for the server response. In this case, you'd better ;; not use byte-compiled codes but original source. If you still have ;; a problems with it, set the variable `nntp-buggy-select' to T. ;; ;; (2) Emacs may hang up while retrieving headers since too many ;; requests have been sent to the NNTP server without reading their ;; replies. In this case, reduce the number of the requests sent to ;; the server at one time by setting the variable ;; `nntp-maximum-request' to a lower value. ;; ;; (3) If the TCP/IP stream (open-network-stream) is not supported by ;; emacs, compile and install `tcp.el' and `tcp.c' which is an ;; emulation program of the stream. If you modified `tcp.c' for your ;; system, please send me the diffs. I'll include some of them in the ;; future releases. ;;; Code: (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-server-name'.") (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 '(usg-unix-v 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.") (defconst nntp-version "NNTP 3.12" "Version numbers of this version of NNTP.") (defvar nntp-server-name nil "The name of the host running NNTP server.") (defvar nntp-server-buffer nil "Buffer associated with 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.") ;;; ;;; Extended Command for retrieving many headers. ;;; ;; Retrieving lots of headers by sending command asynchronously. ;; Access functions to headers are defined as macro. (defmacro nntp-header-number (header) "Return article number in HEADER." (` (aref (, header) 0))) (defmacro nntp-set-header-number (header number) "Set article number of HEADER to NUMBER." (` (aset (, header) 0 (, number)))) (defmacro nntp-header-subject (header) "Return subject string in HEADER." (` (aref (, header) 1))) (defmacro nntp-set-header-subject (header subject) "Set article subject of HEADER to SUBJECT." (` (aset (, header) 1 (, subject)))) (defmacro nntp-header-from (header) "Return author string in HEADER." (` (aref (, header) 2))) (defmacro nntp-set-header-from (header from) "Set article author of HEADER to FROM." (` (aset (, header) 2 (, from)))) (defmacro nntp-header-xref (header) "Return xref string in HEADER." (` (aref (, header) 3))) (defmacro nntp-set-header-xref (header xref) "Set article xref of HEADER to xref." (` (aset (, header) 3 (, xref)))) (defmacro nntp-header-lines (header) "Return lines in HEADER." (` (aref (, header) 4))) (defmacro nntp-set-header-lines (header lines) "Set article lines of HEADER to LINES." (` (aset (, header) 4 (, lines)))) (defmacro nntp-header-date (header) "Return date in HEADER." (` (aref (, header) 5))) (defmacro nntp-set-header-date (header date) "Set article date of HEADER to DATE." (` (aset (, header) 5 (, date)))) (defmacro nntp-header-id (header) "Return Id in HEADER." (` (aref (, header) 6))) (defmacro nntp-set-header-id (header id) "Set article Id of HEADER to ID." (` (aset (, header) 6 (, id)))) (defmacro nntp-header-references (header) "Return references (or in-reply-to) in HEADER." (` (aref (, header) 7))) (defmacro nntp-set-header-references (header ref) "Set article references of HEADER to REF." (` (aset (, header) 7 (, ref)))) (defun nntp-retrieve-headers (sequence) "Return list of article headers specified by SEQUENCE of article id. The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. If there is no References: field, In-Reply-To: field is used instead. Reader macros for the vector are defined as `nntp-header-FIELD'. Writer macros for the vector are defined as `nntp-set-header-FIELD'. Newsgroup must be selected before calling this." (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let ((number (length sequence)) (last-point (point-min)) (received 0) (count 0) (headers nil) ;Result list. (article 0) (subject nil) (message-id) (from nil) (xref nil) (lines 0) (date nil) (references nil)) ;; Send HEAD command. (while sequence (nntp-send-strings-to-server "HEAD" (car sequence)) (setq sequence (cdr sequence)) (setq 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 (accept-process-output) (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$"))) (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 " " t t)) ;;(delete-non-matching-lines ;; "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^References:\\|^[23]") (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (message "NNTP: Parsing headers...")) ;; Then examines replies. (goto-char (point-min)) (while (not (eobp)) (cond ((looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)") (setq article (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))) (setq message-id (buffer-substring (match-beginning 2) (match-end 2))) (forward-line 1) ;; Set default value. (setq subject nil) (setq xref nil) (setq from nil) (setq lines 0) (setq date nil) (setq references nil) ;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik) (while (and (not (eobp)) (not (memq (following-char) '(?2 ?3)))) (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ \t]+\\([^ \t\n]+.*\\)\r$") (let ((s (buffer-substring (match-beginning 2) (match-end 2))) (c (char-after (match-beginning 0)))) ;; We don't have to worry about letter case. (cond ((char-equal c ?F) ;From: (setq from s)) ((char-equal c ?S) ;Subject: (setq subject s)) ((char-equal c ?D) ;Date: (setq date s)) ((char-equal c ?L) ;Lines: (setq lines (string-to-int s))) ((char-equal c ?X) ;Xref: (setq xref s)) ((char-equal c ?R) ;References: (setq references s)) ;; In-Reply-To: should be used only when ;; there is no References: field. ((and (char-equal c ?I) ;In-Reply-To: (null references)) (setq references s)) ))) (forward-line 1)) ;; Finished to parse one header. (if (null subject) (setq subject "(None)")) (if (null from) (setq from "(Unknown User)")) ;; Collect valid article only. (and article message-id (setq headers (cons (vector article subject from xref lines date message-id references) headers))) ) (t (forward-line 1)) ) (setq received (1- received)) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (zerop (% received 20)) (message "NNTP: Parsing headers... %d%%" (/ (* received 100) number))) ) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) (message "NNTP: Parsing headers... done")) (nreverse headers) ))) ;;; ;;; Raw Interface to Network News Transfer Protocol (RFC977). ;;; (defun nntp-open-server (host &optional service) "Open news server on HOST. If HOST is nil, use value of environment variable `NNTPSERVER'. If optional argument SERVICE is non-nil, open by the service name." (let ((host (or host (getenv "NNTPSERVER"))) (status nil)) (setq nntp-status-string "") (cond ((and host (nntp-open-server-internal host service)) (setq status (nntp-wait-for-response "^[23].*\r$")) ;; Do check unexpected close of connection. ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet. (if status (set-process-sentinel nntp-server-process 'nntp-default-sentinel) ;; We have to close connection here, since function ;; `nntp-server-opened' may return incorrect status. (nntp-close-server-internal) )) ((null host) (setq nntp-status-string "NNTP server is not specified.")) ) status )) (defun nntp-close-server () "Close news server." (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) )) (fset 'nntp-request-quit (symbol-function 'nntp-close-server)) (defun nntp-server-opened () "Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL." (and nntp-server-process (memq (process-status nntp-server-process) '(open run)))) (defun nntp-status-message () "Return server status response as 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. "" )) (defun nntp-request-article (id) "Select article by message ID (or number)." (prog1 ;; If NEmacs, end of message may look like: "\256\215" (".^M") (nntp-send-command "^\\.\r$" "ARTICLE" id) (nntp-decode-text) )) (defun nntp-request-body (id) "Select article body by message ID (or number)." (prog1 ;; If NEmacs, end of message may look like: "\256\215" (".^M") (nntp-send-command "^\\.\r$" "BODY" id) (nntp-decode-text) )) (defun nntp-request-head (id) "Select article head by message ID (or number)." (prog1 (nntp-send-command "^\\.\r$" "HEAD" id) (nntp-decode-text) )) (defun nntp-request-stat (id) "Select article by message ID (or number)." (nntp-send-command "^[23].*\r$" "STAT" id)) (defun nntp-request-group (group) "Select news GROUP." ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to ;; end of the status message. (nntp-send-command "^[23].*$" "GROUP" group)) (defun nntp-request-list () "List active newsgroups." (prog1 (nntp-send-command "^\\.\r$" "LIST") (nntp-decode-text) )) (defun nntp-request-list-newsgroups () "List newsgroups (defined in NNTP2)." (prog1 (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS") (nntp-decode-text) )) (defun nntp-request-list-distributions () "List distributions (defined in NNTP2)." (prog1 (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS") (nntp-decode-text) )) (defun nntp-request-last () "Set current article pointer to the previous article in the current news group." (nntp-send-command "^[23].*\r$" "LAST")) (defun nntp-request-next () "Advance current article pointer." (nntp-send-command "^[23].*\r$" "NEXT")) (defun nntp-request-post () "Post a new news in current buffer." (if (nntp-send-command "^[23].*\r$" "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].*$") ))) (defun nntp-default-sentinel (proc status) "Default sentinel function for NNTP server process." (if (and nntp-server-process (not (nntp-server-opened))) (error "NNTP: Connection closed.") )) ;; 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)) (if (not (bolp)) (insert "\n")) ;; Delete status line. (goto-char (point-min)) (delete-region (point) (progn (forward-line 1) (point))) ;; Delete `^M' at end of line. ;; (replace-regexp "\r$" "") (while (not (eobp)) (end-of-line) (if (= (preceding-char) ?\r) (delete-char -1)) (forward-line 1) ) ;; Delete `.' at end of buffer (end of text mark). (goto-char (point-max)) (forward-line -1) ;(beginning-of-line) (if (looking-at "^\\.$") (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)) (if (not (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) "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)) (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) ;;(if nntp-debug-read (message "")) )) ;; Remove "...". (if (and nntp-debug-read (> dotnum 0)) (message "")) ;; Successfully received server response. t )) ))) ;;; ;;; Low-Level Interface to NNTP Server. ;;; (defun nntp-send-strings-to-server (&rest strings) "Send list of STRINGS to news server as command and its arguments." (let ((cmd (car strings)) (strings (cdr strings))) ;; Command and each argument must be separated by one or more spaces. (while strings (setq cmd (concat cmd " " (car strings))) (setq strings (cdr strings))) ;; Command line must be terminated by a CR-LF. (process-send-string nntp-server-process (concat cmd "\r\n")) )) (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-internal (host &optional service) "Open connection to news server on HOST by SERVICE (default is nntp)." (save-excursion ;; Use TCP/IP stream emulation package if needed. (or (fboundp 'open-network-stream) (require 'tcp)) ;; Initialize communication buffer. (setq nntp-server-buffer (get-buffer-create " *nntpd*")) (set-buffer nntp-server-buffer) (buffer-flush-undo (current-buffer)) (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. (setq nntp-server-process (open-network-stream "nntpd" (current-buffer) host (or service "nntp"))) (setq nntp-server-name host) ;; It is possible to change kanji-fileio-code in this hook. (run-hooks 'nntp-server-hook) ;; Return the server process. nntp-server-process )) (defun nntp-close-server-internal () "Close connection to news server." (if nntp-server-process (delete-process nntp-server-process)) (if nntp-server-buffer (kill-buffer nntp-server-buffer)) (setq nntp-server-buffer nil) (setq nntp-server-process nil)) (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'. (or (memq (process-status nntp-server-process) '(open run)) (error "NNTP: Connection closed.")) (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)))) )) )) (provide 'nntp) ;;; nntp.el ends here emacs-19.22/lisp/novice.el100444 12120 1 10425 5377257523 13716 0ustar rmsdaemon;;; novice.el --- handling of disabled commands ("novice mode") for Emacs. ;; Copyright (C) 1985, 1986, 1987 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*" (if (= (aref (this-command-keys) 0) ?\M-x) (princ "You have invoked the disabled command ") (princ "You have typed ") (princ (key-description (this-command-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).")) (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 (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 "~/.emacs"))) (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))) ;; Must have been disabled by default. (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: ") (put command 'disabled t) (save-excursion (set-buffer (find-file-noselect (substitute-in-file-name "~/.emacs"))) (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 "(put '" (symbol-name command) " 'disabled t)\n") (save-buffer))) ;;; novice.el ends here emacs-19.22/lisp/nroff-mode.el100444 12120 1 16405 5400766135 14462 0ustar rmsdaemon;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source ;; Copyright (C) 1985, 1986 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. ;;; Code: (defvar nroff-mode-abbrev-table nil "Abbrev table used while in nroff mode.") (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))) ;;;###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) (set-syntax-table text-mode-syntax-table) (setq local-abbrev-table nroff-mode-abbrev-table) (make-local-variable 'nroff-electric-mode) (setq nroff-electric-mode nil) ;; 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)) ;;; 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.22/lisp/options.el100444 74777 1 11131 5353347760 14271 0ustar ericdaemon;;; 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)))))) ;;;###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 (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.22/lisp/outline.el100444 11732 1 41121 5446736303 14247 0ustar bfoxdaemon;;; outline.el --- outline mode commands for Emacs ;; Copyright (C) 1986, 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 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 "[*\^l]+" "*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-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-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\C-n" 'outline-next-visible-heading) (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading) (define-key outline-mode-map "\C-c\C-i" 'show-children) (define-key outline-mode-map "\C-c\C-s" 'show-subtree) (define-key outline-mode-map "\C-c\C-h" 'hide-subtree) (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading) (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level) (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level) (define-key outline-mode-map [menu-bar hide] (cons "Hide" (make-sparse-keymap "Hide"))) (define-key outline-mode-map [menu-bar hide hide-subtree] '("Hide Subtree" . hide-subtree)) (define-key outline-mode-map [menu-bar hide hide-entry] '("Hide Entry" . hide-entry)) (define-key outline-mode-map [menu-bar hide hide-body] '("Hide Body" . hide-body)) (define-key outline-mode-map [menu-bar hide hide-leaves] '("Hide Leaves" . hide-leaves)) (define-key outline-mode-map [menu-bar show] (cons "Show" (make-sparse-keymap "Show"))) (define-key outline-mode-map [menu-bar show show-subtree] '("Show Subtree" . show-subtree)) (define-key outline-mode-map [menu-bar show show-children] '("Show Children" . show-children)) (define-key outline-mode-map [menu-bar show show-branches] '("Show Branches" . show-branches)) (define-key outline-mode-map [menu-bar show show-entry] '("Show Entry" . show-entry)) (define-key outline-mode-map [menu-bar show show-all] '("Show All" . show-all)) (define-key outline-mode-map [menu-bar headings] (cons "Headings" (make-sparse-keymap "Headings"))) (define-key outline-mode-map [menu-bar headings outline-backward-same-level] '("Previous Same Level" . outline-backward-same-level)) (define-key outline-mode-map [menu-bar headings outline-forward-same-level] '("Next Same Level" . outline-forward-same-level)) (define-key outline-mode-map [menu-bar headings outline-previous-visible-heading] '("Previous" . outline-previous-visible-heading)) (define-key outline-mode-map [menu-bar headings outline-next-visible-heading] '("Next" . outline-next-visible-heading)) (define-key outline-mode-map [menu-bar headings outline-up-heading] '("Up" . outline-up-heading))) (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) (setq minor-mode-alist (append minor-mode-alist (list '(outline-minor-mode " Outl")))) ;;;###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 M-x hide-body make all text invisible (not headings). M-x 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. M-x hide-entry make immediately following body invisible. M-x show-entry make it visible. M-x hide-leaves make body under heading and under its subheadings invisible. The subheadings remain visible. M-x 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 "\\)")) (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.") (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] (lookup-key outline-mode-map [menu-bar])) (define-key outline-minor-mode-map outline-minor-mode-prefix (lookup-key outline-mode-map "\C-c"))) (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)) (set-buffer-modified-p (buffer-modified-p))) (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.") (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 column number of the end of what `outline-regexp matches'." (save-excursion (looking-at outline-regexp) (save-excursion (goto-char (match-end 0)) (current-column)))) (defun outline-next-preface () "Skip forward to just before the next heading line." (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 (possibly invisible) heading line, or to the beginning of this line if it is a heading line." (beginning-of-line) (or (outline-on-heading-p) (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move))) (defun outline-on-heading-p () "Return T if point is on a header line." (save-excursion (beginning-of-line) (and (eq (preceding-char) ?\n) (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)) (re-search-forward (concat "^\\(" outline-regexp "\\)") nil nil 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 `\\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 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)) (forward-char -1) (if (memq (preceding-char) '(?\n ?\^M)) (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 (beginning-of-line) (let ((start-level (funcall outline-level))) (outline-next-heading) (max 1 (- (funcall outline-level) start-level)))))) (save-excursion (save-restriction (beginning-of-line) (setq level (+ level (funcall outline-level))) (narrow-to-region (point) (progn (outline-end-of-subtree) (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 from here of the same level as the present one. It stops 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 () "Position the point at the next heading of the same level, and return that position or nil if it cannot be found." (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 from here of the same level as the present one. It stops 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 () "Position the point at the previous heading of the same level, and return that position or nil if it cannot be found." (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.22/lisp/page-ext.el100444 12120 1 67155 5471622574 14156 0ustar rmsdaemon;;; 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 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 "^ " "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 "^ ") (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)) (forward-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.22/lisp/page.el100444 12120 1 10764 5471623040 13337 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) (if (re-search-backward page-delimiter nil t) (goto-char (match-end 0)) (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.22/lisp/paragraphs.el100444 12120 1 21137 5432375216 14555 0ustar rmsdaemon;;; paragraphs.el --- paragraph and sentence parsing. ;; Copyright (C) 1985, 86, 87, 1991 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: (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). The variable `paragraph-separate' specifies how to distinguish lines that start paragraphs from lines that separate them.") (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.") (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 forward 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))) (paragraph-separate (if fill-prefix-regexp (concat paragraph-separate "\\|^" fill-prefix-regexp "[ \t]*$") paragraph-separate))) (while (< arg 0) (if (and (not (looking-at paragraph-separate)) (re-search-backward "^\n" (max (1- (point)) (point-min)) t)) nil (forward-char -1) (beginning-of-line) (while (and (not (bobp)) (looking-at paragraph-separate)) (forward-line -1)) (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. (progn (while (progn (beginning-of-line) (and (not (bobp)) (not (looking-at paragraph-separate)) (looking-at fill-prefix-regexp))) (forward-line -1)) (not (bobp))) (re-search-backward paragraph-start nil t)) ;; Found one. (progn (while (and (not (eobp)) (looking-at paragraph-separate)) (forward-line 1)) (if (eq (char-after (- (point) 2)) ?\n) (forward-line -1))) ;; No starter or separator line => use buffer beg. (goto-char (point-min)))) (setq arg (1+ arg))) (while (> arg 0) (beginning-of-line) (while (prog1 (and (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)) (not (looking-at paragraph-separate)) (looking-at fill-prefix-regexp)) (forward-line 1)) (if (re-search-forward paragraph-start nil t) (goto-char (match-beginning 0)) (goto-char (point-max)))) (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) (save-excursion (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) (save-excursion (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) (save-excursion (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) (save-excursion (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.22/lisp/paren.el100444 12120 1 11402 5432353026 13517 0ustar rmsdaemon;;; 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 input is pending. (if (and window-system (sit-for 0)) (let (pos dir mismatch (oldpos (point)) (face show-paren-face)) (cond ((eq (char-syntax (following-char)) ?\() (setq dir 1)) ((eq (char-syntax (preceding-char)) ?\)) (setq dir -1))) (if dir (save-excursion (save-restriction ;; Determine the range within which to look for a match. (if blink-matching-paren-distance (narrow-to-region (max (point-min) (- (point) blink-matching-paren-distance)) (min (point-max) (+ (point) blink-matching-paren-distance)))) ;; Scan across one sexp within that range. (condition-case () (setq pos (scan-sexps (point) dir)) (error nil)) ;; See if the "matching" paren is the right kind of paren ;; to match the one we started at. (if pos (let ((beg (min pos oldpos)) (end (max pos oldpos))) (and (/= (char-syntax (char-after beg)) ?\$) (setq mismatch (/= (char-after (1- end)) (logand (lsh (aref (syntax-table) (char-after beg)) -8) 255)))))) ;; If they don't properly match, use a different face, ;; or print a message. (if mismatch (progn (and (null show-paren-mismatch-face) (x-display-color-p) (or (setq show-paren-mismatch-face (internal-find-face 'paren-mismatch)) (progn (make-face 'paren-mismatch) (setq show-paren-mismatch-face 'paren-mismatch) (set-face-background 'paren-mismatch "purple")))) (if show-paren-mismatch-face (setq face show-paren-mismatch-face) (message "Paren mismatch")))) ))) (cond (pos (if (= dir -1) ;; If matching backwards, highlight the closeparen ;; before point as well as its matching open. (progn (if show-paren-overlay-1 (move-overlay show-paren-overlay-1 (+ (point) dir) (point) (current-buffer)) (setq show-paren-overlay-1 (make-overlay (- pos dir) pos))) (overlay-put show-paren-overlay-1 'face face)) ;; Otherwise, turn off any such highlighting. (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1) (delete-overlay show-paren-overlay-1))) ;; Turn on highlighting for the matching paren. (if show-paren-overlay (move-overlay show-paren-overlay (- pos dir) pos (current-buffer)) (setq show-paren-overlay (make-overlay (- pos dir) pos))) (overlay-put show-paren-overlay 'face face)) (t ;; If not at a paren that has a match, ;; turn off any previous paren highlighting. (and show-paren-overlay (overlay-buffer show-paren-overlay) (delete-overlay show-paren-overlay)) (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1) (delete-overlay show-paren-overlay-1))))))) (if window-system (progn (setq blink-paren-function nil) (add-hook 'post-command-hook 'show-paren-command-hook))) ;;; This is in case paren.el is preloaded. (add-hook 'window-setup-hook (function (lambda () (if window-system (progn (setq blink-paren-function nil) (add-hook 'post-command-hook 'show-paren-command-hook)))))) (provide 'paren) ;;; paren.el ends here emacs-19.22/lisp/pascal.el100444 12120 1 104401 5467455733 13717 0ustar rmsdaemon;;; pascal.el - Major mode for editing pascal source in emacs. ;;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Espen Skoglund (espensk@stud.cs.uit.no) ;; 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: ;;; If you want to customize the pascal mode in your startup file, you ;;; can add these lines to your .emacs file (and remove the ;s at the ;;; beginning of the line): ;;; ;;; ;;; Pascal-mode custumization. ;;; (autoload 'pascal-mode "pascal-mode" nil t) ;;; (setq auto-mode-alist (append (list (cons "\\.p$" 'pascal-mode) ;;; (cons "\\.pas$" 'pascal-mode)) ;;; auto-mode-alist)) ;;; (setq pascal-mode-hook '(lambda () ;;; ;; User specifications ;;; (setq pascal-tab-always-indent t ;;; pascal-auto-newline nil ;;; pascal-auto-endcomments t ;;; pascal-indent-level 3 ;;; pascal-continued-expr 1 ;;; pascal-label-offset -2 ;;; pascal-case-offset 2 ;;; pascal-typedecl-indent 10 ;;; pascal-vardecl-indent 20))) ;;; USAGE ;;; ===== ;;; If you have modified your startup file as described above, emacs ;;; should enter pascal-mode when you load a pascal source into emacs. ;;; If not, you will have to start pascal-mode manually: ;;; M-x load-library pascal-mode ;;; M-x pascal-mode ;;; 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 d ;;; 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. But if you DO ;;; find any bugd, you may submitt them to: espensk@stud.cs.uit.no ;;; LCD Archive Entry: ;;; pascal-mode|Espen Skoglund|espensk@stud.cs.uit.no| ;;; Major mode for editing Pascal code| ;;; 14-Sep-93|$Revision: 1.1 $|~/modes/pascal-mode.el.Z| (defconst pascal-mode-version "1.3" "Version of this pascal mode.") (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 (null pascal-mode-map) (setq pascal-mode-map (make-sparse-keymap))) (define-key pascal-mode-map ";" 'electric-pascal-semi) (define-key pascal-mode-map "." 'electric-pascal-dot) (define-key pascal-mode-map ":" 'electric-pascal-colon) (define-key pascal-mode-map "=" 'electric-pascal-equal) (define-key pascal-mode-map "\r" 'electric-pascal-terminate-line) (define-key pascal-mode-map "\t" 'electric-pascal-tab) (define-key pascal-mode-map "\177" 'backward-delete-char-untabify) (define-key pascal-mode-map "\C-\M-a" 'pascal-backward-to-beginning-of-function) (define-key pascal-mode-map "\C-\M-e" 'pascal-forward-to-end-of-function) (define-key pascal-mode-map "\C-\M-h" 'pascal-mark-function) (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block) (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-*" 'pascal-star-comment) ;;; 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-c\C-l" 'pascal-downcase-keywords) ;;;(define-key pascal-mode-map "\C-c\C-u" 'pascal-upcase-keywords) ;;;(define-key pascal-mode-map "\C-c\C-c" 'pascal-capitalize-keywords) (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")) (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)) (defconst pascal-indent-level 3 "*Indentation of Pascal statements with respect to containing block.") (defconst pascal-continued-expr 1 "*Indentation of line that is a continued expression.") (defconst pascal-label-offset -1 "*Offset of Pascal label lines, case statements and record lines. This is relative to usual indentation.") (defconst pascal-case-offset 2 "*Indentation after case statements.") (defconst pascal-vardecl-indent 15 "*Indentation (from the beginning of line to `:' of the declaration.") (defconst pascal-typedecl-indent 10 "*Indentation (from the beginning of line to `=' of the declaration.") (defconst pascal-auto-newline nil "*Non-nil means automatically newline after semicolons and `end'.") (defconst pascal-tab-always-indent t "*Non-nil means TAB in Pascal mode should always reindent the current line. It does so regardless of where in the line point is when the TAB command is used.") (defconst pascal-auto-endcomments t "*Non-nil means make a comment { ... } after the end for a case or function. The name of the function or case is put between the braces.") ;;;###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-mode-map} Variables controlling indentation style: 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-newline (default nil) Non-nil means automatically newline after semicolons and the punctation mark after an end. pascal-auto-endcomments (default t) Non-nil means automatically set name of function or `case' in braces after after the `end' if this end ends a function or a case block. pascal-indent-level (default 3) Indentation of Pascal statements within surrounding block. pascal-continued-expr (default 1) Indentation of a line that is a continued expression. pascal-typedecl-indent (default 10) Indentation to the `=' in type declarations. (Or constant declarations.) pascal-vardecl-indent (default 20) Indentation to the `:' in var declarations. pascal-label-offset (default -1) Extra indentation for line that is a label, case statement or part of a record block. pascal-case-offset (default 2) Extra indent to the `:' in case statements. The only auto indention this mode doesn't fully support is if there is a case within a type declaration. However, this is seldom used. When typing text, you should not worry about to get right indentions, they will be set when you hit return. The mode will also automatically delete the whitespaces between `*' and `)' when ending a starcomment. 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-hook 'pascal-indent-within-comment) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (make-local-variable 'case-fold-search) (setq case-fold-search t) (run-hooks 'pascal-mode-hook)) ;;; ;;; Electric functions ;;; (defun electric-pascal-terminate-line () "Terminate line and indent next line." (interactive) (save-excursion (beginning-of-line) (skip-chars-forward " \t") (if (looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b") (pascal-indent-line))) (newline) (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) (pascal-delete-whitespaces)) ((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 setstar (progn (insert "*") (pascal-indent-command)) (pascal-indent-line)))) (defun electric-pascal-semi () "Insert ; character and correct this line's indention." (interactive) (insert last-command-char) (save-excursion (beginning-of-line) (pascal-indent-line)) (if pascal-auto-newline (electric-pascal-terminate-line))) (defun electric-pascal-dot () "Insert a period and correct this line's indention." (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 of within string. (if (not (pascal-within-string)) (progn (if (save-excursion (backward-char 2) (looking-at "[0-9]")) (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 (nth 1 (pascal-calculate-indent t)) 'decl) (let ((pascal-tab-always-indent nil)) (pascal-indent-command)))) (defun electric-pascal-tab () "Function called when tab is pressed." (interactive) ;; Do nothing if within a string. (if (not (pascal-within-string)) ;; If pascal-tab-always-indent is set then indent the beginning of ;; the line. (progn (if pascal-tab-always-indent (save-excursion (beginning-of-line) (pascal-indent-line))) (pascal-indent-command)))) ;;; ;;; Interactive functions ;;; (defun pascal-insert-block () "Insert begin ... end; block in the code with right indents." (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 star comment in the code." (interactive) (pascal-indent-line) (insert "(*") (electric-pascal-terminate-line) (save-excursion (electric-pascal-terminate-line) (pascal-delete-whitespaces) (insert ")"))) (defun pascal-mark-function () "Mark the current pascal function (or procedure). Put the mark at the end of the function, and point at the beginning." (interactive) (push-mark (point)) (pascal-forward-to-end-of-function) (push-mark (point)) (pascal-backward-to-beginning-of-function) (zmacs-activate-region)) (defun pascal-comment-area (start end) "Put the current region in a comment. The comments that are in this area are be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will however be turned back to normal when the area is uncommented by pressing \\[pascal-uncomment-area]. The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with: ` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area will not be able to recognize them." (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 " ---/\\---EXCLUDED---/\\---}") (setq end (point)) (newline) (goto-char start) (beginning-of-line) (insert "{---\\/---EXCLUDED---\\/--- ") (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 all deformed comments in this area back to normal. This function 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 "{---\\/---EXCLUDED---\\/--" nil t) (point))) (setq end (progn (search-forward "---/\\---EXCLUDED---/\\---}" 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-backward-to-beginning-of-function () "Move backwards to the beginning of this function or procedure." (interactive) ;; Check if this is a (if (save-excursion (re-search-backward "\\\\|\\<") nil t) (funcall change-word -1)))) ;;; ;;; Other functions ;;; (defun pascal-delete-whitespaces () "Deletes the whitespaces around the current point." (interactive) (let ((pos (progn (skip-chars-backward " \t") (point)))) (skip-chars-forward " \t") (delete-region pos (point)))) (defun pascal-get-beg-of-line () (save-excursion (beginning-of-line) (point))) (defun pascal-get-end-of-line () (save-excursion (end-of-line) (point))) (defun pascal-within-string () "Return t if within string; nil otherwise." (and (save-excursion (search-backward "\"" (pascal-get-beg-of-line) t)) (save-excursion (not (search-backward "\"" (pascal-get-beg-of-line) t 2))))) (defun pascal-check-if-within-comment () "If within a comment, return the correct indent. Return nil otherwise." (let ((comstart (point)) (comend (point))) (save-excursion (if (re-search-backward "(\\*\\|{" nil t) (setq comstart (point)) (setq comstart 0))) (save-excursion (if (re-search-backward "\\*)\\|}" nil t) (setq comend (point)) (setq comend 0))) (if (< comend comstart) (save-excursion (goto-char comstart) ;; Add 1 to indent if this is a starcomment (if (looking-at "(\\*") (1+ (current-column)) (current-column))) nil))) (defun pascal-set-auto-comments () "Put { case } or { FUNNAME } on this line if appropriate after `end'." (save-excursion (forward-line -1) (skip-chars-forward " \t") (if (and (looking-at "end\\(\>\\|;\\)") (not (save-excursion (end-of-line) (search-backward "}" (pascal-get-beg-of-line) t)))) (progn (if (eq (nth 1 (pascal-calculate-indent)) 'case) ;; This is a case block (progn (end-of-line) (pascal-delete-whitespaces) (insert " { case }")) (let ((nest 1)) ;; Check if this is the end of a function (save-excursion (while (not (or (looking-at "function\\b\\|\\procedure\\b") (bobp))) (backward-sexp 1) (cond ((looking-at "begin\\b\\|case\\b") (setq nest (1- nest))) ((looking-at "end\\(\\b\\|;\\|\\.\\)") (setq nest (1+ nest))))) (if (bobp) (setq nest 1))) (if (zerop nest) (let ((last-command nil)) ;; Find the function name and put it in braces (save-excursion (pascal-backward-to-beginning-of-function) (skip-chars-forward "^ \t") (skip-chars-forward " \t") (copy-region-as-kill (point) (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))) (end-of-line) (pascal-delete-whitespaces) (insert " { ") ;; We've filled up the kill ring, but hey, who cares? (yank) (rotate-yank-pointer 1) (insert " }"))))))))) ;;; ;;; Indent functions and calculation of indent ;;; (defun pascal-indent-command () "Indent current line as Pascal code and/or indent within line." ;; Call pascal-indent-line. This does nothing if we're not at the ;; beginning of the line. (pascal-indent-line) (let ((indent (pascal-calculate-indent t)) (pos 0)) (save-excursion (cond ((or (eq (nth 1 indent) 'case) (eq (nth 1 indent) 'record)) ;; Indent for case and record blocks (beginning-of-line) (if (search-forward ":" (pascal-get-end-of-line) t) (progn ;; Indent before colon (backward-char 1) (pascal-delete-whitespaces) (indent-to (max (pascal-find-leading-case-colon) (1+ (current-column)))) ;; Indent after colon (forward-char 1) (pascal-delete-whitespaces) (indent-to (1+ (current-column)))) ;; Indent if there is no colon (progn (beginning-of-line) (skip-chars-forward " \t") (if (not (eolp)) (progn (skip-chars-forward "0-9a-zA-Z\"\'_;") (pascal-delete-whitespaces) (indent-to (max (pascal-find-leading-case-colon) (1+ (current-column))))))))) ((eq (nth 1 indent) 'decl) ;; Indent for declarations (let ((posii (pascal-get-beg-of-line))) (re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>" nil t) (cond ((looking-at "var\\b") (pascal-declindent-middle-of-line ":" posii pascal-vardecl-indent)) ((looking-at "type\\b\\|const\\b") (pascal-declindent-middle-of-line "=" posii pascal-typedecl-indent))))) ((eq (nth 1 indent) 'function) ;; Indent for parameterlist ;; Done twice in case something has changed (pascal-indent-parameter-list) (pascal-indent-parameter-list)))) ;; Go to the end of a line if rest of line contains only whitespaces (if (save-excursion (skip-chars-forward " \t") (eolp)) (end-of-line)))) (defun pascal-indent-line () "Indent current line as Pascal code." (let ((indent (list 0 nil)) (comindent 0) beg (point)) (save-excursion (beginning-of-line) (setq indent (pascal-calculate-indent))) ;; If we are inside a comment, do special indent. (if (setq comindent (pascal-check-if-within-comment)) (pascal-indent-within-comment comindent) ;; Skip the rest if we're not standing on the beginning of a line. (if (save-excursion (skip-chars-backward " \t") (bolp)) (progn (beginning-of-line) (pascal-delete-whitespaces) ;; When to skip the ekstra indent: ;; If we are standing at end or until. ;; If we are in an if statement and standing at else, ;; begin or repeat ;; If we are in a with, while or for statement and standing ;; at begin or end. (cond ((or (or (looking-at "end\\b\\|until\\b") (not (nth 1 indent))) (and (eq (nth 1 indent) 'if) (looking-at "begin\\b\\|\\repeat\\b\\|else\\b")) (and (eq (nth 1 indent) 'whilewith) (looking-at "begin\\b\\|\\repeat\\b"))) (indent-to (car indent))) ;; Continued expression ((eq (nth 1 indent) 'contexp) (indent-to (+ (car indent) pascal-continued-expr))) ;; If this is a part of a case or record block, ;; then modify the indent level. ((or (eq (nth 1 indent) 'case) (eq (nth 1 indent) 'record)) (indent-to (+ (car indent) pascal-indent-level pascal-label-offset))) ;; If this is a label - don't indent. ((looking-at "[0-9]*:") (skip-chars-forward "0-9:") (pascal-delete-whitespaces) (indent-to (+ (car indent) pascal-indent-level))) ;; If this is insde a parameter list, do special indent ((eq (nth 1 indent) 'function) (pascal-indent-parameter-list)) ;; All other indents are set normaly. (t (indent-to (+ (car indent) pascal-indent-level))))))))) (defun pascal-calculate-indent (&optional arg) "Search backward in code to find the right indent level. Return a list containing: 1. Indent level 2. The indent keyword (begin, case etc.), or nil if backtracking failed. If arg is non-nil, we do not search for continued expressions." (let ((pascal-nest-depth 1) (oldpos (save-excursion (forward-line -1) (end-of-line) (point))) (samepos (point)) (if-is-set t) (return-struct (list 0 nil)) (pos 0) (contexpr nil) (after-contexpr (not arg)) (case-fold-search t)) (save-excursion (while (and (not (zerop pascal-nest-depth)) (not (bobp))) (progn (backward-sexp 1) (if (save-excursion (setq pos (point)) (end-of-line) (search-backward ";" pos t)) (setq if-is-set nil after-contexpr nil)) (if (looking-at "then\\b\\|end\\b\\|else\\b\\|do\\b") (setq after-contexpr nil)) (cond ((looking-at "begin\\b\\|case\\b\\|record\\b\\|repeat\\b") (setq pascal-nest-depth (1- pascal-nest-depth))) ;; ;; END | UNTIL ((looking-at "end\\(\\b\\|;\\|\\.\\)\\|until\\b") (setq if-is-set nil) (if after-contexpr (setq pascal-nest-depth 0 contexpr t) (setq pascal-nest-depth (1+ pascal-nest-depth)))) ;; ;; IF | ELSE | WITH | WHILE | FOR ;; LABEL | CONST | TYPE | FUNCTION | PROCEDURE ((or (and (looking-at "if\\b\\|else\\b\\|with\\b\\|while\\b\\|for\\b") if-is-set) (looking-at "label\\b\\|const\\b\\|type\\b\\|function\\b\\|procedure\\b")) (setq pascal-nest-depth 0)) ;; ;; VAR ((looking-at "var\\b") ;; A `var' can be in a declaration part or parameter part (let ((stpos 0) (edpos 0)) (save-excursion (if (not (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t)) (beginning-of-buffer)) (setq stpos (save-excursion (search-forward "(" nil t) (point))) (setq edpos (save-excursion (search-forward ")" nil t) (point)))) (cond ((or (= stpos edpos) (< samepos stpos) (and (> (point) edpos) (> edpos stpos))) ;; This is really a declaration block!! nil) ((and (>= samepos stpos) (or (< samepos edpos) (> stpos edpos))) ;; Hmm... part of a parameter (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t)) (t ;; This is just after a parameter declaration (forward-char 1))) ;; We'll quit anyway (setq pascal-nest-depth 0))) ;; ;; CONTINUED EXPRESSIONS (after-contexpr (save-excursion ;; First, we have to be at the begining of a line (if (and (progn (skip-chars-backward " \t") (bolp)) ;; Blank lines don't count (not (progn (skip-chars-forward " \t") (eolp))) ;; But nonblank without ';' do (not (search-forward ";" (pascal-get-end-of-line) t))) (save-excursion (forward-line -1) (end-of-line) (backward-sexp 1) (if (or (looking-at "\\(do\\|then\\|of\\\|begin\\|repeat\\|else\\)\\>") (progn (skip-chars-forward "^; " (pascal-get-end-of-line)) (equal (char-to-string (following-char)) ";"))) (setq pascal-nest-depth 0)) (setq contexpr t))))) ))) (cond (contexpr (setq return-struct (list (pascal-lstart-col) 'contexp))) ((looking-at "begin\\b") (setq return-struct (list (pascal-lstart-col) 'begin))) ((looking-at "else\\b") (setq return-struct (list (save-excursion (re-search-backward "if\\b" nil t) (pascal-lstart-col)) 'if)) ;; Indent line in case this is a multiple if (beginning-of-line) (pascal-delete-whitespaces) (indent-to (car return-struct))) ((looking-at "if\\b") (if (save-excursion (narrow-to-region (pascal-get-beg-of-line) (point)) (backward-sexp 1) (widen) (looking-at "else\\b")) ;; Indent line if this is a multiple if (progn (beginning-of-line) (pascal-delete-whitespaces) (indent-to (save-excursion (re-search-backward "if\\b" nil t) (pascal-lstart-col))))) ;; This could be a continued expression (if (and after-contexpr (not (save-excursion (re-search-forward "then\\b" (pascal-get-end-of-line) t)))) (setq return-struct (list (pascal-lstart-col) 'contexp)) (setq return-struct (list (pascal-lstart-col) 'if)))) ((looking-at "repeat\\b") (setq return-struct (list (pascal-lstart-col) 'repeat))) ((looking-at "case\\b") (setq return-struct (list (current-column) 'case))) ((looking-at "record\\b") (setq return-struct (list (current-column) 'record))) ((looking-at "while\\b\\|with\\b\\|for\\b") ;; This could ba a continued expression (if (and after-contexpr (not (save-excursion (re-search-forward "do\\b" (pascal-get-end-of-line) t)))) (setq return-struct (list (pascal-lstart-col) 'contexp)) (setq return-struct (list (current-column) 'whilewith)))) ((looking-at "procedure\\b\\|function\\b") ;; Make sure that this is a function with parameters, and ;; that we are actually standing inside the paranthesis. (let ((spos (save-excursion (search-forward "(" samepos t) (point))) (epos (save-excursion (search-forward ")" samepos t) (point)))) (if (and (>= samepos spos) (or (< samepos epos) (> spos epos))) (setq return-struct (list 0 'function)) (setq return-struct (list 0 nil))))) ((looking-at "var\\b\\|label\\b\\|const\\b\\|type\\b") ;; Are we really in the declaration part?(Check for blank lines) (if (< oldpos (point)) (setq return-struct (list 0 'decl)) (if (save-excursion (not (re-search-forward "^[ \t]*$" oldpos t))) (setq return-struct (list 0 'decl)) (setq return-struct (list 0 nil))))) (t (setq return-struct (list 0 nil)))) return-struct))) (defun pascal-lstart-col () "Return the column of the beginning of the first command on the line." (save-excursion (beginning-of-line) (skip-chars-forward ":0-9") (skip-chars-forward " \t") (current-column))) (defun pascal-indent-parameter-list () "Indent this line as part of a parameter list in a function." (let ((indents (pascal-get-highest-indents-in-parameterlist)) (pos 0)) (if (not (progn (beginning-of-line) (search-forward "(" (pascal-get-end-of-line) t))) (progn (beginning-of-line) (skip-chars-forward " \t"))) ;; Indent region in front of var (skip-chars-forward " \t") (pascal-delete-whitespaces) (indent-to (nth 0 indents)) (if (looking-at "var\\b") (forward-char 3)) ;; Indent parameternames (pascal-delete-whitespaces) (indent-to (nth 1 indents)) (if (not (save-excursion (skip-chars-forward " \t") (eolp))) (progn ;; Indent colon (if (search-forward ":" (pascal-get-end-of-line) t) (backward-char 1) (end-of-line)) (pascal-delete-whitespaces) (indent-to (nth 2 indents)) ;; Indent after colon (if (equal (following-char) ?:) (progn (forward-char 1) (pascal-delete-whitespaces) (indent-to (+ 2 (nth 2 indents))))))))) ;; Get the indents to use in a parameterlist. ;; Returns: ;; 1. Indent to the beginning of the line. ;; 2. Indent to the beginning of the parameter names. ;; 3. Indent to the right colon position." (defun pascal-get-highest-indents-in-parameterlist () (save-excursion (let ((start (progn (re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t) (search-forward "(") (current-column))) (arglength 0) (vardecl nil) (done nil)) (while (not (or done (eobp))) (beginning-of-line) (if (save-excursion (re-search-forward "\\" (pascal-get-end-of-line) t)) (setq vardecl t)) (if (not (re-search-forward ":" (pascal-get-end-of-line) t)) (setq done t)) (skip-chars-backward ": \t") (setq arglength (max arglength (current-column))) (forward-line 1)) (if vardecl (list start (+ start 4) (1+ arglength)) (list start start (1+ arglength)))))) (defun pascal-declindent-middle-of-line (declkey endpos defaultindent) "Indent declaration line." (let ((decindent 0)) (if (search-forward declkey endpos t) (setq decindent (1- (current-column))) (setq decindent defaultindent)) (goto-char endpos) (end-of-line) (if (save-excursion (search-backward declkey endpos t)) (progn (search-backward declkey) (skip-chars-backward " \t")) (skip-chars-backward " \t")) (pascal-delete-whitespaces) (indent-to (max decindent (1+ (current-column)))) ;; Indent after `declkey' (if (looking-at declkey) (progn (forward-char 1) (pascal-delete-whitespaces) (indent-to (1+ (current-column))))))) (defun pascal-indent-within-comment (indent) "Indent comments and/or indent text within comment." (progn ;; If we are at the beginning of the line, then we indent this line. (if (save-excursion (skip-chars-backward " \t") (bolp)) (progn (beginning-of-line) (pascal-delete-whitespaces) (indent-to indent)) ;; Do nothing if we're not in a star comment. (if (save-excursion (beginning-of-line) (skip-chars-forward " \t") (looking-at "\\*\\|(\\*")) (save-excursion (beginning-of-line) (search-forward "*") (pascal-delete-whitespaces) (indent-to (+ (current-column) 2))))))) (defun pascal-find-leading-case-colon () "Return hpos of first colon after the case-of or record line. If there's no such line, use the place where it ought to be." (let ((pos (save-excursion (beginning-of-line) (skip-chars-forward " \t") (point)))) (save-excursion (re-search-backward "\\<\\(case\\|record\\)\\>") (forward-line 1) (skip-chars-forward " \t") (if (not (eq pos (point))) (progn (search-forward ":" (pascal-get-end-of-line) t) (1- (current-column))) (+ (current-column) pascal-case-offset))))) (provide 'pascal) ;; pascal.el ends here. emacs-19.22/lisp/paths.el100444 12120 1 12155 5471272571 13547 0ustar rmsdaemon;;; paths.el --- define pathnames for use by various Emacs commands. ;; Copyright (C) 1986, 1988 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/info/" "/usr/local/lib/info/")) (configdir (file-name-as-directory configure-info-directory))) (or (member configdir start) (setq start (nconc start (list configdir)))) (or (member (expand-file-name "../info/" data-directory) start) (setq start (nconc start (list (expand-file-name "../info/" data-directory))))) start) "List of directories to search for Info documentation files.") (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. If it is a string such as \":DIRECTORY\", then ~/DIRECTORY is used as a news spool. `gnus-nntp-server' is initialised from NNTPSERVER environment variable or, if none, this value.") (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 mh-progs (cond ((file-directory-p "/usr/bin/mh/") "/usr/bin/mh/") ;Ultrix 4.2 ((file-directory-p "/usr/new/mh/") "/usr/new/mh/") ;Ultrix <4.2 ((file-directory-p "/usr/local/bin/mh/") "/usr/local/bin/mh/") ((file-directory-p "/usr/local/mh/") "/usr/local/mh/") (t "/usr/local/bin/")) "Directory containing MH commands.") (defvar mh-lib (cond ((file-directory-p "/usr/lib/mh/") "/usr/lib/mh/") ;Ultrix 4.2 ((file-directory-p "/usr/new/lib/mh/") "/usr/new/lib/mh/") ;Ultrix <4.2 ((file-directory-p "/usr/local/lib/mh/") "/usr/local/lib/mh/") (t "/usr/local/bin/mh/")) "Directory of MH library.") (defvar rmail-file-name "~/RMAIL" "Name of user's primary mail file.") (defvar gnus-startup-file "~/.newsrc" "The file listing groups to which user is subscribed. Will use `gnus-startup-file'-SERVER instead if exists.") (defconst rmail-spool-directory (cond ((memq system-type '(dgux-unix hpux usg-unix-v unisoft-unix rtu irix)) "/usr/mail/") ((eq system-type 'netbsd) "/var/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 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.") ;; Solaris 2 has both of these files; prefer /usr/ucb/man ;; because the other has nonstandard argument conventions. (defconst manual-program (if (file-exists-p "/usr/ucb/man") "/usr/ucb/man" "/usr/bin/man") "Program to run to print man pages.") (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.22/lisp/perl-mode.el100444 12120 1 62231 5430061763 14306 0ustar rmsdaemon;;; perl-mode.el --- Perl code editing commands for GNU Emacs ;; Copyright (C) 1990 Free Software Foundation, Inc. ;; Author: William F. Mann ;; 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) ) (defconst perl-indent-level 4 "*Indentation of Perl statements with respect to containing block.") (defconst perl-continued-statement-offset 4 "*Extra indent for lines not starting new statements.") (defconst perl-continued-brace-offset -4 "*Extra indent for substatements that start with open-braces. This is in addition to perl-continued-statement-offset.") (defconst perl-brace-offset 0 "*Extra indentation for braces, compared with other text in same context.") (defconst perl-brace-imaginary-offset 0 "*Imagined indentation of an open brace that actually follows a statement.") (defconst perl-label-offset -2 "*Offset of Perl label lines relative to usual indentation.") (defconst perl-tab-always-indent t "*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.") (defconst perl-tab-to-comment t "*Non-nil means that for lines which don't need indenting, TAB will either indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment.") (defconst perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:" "*Lines starting with this regular expression will not be 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 will not be auto-indented. perl-indent-level Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. perl-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. perl-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to perl-continued-statement-offset. perl-brace-offset Extra indentation for line if it starts with an open brace. perl-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. perl-label-offset Extra indentation for line that is a label. Various indentation styles: K&R BSD BLK GNU LW perl-indent-level 5 8 0 2 4 perl-continued-statement-offset 5 8 4 2 4 perl-continued-brace-offset 0 0 0 0 -4 perl-brace-offset -5 -8 0 0 0 perl-brace-imaginary-offset 0 0 4 0 0 perl-label-offset -5 -8 -2 -2 -2 Turning on Perl mode calls the value of the variable perl-mode-hook with no args, if that value is non-nil." (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 nil) (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 (1+ (current-column)) ;Else indent at comment column comment-column)))) ; except leave at least one space. (defun electric-perl-terminator (arg) "Insert character. If at end-of-line, and not in a comment or a quote, correct the line'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.22/lisp/picture.el100444 12120 1 60723 5407144440 14077 0ustar rmsdaemon;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model. ;; 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 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") (move-to-column-force (+ (current-column) arg))) (defun picture-backward-column (arg) "Move cursor left, making whitespace if necessary. With argument, move that many columns." (interactive "p") (move-to-column-force (- (current-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))))) ;; Kludge - force the mode line to be updated. Is there a better ;; way to this? (set-buffer-modified-p (buffer-modified-p)) (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-input-char) (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-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) (let ((i ?\ )) (setq picture-mode-map (make-keymap)) (while (< i ?\177) (define-key picture-mode-map (make-string 1 i) 'picture-self-insert) (setq i (1+ i))) (picture-substitute 'forward-char 'picture-forward-column) (picture-substitute 'backward-char 'picture-backward-column) (picture-substitute 'delete-char 'picture-clear-column) (picture-substitute 'backward-delete-char-untabify '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-andindent '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) ;;;###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) (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) ;; Kludge - force the mode line to be updated. Is there a better ;; way to do this? (set-buffer-modified-p (buffer-modified-p)))) (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.22/lisp/pp.el100666 12120 1 14016 5456104726 13052 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 (emacs-lisp-mode) (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))))) (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))) (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-hook (or (let ((sym (if (> (string-to-int emacs-version) 18) 'temp-buffer-show-function 'temp-buffer-show-hook))) (and (boundp 'sym) (symbol-value sym))) 'display-buffer)) (temp-buffer-show-hook (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))) (progn (goto-char (point-min)) ; expected by some hooks ... (funcall old-show-hook buf)) (message "%s" (buffer-substring (point-min) (point))) (delete-windows-on buf) ; no need to kill it ))))) (temp-buffer-show-function temp-buffer-show-hook)) ; emacs19 name (with-output-to-temp-buffer "*Pp Eval Output*" (pp (car values))) (save-excursion (set-buffer "*Pp Eval Output*") (emacs-lisp-mode)))) (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.22/lisp/profile.el100444 12120 1 32072 5432254172 14062 0ustar rmsdaemon;;; profile.el --- generate run time measurements of Emacs Lisp functions ;; Copyright (C) 1992 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 included with this package 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 . ; HOW TO INSTALL: ; --------------- ; First you need to compile and install the following C program in your ; path under the name "emacs-timer" (or set the variable ; profile-timer-program to whatever name you picked). ; ;/** ; ** 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 ;#include ;static struct timeval TV1,TV2; ;static struct timezone *tzp = (struct timezone *) NULL; /* no need timezone */ ;static int watch_not_started = 1 ; /* flag */ ;static char time_string[30]; ; ;int reset_watch() /* this call resets the stopwatch to zero */ ;{ ; gettimeofday(&TV1, tzp) ; ; watch_not_started = 0; ;} ; ;char *get_time() ; /* 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, returns NULL */ ;{ ; char *result = time_string ; ; int i; ; if (watch_not_started) return((char *) 0); /* call reset_watch first ! */ ; gettimeofday(&TV2, tzp); ; if ( TV1.tv_usec > TV2.tv_usec ) ; { ; TV2.tv_usec += 1000000; ; TV2.tv_sec--; ; } ; sprintf(result,"%lu.%6lu", ; TV2.tv_sec - TV1.tv_sec, TV2.tv_usec - TV1.tv_usec); ; for (result = index(result,'.') + 1 ; *result == ' ' ; result++ ) ; *result = '0'; ; return(time_string); ;} ; ;void main() ;{ ; char inp[10]; ; while (1) ; { ; gets(inp); ; switch (inp[0]) ; { ; case 'z': reset_watch(); ; break; ; case 'p': puts(get_time()); ; break; ; case 'q': exit(0); ; } ; } ;} ; -------- end of clip ---------------- ;;; Code: ;;; ;;; User modifiable VARIABLES ;;; (defvar profile-functions-list nil "*List of functions to profile") (defvar profile-timer-program "emacs-timer" "*Name of the 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 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.22/lisp/prolog.el100444 74777 1 21635 5353350074 14102 0ustar ericdaemon;;; 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 ?< "." 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.22/lisp/rect.el100444 12120 1 20437 5371231522 13355 0ustar rmsdaemon;;; rect.el --- rectangle functions for GNU Emacs. ;; Copyright (C) 1985 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)))) (if (/= 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") (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) (let ((column (+ (current-column) begextra endextra))) (goto-char startpos) (let ((ocol (current-column))) (skip-chars-forward " \t") (setq column (+ column (- (current-column) ocol)))) (delete-region (point) ;; Use skip-chars-backward's LIM argument to leave ;; characters before STARTPOS undisturbed. (progn (skip-chars-backward " \t" startpos) (point))) (indent-to column))) ;;;###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 nil) (goto-char start)) (defun string-rectangle-line (startpos begextra endextra) (let ((column (+ (current-column) begextra endextra))) (goto-char startpos) (let ((ocol (current-column))) (skip-chars-forward " \t") (setq column (+ column (- (current-column) ocol)))) (delete-region (point) ;; Use skip-chars-backward's LIM argument to leave ;; characters before STARTPOS undisturbed. (progn (skip-chars-backward " \t" startpos) (point))) (insert string))) ;;;###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) (skip-chars-forward " \t") (let ((column (+ (current-column) endextra))) (delete-region (point) (progn (goto-char startpos) (skip-chars-backward " \t") (point))) (indent-to column))) (provide 'rect) ;;; rect.el ends here emacs-19.22/lisp/refbib.el100444 12120 1 56317 5257321652 13666 0ustar rmsdaemon;;; 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))) (if (not r2b-load-quietly) (r2b-help)) (message "r2b loaded") (provide 'refer-to-bibtex) ;;; refbib.el ends here emacs-19.22/lisp/refer.el100444 74777 13 23710 5355143005 13431 0ustar ericuser;;; 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 (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 (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 every (pred l) (cond ((null l) nil) ((funcall pred (car l)) (or (null (cdr l)) (every pred (cdr l)))))) (defun 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 hereemacs-19.22/lisp/regi.el100444 12120 1 21314 5474462567 13364 0ustar rmsdaemon;;; regi.el --- REGular expression Interpreting engine ;; 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 ;; Copyright (C) 1993 Barry A. Warsaw ;; This file is not yet 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. ;; LCD Archive Entry ;; regi|Barry A. Warsaw|bwarsaw@cen.com ;; |REGular expression Interpreting engine ;; |1993/06/01 21:33:00|1.8| ;;; 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.22/lisp/register.el100444 12120 1 21330 5467443106 14246 0ustar rmsdaemon;;; register.el --- register commands for Emacs. ;; Copyright (C) 1985, 1993 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 (char) "Return contents of Emacs register named CHAR, or nil if none." (cdr (assq char register-alist))) (defun set-register (char value) "Set contents of Emacs register named CHAR to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUE." (let ((aelt (assq char register-alist))) (if aelt (setcdr aelt value) (setq aelt (cons char value)) (setq register-alist (cons aelt register-alist))) value)) (defun point-to-register (char &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 char (if arg (current-frame-configuration) (point-marker)))) (defun window-configuration-to-register (char &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 char (current-window-configuration))) (defun frame-configuration-to-register (char &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 char (current-frame-configuration))) (defalias 'register-to-point 'jump-to-register) (defun jump-to-register (char &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 char))) (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) (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 (char) "Display what is contained in register named REGISTER. REGISTER is a character." (interactive "cView register: ") (let ((val (get-register char))) (if (null val) (message "Register %s is empty" (single-key-description char)) (with-output-to-temp-buffer "*Output*" (princ "Register ") (princ (single-key-description char)) (princ " contains ") (cond ((integerp val) (princ val)) ((markerp val) (princ "a buffer position:\nbuffer ") (princ (buffer-name (marker-buffer val))) (princ ", position ") (princ (+ 0 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 (char &optional arg) "Insert contents of register REG. REG 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 char))) (if (consp val) (insert-rectangle val) (if (stringp val) (insert val) (if (or (integerp val) (markerp val)) (princ (+ 0 val) (current-buffer)) (error "Register does not contain text"))))) (if (not arg) (exchange-point-and-mark))) (defun copy-to-register (char start end &optional delete-flag) "Copy region into register REG. With prefix arg, delete as well. Called from program, takes four args: REG, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." (interactive "cCopy to register: \nr\nP") (set-register char (buffer-substring start end)) (if delete-flag (delete-region start end))) (defun append-to-register (char start end &optional delete-flag) "Append region to text in register REG. With prefix arg, delete as well. Called from program, takes four args: REG, 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 char)) (error "Register does not contain text")) (set-register char (concat (get-register char) (buffer-substring start end))) (if delete-flag (delete-region start end))) (defun prepend-to-register (char start end &optional delete-flag) "Prepend region to text in register REG. With prefix arg, delete as well. Called from program, takes four args: REG, 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 char)) (error "Register does not contain text")) (set-register char (concat (buffer-substring start end) (get-register char))) (if delete-flag (delete-region start end))) (defun copy-rectangle-to-register (char start end &optional delete-flag) "Copy rectangular region into register REG. With prefix arg, delete as well. Called from program, takes four args: REG, 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 char (if delete-flag (delete-extract-rectangle start end) (extract-rectangle start end)))) ;;; register.el ends here emacs-19.22/lisp/replace.el100444 12120 1 52213 5470323564 14040 0ustar rmsdaemon;;; replace.el --- replace commands for Emacs. ;; Copyright (C) 1985, 1986, 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. ;;; 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) (defun query-replace-read-args (string) (let (from to) (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. Preserves case in each replacement if case-replace and case-fold-search are non-nil and FROM-STRING has no uppercase letters. Third arg DELIMITED (prefix arg if interactive) 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")) (perform-replace from-string to-string t nil arg) (or unread-command-events (message "Done"))) (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. 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) non-nil means replace only matches surrounded by word boundaries. In TO-STRING, \\& means insert what matched REGEXP, and \\=\\ means insert what matched th \\(...\\) in REGEXP." (interactive (query-replace-read-args "Query replace regexp")) (perform-replace regexp to-string t t arg) (or unread-command-events (message "Done"))) (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. A prefix argument N says to use each replacement string N times before rotating to the next." (interactive (let (from to) (setq from (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)) (or unread-command-events (message "Done"))) (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. Third arg DELIMITED (prefix arg if interactive) non-nil means replace only matches surrounded by word boundaries. 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 OLD-STRING nil t) (replace-match REPLACEMENT nil t)) which will run faster and will not set the mark or print anything." (interactive (query-replace-read-args "Replace string")) (perform-replace from-string to-string nil nil delimited) (or unread-command-events (message "Done"))) (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) non-nil means replace only matches surrounded by word boundaries. In TO-STRING, \\& means insert what matched REGEXP, and \\=\\ means insert what matched th \\(...\\) in REGEXP. 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 REPLACEMENT nil nil)) which will run faster and will not set the mark or print anything." (interactive (query-replace-read-args "Replace regexp")) (perform-replace regexp to-string nil t delimited) (or unread-command-events (message "Done"))) (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 "\C-c\C-c" '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 occurrences in this buffer, then use \\[occur-mode-goto-occurrence] to go to the same occurrence in the buffer that the occurrences were found in. \\{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-goto-occurrence () "Go to the line this occurrence was found in, in the buffer it was found in." (interactive) (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* ((occur-number (save-excursion (beginning-of-line) (/ (1- (count-lines (point-min) (save-excursion (beginning-of-line) (point)))) (cond ((< occur-nlines 0) (- 2 occur-nlines)) ((> occur-nlines 0) (+ 2 (* 2 occur-nlines))) (t 1))))) (pos (nth occur-number occur-pos-list))) (or pos (error "No occurrence on this line")) (pop-to-buffer occur-buffer) (goto-char (marker-position pos)))) (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)) (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) (insert "Lines matching ") (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 "%3d" 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) (backward-char (- end start)) (setq tem nlines) (while (> tem 0) (insert empty ?:) (forward-line 1) (setq tem (1- tem))) (let ((this-linenum linenum)) (set-marker final-context-start (+ (point) (- (match-end 0) (match-beginning 0)))) (while (< (point) final-context-start) (if (null tag) (setq tag (format "%3d" this-linenum))) (insert tag ?:) (setq tag nil) (forward-line 1) (setq this-linenum (1+ this-linenum)))) (while (< tem nlines) (insert empty ?:) (forward-line 1) (setq tem (1+ tem)))) (forward-line 1))) (set-buffer standard-output) ;; Put positions in increasing order to go with buffer. (setq occur-pos-list (nreverse 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, ESC 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', 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 "," 'act-and-show) (define-key query-replace-map "\e" 'exit) (define-key query-replace-map [escape] 'exit) (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 "?" 'help) (define-key query-replace-map "\C-g" 'quit) (define-key query-replace-map "\C-]" 'quit) (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 do exactly what you probably 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)) (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) ;; 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) (message "Query replacing %s with %s: " 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. (store-match-data real-match-data) (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))))) ((eq def 'exit) (setq keep-going nil) (setq done t)) ((eq def 'backup) (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)))) ((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)) (t (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 (function (lambda (elt) (and elt (marker-position elt)))) (match-data)))) stack)) (if replaced (setq replace-count (1+ replace-count))))) (setq lastrepl (point))) (and keep-going stack))) ;;; replace.el ends here emacs-19.22/lisp/reporter.el100444 12120 1 20454 5474467072 14300 0ustar rmsdaemon;;; reporter.el --- customizable bug reporting of lisp programs ;; Author: 1993 Barry A. Warsaw, Century Computing Inc. ;; Maintainer: bwarsaw@cen.com ;; Created: 19-Apr-1993 ;; Version: 1.23 ;; Last Modified: 1993/09/02 20:28:36 ;; Keywords: tools, mail, lisp, extensions ;; 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. ;; Introduction ;; ============ ;; This program is for lisp package authors and is 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 use ;; to completely reproduce the environment in which the bug was ;; observed (e.g. by using eval-last-sexp). This package is especially ;; useful for my development of c++-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) ;; (and (y-or-n-p "Do you really want to submit a report on mypkg? ") ;; (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 ;; LCD Archive Entry: ;; reporter|Barry A. Warsaw|bwarsaw@cen.com| ;; Customizable bug reporting of lisp programs.| ;; 1993/09/02 20:28:36|1.23|~/misc/reporter.el.Z| ;;; Code: ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; user defined variables (defvar reporter-mailer '(vm-mail 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.") ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; 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.") (defun reporter-dump-variable (varsym) "Pretty-print the value of the variable in symbol VARSYM." (let ((val (save-excursion (set-buffer reporter-eval-buffer) (eval varsym))) (sym (symbol-name varsym)) (print-escape-newlines t)) (insert " " sym " " (cond ((memq val '(t nil)) "") ((listp val) "'") ((symbolp val) "'") (t "")) (prin1-to-string val) "\n"))) (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 the symbol. 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) "\nPackage: " pkgname "\n") (run-hooks 'pre-hooks) (insert "\ncurrent state:\n==============\n(setq\n") (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) ))) varlist) (insert " )\n") (run-hooks 'post-hooks) )) (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 (do a `\\[describe-function] 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 saluation. The mailer used is described in the variable `reporter-mailer'." (let ((reporter-eval-buffer (current-buffer)) (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 (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))))) (mail-position-on-field "to") (insert address) (mail-position-on-field "subject") (insert "Report on package " pkgname) (re-search-forward mail-header-separator (point-max) 'move) (forward-line 1) (and salutation (insert "\n" salutation "\n\n")) (set-mark (point)) ;user should see mark change (insert "\n\n") (reporter-dump-state pkgname varlist pre-hooks post-hooks) (exchange-point-and-mark)) (let* ((sendkey "C-c C-c") ;can this be generalized like below? (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)) )) ;; this is useful (provide 'reporter) ;;; reporter.el ends here emacs-19.22/lisp/reposition.el100444 12120 1 16351 5422703510 14611 0ustar rmsdaemon;;; reposition.el --- center a Lisp function or comment on the screen ;; Copyright (C) 1991 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. (re-search-forward "[^\\s \n\014]") (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.22/lisp/resume.el100444 13437 1 14407 5371111706 14055 0ustar jimbdaemon;;; 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; 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) (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 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))) ;;; resume.el ends here emacs-19.22/lisp/rfc822.el100444 13437 1 24152 5354240644 13566 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.22/lisp/ring.el100444 74720 14 7503 5431620116 13736 0ustar eggertguest;;; 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-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 a new item onto the ring. 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.22/lisp/rlogin.el100444 12120 1 21670 5462012231 13705 0ustar rmsdaemon;;; rlogin.el --- remote login interface ;; Author: Noah Friedman ;; Maintainer: Noah Friedman ;; Keywords: unix, comm ;; Copyright (C) 1992, 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 Massachusetts Avenue.; Cambridge, MA 02139, USA. ;;; Commentary: ;; Support for remote logins using `rlogin'. ;; $Id: rlogin.el,v 1.13 1993/10/22 17:12:54 rms Exp $ ;;; Todo: ;; Make this mode deal with comint-last-input-end properly. ;;; Code: (require 'comint) (require 'shell) ;;;###autoload (defvar rlogin-program "rlogin" "*Name of program to invoke rlogin") ;;;###autoload (defvar rlogin-explicit-args nil "*List of arguments to pass to rlogin on the command line.") ;;;###autoload (defvar rlogin-mode-hook nil "*Hooks to run after setting current buffer to rlogin-mode.") ;;;###autoload (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.") ;;;###autoload ;(setq rlogin-initially-track-cwd nil) (defvar rlogin-initially-track-cwd t "*If non-`nil', do remote directory tracking via ange-ftp right away. If `nil', you can still enable directory tracking by doing `M-x dirtrack-toggle'.") ;; Leave this nil because it makes rlogin-filter a tiny bit faster. Plus ;; you can still call rlogin-password by hand. ;;;###autoload (defvar rlogin-password-paranoia nil "*If non-`nil', query user for a password in the minibuffer when a Password: prompt appears. It's also possible to selectively enter passwords without echoing them in the minibuffer using the command `rlogin-password' explicitly.") ;; Initialize rlogin mode map. ;;;###autoload (defvar rlogin-mode-map '()) (cond ((not rlogin-mode-map) (setq rlogin-mode-map (cons '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-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))) ;;;###autoload (defun rlogin (input-args &optional prefix) "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*, where HOST is the first word in the string ARGS. If a prefix argument is given and the buffer *rlogin-HOST* already exists, a new buffer with a different connection will be made. 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 ARGS." (interactive (list (read-from-minibuffer "rlogin arguments (hostname first): ") current-prefix-arg)) (let* ((process-connection-type rlogin-process-connection-type) (buffer-name (format "*rlogin-%s*" input-args)) args proc (old-match-data (match-data))) (while (string-match "[ \t]*\\([^ \t]+\\)$" input-args) (setq args (cons (substring input-args (match-beginning 1) (match-end 1)) args) input-args (substring input-args 0 (match-beginning 0)))) (store-match-data old-match-data) (setq buffer-name (format "*rlogin-%s*" (car args)) args (append args rlogin-explicit-args)) (and prefix (setq buffer-name (buffer-name (generate-new-buffer buffer-name)))) (switch-to-buffer buffer-name) (or (comint-check-proc buffer-name) (progn (comint-mode) (comint-exec (current-buffer) buffer-name rlogin-program nil args) (setq proc (get-process buffer-name)) ;; 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) ;; Set this *after* running rlogin-mode because rlogin-mode calls ;; shell-mode, which munges the process filter. (set-process-filter proc 'rlogin-filter) ;; Set the prefix for filename completion and directory tracking ;; to find the remote machine's files by ftp. (setq comint-file-name-prefix (concat "/" (car args) ":")) (and rlogin-initially-track-cwd ;; Presume the user will start in his remote home directory. ;; If this is wrong, M-x dirs will fix it. (cd-absolute (concat "/" (car args) ":~/"))))))) ;;;###autoload (defun rlogin-password (&optional proc) "Read a password and send it to an rlogin session. For each character typed, a `*' is echoed in the minibuffer. End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts attempt to read and send password. Optional argument PROC is the process to which the password should be sent. If not provided, send to the process in the current buffer. This argument is intended primarily for use by `rlogin-filter'." (interactive) (or proc (setq proc (get-buffer-process (current-buffer)))) (let* ((buffer-name (buffer-name (process-buffer proc))) (pass (comint-read-noecho (format "Password for buffer \"%s\": " buffer-name) 'stars))) (and pass (save-excursion (set-buffer buffer-name) (insert-before-markers "\n") (comint-send-string proc (format "%s\n" pass)))))) ;;;###autoload (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-initially-track-cwd) (make-local-variable 'comint-file-name-prefix) (run-hooks 'rlogin-mode-hook)) (defun rlogin-filter (proc string) (let (proc-mark region-begin window) (save-excursion (set-buffer (process-buffer proc)) (setq proc-mark (process-mark proc) region-begin (point) ;; If process mark is at window start, insert-before-markers ;; will insert text off-window since it's also inserting before ;; the start window mark. Make sure we can see the most recent ;; text. (note: it's a buglet that this isn't necessary if ;; scroll-step is 0, but that works to our advantage since it ;; makes the filter a little faster.) window (and (/= 0 scroll-step) (= proc-mark (window-start)) (get-buffer-window (current-buffer)))) (goto-char proc-mark) (insert-before-markers string) (goto-char region-begin) ;; I think something fishy is going on with save-excursion and ;; search-forward. If you don't make search-forward move to the end ;; of the search region when it's done, then if the user switches ;; buffers back and forth, it leaves point sitting behind the ;; process-mark, so that text inserted later goes off-screen. (while (search-forward "\C-m" proc-mark 'goto-end) (delete-char -1))) ;; Frob window-start outside of save-excursion so it works whether the ;; current buffer is the process buffer or not. (and window (>= (window-start window) region-begin) (set-window-start window region-begin 'noforce))) (and rlogin-password-paranoia (string= "Password:" string) (rlogin-password proc))) ;;;###autoload (defun rlogin-send-Ctrl-C () (interactive) (send-string nil "\C-c")) ;;;###autoload (defun rlogin-send-Ctrl-Z () (interactive) (send-string nil "\C-z")) ;;;###autoload (defun rlogin-send-Ctrl-backslash () (interactive) (send-string nil "\C-\\")) ;;;###autoload (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) (send-string nil "\C-d") (delete-char arg))) ;;; rlogin.el ends here emacs-19.22/lisp/rmail.el100444 12120 1 230170 5475465001 13547 0ustar rmsdaemon;;; rmail.el --- main code of "RMAIL" mail reader for Emacs. ;; Copyright (C) 1985, 1986, 1987, 1988, 1993 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 'user-original-login-name)) (fboundp 'user-real-login-name) (defalias 'user-original-login-name 'user-real-login-name)) (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") ; "") ;;;###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:\\|^message-id:\\|^summary-line:" "\ *Gubbish headers one would rather not see.") ;;;###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-retry-setup-hook nil "Hook that `rmail-retry-failure' uses in place of `mail-setup-hook'.") ;; 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, is a filter function for new headers in RMAIL. Called with region narrowed to unformatted header.") (defvar rmail-reply-prefix "Re: " "String to prepend to Subject line when replying to a message.") (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) ;; 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-file nil) (defvar rmail-last-regexp nil) (defvar rmail-last-rmail-file (expand-file-name "~/XMAIL")) ;;; Regexp matching the delimiter of messages in UNIX mail format ;;; (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]*\\)" "\\) ?" ;; 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 ;; I'm not sure what this is. "\\(remote from [^\n]*\\)?" "\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) (` (progn (if (rmail-summary-displayed) (let ((window (selected-window))) (save-excursion (unwind-protect (progn (pop-to-buffer rmail-summary-buffer) (,@ body)) (select-window window)))) (save-excursion (set-buffer rmail-summary-buffer) (progn (,@ 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 filename as argument; then performs rmail editing on that file, but does not copy any new mail into the file." (interactive (if current-prefix-arg (list (read-file-name "Run rmail on RMAIL file: " nil nil t)))) (or rmail-last-file (setq rmail-last-file (expand-file-name "~/xmail"))) (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)))) (let ((existing-unseen (rmail-first-unseen-message))) (or file-name-arg (rmail-get-new-mail)) ;; Show the first unseen message, which might be from a previous session ;; or might have been just read in by rmail-get-new-mail. Must ;; determine already unseen messages first, as rmail-get-new-mail ;; positions on the first new message, thus marking it as seen. (rmail-show-message existing-unseen)))) ;; 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 "\^_") (forward-char 1) (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 [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 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 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 continue] '("Continue" . rmail-continue)) (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-backward)) (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) ;;;###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. (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 '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 'version-control) (setq version-control 'never) (make-local-variable 'file-precious-flag) (setq file-precious-flag t) (make-local-variable 'rmail-message-vector) (make-local-variable 'rmail-last-file) (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-original-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) ;; 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-set-message-counters) (rmail-show-message))))) ;; 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)) (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 (bury-buffer rmail-summary-buffer)) (let ((obuf (current-buffer))) (switch-to-buffer (other-buffer)) (bury-buffer obuf))) ;;;###autoload (defun rmail-input (filename) "Run Rmail on file FILENAME." (interactive "FRun rmail on RMAIL file: ") (rmail filename)) ;;;; *** 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." (interactive (list (if current-prefix-arg (read-file-name "Get new mail from file: ")))) (or (verify-visited-file-modtime (current-buffer)) (progn (find-file (buffer-file-name)) (setq buffer-read-only t) (if (verify-visited-file-modtime (current-buffer)) (rmail-forget-messages)))) (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\^_") (narrow-to-region (point) (point-max)) (goto-char (1+ (point-min))) (rmail-count-new-messages) (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)"))) (if (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))) (message "%d new message%s read" new-messages (if (= 1 new-messages) "" "s")) (and (boundp 'display-time-string) (string-match " Mail" display-time-string) (setq display-time-string (concat (substring display-time-string 0 (match-beginning 0)) (substring display-time-string (match-end 0)))) (force-mode-line-update 'all)))) ;; 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 (expand-file-name (substitute-in-file-name (car files))) ;;>> un*x specific << ;; The "+" used to be "~", which is an extremely poor choice; ;; it might accidentally be deleted when space is low ;; (as happened to me!). tofile (concat file "+")) ;; If getting from mail spool directory, ;; use movemail to move rather than just renaming, ;; so as to interlock with the mailer. (setq movemail (equal (file-name-directory file) rmail-spool-directory) popmail (string-match "^po:" (file-name-nondirectory file))) (if popmail (setq file (file-name-nondirectory file) renamep t)) (if movemail (progn (setq 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)))) ;; 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-original-login-name) file))))) (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 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 (rename-file file tofile nil))) ;; 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 (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) (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)))) (read (buffer-substring beg eol))))))) (and size (numberp size) (>= size 0) (goto-char (+ header-end size)))) (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-ignored-headers (rmail-clear-headers)) (if rmail-message-filter (funcall rmail-message-filter)))) (defun rmail-clear-headers () (if (search-forward "\n\n" nil t) (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 rmail-ignored-headers nil t)) (beginning-of-line) (delete-region (point) (progn (re-search-forward "\n[^ \t]") (forward-char -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 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 (concat " " 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\^_") (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) "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) (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. (if (rmail-summary-exists) (let ((curr-msg rmail-current-message)) (rmail-select-summary (rmail-summary-goto-msg curr-msg t t)))) (if blurb (message blurb)))))) (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))) (defun rmail-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)))) (rmail-search regexp (- n))) (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)) ;;;; *** 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)) (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) (let ((del-msg rmail-current-message)) (if (rmail-summary-exists) (save-excursion (set-buffer rmail-summary-buffer) (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)) (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) (= ?D (aref rmail-deleted-vector 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) (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) (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) (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 (cond (resent-reply-to (mail-fetch-field "resent-date" t)) ((mail-fetch-field "date"))) to (cond (resent-reply-to (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) (or (string-match (concat "\\`" (regexp-quote rmail-reply-prefix)) subject) (setq subject (concat rmail-reply-prefix 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 (buf msgnum) (save-excursion (set-buffer buf) (rmail-set-attribute "answered" t msgnum))) (current-buffer) rmail-current-message))))) (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 ")")) ;; 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)) (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 (buf msgnum) (save-excursion (set-buffer buf) (rmail-set-attribute "forwarded" t msgnum)))) (current-buffer) rmail-current-message))) (save-excursion ;; 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-buffer forward-buffer)))))) (defun rmail-resend (address &optional from comment mail-alias-file) "Resend current message to ADDRESSES. ADDRESSES should be a single address, a 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. (if (re-search-forward "^Sender:" nil t) (let (beg) (beginning-of-line) (setq beg (point)) (forward-line 1) (while (looking-at "[ \t]") (forward-line 1)) (delete-region beg (point)))) ;;>> Insert resent-from: (insert "Resent-From: " from "\n") (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-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) (sendmail-send-it))) (kill-buffer tembuf)) (rmail-set-attribute "resent" t rmail-current-message))) (defvar mail-unsent-separator (concat "^ *---+ +Unsent message follows +---+ *$\\|" "^ *---+ +Returned message +---+ *$\\|" "^ *---+ +Original message +---+ *$\\|" "^ *--+ +begin message +--+ *$\\|" "^ *---+ +Original message follows +---+ *$\\|" "^|? *---+ +Message text follows: +---+ *|?$")) (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; otherwise copy the current message." (interactive) (require 'mail-utils) (let (to subj irp2 cc orig-message) (save-excursion ;; Narrow down to just the quoted original message (rmail-beginning-of-message) (let ((case-fold-search t)) (or (re-search-forward mail-unsent-separator nil t) (error "Cannot parse this as a failure message"))) (save-restriction (narrow-to-region (point) (point-max)) ;; Now mail-fetch-field will get from headers of the original message, ;; not from the headers of the rejection. (setq to (mail-fetch-field "To") subj (mail-fetch-field "Subject") irp2 (mail-fetch-field "In-reply-to") cc (mail-fetch-field "Cc")) ;; Get the entire text (not headers) of the original message. (setq orig-message (buffer-substring (progn (search-forward "\n\n") (point)) (point-max))))) ;; 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 rmail-retry-setup-hook)) (if (rmail-start-mail nil to subj irp2 cc (current-buffer)) ;; Insert original text as initial text of new draft message. (progn (goto-char (point-max)) (insert orig-message) (goto-char (point-min)) (end-of-line)))))) (defun rmail-bury () "Bury current Rmail buffer and its summary buffer." (interactive) (let ((rmail-buffer (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 rmail-buffer))) (defun rmail-summary-exists () "Non-nil iff in an RMAIL buffer and an associated summary buffer exists. Non-nil value returned is the summary buffer." (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.") ;; Put the summary buffer back on the screen, if user wants that. (defun rmail-maybe-display-summary () (and rmail-summary-buffer (buffer-name rmail-summary-buffer) rmail-redisplay-summary (display-buffer rmail-summary-buffer))) ;;;; *** 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) ;;;; *** 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) ;;;; *** 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.22/lisp/rmailedit.el100444 12120 1 7630 5422700037 14351 0ustar rmsdaemon;;; rmailedit.el --- "RMAIL edit mode" Edit the current message. ;; 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: (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))) (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) (set-buffer-modified-p (buffer-modified-p)) ;; Make 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) ;; 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)) ;; Update the mode line. (set-buffer-modified-p (buffer-modified-p)) (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)) ;;; rmailedit.el ends here emacs-19.22/lisp/rmailkwd.el100444 12120 1 22501 5257323553 14235 0ustar rmsdaemon;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs. ;; Copyright (C) 1985, 1988 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 '(lambda (s) (intern s rmail-label-obarray)) '("deleted" "answered" "filed" "forwarded" "unseen" "edited")))) (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-attribute-p (attribute &optional n) ; "Returns t if ATTRIBUTE on NTH or current message." ; (rmail-message-labels-p (rmail-make-label attribute t) n)) ;(defun rmail-message-keyword-p (keyword &optional n) ; "Returns t if KEYWORD on NTH or current message." ; (rmail-message-labels-p (rmail-make-label keyword t) n t)) ;(defun rmail-message-label-p (label &optional n) ; "Returns symbol if LABEL (attribute or keyword) on NTH or current message." ; (rmail-message-labels-p (rmail-make-label label t) n 'all)) ;; Not used by RMAIL but might be nice for user package. ;(defun rmail-parse-message-labels (&optional n) ; "Returns labels associated with NTH or current RMAIL message. ;Results is a list of two lists. The first is the message attributes ;and the second is the message keywords. Labels are represented as symbols." ; (let ((omin (- (buffer-size) (point-min))) ; (omax (- (buffer-size) (point-max))) ; (result)) ; (unwind-protect ; (save-excursion ; (let ((beg (rmail-msgbeg (or n rmail-current-message)))) ; (widen) ; (goto-char beg) ; (forward-line 1) ; (if (looking-at "[01],") ; (save-restriction ; (narrow-to-region (point) (save-excursion (end-of-line) (point))) ; (rmail-nuke-whitespace) ; (goto-char (1+ (point-min))) ; (list (mail-parse-comma-list) (mail-parse-comma-list)))))) ; (narrow-to-region (- (buffer-size) omin) ; (- (buffer-size) omax)) ; nil))) (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.22/lisp/rmailmsc.el100444 74777 1 3512 5351650133 14356 0ustar ericdaemon;;; 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. This may be a list of file names separated by commas. If FILE-NAME is empty, remove any 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 "Mail: " file-name "\n")))))) (setq rmail-inbox-list (rmail-parse-file-inboxes)) (rmail-show-message rmail-current-message)) ;;; rmailmsc.el ends here emacs-19.22/lisp/rmailout.el100444 12120 1 22204 5472127263 14256 0ustar rmsdaemon;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. ;; Copyright (C) 1985, 1987, 1993 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: ;; 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. 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-last-rmail-file)))) (list (setq rmail-last-rmail-file (read-file-name (concat "Output message to Rmail file: (default " (file-name-nondirectory default-file) ") ") (file-name-directory default-file) default-file)) (prefix-numeric-value current-prefix-arg)))) (or count (setq count 1)) (setq file-name (expand-file-name file-name (file-name-directory rmail-last-rmail-file))) (if (and (file-readable-p file-name) (not (rmail-file-p file-name))) (rmail-output file-name count) (rmail-maybe-set-message-counters) (setq file-name (abbreviate-file-name file-name)) (or (get-file-buffer file-name) (file-exists-p file-name) (if (yes-or-no-p (concat "\"" file-name "\" does not exist, create it? ")) (let ((file-buffer (create-file-buffer file-name))) (save-excursion (set-buffer file-buffer) (rmail-insert-rmail-file-header) (let ((require-final-newline nil)) (write-region (point-min) (point-max) file-name t 1))) (kill-buffer file-buffer)) (error "Output file does not exist"))) (while (> count 0) (let (redelete) (unwind-protect (progn (save-restriction (widen) (if (rmail-message-deleted-p rmail-current-message) (progn (setq redelete t) (rmail-set-attribute "deleted" nil))) ;; Decide whether to append to a file or to an Emacs buffer. (save-excursion (let ((buf (get-file-buffer file-name)) (cur (current-buffer)) (beg (1+ (rmail-msgbeg rmail-current-message))) (end (1+ (rmail-msgend rmail-current-message)))) (if (not buf) (append-to-file beg end file-name) (if (eq buf (current-buffer)) (error "Can't output message to same file it's already in")) ;; File has been visited, in buffer BUF. (set-buffer buf) (let ((buffer-read-only nil) (msg (and (boundp 'rmail-current-message) rmail-current-message))) ;; If MSG is non-nil, buffer is in RMAIL mode. (if msg (progn (rmail-maybe-set-message-counters) (widen) (narrow-to-region (point-max) (point-max)) (insert-buffer-substring cur beg end) (goto-char (point-min)) (widen) (search-backward "\n\^_") (narrow-to-region (point) (point-max)) (rmail-count-new-messages t) (rmail-show-message msg)) ;; Output file not in rmail mode => just insert at the end. (narrow-to-region (point-min) (1+ (buffer-size))) (goto-char (point-max)) (insert-buffer-substring cur beg end))))))) (rmail-set-attribute "filed" t)) (if redelete (rmail-set-attribute "deleted" t)))) (setq count (1- count)) (if rmail-delete-after-output (rmail-delete-forward) (if (> count 0) (rmail-next-undeleted-message 1)))))) ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun rmail-file-p (file) (let ((buf (generate-new-buffer " *rmail-file-p*"))) (unwind-protect (save-excursion (set-buffer buf) (insert-file-contents file nil 0 100) (looking-at "BABYL OPTIONS:")) (kill-buffer buf)))) ;;; There are functions elsewhere in Emacs that use this function; check ;;; them out before you change the calling method. (defun rmail-output (file-name &optional count noattribute from-gnus) "Append this message to Unix mail file named FILE-NAME. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. When called from lisp code, N may be omitted. 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 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 (list (setq rmail-last-file (read-file-name (concat "Output message to Unix mail file" (if rmail-last-file (concat " (default " (file-name-nondirectory rmail-last-file) "): " ) ": ")) (and rmail-last-file (file-name-directory rmail-last-file)) rmail-last-file)) (prefix-numeric-value current-prefix-arg))) (or count (setq count 1)) (setq file-name (expand-file-name file-name (and rmail-last-file (file-name-directory rmail-last-file)))) (if (and (file-readable-p file-name) (rmail-file-p file-name)) (rmail-output-to-rmail-file file-name count) (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) (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.) (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.22/lisp/rmailsort.el100444 12120 1 15211 5474613232 14434 0ustar rmsdaemon;;; rmailsort.el --- Rmail: sort messages. ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/rmailsort.el,v 1.16 1993/11/24 08:08:56 rms 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 msgnum) (rmail-msgend msgnum)))))) ;; 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-flush-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))))) (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.22/lisp/rmailsum.el100444 12120 1 114607 5474333521 14302 0ustar rmsdaemon;;; rmailsum.el --- make summary buffers for the mail reader ;; Copyright (C) 1985, 1993 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: ;; 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) '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)) (save-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))))) ;; 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 (pop-to-buffer sumbuf)) (rmail-summary-goto-msg mesg t t) (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)) (progn (end-of-line) (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 9) 0) 0) ((< len (+ mch 16)) (- len 25)) (t (- mch 9)))) (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)) (display-buffer rmail-buffer)) (defun rmail-summary-previous-all (&optional number) (interactive "p") (forward-line (- (if number number 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))) ;; 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-forward backward) (pop-to-buffer rmail-summary-buffer))) (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) (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)) (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)))))) (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." (interactive) (kill-all-local-variables) (setq major-mode 'rmail-summary-mode) (setq mode-name "RMAIL Summary") (use-local-map rmail-summary-mode-map) (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) (setq revert-buffer-function 'rmail-update-summary) (make-local-variable 'post-command-hook) (add-hook 'post-command-hook 'rmail-summary-rmail-update) (run-hooks 'rmail-summary-mode-hook)) ;; 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 () (if (get-buffer-window rmail-buffer) (let (buffer-read-only) (save-excursion (beginning-of-line) (skip-chars-forward " ") (let ((beg (point)) msg-num (buf rmail-buffer)) (skip-chars-forward "0-9") (setq msg-num (string-to-int (buffer-substring beg (point)))) (or (eq rmail-current-message msg-num) (let (go-where window (owin (selected-window))) (setq rmail-current-message msg-num) (if (= (following-char) ?-) (progn (delete-char 1) (insert " "))) (setq window (display-buffer rmail-buffer)) ;; Using save-window-excursion caused the new value ;; of point to get lost. (unwind-protect (progn (select-window window) (rmail-show-message msg-num)) (select-window owin))))))))) (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-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) ) ;;; 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-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 continue] '("Continue" . rmail-summary-continue)) (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)) (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 ((buf rmail-buffer) (cur (point)) (curmsg (string-to-int (buffer-substring (point) (min (point-max) (+ 5 (point))))))) (if (not n) (setq n curmsg) (if (< n 1) (progn (message "No preceding message") (setq n 1))) (if (> n rmail-total-messages) (progn (message "No following message") (goto-char (point-max)) (rmail-summary-goto-msg))) (goto-char (point-min)) (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t)) (progn (or nowarn (message "Message %d not found" n)) (setq n curmsg) (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 " ")))) (beginning-of-line) (if skip-rmail nil (pop-to-buffer buf) (rmail-show-message n) (pop-to-buffer rmail-summary-buffer)))) (defun rmail-summary-scroll-msg-up (&optional dist) "Scroll other window forward." (interactive "P") (scroll-other-window dist)) (defun rmail-summary-scroll-msg-down (&optional dist) "Scroll other window backward." (interactive "P") (scroll-other-window (cond ((eq dist '-) nil) ((null dist) '-) (t (- (prefix-numeric-value dist)))))) (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))) (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))) (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) (mail-other-window nil nil nil nil nil rmail-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) (mail-other-window 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 (mailbuf) (save-window-excursion (set-buffer rmail-buffer) (rmail-reply just-sender) (setq mailbuf (current-buffer))) (pop-to-buffer mailbuf) (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 (mailbuf) (save-window-excursion (set-buffer rmail-buffer) (rmail-retry-failure) (setq mailbuf (current-buffer))) (pop-to-buffer mailbuf) (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 (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))) ;; Summary output commands. (defun rmail-summary-output-to-rmail-file () "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) (call-interactively 'rmail-output-to-rmail-file))) (defun rmail-summary-output () "Append this message to Unix mail file named FILE-NAME." (interactive) (save-excursion (set-buffer rmail-buffer) (call-interactively 'rmail-output))) ;; 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-sort-from-summary (sortfun reverse) "Sort Rmail messages from Summary buffer and update it after sorting." (require 'rmailsort) (pop-to-buffer rmail-buffer) (funcall sortfun reverse) (rmail-summary)) ;;; rmailsum.el ends here emacs-19.22/lisp/rnews.el100444 74720 14 106122 5431620121 14166 0ustar eggertguest;;; 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) (if (boundp 'minor-mode-alist) ;; Emacs versions 18.16 and up. (setq mode-name '("NEWS" news-minor-modes)) ;; Earlier versions display minor-modes via a special mechanism. (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 (file-exists-p file) (let ((buffer-read-only ())) (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) (news-read-in-file file) (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.22/lisp/rnewspost.el100444 12120 1 35732 5246311621 14470 0ustar rmsdaemon;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs ;; Copyright (C) 1985, 1986, 1987 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?" 'describe-mode) (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-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))) (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") (make-local-variable 'paragraph-separate) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^" mail-header-separator "$\\|" paragraph-start)) (setq paragraph-separate (concat "^" 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 rmail). 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 newsgroups names at your site: 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, that are also in the Newsgroups: field: 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) "Setup the news reply or posting buffer with the proper headers and in news-reply-mode." (setq mail-reply-buffer replybuffer) (let ((mail-setup-hook nil)) (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 (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.22/lisp/rot13.el100444 12120 1 3465 5407711515 13357 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." (interactive) (let ((w (display-buffer (current-buffer) t))) (set-window-display-table w rot13-display-table))) (provide 'rot13) ;;; rot13.el ends here emacs-19.22/lisp/saveplace.el100444 12120 1 15361 5432564646 14401 0ustar rmsdaemon;;; saveplace.el --- automatically save place in files. ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Karl Fogel ;; Maintainer: FSF ;; Created: July, 1993 ;; Version: 1.0 ;; 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. ;; ;; Don't autoload this, rather, load it, since it modifies ;; find-file-hooks and other hooks. ;; 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-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 (point)) 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)) (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)))))) (add-hook 'find-file-hooks (function (lambda () (or save-place-loaded (load-save-place-alist-from-file)) (let ((cell (assoc buffer-file-name save-place-alist))) (if cell (progn (goto-char (cdr cell)) ;; and make sure it will be saved again for later. (setq save-place t))))))) (add-hook 'kill-emacs-hook (function (lambda () (progn (save-places-to-alist) (save-place-alist-to-file))))) (add-hook 'kill-buffer-hook 'save-place-to-alist) (provide 'saveplace) ; why not... ;;; saveplace.el ends here emacs-19.22/lisp/sc.el100666 12120 1 25 5456717243 12757 0ustar rmsdaemon(require 'supercite) emacs-19.22/lisp/scheme.el100444 13437 1 45023 5405344421 14017 0ustar jimbdaemon;;; 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 '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) (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)) (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.22/lisp/scribe.el100444 13437 1 25571 5354236411 14032 0ustar jimbdaemon;;; scribe.el --- scribe mode, and its idiosyncratic commands. ;; Copyright (C) 1985 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp ;; This file might become 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. ;; Everyone is granted permission to copy, modify and redistribute ;; GNU Emacs, but only under the conditions described in the ;; document "GNU Emacs copying permission notice". An exact copy ;; of the document is supposed to have been given to you along with ;; GNU Emacs so that you can know how you may redistribute it all. ;; It should be in a file named COPYING. Among other things, the ;; copyright notice and this notice must be preserved on all copies. ;;; 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 "\^cc" 'scribe-chapter) (define-key scribe-mode-map "\^cS" 'scribe-section) (define-key scribe-mode-map "\^cs" 'scribe-subsection) (define-key scribe-mode-map "\^ce" 'scribe-insert-environment) (define-key scribe-mode-map "\^c\^e" 'scribe-bracket-region-be) (define-key scribe-mode-map "\^c[" 'scribe-begin) (define-key scribe-mode-map "\^c]" 'scribe-end) (define-key scribe-mode-map "\^ci" 'scribe-italicize-word) (define-key scribe-mode-map "\^cb" 'scribe-bold-word) (define-key scribe-mode-map "\^cu" '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 '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.22/lisp/scroll-bar.el100444 12241 1 14507 5430543062 15144 0ustar rolanddaemon;;; scroll-bar.el --- window system-independent scroll bar support. ;;; Copyright (C) 1993 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-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) (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))))))) (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))) (select-window window) (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))) (select-window window) (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.22/lisp/select.el100444 12120 1 24406 5400515610 13673 0ustar rmsdaemon;;; select.el --- lisp portion of standard selection support. ;; Keywords: internal ;; Copyright (c) 1993 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), 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." (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)))))) ;; 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)))))) ;;; (and (fboundp 'extentp) ;;; (extentp 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) ;;; ((extentp value) ;;; (save-excursion ;;; (set-buffer (extent-buffer value)) ;;; (buffer-substring (extent-start-position value) ;;; (extent-end-position 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)) ;;; ((extentp value) ;;; (extent-length 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 ;;; ((extentp value) ;;; (buffer-file-name (or (extent-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 ;;; ((extentp value) ;;; (setq a (extent-start-position value) ;;; b (extent-end-position 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)))) ;;; ((extentp value) ;;; (setq buf (extent-buffer value) ;;; a (extent-start-position value) ;;; b (extent-end-position 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))) ;;; ((extentp value) ;;; (setq buf (extent-buffer value) ;;; a (extent-start-position value) ;;; b (extent-end-position 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.22/lisp/sendmail.el100444 12120 1 72772 5473764367 14252 0ustar rmsdaemon;;; sendmail.el --- mail sending commands for Emacs. ;; Copyright (C) 1985, 1986, 1992 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-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 are be delimited by a line which is `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. Do not use an rmail file here! Instead, use its inbox file.") (defvar mail-default-reply-to nil "*Address to insert as default Reply-to field of outgoing messages.") (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-aliases t "Alist of mail address aliases, or t meaning should be initialized from `~/.mailrc'. The alias definitions in `~/.mailrc' have this form: alias ALIAS MEANING") (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 `~/.mailrc' 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 `~/.signature'.") (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-mode-syntax-table nil "Syntax table used while in mail mode.") (if (null mail-mode-syntax-table) (progn (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)) (modify-syntax-entry ?% ". " mail-mode-syntax-table))) (defun mail-setup (to subject in-reply-to cc replybuffer actions) (if (eq mail-aliases t) (progn (setq mail-aliases nil) (if (file-exists-p "~/.mailrc") (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 (insert "In-reply-to: " in-reply-to "\n")) (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 "~/.signature") (insert-file-contents "~/.signature"))) (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 Subj: C-c C-f C-b move to BCC: C-c C-f C-c move to CC: C-c C-t move to message text. 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 'paragraph-separate) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^" mail-header-separator "$\\|^[ \t]*[-_][-_][-_]+$\\|" paragraph-start)) (setq paragraph-separate (concat "^" 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-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 "Headers"))) (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)) (if (and (not arg) (not (one-window-p)) (save-excursion (set-buffer (window-buffer (next-window (selected-window) 'not))) (eq major-mode 'rmail-mode))) (delete-window) (switch-to-buffer newbuf))))) (defun mail-send () "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 (message "Sending...") (run-hooks 'mail-send-hook) (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 () (let ((errbuf (if mail-interactive (generate-new-buffer " sendmail errors") 0)) (tembuf (generate-new-buffer " sendmail 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 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)) (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)) (if (re-search-forward "^Sender:" delimline t) (error "Sender may not be specified.")) ;; Find and handle any FCC fields. (goto-char (point-min)) (if (re-search-forward "^FCC:" delimline t) (mail-do-fcc delimline)) ;;; 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"))) ;; "S:" is an abbreviation for "Subject:". (goto-char (point-min)) (if (re-search-forward "^S:" delimline t) (replace-match "Subject:")) ;; 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)))) (apply 'call-process-region (append (list (point-min) (point-max) (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail") nil errbuf nil "-oi" "-t") ;; 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")))) (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 (get-file-buffer (car fcc-list)))) (if buffer ;; File is present in a buffer => append to that buffer. (let ((curbuf (current-buffer)) (beg (point-min)) (end (point-max)) (beg2 (save-excursion (goto-char (point-min)) (forward-line 2) (point)))) (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" "From: " (user-login-name) "\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. (write-region ;; Include a blank line before if file already exists. (if (file-exists-p (car fcc-list)) (point-min) (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 () "Add a new FCC field, with file name completion." (interactive) (expand-abbrev) (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. (mail-position-on-field "to")) (insert "\nFCC: " (read-file-name "Folder carbon copy: "))) (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) "\n")) (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 text field." (interactive) (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n"))) (defun mail-signature (atpoint) "Sign letter with contents of `mail-signature-file'." (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") (insert-file-contents (expand-file-name "~/.signature")))) (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) (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. By default, the signature file `~/.signature' is 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. If `mail-setup-hook' is bound, its value is called with no arguments after the message is initialized. It can add more default fields. When calling from a program, 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)) (switch-to-buffer "*mail*") (setq default-directory (expand-file-name "~/")) (auto-save-mode auto-save-default) (mail-mode) (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) (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)) (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)) (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) ;;; Do not add anything but external entries on this page. (provide 'sendmail) ;;; sendmail.el ends here emacs-19.22/lisp/server.el100444 12120 1 31311 5431363067 13726 0ustar rmsdaemon;;; server.el --- Lisp code for GNU Emacs running as server process. ;; Copyright (C) 1986, 1987, 1992 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 "emacsserver" "*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-process nil "the current server process") (defvar server-previous-string "") (defvar server-clients nil "List of current server clients. Each element is (CLIENTID FILES...) 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.") ;; 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.") (make-variable-buffer-local 'server-buffer-clients) (put 'server-buffer-clients 'permanent-local t) (setq-default server-buffer-clients nil) (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 string) (or (bobp) (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 `etc/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)) ;; 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"))) (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 (not (and (eq ?\n (aref string (1- (length string)))) (eq 0 (string-match "Client: " string)))) ;; If input is not complete, save it for later. (setq server-previous-string string) ;; If it is complete, process it now, and discard what was saved. (setq string (substring string (match-end 0))) (setq server-previous-string "") (let ((client (list (substring string 0 (string-match " " string)))) (files nil) (lineno 1)) (setq string (substring string (match-end 0))) (while (string-match "[^ ]+ " string) (let ((arg (substring string (match-beginning 0) (1- (match-end 0))))) (setq string (substring string (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]."))))) (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)." (let (client-record (obuf (current-buffer))) ;; Restore the current buffer afterward, but not using save-excursion, ;; because we don't want to save point in this buffer ;; if it happens to be one of those specified by the server. (unwind-protect (while files ;; If there is an existing buffer modified or the file is modified, ;; revert it. ;; If there is an existing buffer with deleted file, offer to write it. (let* ((filen (car (car files))) (obuf (get-file-buffer filen))) (if (and obuf (set-buffer obuf)) (if (file-exists-p filen) (if (or (not (verify-visited-file-modtime obuf)) (buffer-modified-p obuf)) (revert-buffer t nil)) (if (y-or-n-p (concat "File no longer exists: " filen ", write buffer to file? ")) (write-file filen))) (set-buffer (find-file-noselect filen)) (run-hooks 'server-visit-hook))) (goto-line (nth 1 (car files))) (setq server-buffer-clients (cons (car client) server-buffer-clients)) (setq client-record (cons (current-buffer) client-record)) (setq files (cdr files))) (set-buffer obuf)) (nconc client client-record))) (defun server-buffer-done (buffer) "Mark BUFFER as \"done\" for its client(s). Buries the buffer, and returns another server buffer as a suggestion for what to select next." (let ((running (eq (process-status server-process) 'run)) (next-buffer nil) (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) ;; If client now has no pending buffers, ;; tell it that it is done, and forget it entirely. (if (cdr client) nil (if running (progn (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 (buffer-name buffer) (save-excursion (set-buffer buffer) (setq server-buffer-clients nil))) (bury-buffer buffer) next-buffer)) (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. Then bury it, and return a suggested buffer to select next." (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) (kill-buffer buffer)) (if (and (buffer-modified-p) (y-or-n-p (concat "Save file " buffer-file-name "? "))) (save-buffer buffer))) (server-buffer-done buffer))))) (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) (server-switch-buffer (server-done)))) (defun server-switch-buffer (next-buffer) "Switch to another buffer, preferably one that has a client. Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." (cond ((windowp server-window) (select-window server-window)) ((framep server-window) (select-window (frame-selected-window server-window)))) (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. (server-switch-buffer (server-buffer-done next-buffer))) (if server-clients (server-switch-buffer (nth 1 (car server-clients))) (switch-to-buffer (other-buffer))))) (global-set-key "\C-x#" 'server-edit) (provide 'server) ;;; server.el ends here emacs-19.22/lisp/sgml-mode.el100444 12120 1 20566 5402476773 14325 0ustar rmsdaemon;;; 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; 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.22/lisp/shadowfile.el100444 12120 1 74443 5474325370 14564 0ustar rmsdaemon;;; shadowfile.el -- automatic file copying for Emacs 19 ;;; Author: Boris Goldowsky ;;; Keywords: comm ;;; Copyright (c) 1993 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. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author or from the Free Software Foundation, Inc., 675 ;;; Mass Ave, Cambridge, MA 02139, USA. ;;; LCD Archive Entry: ;;; shadowfile|Boris Goldowsky|boris@cs.rochester.edu| ;;; Helps you keep identical copies of files in multiple places.| ;;; $Date: 1993/11/23 06:17:27 $ |$Revision: 1.1 $|~/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@cs.rochester.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 nonnil, always copy shadow files without asking.") (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 (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 (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) ((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 (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 (may not be complete) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (shadow-when (not (fboundp 'file-truename)) (require 'symlink-fix) (defun shadow-expand-file-name (file &optional default) (symlink-expand-file-name file default))) (shadow-when (not (fboundp 'ange-ftp-ftp-name)) (require 'ange-ftp) (defun shadow-parse-fullpath (fullpath) (if (listp fullpath) fullpath (ange-ftp-ftp-path fullpath)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; 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.22/lisp/shell.el100444 12120 1 72231 5475014641 13534 0ustar rmsdaemon;;; shell.el --- specialized comint.el for running the shell. ;;; Copyright (C) 1988, 1993 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 (s.marshall@dcs.hull.ac.uk) ;;; 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 C-c t to run my favorite command in shell mode: ;; (setq shell-mode-hook ;; '((lambda () ;; (define-key shell-mode-map "\C-ct" 'favorite-cmd)))) ;;; 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-R comint-previous-matching-input-from-input -"- matching input ;;; m-s comint-next-matching-input Next input that matches ;;; m-S comint-next-matching-input-from-input -"- matching input ;;; m-c-r comint-previous-input-matching Search backwards in input history ;;; return comint-send-input ;;; c-a comint-bol Beginning of line; skip prompt ;;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff. ;;; 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 ;;; ;;; 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. ;;; SHELL.EL COMPATIBILITY ;;; Notes from when this was called cmushell, and was not the standard emacs ;;; shell package. ;;;============================================================================ ;;; In brief: this package should have no trouble coexisting with shell.el. ;;; ;;; Most customising variables -- e.g., explicit-shell-file-name -- are the ;;; same, so the users shouldn't have much trouble. Hooks have different ;;; names, however, so you can customise shell mode differently from cmushell ;;; mode. You basically just have to remember to type M-x cmushell instead of ;;; M-x shell. ;;; ;;; It would be nice if this file was completely plug-compatible with the old ;;; shell package -- if you could just name this file shell.el, and have it ;;; transparently replace the old one. But you can't. Several other packages ;;; (tex-mode, background, dbx, gdb, kermit, monkey, prolog, telnet) are also ;;; clients of shell mode. These packages assume detailed knowledge of shell ;;; mode internals in ways that are incompatible with cmushell mode (mostly ;;; because of cmushell mode's greater functionality). So, unless we are ;;; willing to port all of these packages, we can't have this file be a ;;; complete replacement for shell.el -- that is, we can't name this file ;;; shell.el, and its main entry point (shell), because dbx.el will break ;;; when it loads it in and tries to use it. ;;; ;;; There are two ways to fix this. One: rewrite these other modes to use the ;;; new package. This is a win, but can't be assumed. The other, backwards ;;; compatible route, is to make this package non-conflict with shell.el, so ;;; both files can be loaded in at the same time. And *that* is why some ;;; functions and variables have different names: (cmushell), ;;; cmushell-mode-map, that sort of thing. All the names have been carefully ;;; chosen so that shell.el and cmushell.el won't tromp on each other. ;;; 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-delimiter-argument-list '("|" "&" "<" ">" "(" ")" ";") "List of characters to recognise as separate arguments. Defaults to \(\"|\" \"&\" \"\(\" \")\" \";\"), which works pretty well. This variable is used to initialise `comint-delimiter-argument-list' in the shell buffer. This is a fine thing to set in your `.emacs' file.") (defvar shell-command-regexp "\\((.*)\\|[^;&|]\\)+" "*Regexp to match shell commands. Elements of pipes are considered as separate commands, forks and redirections as part of one command.") (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.") ;;; All the above vars aren't prefixed "cmushell-" to make them ;;; backwards compatible w/shell.el and old .emacs files. (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-last-dir nil "Keep track of last directory for ksh `cd -' command.") (defvar shell-dirstack-query "dirs" "Command used by `shell-resync-dir' to query the shell.") (defvar shell-mode-map '()) (cond ((not shell-mode-map) (setq shell-mode-map (full-copy-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))) (defvar shell-mode-hook '() "*Hook for customising Shell mode.") ;;; Basic Procedures ;;; =========================================================================== ;;; (defun shell-mode () "Major mode for interacting with an inferior shell. Return after the end of the process' output sends the text from the end of process to the end of the current line. Return before end of process output copies the current line (except for the prompt) to the end of the buffer and sends it. M-x send-invisible reads a line of text without echoing it, and sends it to the shell. This is useful for entering passwords. 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. M-x dirs queries the shell and resyncs Emacs' idea of what the current directory stack is. M-x 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). 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' and `comint-completion-recexact' control the behavior of file name, command name and variable name completion. Variable `shell-completion-execonly' controls the behavior of command name completion. 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', `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-delimiter-argument-list shell-delimiter-argument-list) (setq comint-after-partial-filename-command 'shell-after-partial-filename) (setq comint-get-current-command 'shell-get-current-command) (setq comint-dynamic-complete-command-command 'shell-dynamic-complete-command) (make-local-variable 'paragraph-start) (setq paragraph-start comint-prompt-regexp) (make-local-variable 'shell-dirstack) (setq shell-dirstack nil) (setq shell-last-dir nil) (make-local-variable 'shell-dirtrackp) (setq shell-dirtrackp t) (setq comint-input-sentinel 'shell-directory-tracker) ;; shell-dependent assignments. (let ((shell (car (process-command (get-buffer-process (current-buffer)))))) (setq comint-input-ring-file-name (or (getenv "HISTFILE") (cond ((string-match "csh$" shell) "~/.history") ((string-match "bash$" shell) "~/.bash_history") ((string-match "ksh$" shell) "~/.sh_history") (t "~/.history"))))) (run-hooks 'shell-mode-hook) (comint-read-input-ring) (shell-dirstack-message)) ;;;###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")))) (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")))) (shell-mode))) (switch-to-buffer "*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 "^[;\\s ]*" 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 ((eq (string-match shell-popd-regexp cmd) 0) (shell-process-popd (substitute-in-file-name arg1))) ((eq (string-match shell-pushd-regexp cmd) 0) (shell-process-pushd (substitute-in-file-name arg1))) ((eq (string-match shell-cd-regexp cmd) 0) (shell-process-cd (substitute-in-file-name arg1)))) (setq start (progn (string-match "[;\\s ]*" str end) ; skip again (match-end 0))))) (error (message "Couldn't cd"))))) ;; Like `cd', but prepends comint-file-name-prefix to absolute names. (defsubst shell-cd (directory) (if (file-name-absolute-p directory) (cd-absolute (concat comint-file-name-prefix directory)) (cd directory))) ;;; 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 (message "Couldn't popd.")))))) ;;; cd [dir] (defun shell-process-cd (arg) (let ((new-dir (cond ((zerop (length arg)) (getenv "HOME")) ((string-equal "-" arg) shell-last-dir) (t 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 "~")) (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 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) (setq shell-dirtrackp (not shell-dirtrackp)) (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF"))) ;;; For your typing convenience: (defalias 'dirtrack-toggle 'shell-dirtrack-toggle) (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 (substring dl (match-beginning 1) (match-end 1)) ds)) (setq i (match-end 0))) (let ((ds (reverse ds))) (condition-case nil (progn (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 "\\([;&|][\\s ]*\\)+") limit 'move arg) (skip-syntax-backward "^\\s ")))) (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)))) (skip-syntax-backward "\\s " limit) (if (re-search-backward (format "[;&|]+[\\s ]*\\(%s\\)" shell-command-regexp) limit 'move arg) (progn (goto-char (match-beginning 1)) (skip-syntax-backward "^\\s "))))) (defun shell-get-current-command () "Function that returns the current command including arguments." (save-excursion (if (looking-at "\\s *[^;&|]") (goto-char (match-end 0))) (buffer-substring (progn (shell-backward-command 1) (point)) (progn (shell-forward-command 1) (if (eolp) (point) (match-end 1)))))) (defun shell-after-partial-filename () "Returns t if point is after a file name. File names are assumed to contain `/'s or not be the first item in the command. See also `shell-backward-command'." (let ((filename (comint-match-partial-filename))) (or (save-match-data (string-match "/" filename)) (not (eq (match-beginning 0) (save-excursion (shell-backward-command 1) (point))))))) (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 `comint-dynamic-complete-filename'." (interactive) (let* ((completion-ignore-case nil) (filename (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 (mapconcat (function (lambda (x) (concat (regexp-quote x) "$"))) completion-ignored-extensions "\\|")) (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 (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. (cond ((null completions) (message "No completions of %s" filename) (ding)) ((= 1 (length completions)) ; Gotcha! (let ((completion (car completions))) (if (string-equal completion pathnondir) (message "Sole completion") (insert (substring (directory-file-name completion) (length pathnondir))) (message "Completed")) (if comint-completion-addsuffix (insert (if (file-directory-p completion) "/" " "))))) (t ; There's no unique completion. (let ((completion (try-completion pathnondir (mapcar (function (lambda (x) (list x))) completions)))) ;; Insert the longest substring. (insert (substring (directory-file-name completion) (length pathnondir))) (cond ((and comint-completion-recexact comint-completion-addsuffix (string-equal pathnondir completion) (member completion completions)) ;; It's not unique, but user wants shortest match. (insert (if (file-directory-p completion) "/" " ")) (message "Completed shortest")) ((or comint-completion-autolist (string-equal pathnondir completion)) ;; It's not unique, list possible completions. (comint-dynamic-list-completions completions)) (t (message "Partially completed")))))))) ;;; Do the user's customization... ;;; ;;; Isn't this what eval-after-load is for? ;;;(defvar shell-load-hook nil ;;; "This hook is run when shell is loaded in. ;;;This is a good place to put keybindings.") ;;; ;;;(run-hooks 'shell-load-hook) (provide 'shell) ;;; shell.el ends here emacs-19.22/lisp/simple.el100444 12120 1 243333 5475024301 13733 0ustar rmsdaemon;;; simple.el --- basic editing commands for Emacs ;; 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. ;;; Commentary: ;; A grab-bag of basic Emacs commands not specifically related to some ;; major mode or to file-handling. ;;; Code: (defun open-line (arg) "Insert a newline and leave point before it. If there is a fill prefix, insert the fill prefix on the new line if the line would have been empty. With arg N, insert N newlines." (interactive "*p") (let* ((do-fill-prefix (and fill-prefix (bolp))) (flag (and (null do-fill-prefix) (bolp) (not (bobp))))) ;; If this is a simple case, and we are at the beginning of a line, ;; actually insert the newline *before* the preceding newline ;; instead of after. That makes better display behavior. (if flag (progn ;; If undo is enabled, don't let this hack be visible: ;; record the real value of point as the place to move back to ;; if we undo this insert. (if (and buffer-undo-list (not (eq buffer-undo-list t))) (setq buffer-undo-list (cons (point) buffer-undo-list))) (forward-char -1))) (while (> arg 0) (save-excursion (insert ?\n)) (if do-fill-prefix (insert fill-prefix)) (setq arg (1- arg))) (if flag (forward-char 1)))) (defun split-line () "Split current line, moving portion beyond point vertically down." (interactive "*") (skip-chars-forward " \t") (let ((col (current-column)) (pos (point))) (insert ?\n) (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 (eq overwrite-mode 'overwrite-mode-binary) (delete-char arg)) (insert-char char 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 all blank lines that follow it." (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 variable `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 variable `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 prefix arg is 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 true beginning. Don't use this command in Lisp programs! \(goto-char (point-min)) is faster and avoids clobbering the mark." (interactive "P") (push-mark) (goto-char (if arg (if (> (buffer-size) 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ (buffer-size) 10)) (/ (+ 10 (* (buffer-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 true end. Don't use this command in Lisp programs! \(goto-char (point-max)) is faster and avoids clobbering the mark." (interactive "P") (push-mark) (goto-char (if arg (- (1+ (buffer-size)) (if (> (buffer-size) 10000) ;; Avoid overflow for large buffer sizes! (* (prefix-numeric-value arg) (/ (buffer-size) 10)) (/ (* (buffer-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))) (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 line number (in the buffer) of point." (interactive) (save-restriction (widen) (save-excursion (beginning-of-line) (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-match-data (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (if (eq selective-display t) (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) point=%d of %d(%d%%) <%d - %d> column %d %s" (single-key-description char) char pos total percent beg end col hscroll) (message "Char: %s (0%o) point=%d of %d(%d%%) column %d %s" (single-key-description 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)))) (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 (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 "Nonzero 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 "") (setcar minibuffer-history-search-history (nth 1 minibuffer-history-search-history)) 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 (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 (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") (let ((narg (min (max 1 (- minibuffer-history-position n)) (length (symbol-value minibuffer-history-variable))))) (if (= minibuffer-history-position narg) (error (if (= 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 (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 previous 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 next 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: ") (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") (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))) (setq this-command 'undo) (undo-more (or arg 1)) (and modified (not (buffer-modified-p)) (delete-auto-save-file-if-necessary recent-save)))) (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.") (defun shell-command (command &optional flag) "Execute string COMMAND in inferior shell; display output, if any. If COMMAND ends in ampersand, execute it asynchronously. Optional second arg non-nil (prefix arg, if interactive) means insert output in current buffer after point (leave mark after it). This cannot be done asynchronously." (interactive (list (read-from-minibuffer "Shell command: " nil nil nil 'shell-command-history) current-prefix-arg)) (if flag (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 "-c" 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. (let ((data (match-data))) (unwind-protect (if (string-match "[ \t]*&[ \t]*$" command) ;; Command ending with ampersand means asynchronous. (let ((buffer (get-buffer-create "*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) (erase-buffer) (display-buffer buffer) (setq default-directory directory) (setq proc (start-process "Shell" buffer shell-file-name "-c" command)) (setq mode-line-process '(": %s")) (set-process-sentinel proc 'shell-command-sentinel) (set-process-filter proc 'shell-command-filter) )) (shell-command-on-region (point) (point) command nil)) (store-match-data data))))) ;; 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)) (progn (message "%s: %s." (car (cdr (cdr (process-command process)))) (substring signal 0 -1)) (save-excursion (set-buffer (process-buffer process)) (setq mode-line-process nil)) (delete-process process)))) (defun shell-command-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) (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. (goto-char opoint) (set-buffer obuf)))) (defun shell-command-on-region (start end command &optional flag interactive) "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. Noninteractive args are START, END, COMMAND, FLAG. Noninteractively FLAG means insert output in place of text from START to END, and put point at the end, but don't alter the mark. 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 output is inserted in the current buffer then `*Shell Command Output*' is deleted." (interactive (list (region-beginning) (region-end) (read-from-minibuffer "Shell command on region: " nil nil nil 'shell-command-history) current-prefix-arg (prefix-numeric-value current-prefix-arg))) (if flag ;; Replace specified region with output from command. (let ((swap (and interactive (< (point) (mark))))) ;; Don't muck with mark ;; unless called interactively. (and interactive (push-mark)) (call-process-region start end shell-file-name t t nil "-c" command) (if (get-buffer "*Shell Command Output*") (kill-buffer "*Shell Command Output*")) (and interactive swap (exchange-point-and-mark))) ;; No prefix argument: put the output in a temp buffer, ;; replacing its entire contents. (let ((buffer (get-buffer-create "*Shell Command Output*"))) (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 (delete-region end (point-max)) (delete-region (point-min) start) (call-process-region (point-min) (point-max) shell-file-name t t nil "-c" command)) ;; Clear the output buffer, then run the command with output there. (save-excursion (set-buffer buffer) (erase-buffer)) (call-process-region start end shell-file-name nil buffer nil "-c" command)) ;; 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) (message "(Shell command completed with no output)") (kill-buffer "*Shell Command Output*")) ((= 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))))))) (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 nil) (let ((factor 4) key) ;; (describe-arg (list factor) 1) (setq key (read-key-sequence nil t)) (while (equal (key-binding key) 'universal-argument) (setq factor (* 4 factor)) ;; (describe-arg (list factor) 1) (setq key (read-key-sequence nil t))) (prefix-arg-internal key factor nil))) (defun prefix-arg-internal (key factor value) (let ((sign 1)) (if (and (numberp value) (< value 0)) (setq sign -1 value (- value))) (if (eq value '-) (setq sign -1 value nil)) ;; (describe-arg value sign) (while (equal key "-") (setq sign (- sign) factor nil) ;; (describe-arg value sign) (setq key (read-key-sequence nil t))) (while (and (stringp key) (= (length key) 1) (not (string< key "0")) (not (string< "9" key))) (setq value (+ (* (if (numberp value) value 0) 10) (- (aref key 0) ?0)) factor nil) ;; (describe-arg value sign) (setq key (read-key-sequence nil t))) (setq prefix-arg (cond (factor (list factor)) ((numberp value) (* value sign)) ((= sign -1) '-))) ;; Calling universal-argument after digits ;; terminates the argument but is ignored. (if (eq (key-binding key) 'universal-argument) (progn (describe-arg value sign) (setq key (read-key-sequence nil t)))) (setq unread-command-events (listify-key-sequence key)))) (defun describe-arg (value sign) (cond ((numberp value) (message "Arg: %d" (* value sign))) ((consp value) (message "Arg: [%d]" (car value))) ((< sign 0) (message "Arg: -")))) (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") (prefix-arg-internal (char-to-string (logand last-command-char ?\177)) nil arg)) (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") (prefix-arg-internal "-" nil arg)) (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) ;; Don't shift point before doing the delete; that way, ;; undo will record the right position of point. (save-excursion (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) "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." (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 t))) (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." (setcar kill-ring (if before-p (concat string (car kill-ring)) (concat (car kill-ring) string))) (if interprogram-cut-function (funcall interprogram-cut-function (car kill-ring)))) (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. (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. (buffer-read-only (copy-region-as-kill beg end) ;; This should always barf, and give us the correct error. (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) (equal 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))) (setq this-command 'kill-region))) (t (copy-region-as-kill beg end) (delete-region beg end)))) (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))) (setq this-command 'kill-region) 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") (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))))) 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) 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 nil 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))))) (defvar mark-even-if-inactive nil "*Non-nil means you can use the mark even when inactive. This option makes a difference in Transient Mark mode. When the option is non-nil, deactivation of the mark turns off region highlighting, but commands that use the mark behave as if the mark were still active.") (put 'mark-inactive 'error-conditions '(mark-inactive error)) (put 'mark-inactive 'error-message "The mark is not active now") (defun mark (&optional force) "Return this buffer's mark value as integer; error if mark inactive. 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 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'." (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))) (deactivate-mark) (set-marker (mark-marker) pos (current-buffer)))) (defvar mark-ring nil "The list of saved former marks of the current buffer, most recent first.") (make-variable-buffer-local 'mark-ring) (defconst mark-ring-max 16 "*Maximum size of 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, and push old mark position on mark ring. With argument, jump to mark, and pop a new position for mark off the 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. 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)) (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, changing the buffer \"deactivates\" the mark. While the mark is active, the region is highlighted." (interactive "P") (setq transient-mark-mode (if (null arg) (not transient-mark-mode) (> (prefix-numeric-value arg) 0)))) (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, a newline character is inserted to create a line and the cursor moves to that line, otherwise the cursor is moved to the end of the buffer (if already at the end of the buffer, an error is signaled). 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") (let ((opoint (point))) (if next-line-add-newlines (if (/= arg 1) (line-move arg) (forward-line 1) (if (or (= opoint (point)) (not (eq (preceding-char) ?\n))) (insert ?\n) (goto-char opoint) (line-move arg))) (if (eobp) (signal 'end-of-buffer nil)) (line-move arg) (if (= opoint (point)) (end-of-line)))) 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") (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.") (defun line-move (arg) (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 (not (integerp selective-display)) (forward-line arg) ;; Move by arg lines, but ignore invisible ones. (while (> arg 0) (vertical-motion 1) (forward-char -1) (forward-line 1) (setq arg (1- arg))) (while (< arg 0) (vertical-motion -1) (beginning-of-line) (setq arg (1+ arg)))) (move-to-column (or goal-column temporary-goal-column)) 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 window horizontally to make point visible." (let* ((here (current-column)) (left (window-hscroll)) (right (- (+ left (window-width)) 3))) (cond ;; Should we recenter? ((or (< here (- left hscroll-step)) (> here (+ right hscroll-step))) (set-window-hscroll (selected-window) ;; Recenter, but don't show too much white space off the end of ;; the line. (max 0 (min (- (save-excursion (end-of-line) (current-column)) (window-width) -5) (- here (/ (window-width) 2)))))) ;; Should we scroll left? ((> here right) (scroll-left hscroll-step)) ;; Or right? ((< here left) (scroll-right hscroll-step))))) ;; 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 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 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 defined.") (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.") (defun indent-for-comment () "Indent this line's comment to comment column, or insert an empty comment." (interactive "*") (beginning-of-line 1) (if (null comment-start) (error "No comment syntax defined") (let* ((eolpos (save-excursion (end-of-line) (point))) cpos indent begpos) (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 comment-start) (save-excursion (insert comment-end)))))) (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 the region; third arg numeric 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)) (cond ((not arg) (setq arg 1)) ((> arg 1) (while (> (setq arg (1- arg)) 0) (setq cs (concat cs comment-start) ce (concat ce comment-end))))) (narrow-to-region beg end) (goto-char beg) (while (not (eobp)) (if (< arg 0) (let ((count arg)) (while (and (> 1 (setq count (1+ count))) (looking-at (regexp-quote cs))) (delete-char (length cs))) (if (string= "" ce) () (setq count arg) (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") (backward-char (length ce)) (if (looking-at (regexp-quote ce)) (delete-char (length ce))))) (forward-line 1)) (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) (save-excursion (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 () "Return the word point is on as a string, if it's between two word-constituent characters. If not, but it immediately follows one, move back first. Otherwise, if point precedes a word constituent, move forward first. Otherwise, move backwards until a word constituent is found and get that word; if you reach a newline first, move forward instead." (interactive) (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)) (progn (skip-syntax-backward "^w_" (save-excursion (beginning-of-line) (point))) (if (eq (preceding-char) ?\n) (progn (skip-syntax-forward "^w_") (setq start (point)) (skip-syntax-forward "w_") (setq end (point))) (setq end (point)) (skip-syntax-backward "w_") (setq start (point))))) (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 (give-up) (or (and auto-fill-inhibit-regexp (save-excursion (beginning-of-line) (looking-at auto-fill-inhibit-regexp))) (while (and (not give-up) (> (current-column) fill-column)) (let ((fill-point (let ((opoint (point))) (save-excursion (move-to-column (1+ fill-column)) (skip-chars-backward "^ \t\n") (if (bolp) (re-search-forward "[ \t]" opoint t)) (skip-chars-backward " \t") (point))))) ;; If there is a space on the line before fill-point, ;; and nonspaces precede it, 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) (save-excursion (goto-char fill-point) (indent-new-comment-line))) ;; If making the new line didn't reduce the hpos of ;; the end of the line, then give up now; ;; trying again will not help. (if (>= (current-column) prev-column) (setq give-up t))) ;; No place to break => stop trying. (setq give-up t))))))) (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 () "Break line at point and indent, continuing comment if presently within one. The body of the continued comment is indented 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]." (interactive "*") (let (comcol comstart) (skip-chars-backward " \t") (delete-region (point) (progn (skip-chars-forward " \t") (point))) (insert ?\n) (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. (let ((win (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 (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 ?\n) (forward-char -1) (indent-for-comment) (save-excursion ;; Make sure we delete the newline inserted above. (end-of-line) (delete-char 1))) (if fill-prefix (insert fill-prefix) (indent-according-to-mode))))) (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 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)) ;; update mode-line (set-buffer-modified-p (buffer-modified-p)))) (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)) (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 nil "*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 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.") (defun blink-matching-open () "Move cursor momentarily to the beginning of the sexp before point." (interactive) (and (> (point) (1+ (point-min))) (not (memq (char-syntax (char-after (- (point) 2))) '(?/ ?\\ ))) blink-matching-paren (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 () (setq blinkpos (scan-sexps oldpos -1)) (error nil))) (and blinkpos (/= (char-syntax (char-after blinkpos)) ?\$) (setq mismatch (/= (char-after (1- oldpos)) (logand (lsh (aref (syntax-table) (char-after blinkpos)) -8) 255)))) (if mismatch (setq blinkpos nil)) (if blinkpos (progn (goto-char blinkpos) (if (pos-visible-in-window-p) (sit-for 1) (goto-char blinkpos) (message "Matches %s" (if (save-excursion (skip-chars-backward " \t") (not (bolp))) (buffer-substring (progn (beginning-of-line) (point)) (1+ blinkpos)) (buffer-substring blinkpos (progn (forward-char 1) (skip-chars-forward "\n \t") (end-of-line) (point))))))) (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) (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)))) 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) (or completion-list-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'mouse-choose-completion) (setq completion-list-mode-map map))) ;; Completion mode is suitable only for specially formatted data. (put 'completion-list-mode 'mode-class 'special) (defun completion-list-mode () "Major mode for buffers showing lists of possible completions. Type \\\\[mouse-choose-completion] to select a completion with the mouse." (interactive) (kill-all-local-variables) (use-local-map completion-list-mode-map) (setq mode-name "Completion List") (setq major-mode 'completion-list-mode) (run-hooks 'completion-list-mode-hook)) (defun completion-setup-function () (save-excursion (completion-list-mode) (goto-char (point-min)) (if window-system (insert (substitute-command-keys "Click \\[mouse-choose-completion] on a completion to select it.\n\n"))))) (add-hook 'completion-setup-hook 'completion-setup-function) ;;;; Keypad support. ;;; 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. (mapcar (lambda (keypad-normal) (let ((keypad (nth 0 keypad-normal)) (normal (nth 1 keypad-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.22/lisp/simula.el100444 11732 1 132736 5447530317 14115 0ustar bfoxdaemon;;; 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.22/lisp/icomplete.elc100666 12120 1 11617 5475727662 14576 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 14:51:13 1993 ;;; from file /home/fsf/rms/e19/lisp/icomplete.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (provide (quote icomplete)) (defvar icomplete-inhibit nil "\ *Set this variable to t at any time to inhibit icomplete.") (defvar icomplete-eoinput 1 "\ Point where minibuffer input ends and completion info begins.") (make-variable-buffer-local (quote icomplete-eoinput)) (defalias 'icomplete-prime-session #[nil "ÀÁ\n\"…Ã\nĔĕO!‰ƒ! ÆVƒ!ÇÈÉ\"‚8 ƒ3ÇÊËÌ#ˆÇÍÎÌ#‚8ÏÐ\nÑ#)‡" [string-match "^19\\.\\([0-9]+\\)" emacs-version string-to-int 1 v19-rev 17 add-hook minibuffer-setup-hook icomplete-prime-minibuffer pre-command-hook icomplete-pre-command-hook append post-command-hook icomplete-post-command-hook format "icomplete: non v19 emacs, %s - %s" "try elisp-archive icomplete"] 5 "\ Prep emacs v 19 for icompletion. For emacs v19.18 and later revs, icomplete is installed in 'minibuffer-setup-hook'. Global pre- and post-command-hook functions are used in v19.17 and earlier revs."]) (defalias 'icomplete-prime-minibuffer #[nil "ÀÁ!ˆÀÂ!ˆÃÁÄ\"ˆÃÂÅ\"‡" [make-local-variable pre-command-hook post-command-hook add-hook icomplete-pre-command-hook icomplete-post-command-hook] 3 "\ Prep emacs, v 19.18 or later, for icomplete. (icomplete-prime- session establishes global hooks, instead, in emacs 19 versions 19.17 and prior.) Run via minibuffer-setup-hook (emacs 19.18 or later), adds icomplete pre- and post-command hooks to do icomplete display management."]) (defalias 'icomplete-window-minibuffer-p '(macro . #[nil "À‡" [(window-minibuffer-p nil)] 1 "\ Returns non-nil if current window is a minibuffer window. Trivially equates to '(window-minibuffer-p nil)', with the nil provided in case the argument is not optional in Lucid emacs (which some net correspondance seems to indicate)."])) (defalias 'icomplete-pre-command-hook #[nil "ÀÁ!…5\n9?…5 ?…5ÄÅ!ƒ. ƒ. dVƒ%d‰‡ d|)‡ÇÅ!ˆÈ‰‡" [window-minibuffer-p nil minibuffer-completion-table icomplete-inhibit boundp icomplete-eoinput buffer-undo-list make-local-variable 1] 2 "\ Cleanup completions exhibit before user's new input (or whatever) is dealt with."]) (defalias 'icomplete-post-command-hook #[nil "ÀÁ!…\n?… 9?… Å )‡" [window-minibuffer-p nil icomplete-inhibit minibuffer-completion-table buffer-undo-list icomplete-exhibit] 2 "\ Exhibit completions, leaving icomplete-eoinput with position where user input leaves off and exhibit begins, so icomplete-pre-command-hook can subsequently cleanup."]) (defalias 'icomplete-window-setup-hook #[nil "ÀÁ!ƒ\nÂÃ!‡ÄÅ!‡" [window-minibuffer-p nil message "ic ws doing" sit-for 1] 2 "\ Exhibit completions, leaving icomplete-eoinput with position where user input leaves off and exhibit begins, so icomplete-pre-command-hook can subsequently cleanup."]) (defalias 'icomplete-exhibit #[nil "9?….ed{ÁŠdbˆÄÅ!„ÆÅ!ˆ`dÇV…-ÈÉ \n ?$!+‡" [minibuffer-completion-table t buffer-undo-list contents boundp icomplete-eoinput make-local-variable 1 insert-string icomplete-prompt minibuffer-completion-predicate minibuffer-completion-confirm] 6 "\ Exhibit completions, leaving icomplete-eoinput with position where user input leaves off and exhibit begins, so icomplete-pre-command-hook can subsequently cleanup."]) (defalias 'icomplete-prompt #[(name candidates predicate require-match) "À \n # ƒ Å‚Æ ƒÇ‚ÈÉÊ   ‰„1ÐÑ #‚™A„V@G GVƒP@ GÒO Q‚QÓÔP‚™Õ \n #‰GÒÙÚÙÛÜÝ\"\"A\" GV…… GÒO Q ƒ“ß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 append mapcar #[(com) "G Uƒ ÂćÅ ÄOD‡" [com most-len t most-is-exact nil ","] 4] alternatives ","] 8 "\ Identify prospective candidates for minibuffer completion. The display is updated with each minibuffer keystroke when icomplete is enabled (by loading the 'icomplete' elisp package) and doing 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."]) (icomplete-prime-session) emacs-19.22/lisp/solar.el100444 12120 1 50141 5471533447 13547 0ustar rmsdaemon;;; solar.el --- calendar functions for solar events. ;; Copyright (C) 1992 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 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. ;;; Commentary: ;; This collection of functions implements the features of calendar.el and ;; diary.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 and ;; on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus, ;; Willmann-Bell, Inc., 1985. ;; ;; 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 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, + north, - south. For example, 40.7 for New York City. It may not be a good idea to set this in advance for your site; if there may be users running Emacs at your site who are physically located elsewhere, they would get the wrong value and might not know how to override it.") ;;;###autoload (defvar calendar-longitude nil "*Longitude of `calendar-location-name' in degrees, + east, - west. For example, -74.0 for New York City. It may not be a good idea to set this in advance for your site; if there may be users running Emacs at your site who are physically located elsewhere, they would get the wrong value and might not know how to override it.") ;;;###autoload (defvar calendar-location-name '(let ((float-output-format "%.1f")) (format "%s%s, %s%s" (abs calendar-latitude) (if (> calendar-latitude 0) "N" "S") (abs calendar-longitude) (if (> calendar-longitude 0) "E" "W"))) "*Expression evaluating to name of `calendar-longitude', calendar-latitude'. Default value is just the latitude, longitude pair.") (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)))) (defun solar-sin-degrees (x) (sin (degrees-to-radians x))) (defun solar-cosine-degrees (x) (cos (degrees-to-radians x))) (defun solar-tangent-degrees (x) (tan (degrees-to-radians x))) (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.") (defmacro solar-degrees-to-hours (deg) (list '/ deg 15)) (defmacro solar-hours-to-days (hour) (list '/ hour 24)) (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 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 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 date &optional style) "Printable form for decimal fraction *standard* TIME on DATE. Optional parameter STYLE forces the time to be standard time when its value is 'standard and daylight savings time (if available) when its value is 'daylight. Format used is given by `calendar-time-display-form'. Converted to daylight savings time 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* ((year (extract-calendar-year date)) (time (round (* 60 time))) (rounded-abs-date (+ (calendar-absolute-from-gregorian date) (/ time 60.0 24.0))) (dst-starts (and 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 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)))) (dst (and (not (eq style 'standard)) (or (eq style 'daylight) (and dst-starts dst-ends (or (and (< dst-starts dst-ends);; northern hemi. (<= dst-starts rounded-abs-date) (< rounded-abs-date dst-ends)) (and (< dst-ends dst-starts);; southern hemi. (or (< rounded-abs-date dst-ends) (<= dst-starts rounded-abs-date))))) (and dst-starts (not dst-ends) (<= dst-starts rounded-abs-date)) (and dst-ends (not dst-starts) (< rounded-abs-date dst-ends))))) (time-zone (if dst calendar-daylight-time-zone-name calendar-standard-time-zone-name)) (time (+ time (if dst calendar-daylight-time-offset 0))) (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)) (set (solar-sunset date))) (format "%s, %s at %s" (if rise (concat "Sunrise " (solar-time-string rise date)) "No sunrise") (if set (concat "sunset " (solar-time-string set date)) "no sunset") (eval calendar-location-name)))) (defun solar-apparent-longitude-of-sun (date) "Apparent longitude of the sun on Gregorian DATE." (let* ((time (/ (- (calendar-absolute-from-gregorian date) (calendar-absolute-from-gregorian '(1 0.5 1900))) 36525)) (l (+ 279.69668 (* 36000.76892 time) (* 0.0003025 time time))) (m (+ 358.47583 (* 35999.04975 time) (* -0.000150 time time) (* -0.0000033 time time time))) (c (+ (* (+ 1.919460 (* -0.004789 time) (* -0.000014 time time)) (solar-sin-degrees m)) (* (+ 0.020094 (* -0.000100 time)) (solar-sin-degrees (* 2 m))) (* 0.000293 (solar-sin-degrees (* 3 m))))) (L (+ l c)) (omega (+ 259.18 (* -1934.142 time))) (app (+ L -0.00569 (* -0.00479 (solar-sin-degrees omega))))) app)) (defun solar-ephemeris-correction (year) "Difference in minutes between Ephemeris time and UTC in YEAR. Value is only an approximation." (let ((T (/ (- year 1900) 100.0))) (+ 0.41 (* 1.2053 T) (* 0.4992 T T)))) (defun solar-equinoxes/solstices (k year) "Date of equinox/solstice K for YEAR. K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within several minutes." (let ((date (list (+ 3 (* k 3)) 21 year)) app (correction 1000)) (while (> correction 0.00001) (setq app (mod (solar-apparent-longitude-of-sun date) 360)) (setq correction (* 58 (solar-sin-degrees (- (* k 90) app)))) (setq date (list (extract-calendar-month date) (+ (extract-calendar-day date) correction) year))) (list (extract-calendar-month date) (+ (extract-calendar-day date) (/ calendar-time-zone 60.0 24.0) (- (/ (solar-ephemeris-correction year) 60.0 24.0))) year))) ;;;###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, prompts for date. If called with an optional double prefix argument, prompts for longitude, latitude, time zone, and date. This function is suitable for execution in a .emacs file." (interactive "p") (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" (abs calendar-latitude) (if (> calendar-latitude 0) "N" "S") (abs calendar-longitude) (if (> calendar-longitude 0) "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)) (message (solar-sunrise-sunset (or (calendar-cursor-to-date) (error "Cursor is not on a 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 (- sunset (/ 18.0 60.0))))) (if light (format "%s Sabbath candle lighting" (solar-time-string light date)))))) ;;;###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))) (date (solar-equinoxes/solstices k y)) (day (extract-calendar-day date)) (time (* 24 (- day (truncate day)))) (s-hemi (and calendar-latitude (< calendar-latitude 0))) ;; Time zone/DST can't move the date out of range, ;; so let solar-time-string do the conversion. (date (list (extract-calendar-month date) (truncate day) (extract-calendar-year date)))) (list (list date (format "%s %s" (nth k (if s-hemi solar-s-hemi-seasons solar-n-hemi-seasons)) (solar-time-string time date))))))) (provide 'solar) ;;; solar.el ends here emacs-19.22/lisp/sort.el100444 12120 1 43111 5424022572 13403 0ustar rmsdaemon;;; sort.el --- commands to sort text in an Emacs buffer. ;; Copyright (C) 1986, 1987 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.") (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))) (function (lambda (a b) (< (car a) (car b))))) ((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 () (skip-chars-forward "\n \t\f"))) '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. If you want to sort floating-point numbers, try `sort-float-fields'." (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"))) ;;;###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) ;isn't dynamic scoping wonderful? (re-search-forward record-regexp) (setq sort-regexp-record-end (point)) (goto-char (match-beginning 0)) (sort-subr reverse (function (lambda () (and (re-search-forward record-regexp nil 'move) (setq sort-regexp-record-end (match-end 0)) (goto-char (match-beginning 0))))) (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.22/lisp/spell.el100444 13437 1 11611 5405344455 13675 0ustar jimbdaemon;;; 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 (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.22/lisp/spook.el100444 12241 1 4254 5421114245 14212 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.22/lisp/startup.el100444 12120 1 41436 5473254207 14134 0ustar rmsdaemon;;; startup.el --- process Emacs shell arguments ;; Copyright (C) 1985, 1986, 1992 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 processed only at the beginning of the argument list. ; -batch execute noninteractively (messages go to stdout, ; variable noninteractive set to t) ; This option must be the first in the arglist. ; Processed by `main' in emacs.c -- never seen by lisp ; -t file Specify to use file rather than stdin/stdout ; as the terminal. ; This option must be the first in the arglist. ; Processed by `main' in emacs.c -- never seen by lisp ; -nw Inhibit the use of any window-system-specific display ; code; use the current virtual terminal. ; This option must be the first in the arglist. ; Processed by `main' in emacs.c -- never seen by lisp ; -q load no init file ; -no-init-file same ; -u user load user's init file ; -user user same ; -debug-init Don't catch errors in init file; let debugger run. ; These are processed in the order encountered. ; -f function execute function ; -funcall function same ; -l file load file ; -load file same ; -insert file same ; file visit file ; -kill kill (exit) emacs ;;; 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 messages. This is for use in your personal init file, once you are familiar with the contents of the startup message.") (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-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 before-init-hook nil "Functions to call after handling urgent options but before loading init file. 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 "Function called to initialize window system display. Emacs calls this after processing the command line arguments and loading the user's init file. Users should not set this variable; use term-setup-hook instead.") (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 may be the null string or a string containing a user's name. If the value is a null string, it means that the init file was taken from the user that originally logged in. In all cases, `(concat \"~\" init-file-user \"/\")' evaluates to the directory name of the directory where the `.emacs' file was looked for.") (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'.") (defvar init-file-debug nil) (defvar init-file-had-error nil) (defun normal-top-level () (if command-line-processed (message "Back to top level.") (setq command-line-processed t) (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)) (unwind-protect (command-line) ;; Do this again, in case .emacs defined more abbreviations. (setq default-directory (abbreviate-file-name default-directory)) (run-hooks 'emacs-startup-hook) (and term-setup-hook (run-hooks 'term-setup-hook)) ;; Modify the initial frame based on what .emacs puts into ;; ...-frame-alist. (if (fboundp 'frame-notice-user-settings) (frame-notice-user-settings)) ;; Now we know the user's default font, so add it to the menu. (if (fboundp 'font-menu-add-default) (font-menu-add-default)) (and window-setup-hook (run-hooks 'window-setup-hook))))) (defun command-line () ;; 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)))) ;;! 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. (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)) (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 ((argi (car args))) (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")) (setq args (cdr args) init-file-user (car args) 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))) (t (setq done t))))) ;; Re-attach the program name to the front of the arg list. (setcdr command-line-args args)) ;; Under X Windows, this creates the X frame and deletes the terminal frame. (if (fboundp 'frame-initialize) (frame-initialize)) (if (fboundp 'face-initialize) (face-initialize)) (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 init-file-debug) ;; This function actually reads the init files. (inner (function (lambda () (if init-file-user (progn (load (if (eq system-type 'vax-vms) "sys$login:.emacs" (concat "~" init-file-user "/.emacs")) 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))))) (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 (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) (unwind-protect (progn (insert (emacs-version) " Copyright (C) 1993 Free Software Foundation, Inc.\n\n") ;; 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-h\C-c") 'describe-copying) (eq (key-binding "\C-h\C-d") 'describe-distribution) (eq (key-binding "\C-h\C-w") 'describe-no-warranty) (eq (key-binding "\C-ht") 'help-with-tutorial)) (insert "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. 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 "Type \\[help-command] 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. 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))))) (let ((dir default-directory) (file-count 0) first-file-buffer (line 0)) (while command-line-args-left (let ((argi (car command-line-args-left)) tem) (setq command-line-args-left (cdr command-line-args-left)) (cond ((setq tem (assoc argi command-switch-alist)) (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 (setq tem (intern (car command-line-args-left))) (setq command-line-args-left (cdr command-line-args-left)) (funcall tem)) ((or (string-equal argi "-l") (string-equal argi "-load")) (let ((file (car command-line-args-left))) ;; 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)) (setq command-line-args-left (cdr command-line-args-left))) ((string-equal argi "-insert") (or (stringp (car command-line-args-left)) (error "filename omitted from `-insert' option")) (insert-file-contents (car command-line-args-left)) (setq command-line-args-left (cdr command-line-args-left))) ((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 (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.22/lisp/studly.el100444 13437 1 3275 5354240752 14067 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.22/lisp/subr.el100444 12120 1 60711 5474601420 13374 0ustar rmsdaemon;;; subr.el --- basic lisp subroutines for Emacs ;;; 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. ;;; 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, etcetera. ARGS should take the same form as an argument list for a `defun'. DOCSTRING should be a string, as described for `defun'. It may be omitted. 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)))) ;;;; Window tree functions. (defun one-window-p (&optional nomini) "Returns non-nil if there is only one window. Optional arg NOMINI non-nil means don't count the minibuffer even if it is active." (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))))) (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. If MINIBUF is neither t nor nil it means not to count the minibuffer even if it is active. Optional third arg ALL-FRAMES, if t, means include all frames. ALL-FRAMES nil or omitted means 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, stick strictly to the selected 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." ;; nil nil means include WINDOW's frame ;; and other frames using WINDOW as minibuffer, ;; and include minibuffer if active. (let ((prev (previous-window window nil nil))) ;; If PREV equals WINDOW, WINDOW must be on a minibuffer-only frame ;; and it's not currently being used. So return nil. (and (not (eq window prev)) (let ((should-be-same (next-window prev nil nil))) ;; If next-window doesn't reverse previous-window, ;; WINDOW must be outside the cycle specified by nil nil. (eq should-be-same window))))) ;;;; Keymap support. (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))) (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))) ;; 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) ;; Skip past menu-prompt. (while (stringp (car-safe 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 newdef) (if (keymapp defn) (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) ;; Skip past menu-prompt. (while (stringp (car-safe 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 newdef) (if (keymapp defn) (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--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. ;; This code exists specifically to make sure that the ;; resulting number does not appear in the .elc file. ;; The number is negative on most machines, but not on all! (defconst listify-key-sequence-1 (lsh 1 7)) (setq listify-key-sequence-1 (logior (lsh 1 23) listify-key-sequence-1)) (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 (lsh 1 23))) (setq list (cons 'meta list))) (or (and (zerop (logand type (lsh 1 22))) (>= (logand type 127) 32)) (setq list (cons 'control list))) (or (and (zerop (logand type (lsh 1 21))) (= (logand type 255) (downcase (logand type 255)))) (setq list (cons 'shift list))) (or (zerop (logand type (lsh 1 20))) (setq list (cons 'hyper list))) (or (zerop (logand type (lsh 1 19))) (setq list (cons 'super list))) (or (zerop (logand type (lsh 1 18))) (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 (COL . ROW) 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 (COL . ROW) 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 (COL . ROW) 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 (COL . ROW) 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-col-row (position) "Return the row and column in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP) as returned by the `event-start' and `event-end' functions." (nth 2 position)) (defsubst posn-timestamp (position) "Return the timestamp of POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP) as returned by the `event-start' and `event-end' functions." (nth 3 position)) ;;;; Obsolescent names for functions. (defalias 'make-syntax-table 'copy-syntax-table) (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) ;;; 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. (defun run-hooks (&rest hooklist) "Takes hook names and runs each one in turn. Major mode functions use this. Each argument should be a symbol, a hook variable. These symbols are processed in the order specified. If a hook symbol has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with no arguments. If it is a list, the elements are called, in order, with no arguments." (while hooklist (let ((sym (car hooklist))) (and (boundp sym) (symbol-value sym) (let ((value (symbol-value sym))) (if (and (listp value) (not (eq (car value) 'lambda))) (mapcar 'funcall value) (funcall value))))) (setq hooklist (cdr hooklist)))) ;; Tell C code how to call this function. (defconst run-hooks 'run-hooks "Variable by which C primitives find the function `run-hooks'. Don't change it.") (defun add-hook (hook function &optional append) "Add to the value of HOOK the function FUNCTION. FUNCTION is not added if already present. FUNCTION is added (if necessary) at the beginning of the hook list unless the optional argument APPEND is non-nil, in which case FUNCTION is added at the end. HOOK should be a symbol, and FUNCTION may be any valid function. If HOOK is void, it is first set to nil. If HOOK's value is a single function, it is changed to a list of functions." (or (boundp hook) (set hook nil)) ;; If the hook value is a single function, turn it into a list. (let ((old (symbol-value hook))) (if (or (not (listp old)) (eq (car old) 'lambda)) (set hook (list old)))) (or (if (consp function) ;; Clever way to tell whether a given lambda-expression ;; 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)))))) (defun remove-hook (hook function) "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'." (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) (setq hook-value (delete function hook-value)) (if (eq hook-value function) (setq hook-value nil))) (set hook hook-value)))) ;;;; 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'. FILE should be the name of a library, with no directory name." (or (assoc file after-load-alist) (setq after-load-alist (cons (list file) after-load-alist))) (nconc (assoc file after-load-alist) (list 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 ((count 0) (code 0) char) (while (< count 3) (let ((inhibit-quit (zerop count)) (help-form nil)) (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)))) (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 then force then 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) (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. (defun ignore (&rest ignore) "Do nothing. Accept any number of arguments, but ignore them." 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))))) (defun user-original-login-name () "Return user's login name from original login. This tries to remain unaffected by `su', by looking in environment variables." (or (getenv "LOGNAME") (getenv "USER") (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 handle as usual in the shell." (if (eq system-type 'vax-vms) (apply 'start-process name buffer args) (start-process name buffer shell-file-name "-c" (concat "exec " (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))))) ;; 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.22/lisp/sun-curs.el100444 12241 12 15345 5444575256 14565 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.22/lisp/sun-fns.el100444 12241 12 54537 5444575257 14406 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.22/lisp/supercite.el100444 12120 1 211042 5474463321 14445 0ustar rmsdaemon;;; supercite.el --- minor mode for citing mail and news replies ;; 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 ;; Copyright (C) 1993 Barry A. Warsaw ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public 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) ) (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) (funcall 'read-string prompt initial-contents history) (funcall 'read-string prompt initial-contents))) (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)))) (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))))) (and (memq 'v19 sc-emacs-features) (fset 'sc-member 'member)) (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-submatch 1 curline))) (val (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-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 (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 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) (set-buffer-modified-p (buffer-modified-p))) (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)) 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 (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.22/lisp/swedish.el100444 13437 1 12051 5400077412 14212 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.22/lisp/tabify.el100444 12120 1 4621 5475026626 13667 0ustar rmsdaemon;;; tabify.el --- tab conversion 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: ;; 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 ((start (point)) (column (current-column)) (indent-tabs-mode nil)) (skip-chars-backward "\t") (delete-region start (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 (narrow-to-region start 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.22/lisp/tar-mode.el100444 12241 1 125111 5432507001 14621 0ustar rolanddaemon;;; tar-mode.el --- simple editing of tar files from GNU emacs ;;; Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Created: 04 Apr 1990 ;; Version: 1.21bis (some cleanup by ESR) ;; 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 In the directory listing, we don't show creation times because I don't ;;; know how to print an arbitrary date, and I don't really want to have to ;;; implement decode-universal-time. ;;; ;;; 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. ;;; 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 "*Whether 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-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 tokenize-tar-header-block (string) "Return a `tar-header' structure. This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name." (cond ((< (length string) 512) nil) (;(some 'plusp string) ; <-- oops, massive cycle hog! (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-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) 48))) start (1+ start))) n))) (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 checksum-tar-header-block (string) "Compute and return a tar-acceptable checksum for this block." (let* ((chk-field-start tar-chk-offset) (chk-field-end (+ chk-field-start 8)) (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 check-tar-header-block-checksum (hblock desired-checksum file-name) "Beep and print a warning if the checksum doesn't match." (if (not (= desired-checksum (checksum-tar-header-block hblock))) (progn (beep) (message "Invalid checksum for file %s!" file-name)))) (defun recompute-tar-header-block-checksum (hblock) "Modifies the given string to have a valid checksum field." (let* ((chk (checksum-tar-header-block 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-grind-file-mode (mode string start) "Write a \"-rw--r--r-\" representing MODE into STRING beginning at START." (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 summarize-tar-header-block (tar-hblock &optional mod-p) "Returns a line similar to the output of `tar -vtf'." (let ((name (tar-header-name tar-hblock)) (mode (tar-header-mode tar-hblock)) (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 2) (slash (1- (+ left namew))) (lastdigit (+ slash groupw sizew)) (namestart (+ lastdigit 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)) (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)))) ;; ## bloody hell, how do I print an arbitrary date?? (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))))) 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 nil)) (while (not (eq tokens 'empty-tar-block)) (let* ((hblock (buffer-substring pos (+ pos 512)))) (setq tokens (tokenize-tar-header-block hblock)) (setq pos (+ pos 512)) (message "parsing tar file...%s%%" ;(/ (* pos 100) bs) ; this gets round-off lossage (/ pos bs100) ; this doesn't ) (if (eq tokens 'empty-tar-block) nil (if (null tokens) (error "premature EOF parsing tar file.")) (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.... ;(check-tar-header-block-checksum ; hblock (checksum-tar-header-block hblock) ; (tar-header-name tokens)) (setq result (cons (make-tar-desc pos tokens) result)) (if (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))) (save-excursion (goto-char (point-min)) (let ((buffer-read-only nil)) (tar-dolist (tar-desc tar-parse-info) (insert-string (summarize-tar-header-block (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))) (message "parsing tar file...done.")) (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 "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-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. 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) (setq major-mode 'tar-mode) (setq mode-name "Tar") (use-local-map tar-mode-map) (auto-save-mode 0) (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) ) ;; This should be converted to use a minor mode keymap. (defun tar-subfile-mode (p) "Minor mode for editing an element of a tar-file. This mode redefines C-x C-s to save the current buffer back into its associated tar-file buffer. You must save that buffer to actually save your changes to disk." (interactive "P") (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) (error "This buffer is not an element of a tar file")) (or (assq 'tar-subfile-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist (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 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-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-current-descriptor)) (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (link-p (tar-header-link-type tokens)) (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) (end (+ start size))) (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.")) (let* ((tar-buffer (current-buffer)) (bufname (concat (file-name-nondirectory name) " (" name " in " (file-name-nondirectory (buffer-file-name)) ")")) (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) (set-visited-file-name name) ; give it a name to decide mode. (normal-mode) ; pick a mode. (set-visited-file-name nil) ; nuke the name - not meaningful. (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 (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-current-descriptor)) (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (link-p (tar-header-link-type tokens)) (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) (end (+ start size))) (if link-p (error "This is a link, not a real file.")) (if (zerop size) (error "This is a zero-length file.")) (let* ((tar-buffer (current-buffer)) buffer) (unwind-protect (progn (setq buffer (generate-new-buffer "*tar-copy-tmp*")) (widen) (save-excursion (set-buffer buffer) (insert-buffer-substring tar-buffer start end) (set-buffer-modified-p nil) ; in case we abort (write-file to-file) (message "Copied tar entry %s to %s" name to-file) (set-buffer tar-buffer))) (narrow-to-region 1 tar-header-offset) (if buffer (kill-buffer buffer))) ))) (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 expunged. Be sure to save this buffer." n))))) (defun tar-clear-modification-flags () "Remove the stars at the beginning of each line." (save-excursion (goto-char 0) (while (< (point) tar-header-offset) (if (looking-at "*") (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 (summarize-tar-header-block 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 (checksum-tar-header-block (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. (check-tar-header-block-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 (checksum-tar-header-block (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)) (m (set-marker (make-marker) tar-header-offset))) (forward-line 1) (delete-region p (point)) (insert-before-markers (summarize-tar-header-block tokens t) "\n") (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\" - remember 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)))) (buffer-read-only nil) ; ## ) ;; 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))) ))) (defun maybe-write-tar-file () "Used as a write-file-hook to write tar-files out correctly." ;; ;; If the current buffer is in Tar mode and has its header-offset set, ;; only write out the part of the file after the header-offset. ;; (if (and (eq major-mode 'tar-mode) (and (boundp 'tar-header-offset) tar-header-offset)) (unwind-protect (save-excursion (tar-clear-modification-flags) (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 (1+ (buffer-size)) buffer-file-name nil t) ;; return T because we've written the file. t) (narrow-to-region 1 tar-header-offset) t) ;; return NIL because we haven't. nil)) ;;; Patch it in. (or (memq 'maybe-write-tar-file write-file-hooks) (setq write-file-hooks (cons 'maybe-write-tar-file write-file-hooks))) (provide 'tar-mode) ;;; tar-mode.el ends here emacs-19.22/lisp/tcp.el100444 12120 1 5366 5433337121 13173 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.22/lisp/telnet.el100444 12120 1 21102 5474502722 13710 0ustar rmsdaemon;;; telnet.el --- run a telnet session from within an Emacs buffer ;;; Copyright (C) 1985, 1988, 1992 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 "^[^#$%>]*[#$%>] *") (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-rsh-program (if (memq system-type '(hpux usg-unix-v)) "remsh" "rsh") "Program to run for opening a remote shell.") (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 for the 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 (copy-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 "^[^*>]*[*>] *")) ((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) (let* ((echo-keystrokes 0) (password (read-password))) (setq telnet-count 0) (send-string proc (concat password 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) (let ((at-end (and (eq (process-buffer proc) (current-buffer)) (= (point) (point-max))))) (save-excursion (set-buffer (process-buffer proc)) (goto-char (process-mark proc)) (let ((now (point))) ;; Insert STRING, omitting all C-m characters. (let ((index 0) c-m) (while (setq c-m (string-match "\C-m" string index)) (insert-before-markers (substring string index c-m)) (setq index (1+ c-m))) (insert-before-markers (substring string index))) (and telnet-replace-c-g (subst-char-in-region now (point) ?\C-g telnet-replace-c-g))) ; (if (and (integer-or-marker-p last-input-start) ; (marker-position last-input-start) ; telnet-remote-echoes) ; (delete-region last-input-start last-input-end)) ) (if at-end (goto-char (point-max))))) (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 (defun telnet (host) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-telnet*. Normally input is edited in Emacs and sent a line at a time." (interactive "sOpen telnet connection to host: ") (let* ((name (concat host "-telnet" )) (buffer (get-buffer (concat "*" name "*")))) (if (and buffer (get-buffer-process buffer)) (switch-to-buffer (concat "*" name "*")) (switch-to-buffer (make-comint name "telnet")) (set-process-filter (get-process name) 'telnet-initial-filter) ;; Don't send the `open' cmd till telnet is ready for it. (accept-process-output (get-process name)) (erase-buffer) (send-string name (concat "open " host "\n")) (telnet-mode) (setq comint-input-sender 'telnet-simple-send) (setq telnet-count telnet-initial-count)))) (defun telnet-mode () "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 (defun rsh (host) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-rsh*. Normally input is edited in Emacs and sent a line at a time." (interactive "sOpen rsh connection to host: ") (require 'shell) (let ((name (concat host "-rsh" ))) (switch-to-buffer (make-comint name telnet-rsh-program nil host)) (set-process-filter (get-process name) 'telnet-initial-filter) (telnet-mode) (setq telnet-count -16))) (defun read-password () (let ((answ "") tem) (message "Reading password...") (while (prog1 (not (memq (setq tem (read-char)) '(?\C-m ?\n ?\C-g))) (setq quit-flag nil)) (setq answ (concat answ (char-to-string tem)))) answ)) (provide 'telnet) ;;; telnet.el ends here emacs-19.22/lisp/term-nasty.el100444 12120 1 1723 5235605662 14511 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.22/lisp/terminal.el100444 13437 1 123474 5405344516 14422 0ustar jimbdaemon;;; terminal.el --- terminal emulator for GNU Emacs. ;; Copyright (C) 1986, 1987, 1988, 1989, 1993 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 ;;>> terminfo? ;;>> ** 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 "\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) ;;;; 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 prefix-arg (format "Emacs Terminal escape> %d " (prefix-numeric-value prefix-arg)) "Emacs Terminal escape> ")))) (use-global-map global) (use-local-map local)) (message "") (cond ((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 nil 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 nil 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 (lsh 1 23))))) (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) (set-buffer-modified-p (buffer-modified-p)) ;; 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)) (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) (set-buffer-modified-p (buffer-modified-p)) (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)))))) ;; update mode line (set-buffer-modified-p (buffer-modified-p))) (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. Presently with `termcap' only; if somebody sends us code to make this work with `terminfo' we will try to use it." (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 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 ((termcap ;; 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 "emacs-virtual:co#%d:li#%d:%s" ;; Sigh. These can't be dynamically changed. 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:"))) (let ((process-environment (cons "TERM=emacs-virtual" (cons (concat "TERMCAP=" termcap) 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 nil 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 "\""))))) (provide 'terminal) ;;; terminal.el ends here emacs-19.22/lisp/tex-mode.el100444 12120 1 115251 5473514144 14170 0ustar rmsdaemon;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands. ;; Copyright (C) 1985, 1986, 1989, 1992 Free Software Foundation, Inc. ;; Maintainer: Edward M. Reingold ;; Keywords: tex ;; Contributions over the years by William F. Schelter, Dick King, ;; Stephen Gildea, Michael Prange, and Jacob Gore. ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public 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 'comint) (require 'compile) ;;;###autoload (defvar tex-shell-file-name nil "*If non-nil, is file name to use for the subshell in which TeX is run.") ;;;###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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") ;;;###autoload (defvar latex-run-command "latex" "*Command used to run LaTeX subjob. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") ;;;###autoload (defvar tex-bibtex-command "bibtex" "*Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") ;;;###autoload (defvar tex-dvi-print-command "lpr -d" "*Command used by \\[tex-print] to print a .dvi file. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") ;;;###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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string. If two printers are not enough of a choice, you can define the value of tex-alt-dvi-print-command to be 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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string. 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] 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 goes away.") (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 "String used by \\[tex-region] to delimit the start of the file's header.") (defvar tex-end-of-header nil "String used by \\[tex-region] to delimit the end of the file's header.") (defvar tex-shell-cd-command "cd" "Command to give to shell running TeX to change directory. The value of tex-directory will be 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.") (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 [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. A comint-mode-map with a few additions.") (defvar compare-windows-whitespace nil) ; 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 is used." (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") (if (looking-at "documentstyle{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 calls the value of `text-mode-hook', then the value of `tex-mode-hook', and then the value of `plain-tex-mode-hook'. When the special subshell is initiated, the value of `tex-shell-hook' is called." (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 calls the value of text-mode-hook, then the value of tex-mode-hook, and then the value of latex-mode-hook. When the special subshell is initiated, the value of tex-shell-hook is called." (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") (setq tex-end-of-header "\\begin{document}") (setq tex-trailer "\\end{document}\n") (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 calls the value of `text-mode-hook', then the value of `tex-mode-hook', then the value of `latex-mode-hook', and then the value of `slitex-mode-hook'. When the special subshell is initiated, the value of `tex-shell-hook' is called." (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}") (setq tex-end-of-header "\\begin{document}") (setq tex-trailer "\\end{document}\n") (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) (setq paragraph-start "^[ \t]*$\\|^[\f\\\\%]") (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (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 '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/$'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-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: (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 tex-shell-map (copy-keymap comint-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-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 (get-process "tex-shell")) (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 "&" "")))) ;; If text is unchanged since previous tex-send-command, ;; we haven't got any output. So wait for output now. (if (= (buffer-modified-tick) tex-send-command-modified-tick) (accept-process-output proc)) (set-buffer (process-buffer proc)) (goto-char (process-mark proc)) (insert string) (comint-send-input) (setq tex-send-command-modified-tick (buffer-modified-tick))))) (defun tex-delete-last-temp-files () "Delete any junk files from last temp file." (if tex-last-temp-file (let* ((dir (file-name-directory tex-last-temp-file)) (list (file-name-all-completions (file-name-nondirectory tex-last-temp-file) dir))) (while 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))) (tex-delete-last-temp-files) ;; 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 (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 (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) (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)) (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)) (file-newer-than-file-p (setq test-name (tex-append (buffer-file-name) ".dvi")) print-file-name-dvi)) (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." (interactive) (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 first period (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 last 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)) (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))) (run-hooks 'tex-mode-load-hook) (provide 'tex-mode) ;;; tex-mode.el ends here emacs-19.22/lisp/texinfmt.el100444 12062 1 337112 5473243142 14251 0ustar bobdaemon;;;; texinfmt.el ;;; Copyright (C) 1985, 1986, 1988, ;;; 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Maintainer: Robert J. Chassell ;;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: ;;; Emacs lisp functions to convert Texinfo files to Info files. (defvar texinfmt-version "2.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-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)))) (beginning-of-line) (delete-region (point) (save-excursion (forward-line 1) (point))) (message "Reading included file: %s" filename) (save-excursion (save-restriction (narrow-to-region (point) (+ (point) (car (cdr (insert-file-contents filename))))) (goto-char (point-min)) ;; Remove `@setfilename' line from included file, if any, ;; so @setfilename command not duplicated. (if (re-search-forward "^@setfilename" (save-excursion (forward-line 100) (point)) t) (progn (beginning-of-line) (delete-region (point) (save-excursion (forward-line 1) (point))))))))) ;; Raise or lower level of each section, if necessary. (goto-char (point-min)) (texinfo-raise-lower-sections) ;; Append @refill to appropriate paragraphs for filling. (goto-char (point-min)) (texinfo-append-refill) ;; If the region includes the effective end of the data, ;; discard everything after that. (goto-char (point-max)) (if (re-search-backward "^@bye" nil t) (delete-region (point) (point-max))) ;; Make sure buffer ends in a newline. (or (= (preceding-char) ?\n) (insert "\n")) ;; Don't use a previous value of texinfo-enclosure-list. (setq texinfo-enclosure-list nil) (goto-char (point-min)) (if (looking-at "\\\\input[ \t]+texinfo") (delete-region (point) (save-excursion (forward-line 1) (point)))) ;; Insert Info region title text. (goto-char (point-min)) (if (search-forward "@setfilename" (save-excursion (forward-line 100) (point)) t) (progn (setq texinfo-command-end (point)) (beginning-of-line) (setq texinfo-command-start (point)) (let ((arg (texinfo-parse-arg-discard))) (insert " " texinfo-region-buffer-name " buffer for: `") (insert (file-name-nondirectory (expand-file-name arg))) (insert "', -*-Text-*-\n"))) ;; Else no `@setfilename' line (insert " " texinfo-region-buffer-name " buffer -*-Text-*-\n")) (insert "produced by `texinfo-format-region'\n" "from a region in: " (if (buffer-file-name input-buffer) (concat "`" (file-name-sans-versions (file-name-nondirectory (buffer-file-name input-buffer))) "'") (concat "buffer `" (buffer-name input-buffer) "'")) "\nusing `texinfmt.el' version " texinfmt-version ".\n\n") ;; Now convert for real. (goto-char (point-min)) (texinfo-format-scan) (goto-char (point-min)) (message "Done."))) ;;; Primary internal formatting function for the whole buffer. (defun texinfo-format-buffer-1 () (let (texinfo-format-filename texinfo-example-start texinfo-command-start texinfo-command-end texinfo-command-name texinfo-last-node texinfo-last-node-pos texinfo-vindex texinfo-findex texinfo-cindex texinfo-pindex texinfo-tindex texinfo-kindex texinfo-stack texinfo-node-names (texinfo-footnote-number 0) last-input-buffer outfile (fill-column-for-info fill-column) (input-buffer (current-buffer)) (input-directory default-directory)) (setq texinfo-enclosure-list nil) (save-excursion (goto-char (point-min)) (or (search-forward "@setfilename" nil t) (error "Texinfo file needs an `@setfilename FILENAME' line.")) (setq texinfo-command-end (point)) (setq outfile (texinfo-parse-line-arg))) (find-file outfile) (texinfo-mode) (setq fill-column fill-column-for-info) (set-syntax-table texinfo-format-syntax-table) (erase-buffer) (insert-buffer-substring input-buffer) (message "Converting %s to Info format..." (buffer-name input-buffer)) ;; Insert @include files so `texinfo-raise-lower-sections' can ;; work on them without losing track of multiple ;; @raise/@lowersections commands. (goto-char (point-min)) (while (re-search-forward "^@include" nil t) (setq texinfo-command-end (point)) (let ((filename (concat input-directory (texinfo-parse-line-arg)))) (beginning-of-line) (delete-region (point) (save-excursion (forward-line 1) (point))) (message "Reading included file: %s" filename) (save-excursion (save-restriction (narrow-to-region (point) (+ (point) (car (cdr (insert-file-contents filename))))) (goto-char (point-min)) ;; Remove `@setfilename' line from included file, if any, ;; so @setfilename command not duplicated. (if (re-search-forward "^@setfilename" (save-excursion (forward-line 100) (point)) t) (progn (beginning-of-line) (delete-region (point) (save-excursion (forward-line 1) (point))))))))) ;; Raise or lower level of each section, if necessary. (goto-char (point-min)) (texinfo-raise-lower-sections) ;; Append @refill to appropriate paragraphs (goto-char (point-min)) (texinfo-append-refill) (goto-char (point-min)) (search-forward "@setfilename") (beginning-of-line) (delete-region (point-min) (point)) ;; Remove @bye at end of file, if it is there. (goto-char (point-max)) (if (search-backward "@bye" nil t) (delete-region (point) (point-max))) ;; Make sure buffer ends in a newline. (or (= (preceding-char) ?\n) (insert "\n")) ;; Scan the whole buffer, converting to Info format. (texinfo-format-scan) ;; Return data for indices. (goto-char (point-min)) (list outfile texinfo-vindex texinfo-findex texinfo-cindex texinfo-pindex texinfo-tindex texinfo-kindex))) ;;; Perform non-@-command file conversions: quotes and hyphens (defun texinfo-format-convert (min max) ;; Convert left and right quotes to typewriter font quotes. (goto-char min) (while (search-forward "``" max t) (replace-match "\"")) (goto-char min) (while (search-forward "''" max t) (replace-match "\"")) ;; Convert three hyphens in a row to two. (goto-char min) (while (re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\)" max t) (delete-region (1+ (match-beginning 2)) (+ 2 (match-beginning 2))))) ;;; Handle paragraph filling (defvar texinfo-no-refill-regexp "^@\\(example\\|smallexample\\|lisp\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|menu\\|titlepage\\|iftex\\|tex\\)" "Regexp specifying environments in which paragraphs are not filled.") (defvar texinfo-part-of-para-regexp "^@\\(b{\\|bullet{\\|cite{\\|code{\\|emph{\\|equiv{\\|error{\\|expansion{\\|file{\\|i{\\|inforef{\\|kbd{\\|key{\\|lisp{\\|minus{\\|point{\\|print{\\|pxref{\\|r{\\|ref{\\|result{\\|samp{\\|sc{\\|t{\\|TeX{\\|today{\\|var{\\|w{\\|xref{\\)" "Regexp specifying @-commands found within paragraphs.") (defun texinfo-append-refill () "Append @refill at end of each paragraph that should be filled. Do not append @refill to paragraphs within @example and similar environments. Do not append @refill to paragraphs containing @w{TEXT} or @*." ;; It is necessary to append @refill before other processing because ;; the other processing removes information that tells Texinfo ;; whether the text should or should not be filled. (while (< (point) (point-max)) (let ((refill-blank-lines "^[ \t\n]*$") (case-fold-search nil)) ; Don't confuse @TeX and @tex.... (beginning-of-line) ;; 1. Skip over blank lines; ;; skip over lines beginning with @-commands, ;; but do not skip over lines ;; that are no-refill environments such as @example or ;; that begin with within-paragraph @-commands such as @code. (while (and (looking-at (concat "^@\\|^\\\\\\|" refill-blank-lines)) (not (looking-at (concat "\\(" texinfo-no-refill-regexp "\\|" texinfo-part-of-para-regexp "\\)"))) (< (point) (point-max))) (forward-line 1)) ;; 2. Skip over @example and similar no-refill environments. (if (looking-at texinfo-no-refill-regexp) (let ((environment (buffer-substring (match-beginning 1) (match-end 1)))) (progn (re-search-forward (concat "^@end " environment) nil t) (forward-line 1))) ;; 3. Do not refill a paragraph containing @w or @* (if (or (>= (point) (point-max)) (re-search-forward "@w{\\|@\\*" (save-excursion (forward-paragraph) (point)) t)) ;; Go to end of paragraph and do nothing. (forward-paragraph) ;; 4. Else go to end of paragraph and insert @refill (forward-paragraph) (forward-line -1) (end-of-line) (delete-region (point) (save-excursion (skip-chars-backward " \t") (point))) ;; `looking-at-backward' not available in v. 18.57 ;; (if (not (looking-at-backward "@refill\\|@bye")) ;) (if (not (re-search-backward "@refill\\|@bye" (save-excursion (beginning-of-line) (point)) t)) (insert "@refill")) (forward-line 1)))))) ;;; Handle `@raisesections' and `@lowersections' commands ;; These commands change the hierarchical level of chapter structuring ;; commands. ;; ;; @raisesections changes @subsection to @section, ;; @section to @chapter, ;; etc. ;; ;; @lowersections changes @chapter to @section ;; @subsection to @subsubsection, ;; etc. ;; ;; An @raisesections/@lowersections command changes only those ;; structuring commands that follow the @raisesections/@lowersections ;; command. ;; ;; Repeated @raisesections/@lowersections continue to raise or lower ;; the heading level. ;; ;; An @lowersections command cancels an @raisesections command, and ;; vice versa. ;; ;; You cannot raise or lower "beyond" chapters or subsubsections, but ;; trying to do so does not elicit an error---you just get more ;; headings that mean the same thing as you keep raising or lowering ;; (for example, after a single @raisesections, both @chapter and ;; @section produce chapter headings). (defun texinfo-raise-lower-sections () "Raise or lower the hierarchical level of chapters, sections, etc. This function acts according to `@raisesections' and `@lowersections' commands in the Texinfo file. For example, an `@lowersections' command is useful if you wish to include what is written as an outer or standalone Texinfo file in another Texinfo file as an inner, included file. The `@lowersections' command changes chapters to sections, sections to subsections and so on. @raisesections changes @subsection to @section, @section to @chapter, @heading to @chapheading, etc. @lowersections changes @chapter to @section, @subsection to @subsubsection, @heading to @subheading, etc. An `@raisesections' or `@lowersections' command changes only those structuring commands that follow the `@raisesections' or `@lowersections' command. An `@lowersections' command cancels an `@raisesections' command, and vice versa. Repeated use of the commands continue to raise or lower the hierarchical level a step at a time. An attempt to raise above `chapters' reproduces chapter commands; an attempt to lower below subsubsections reproduces subsubsection commands." ;; `texinfo-section-types-regexp' is defined in `texnfo-upd.el'; ;; it is a regexp matching chapter, section, other headings ;; (but not the top node). (let (type (level 0)) (while (re-search-forward (concat "\\(\\(^@\\(raise\\|lower\\)sections\\)\\|\\(" texinfo-section-types-regexp "\\)\\)") nil t) (beginning-of-line) (save-excursion (setq type (read (current-buffer)))) (cond ;; 1. Increment level ((eq type '@raisesections) (setq level (1+ level)) (delete-region (point) (save-excursion (forward-line 1) (point)))) ;; 2. Decrement level ((eq type '@lowersections) (setq level (1- level)) (delete-region (point) (save-excursion (forward-line 1) (point)))) ;; Now handle structuring commands ((cond ;; 3. Raise level when positive ((> level 0) (let ((count level) (new-level type)) (while (> count 0) (setq new-level (cdr (assq new-level texinfo-raisesections-alist))) (setq count (1- count))) (kill-word 1) (insert (symbol-name new-level)))) ;; 4. Do nothing except move point when level is zero ((= level 0) (forward-line 1)) ;; 5. Lower level when positive ((< level 0) (let ((count level) (new-level type)) (while (< count 0) (setq new-level (cdr (assq new-level texinfo-lowersections-alist))) (setq count (1+ count))) (kill-word 1) (insert (symbol-name new-level)))))))))) (defvar texinfo-raisesections-alist '((@chapter . @chapter) ; Cannot go higher (@unnumbered . @unnumbered) (@majorheading . @majorheading) (@chapheading . @chapheading) (@appendix . @appendix) (@section . @chapter) (@unnumberedsec . @unnumbered) (@heading . @chapheading) (@appendixsec . @appendix) (@subsection . @section) (@unnumberedsubsec . @unnumberedsec) (@subheading . @heading) (@appendixsubsec . @appendixsec) (@subsubsection . @subsection) (@unnumberedsubsubsec . @unnumberedsubsec) (@subsubheading . @subheading) (@appendixsubsubsec . @appendixsubsec)) "*An alist of next higher levels for chapters, sections. etc. For example, section to chapter, subsection to section. Used by `texinfo-raise-lower-sections'. The keys specify types of section; the values correspond to the next higher types.") (defvar texinfo-lowersections-alist '((@chapter . @section) (@unnumbered . @unnumberedsec) (@majorheading . @heading) (@chapheading . @heading) (@appendix . @appendixsec) (@section . @subsection) (@unnumberedsec . @unnumberedsubsec) (@heading . @subheading) (@appendixsec . @appendixsubsec) (@subsection . @subsubsection) (@unnumberedsubsec . @unnumberedsubsubsec) (@subheading . @subsubheading) (@appendixsubsec . @appendixsubsubsec) (@subsubsection . @subsubsection) ; Cannot go lower. (@unnumberedsubsubsec . @unnumberedsubsubsec) (@subsubheading . @subsubheading) (@appendixsubsubsec . @appendixsubsubsec)) "*An alist of next lower levels for chapters, sections. etc. For example, chapter to section, section to subsection. Used by `texinfo-raise-lower-sections'. The keys specify types of section; the values correspond to the next lower types.") ;;; Perform those texinfo-to-info conversions that apply to the whole input ;;; uniformly. (defun texinfo-format-scan () (texinfo-format-convert (point-min) (point-max)) ;; Scan for @-commands. (goto-char (point-min)) (while (search-forward "@" nil t) (if (looking-at "[@{}'` *]") ;; Handle a few special @-followed-by-one-char commands. (if (= (following-char) ?*) (progn ;; remove command (delete-region (1- (point)) (1+ (point))) ;; insert return if not at end of line; ;; else line is already broken. (if (not (= (following-char) ?\n)) (insert ?\n))) ;; The other characters are simply quoted. Delete the @. (delete-char -1) (forward-char 1)) ;; @ is followed by a command-word; find the end of the word. (setq texinfo-command-start (1- (point))) (if (= (char-syntax (following-char)) ?w) (forward-word 1) (forward-char 1)) (setq texinfo-command-end (point)) ;; Call the handler for this command. (setq texinfo-command-name (intern (buffer-substring (1+ texinfo-command-start) texinfo-command-end))) (let ((enclosure-type (assoc (symbol-name texinfo-command-name) texinfo-enclosure-list))) (if enclosure-type (progn (insert (car (car (cdr enclosure-type))) (texinfo-parse-arg-discard) (car (cdr (car (cdr enclosure-type))))) (goto-char texinfo-command-start)) (let ((cmd (get texinfo-command-name 'texinfo-format))) (if cmd (funcall cmd) (texinfo-unsupported))))))) (cond (texinfo-stack (goto-char (nth 2 (car texinfo-stack))) (error "Unterminated @%s" (car (car texinfo-stack)))))) (put 'begin 'texinfo-format 'texinfo-format-begin) (defun texinfo-format-begin () (texinfo-format-begin-end 'texinfo-format)) (put 'end 'texinfo-format 'texinfo-format-end) (defun texinfo-format-end () (texinfo-format-begin-end 'texinfo-end)) (defun texinfo-format-begin-end (prop) (setq texinfo-command-name (intern (texinfo-parse-line-arg))) (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) (or (bolp) (insert ?\n)) (insert "\^_\nFile: " texinfo-format-filename ", Node: " name) (if next (insert ", Next: " next)) (if prev (insert ", Prev: " prev)) (if up (insert ", Up: " up)) (insert ?\n) (setq texinfo-last-node-pos (point)))) (put 'menu 'texinfo-format 'texinfo-format-menu) (defun texinfo-format-menu () (texinfo-discard-line) (insert "* Menu:\n\n")) (put 'menu 'texinfo-end 'texinfo-discard-command) ;;; Cross references ; @xref {NODE, FNAME, NAME, FILE, DOCUMENT} ; -> *Note FNAME: (FILE)NODE ; If FILE is missing, ; *Note FNAME: NODE ; If FNAME is empty and NAME is present ; *Note NAME: Node ; If both NAME and FNAME are missing ; *Note NODE:: ; texinfo ignores the DOCUMENT argument. ; -> See section [NAME, else NODE], page ; If FILE is specified, (FILE)NODE is used for xrefs. ; If fifth argument DOCUMENT is specified, produces ; See section [NAME, else NODE], page ; of DOCUMENT ; @ref a reference that does not put `See' or `see' in ; the hardcopy and is the same as @xref in Info (put 'ref 'texinfo-format 'texinfo-format-xref) (put 'xref 'texinfo-format 'texinfo-format-xref) (defun texinfo-format-xref () (let ((args (texinfo-format-parse-args))) (texinfo-discard-command) (insert "*Note ") (let ((fname (or (nth 1 args) (nth 2 args)))) (if (null (or fname (nth 3 args))) (insert (car args) "::") (insert (or fname (car args)) ": ") (if (nth 3 args) (insert "(" (nth 3 args) ")")) (insert (car args)))))) (put 'pxref 'texinfo-format 'texinfo-format-pxref) (defun texinfo-format-pxref () (texinfo-format-xref) (or (save-excursion (forward-char -2) (looking-at "::")) (insert "."))) ;@inforef{NODE, FNAME, FILE} ;Like @xref{NODE, FNAME,,FILE} in texinfo. ;In Tex, generates "See Info file FILE, node NODE" (put 'inforef 'texinfo-format 'texinfo-format-inforef) (defun texinfo-format-inforef () (let ((args (texinfo-format-parse-args))) (texinfo-discard-command) (if (nth 1 args) (insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args)) (insert "*Note " "(" (nth 2 args) ")" (car args) "::")))) ;;; Section headings (put 'majorheading 'texinfo-format 'texinfo-format-chapter) (put 'chapheading 'texinfo-format 'texinfo-format-chapter) (put 'ichapter 'texinfo-format 'texinfo-format-chapter) (put 'chapter 'texinfo-format 'texinfo-format-chapter) (put 'iappendix 'texinfo-format 'texinfo-format-chapter) (put 'appendix 'texinfo-format 'texinfo-format-chapter) (put 'iunnumbered 'texinfo-format 'texinfo-format-chapter) (put 'top 'texinfo-format 'texinfo-format-chapter) (put 'unnumbered 'texinfo-format 'texinfo-format-chapter) (defun texinfo-format-chapter () (texinfo-format-chapter-1 ?*)) (put 'heading 'texinfo-format 'texinfo-format-section) (put 'isection 'texinfo-format 'texinfo-format-section) (put 'section 'texinfo-format 'texinfo-format-section) (put 'iappendixsection 'texinfo-format 'texinfo-format-section) (put 'appendixsection 'texinfo-format 'texinfo-format-section) (put 'iappendixsec 'texinfo-format 'texinfo-format-section) (put 'appendixsec 'texinfo-format 'texinfo-format-section) (put 'iunnumberedsec 'texinfo-format 'texinfo-format-section) (put 'unnumberedsec 'texinfo-format 'texinfo-format-section) (defun texinfo-format-section () (texinfo-format-chapter-1 ?=)) (put 'subheading 'texinfo-format 'texinfo-format-subsection) (put 'isubsection 'texinfo-format 'texinfo-format-subsection) (put 'subsection 'texinfo-format 'texinfo-format-subsection) (put 'iappendixsubsec 'texinfo-format 'texinfo-format-subsection) (put 'appendixsubsec 'texinfo-format 'texinfo-format-subsection) (put 'iunnumberedsubsec 'texinfo-format 'texinfo-format-subsection) (put 'unnumberedsubsec 'texinfo-format 'texinfo-format-subsection) (defun texinfo-format-subsection () (texinfo-format-chapter-1 ?-)) (put 'subsubheading 'texinfo-format 'texinfo-format-subsubsection) (put 'isubsubsection 'texinfo-format 'texinfo-format-subsubsection) (put 'subsubsection 'texinfo-format 'texinfo-format-subsubsection) (put 'iappendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (put 'appendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (put 'iunnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (put 'unnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection) (defun texinfo-format-subsubsection () (texinfo-format-chapter-1 ?.)) (defun texinfo-format-chapter-1 (belowchar) (let ((arg (texinfo-parse-arg-discard))) (message "Formatting: %s ... " arg) ; So we can see where we are. (insert ?\n arg ?\n "@SectionPAD " belowchar ?\n) (forward-line -2))) (put 'SectionPAD 'texinfo-format 'texinfo-format-sectionpad) (defun texinfo-format-sectionpad () (let ((str (texinfo-parse-arg-discard))) (forward-char -1) (let ((column (current-column))) (forward-char 1) (while (> column 0) (insert str) (setq column (1- column)))) (insert ?\n))) ;;; Space controling commands: @. and @: (put '\. 'texinfo-format 'texinfo-format-\.) (defun texinfo-format-\. () (texinfo-discard-command) (insert ".")) (put '\: 'texinfo-format 'texinfo-format-\:) (defun texinfo-format-\: () (texinfo-discard-command)) ;;; @center, @sp, and @br (put 'center 'texinfo-format 'texinfo-format-center) (defun texinfo-format-center () (let ((arg (texinfo-parse-expanded-arg))) (texinfo-discard-command) (insert arg) (insert ?\n) (save-restriction (goto-char (1- (point))) (let ((indent-tabs-mode nil)) (center-line))))) (put 'sp 'texinfo-format 'texinfo-format-sp) (defun texinfo-format-sp () (let* ((arg (texinfo-parse-arg-discard)) (num (read arg))) (insert-char ?\n num))) (put 'br 'texinfo-format 'texinfo-format-paragraph-break) (defun texinfo-format-paragraph-break () "Force a paragraph break. If used within a line, follow `@br' with braces." (texinfo-optional-braces-discard) ;; insert one return if at end of line; ;; else insert two returns, to generate a blank line. (if (= (following-char) ?\n) (insert ?\n) (insert-char ?\n 2))) ;;; @footnote and @footnotestyle ; In Texinfo, footnotes are created with the `@footnote' command. ; This command is followed immediately by a left brace, then by the text of ; the footnote, and then by a terminating right brace. The ; template for a footnote is: ; ; @footnote{TEXT} ; ; Info has two footnote styles: ; ; * In the End of node style, all the footnotes for a single node ; are placed at the end of that node. The footnotes are ; separated from the rest of the node by a line of dashes with ; the word `Footnotes' within it. ; ; * In the Separate node style, all the footnotes for a single node ; are placed in an automatically constructed node of their own. ; Footnote style is specified by the @footnotestyle command, either ; @footnotestyle separate ; or ; @footnotestyle end ; ; The default is separate (defvar texinfo-footnote-style "separate" "Footnote style, either separate or end.") (put 'footnotestyle 'texinfo-format 'texinfo-footnotestyle) (defun texinfo-footnotestyle () "Specify whether footnotes are at end of node or in separate nodes. Argument is either end or separate." (setq texinfo-footnote-style (texinfo-parse-arg-discard))) (defvar texinfo-footnote-number) (put 'footnote 'texinfo-format 'texinfo-format-footnote) (defun texinfo-format-footnote () "Format a footnote in either end of node or separate node style. The texinfo-footnote-style variable controls which style is used." (setq texinfo-footnote-number (1+ texinfo-footnote-number)) (cond ((string= texinfo-footnote-style "end") (texinfo-format-end-node)) ((string= texinfo-footnote-style "separate") (texinfo-format-separate-node)))) (defun texinfo-format-separate-node () "Format footnote in Separate node style, with notes in own node. The node is constructed automatically." (let* (start (arg (texinfo-parse-line-arg)) (node-name-beginning (save-excursion (re-search-backward "^File: \\w+\\(\\w\\|\\s_\\|\\.\\|,\\)*[ \t]+Node:") (match-end 0))) (node-name (save-excursion (buffer-substring (progn (goto-char node-name-beginning) ; skip over node command (skip-chars-forward " \t") ; and over spaces (point)) (if (search-forward "," (save-excursion (end-of-line) (point)) t) ; bound search (1- (point)) (end-of-line) (point)))))) (texinfo-discard-command) ; remove or insert whitespace, as needed (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) (insert (format " (%d) (*Note %s-Footnotes::)" texinfo-footnote-number node-name)) (fill-paragraph nil) (save-excursion (if (re-search-forward "^@node" nil 'move) (forward-line -1)) ;; two cases: for the first footnote, we must insert a node header; ;; for the second and subsequent footnotes, we need only insert ;; the text of the footnote. (if (save-excursion (re-search-backward (concat node-name "-Footnotes, Up: ") node-name-beginning t)) (progn ; already at least one footnote (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) (fill-region start (point))) ;; else not yet a footnote (insert "\n\^_\nFile: " texinfo-format-filename " Node: " node-name "-Footnotes, Up: " node-name "\n") (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) (fill-region start (point)))))) (defun texinfo-format-end-node () "Format footnote in the End of node style, with notes at end of node." (let (start (arg (texinfo-parse-line-arg))) (texinfo-discard-command) ; remove or insert whitespace, as needed (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) (insert (format " (%d) " texinfo-footnote-number)) (fill-paragraph nil) (save-excursion (if (search-forward "\n--------- Footnotes ---------\n" nil t) (progn ; already have footnote, put new one before end of node (if (re-search-forward "^@node" nil 'move) (forward-line -1)) (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) (fill-region start (point))) ;; else no prior footnote (if (re-search-forward "^@node" nil 'move) (forward-line -1)) (insert "\n--------- Footnotes ---------\n") (setq start (point)) (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)))))) ;;; @itemize, @enumerate, and similar commands ;; @itemize pushes (itemize "COMMANDS" STARTPOS) on texinfo-stack. ;; @enumerate pushes (enumerate 0 STARTPOS). ;; @item dispatches to the texinfo-item prop of the first elt of the list. ;; For itemize, this puts in and rescans the COMMANDS. ;; For enumerate, this increments the number and puts it in. ;; In either case, it puts a Backspace at the front of the line ;; which marks it not to be indented later. ;; All other lines get indented by 5 when the @end is reached. (defvar texinfo-stack-depth 0 "Count of number of unpopped texinfo-push-stack calls. Used by @refill indenting command to avoid indenting within lists, etc.") (defun texinfo-push-stack (check arg) (setq texinfo-stack-depth (1+ texinfo-stack-depth)) (setq texinfo-stack (cons (list check arg texinfo-command-start) texinfo-stack))) (defun texinfo-pop-stack (check) (setq texinfo-stack-depth (1- texinfo-stack-depth)) (if (null texinfo-stack) (error "Unmatched @end %s" check)) (if (not (eq (car (car texinfo-stack)) check)) (error "@end %s matches @%s" check (car (car texinfo-stack)))) (prog1 (cdr (car texinfo-stack)) (setq texinfo-stack (cdr texinfo-stack)))) (put 'itemize 'texinfo-format 'texinfo-itemize) (defun texinfo-itemize () (texinfo-push-stack 'itemize (progn (skip-chars-forward " \t") (if (eolp) "@bullet" (texinfo-parse-line-arg)))) (texinfo-discard-line-with-args) (setq fill-column (- fill-column 5))) (put 'itemize 'texinfo-end 'texinfo-end-itemize) (defun texinfo-end-itemize () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'itemize))) (texinfo-do-itemize (nth 1 stacktop)))) (put 'enumerate 'texinfo-format 'texinfo-enumerate) (defun texinfo-enumerate () (texinfo-push-stack 'enumerate (progn (skip-chars-forward " \t") (if (eolp) 1 (read (current-buffer))))) (if (and (symbolp (car (cdr (car texinfo-stack)))) (> 1 (length (symbol-name (car (cdr (car texinfo-stack))))))) (error "@enumerate: Use a number or letter, eg: 1, A, a, 3, B, or d." )) (texinfo-discard-line-with-args) (setq fill-column (- fill-column 5))) (put 'enumerate 'texinfo-end 'texinfo-end-enumerate) (defun texinfo-end-enumerate () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'enumerate))) (texinfo-do-itemize (nth 1 stacktop)))) ;; @alphaenumerate never became a standard part of Texinfo (put 'alphaenumerate 'texinfo-format 'texinfo-alphaenumerate) (defun texinfo-alphaenumerate () (texinfo-push-stack 'alphaenumerate (1- ?a)) (setq fill-column (- fill-column 5)) (texinfo-discard-line)) (put 'alphaenumerate 'texinfo-end 'texinfo-end-alphaenumerate) (defun texinfo-end-alphaenumerate () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'alphaenumerate))) (texinfo-do-itemize (nth 1 stacktop)))) ;; @capsenumerate never became a standard part of Texinfo (put 'capsenumerate 'texinfo-format 'texinfo-capsenumerate) (defun texinfo-capsenumerate () (texinfo-push-stack 'capsenumerate (1- ?A)) (setq fill-column (- fill-column 5)) (texinfo-discard-line)) (put 'capsenumerate 'texinfo-end 'texinfo-end-capsenumerate) (defun texinfo-end-capsenumerate () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'capsenumerate))) (texinfo-do-itemize (nth 1 stacktop)))) ;; At the @end, indent all the lines within the construct ;; except those marked with backspace. FROM says where ;; construct started. (defun texinfo-do-itemize (from) (save-excursion (while (progn (forward-line -1) (>= (point) from)) (if (= (following-char) ?\b) (save-excursion (delete-char 1) (end-of-line) (delete-char 6)) (if (not (looking-at "[ \t]*$")) (save-excursion (insert " "))))))) (put 'item 'texinfo-format 'texinfo-item) (put 'itemx 'texinfo-format 'texinfo-item) (defun texinfo-item () (funcall (get (car (car texinfo-stack)) 'texinfo-item))) (put 'itemize 'texinfo-item 'texinfo-itemize-item) (defun texinfo-itemize-item () ;; (texinfo-discard-line) ; Did not handle text on same line as @item. (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point))) (if (looking-at "[ \t]*[^ \t\n]+") ;; Text on same line as @item command. (insert "\b " (nth 1 (car texinfo-stack)) " \n") ;; Else text on next line. (insert "\b " (nth 1 (car texinfo-stack)) " ")) (forward-line -1)) (put 'enumerate 'texinfo-item 'texinfo-enumerate-item) (defun texinfo-enumerate-item () (texinfo-discard-line) (let (enumerating-symbol) (cond ((integerp (car (cdr (car texinfo-stack)))) (setq enumerating-symbol (car (cdr (car texinfo-stack)))) (insert ?\b (format "%3d. " enumerating-symbol) ?\n) (setcar (cdr (car texinfo-stack)) (1+ enumerating-symbol))) ((symbolp (car (cdr (car texinfo-stack)))) (setq enumerating-symbol (symbol-name (car (cdr (car texinfo-stack))))) (if (or (equal ?\[ (string-to-char enumerating-symbol)) (equal ?\{ (string-to-char enumerating-symbol))) (error "Too many items in enumerated list; alphabet ends at Z.")) (insert ?\b (format "%3s. " enumerating-symbol) ?\n) (setcar (cdr (car texinfo-stack)) (make-symbol (char-to-string (1+ (string-to-char enumerating-symbol)))))) (t (error "@enumerate: Use a number or letter, eg: 1, A, a, 3, B or d." ))) (forward-line -1))) (put 'alphaenumerate 'texinfo-item 'texinfo-alphaenumerate-item) (defun texinfo-alphaenumerate-item () (texinfo-discard-line) (let ((next (1+ (car (cdr (car texinfo-stack)))))) (if (> next ?z) (error "More than 26 items in @alphaenumerate; get a bigger alphabet.")) (setcar (cdr (car texinfo-stack)) next) (insert "\b " next ". \n")) (forward-line -1)) (put 'capsenumerate 'texinfo-item 'texinfo-capsenumerate-item) (defun texinfo-capsenumerate-item () (texinfo-discard-line) (let ((next (1+ (car (cdr (car texinfo-stack)))))) (if (> next ?Z) (error "More than 26 items in @capsenumerate; get a bigger alphabet.")) (setcar (cdr (car texinfo-stack)) next) (insert "\b " next ". \n")) (forward-line -1)) ;;; @table ; The `@table' command produces two-column tables. (put 'table 'texinfo-format 'texinfo-table) (defun texinfo-table () (texinfo-push-stack 'table (progn (skip-chars-forward " \t") (if (eolp) "@asis" (texinfo-parse-line-arg)))) (texinfo-discard-line-with-args) (setq fill-column (- fill-column 5))) (put 'table 'texinfo-item 'texinfo-table-item) (defun texinfo-table-item () (let ((arg (texinfo-parse-arg-discard)) (itemfont (car (cdr (car texinfo-stack))))) (insert ?\b itemfont ?\{ arg "}\n \n")) (forward-line -2)) (put 'table 'texinfo-end 'texinfo-end-table) (defun texinfo-end-table () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'table))) (texinfo-do-itemize (nth 1 stacktop)))) ;; @description appears to be an undocumented variant on @table that ;; does not require an arg. It fails in texinfo.tex 2.58 and is not ;; part of makeinfo.c The command appears to be a relic of the past. (put 'description 'texinfo-end 'texinfo-end-table) (put 'description 'texinfo-format 'texinfo-description) (defun texinfo-description () (texinfo-push-stack 'table "@asis") (setq fill-column (- fill-column 5)) (texinfo-discard-line)) ;;; @ftable, @vtable ; The `@ftable' and `@vtable' commands are like the `@table' command ; but they also insert each entry in the first column of the table ; into the function or variable index. ;; Handle the @ftable and @vtable commands: (put 'ftable 'texinfo-format 'texinfo-ftable) (put 'vtable 'texinfo-format 'texinfo-vtable) (defun texinfo-ftable () (texinfo-indextable 'ftable)) (defun texinfo-vtable () (texinfo-indextable 'vtable)) (defun texinfo-indextable (table-type) (texinfo-push-stack table-type (texinfo-parse-arg-discard)) (setq fill-column (- fill-column 5))) ;; Handle the @item commands within ftable and vtable: (put 'ftable 'texinfo-item 'texinfo-ftable-item) (put 'vtable 'texinfo-item 'texinfo-vtable-item) (defun texinfo-ftable-item () (texinfo-indextable-item 'texinfo-findex)) (defun texinfo-vtable-item () (texinfo-indextable-item 'texinfo-vindex)) (defun texinfo-indextable-item (index-type) (let ((item (texinfo-parse-arg-discard)) (itemfont (car (cdr (car texinfo-stack)))) (indexvar index-type)) (insert ?\b itemfont ?\{ item "}\n \n") (set indexvar (cons (list item texinfo-last-node) (symbol-value indexvar))) (forward-line -2))) ;; Handle @end ftable, @end vtable (put 'ftable 'texinfo-end 'texinfo-end-ftable) (put 'vtable 'texinfo-end 'texinfo-end-vtable) (defun texinfo-end-ftable () (texinfo-end-indextable 'ftable)) (defun texinfo-end-vtable () (texinfo-end-indextable 'vtable)) (defun texinfo-end-indextable (table-type) (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack table-type))) (texinfo-do-itemize (nth 1 stacktop)))) ;;; @ifinfo, @iftex, @tex (put 'ifinfo 'texinfo-format 'texinfo-discard-line) (put 'ifinfo 'texinfo-end 'texinfo-discard-command) (put 'iftex 'texinfo-format 'texinfo-format-iftex) (defun texinfo-format-iftex () (delete-region texinfo-command-start (progn (re-search-forward "@end iftex[ \t]*\n") (point)))) (put 'tex 'texinfo-format 'texinfo-format-tex) (defun texinfo-format-tex () (delete-region texinfo-command-start (progn (re-search-forward "@end tex[ \t]*\n") (point)))) ;;; @titlepage (put 'titlepage 'texinfo-format 'texinfo-format-titlepage) (defun texinfo-format-titlepage () (delete-region texinfo-command-start (progn (re-search-forward "@end titlepage[ \t]*\n") (point)))) (put 'endtitlepage 'texinfo-format 'texinfo-discard-line) ; @titlespec an alternative titling command; ignored by Info (put 'titlespec 'texinfo-format 'texinfo-format-titlespec) (defun texinfo-format-titlespec () (delete-region texinfo-command-start (progn (re-search-forward "@end titlespec[ \t]*\n") (point)))) (put 'endtitlespec 'texinfo-format 'texinfo-discard-line) ;;; @today (put 'today 'texinfo-format 'texinfo-format-today) ; Produces Day Month Year style of output. eg `1 Jan 1900' ; The `@today{}' command requires a pair of braces, like `@dots{}'. (defun texinfo-format-today () (texinfo-parse-arg-discard) (insert (format "%s %s %s" (substring (current-time-string) 8 10) (substring (current-time-string) 4 7) (substring (current-time-string) -4)))) ;;; @ignore (put 'ignore 'texinfo-format 'texinfo-format-ignore) (defun texinfo-format-ignore () (delete-region texinfo-command-start (progn (re-search-forward "@end ignore[ \t]*\n") (point)))) (put 'endignore 'texinfo-format 'texinfo-discard-line) ;;; Define the Info enclosure command: @definfoenclose ; A `@definfoenclose' command may be used to define a highlighting ; command for Info, but not for TeX. A command defined using ; `@definfoenclose' marks text by enclosing it in strings that precede ; and follow the text. ; ; Presumably, if you define a command with `@definfoenclose` for Info, ; you will also define the same command in the TeX definitions file, ; `texinfo.tex' in a manner appropriate for typesetting. ; ; Write a `@definfoenclose' command on a line and follow it with three ; arguments separated by commas (commas are used as separators in an ; `@node' line in the same way). The first argument to ; `@definfoenclose' is the @-command name \(without the `@'\); the ; second argument is the Info start delimiter string; and the third ; argument is the Info end delimiter string. The latter two arguments ; enclose the highlighted text in the Info file. A delimiter string ; may contain spaces. Neither the start nor end delimiter is ; required. However, if you do not provide a start delimiter, you ; must follow the command name with two commas in a row; otherwise, ; the Info formatting commands will misinterpret the end delimiter ; string as a start delimiter string. ; ; An enclosure command defined this way takes one argument in braces. ; ; For example, you can write: ; ; @ifinfo ; @definfoenclose phoo, //, \\ ; @end ifinfo ; ; near the beginning of a Texinfo file at the beginning of the lines ; to define `@phoo' as an Info formatting command that inserts `//' ; before and `\\' after the argument to `@phoo'. You can then write ; `@phoo{bar}' wherever you want `//bar\\' highlighted in Info. ; ; Also, for TeX formatting, you could write ; ; @iftex ; @global@let@phoo=@i ; @end iftex ; ; to define `@phoo' as a command that causes TeX to typeset ; the argument to `@phoo' in italics. ; ; Note that each definition applies to its own formatter: one for TeX, ; the other for texinfo-format-buffer or texinfo-format-region. ; ; Here is another example: write ; ; @definfoenclose headword, , : ; ; near the beginning of the file, to define `@headword' as an Info ; formatting command that inserts nothing before and a colon after the ; argument to `@headword'. (put 'definfoenclose 'texinfo-format 'texinfo-define-info-enclosure) (defun texinfo-define-info-enclosure () (let* ((args (texinfo-format-parse-line-args)) (command-name (nth 0 args)) (beginning-delimiter (or (nth 1 args) "")) (end-delimiter (or (nth 2 args) ""))) (texinfo-discard-command) (setq texinfo-enclosure-list (cons (list command-name (list beginning-delimiter end-delimiter)) texinfo-enclosure-list)))) ;;; @var, @code and the like (put 'var 'texinfo-format 'texinfo-format-var) ; @sc a small caps font for TeX; formatted as `var' in Info (put 'sc 'texinfo-format 'texinfo-format-var) (defun texinfo-format-var () (insert (upcase (texinfo-parse-arg-discard))) (goto-char texinfo-command-start)) ; various noops (put 'b 'texinfo-format 'texinfo-format-noop) (put 'i 'texinfo-format 'texinfo-format-noop) (put 'r 'texinfo-format 'texinfo-format-noop) (put 't 'texinfo-format 'texinfo-format-noop) (put 'w 'texinfo-format 'texinfo-format-noop) (put 'asis 'texinfo-format 'texinfo-format-noop) (put 'dmn 'texinfo-format 'texinfo-format-noop) (put 'key 'texinfo-format 'texinfo-format-noop) (put 'math 'texinfo-format 'texinfo-format-noop) (put 'titlefont 'texinfo-format 'texinfo-format-noop) (defun texinfo-format-noop () (insert (texinfo-parse-arg-discard)) (goto-char texinfo-command-start)) (put 'cite 'texinfo-format 'texinfo-format-code) (put 'code 'texinfo-format 'texinfo-format-code) (put 'file 'texinfo-format 'texinfo-format-code) (put 'kbd 'texinfo-format 'texinfo-format-code) (put 'samp 'texinfo-format 'texinfo-format-code) (defun texinfo-format-code () (insert "`" (texinfo-parse-arg-discard) "'") (goto-char texinfo-command-start)) (put 'emph 'texinfo-format 'texinfo-format-emph) (put 'strong 'texinfo-format 'texinfo-format-emph) (defun texinfo-format-emph () (insert "*" (texinfo-parse-arg-discard) "*") (goto-char texinfo-command-start)) (put 'dfn 'texinfo-format 'texinfo-format-defn) (put 'defn 'texinfo-format 'texinfo-format-defn) (defun texinfo-format-defn () (insert "\"" (texinfo-parse-arg-discard) "\"") (goto-char texinfo-command-start)) (put 'bullet 'texinfo-format 'texinfo-format-bullet) (defun texinfo-format-bullet () "Insert an asterisk. If used within a line, follow `@bullet' with braces." (texinfo-optional-braces-discard) (insert "*")) ;;; @example, @lisp, @quotation, @display, @smalllisp, @smallexample (put 'display 'texinfo-format 'texinfo-format-example) (put 'example 'texinfo-format 'texinfo-format-example) (put 'lisp 'texinfo-format 'texinfo-format-example) (put 'quotation 'texinfo-format 'texinfo-format-example) (put 'smallexample 'texinfo-format 'texinfo-format-example) (put 'smalllisp 'texinfo-format 'texinfo-format-example) (defun texinfo-format-example () (texinfo-push-stack 'example nil) (setq fill-column (- fill-column 5)) (texinfo-discard-line)) (put 'example 'texinfo-end 'texinfo-end-example) (put 'display 'texinfo-end 'texinfo-end-example) (put 'lisp 'texinfo-end 'texinfo-end-example) (put 'quotation 'texinfo-end 'texinfo-end-example) (put 'smallexample 'texinfo-end 'texinfo-end-example) (put 'smalllisp 'texinfo-end 'texinfo-end-example) (defun texinfo-end-example () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'example))) (texinfo-do-itemize (nth 1 stacktop)))) (put 'exdent 'texinfo-format 'texinfo-format-exdent) (defun texinfo-format-exdent () (texinfo-discard-command) (delete-region (point) (progn (skip-chars-forward " ") (point))) (insert ?\b) ;; Cancel out the deletion that texinfo-do-itemize ;; is going to do at the end of this line. (save-excursion (end-of-line) (insert "\n "))) ;;; @cartouche ; The @cartouche command is a noop in Info; in a printed manual, ; it makes a box with rounded corners. (put 'cartouche 'texinfo-format 'texinfo-discard-line) (put 'cartouche 'texinfo-end 'texinfo-discard-command) ;;; @flushleft and @format ; The @flushleft command left justifies every line but leaves the ; right end ragged. As far as Info is concerned, @flushleft is a ; `do-nothing' command ; The @format command is similar to @example except that it does not ; indent; this means that in Info, @format is similar to @flushleft. (put 'format 'texinfo-format 'texinfo-format-flushleft) (put 'flushleft 'texinfo-format 'texinfo-format-flushleft) (defun texinfo-format-flushleft () (texinfo-discard-line)) (put 'format 'texinfo-end 'texinfo-end-flushleft) (put 'flushleft 'texinfo-end 'texinfo-end-flushleft) (defun texinfo-end-flushleft () (texinfo-discard-command)) ;;; @flushright ; The @flushright command right justifies every line but leaves the ; left end ragged. Spaces and tabs at the right ends of lines are ; removed so that visible text lines up on the right side. (put 'flushright 'texinfo-format 'texinfo-format-flushright) (defun texinfo-format-flushright () (texinfo-push-stack 'flushright nil) (texinfo-discard-line)) (put 'flushright 'texinfo-end 'texinfo-end-flushright) (defun texinfo-end-flushright () (texinfo-discard-command) (let ((stacktop (texinfo-pop-stack 'flushright))) (texinfo-do-flushright (nth 1 stacktop)))) (defun texinfo-do-flushright (from) (save-excursion (while (progn (forward-line -1) (>= (point) from)) (beginning-of-line) (insert (make-string (- fill-column (save-excursion (end-of-line) (skip-chars-backward " \t") (delete-region (point) (progn (end-of-line) (point))) (current-column))) ? ))))) ;;; @ctrl, @TeX, @copyright, @minus, @dots (put 'ctrl 'texinfo-format 'texinfo-format-ctrl) (defun texinfo-format-ctrl () (let ((str (texinfo-parse-arg-discard))) (insert (logand 31 (aref str 0))))) (put 'TeX 'texinfo-format 'texinfo-format-TeX) (defun texinfo-format-TeX () (texinfo-parse-arg-discard) (insert "TeX")) (put 'copyright 'texinfo-format 'texinfo-format-copyright) (defun texinfo-format-copyright () (texinfo-parse-arg-discard) (insert "(C)")) (put 'minus 'texinfo-format 'texinfo-format-minus) (defun texinfo-format-minus () "Insert a minus sign. If used within a line, follow `@minus' with braces." (texinfo-optional-braces-discard) (insert "-")) (put 'dots 'texinfo-format 'texinfo-format-dots) (defun texinfo-format-dots () (texinfo-parse-arg-discard) (insert "...")) ;;; Refilling and indenting: @refill, @paragraphindent, @noindent ;;; Indent only those paragraphs that are refilled as a result of an ;;; @refill command. ; * If the value is `asis', do not change the existing indentation at ; the starts of paragraphs. ; * If the value zero, delete any existing indentation. ; * If the value is greater than zero, indent each paragraph by that ; number of spaces. ;;; But do not refill paragraphs with an @refill command that are ;;; preceded by @noindent or are part of a table, list, or deffn. (defvar texinfo-paragraph-indent "asis" "Number of spaces for @refill to indent a paragraph; else to leave as is.") (put 'paragraphindent 'texinfo-format 'texinfo-paragraphindent) (defun texinfo-paragraphindent () "Specify the number of spaces for @refill to indent a paragraph. Default is to leave the number of spaces as is." (let ((arg (texinfo-parse-arg-discard))) (if (string= "asis" arg) (setq texinfo-paragraph-indent "asis") (setq texinfo-paragraph-indent (string-to-int arg))))) (put 'refill 'texinfo-format 'texinfo-format-refill) (defun texinfo-format-refill () "Refill paragraph. Also, indent first line as set by @paragraphindent. Default is to leave paragraph indentation as is." (texinfo-discard-command) (forward-paragraph -1) (if (looking-at "[ \t\n]*$") (forward-line 1)) ;; Do not indent if an entry in a list, table, or deffn, ;; or if paragraph is preceded by @noindent. ;; Otherwise, indent (cond ;; delete a @noindent line and do not indent paragraph ((save-excursion (forward-line -1) (looking-at "^@noindent")) (forward-line -1) (delete-region (point) (progn (forward-line 1) (point)))) ;; do nothing if "asis" ((equal texinfo-paragraph-indent "asis")) ;; do no indenting in list, etc. ((> texinfo-stack-depth 0)) ;; otherwise delete existing whitespace and indent (t (delete-region (point) (progn (skip-chars-forward " \t") (point))) (insert (make-string texinfo-paragraph-indent ? )))) (forward-paragraph 1) (forward-line -1) (end-of-line) ;; Do not fill a section title line with asterisks, hyphens, etc. that ;; are used to underline it. This could occur if the line following ;; the underlining is not an index entry and has text within it. (let* ((previous-paragraph-separate paragraph-separate) (paragraph-separate (concat paragraph-separate "\\|^[=*---.]+")) (previous-paragraph-start paragraph-start) (paragraph-start (concat paragraph-start "\\|^[=*---.]+"))) (unwind-protect (fill-paragraph nil) (setq paragraph-separate previous-paragraph-separate) (setq paragraph-start previous-paragraph-start)))) (put 'noindent 'texinfo-format 'texinfo-noindent) (defun texinfo-noindent () (save-excursion (forward-paragraph 1) (if (search-backward "@refill" (save-excursion (forward-line -1) (point)) t) () ; leave @noindent command so @refill command knows not to indent ;; else (texinfo-discard-line)))) ;;; Index generation (put 'vindex 'texinfo-format 'texinfo-format-vindex) (defun texinfo-format-vindex () (texinfo-index 'texinfo-vindex)) (put 'cindex 'texinfo-format 'texinfo-format-cindex) (defun texinfo-format-cindex () (texinfo-index 'texinfo-cindex)) (put 'findex 'texinfo-format 'texinfo-format-findex) (defun texinfo-format-findex () (texinfo-index 'texinfo-findex)) (put 'pindex 'texinfo-format 'texinfo-format-pindex) (defun texinfo-format-pindex () (texinfo-index 'texinfo-pindex)) (put 'tindex 'texinfo-format 'texinfo-format-tindex) (defun texinfo-format-tindex () (texinfo-index 'texinfo-tindex)) (put 'kindex 'texinfo-format 'texinfo-format-kindex) (defun texinfo-format-kindex () (texinfo-index 'texinfo-kindex)) (defun texinfo-index (indexvar) (let ((arg (texinfo-parse-expanded-arg))) (texinfo-discard-command) (set indexvar (cons (list arg texinfo-last-node ;; Region formatting may not provide last node position. (if texinfo-last-node-pos (1+ (count-lines texinfo-last-node-pos (point))) 1)) (symbol-value indexvar))))) (defconst texinfo-indexvar-alist '(("cp" . texinfo-cindex) ("fn" . texinfo-findex) ("vr" . texinfo-vindex) ("tp" . texinfo-tindex) ("pg" . texinfo-pindex) ("ky" . texinfo-kindex))) ;;; @defindex @defcodeindex (put 'defindex 'texinfo-format 'texinfo-format-defindex) (put 'defcodeindex 'texinfo-format 'texinfo-format-defindex) (defun texinfo-format-defindex () (let* ((index-name (texinfo-parse-arg-discard)) ; eg: `aa' (indexing-command (intern (concat index-name "index"))) (index-formatting-command ; eg: `texinfo-format-aaindex' (intern (concat "texinfo-format-" index-name "index"))) (index-alist-name ; eg: `texinfo-aaindex' (intern (concat "texinfo-" index-name "index")))) (set index-alist-name nil) (put indexing-command ; eg, aaindex 'texinfo-format index-formatting-command) ; eg, texinfo-format-aaindex ;; eg: "aa" . texinfo-aaindex (or (assoc index-name texinfo-indexvar-alist) (setq texinfo-indexvar-alist (cons (cons index-name index-alist-name) texinfo-indexvar-alist))) (fset index-formatting-command (list 'lambda 'nil (list 'texinfo-index (list 'quote index-alist-name)))))) ;;; @synindex @syncodeindex (put 'synindex 'texinfo-format 'texinfo-format-synindex) (put 'syncodeindex 'texinfo-format 'texinfo-format-synindex) (defun texinfo-format-synindex () (let* ((args (texinfo-parse-arg-discard)) (second (cdr (read-from-string args))) (joiner (symbol-name (car (read-from-string args)))) (joined (symbol-name (car (read-from-string args second))))) (if (assoc joiner texinfo-short-index-cmds-alist) (put (cdr (assoc joiner texinfo-short-index-cmds-alist)) 'texinfo-format (or (cdr (assoc joined texinfo-short-index-format-cmds-alist)) (intern (concat "texinfo-format-" joined "index")))) (put (intern (concat joiner "index")) 'texinfo-format (or (cdr(assoc joined texinfo-short-index-format-cmds-alist)) (intern (concat "texinfo-format-" joined "index"))))))) (defconst texinfo-short-index-cmds-alist '(("cp" . cindex) ("fn" . findex) ("vr" . vindex) ("tp" . tindex) ("pg" . pindex) ("ky" . kindex))) (defconst texinfo-short-index-format-cmds-alist '(("cp" . texinfo-format-cindex) ("fn" . texinfo-format-findex) ("vr" . texinfo-format-vindex) ("tp" . texinfo-format-tindex) ("pg" . texinfo-format-pindex) ("ky" . texinfo-format-kindex))) ;;; Sort and index (for VMS) ;; Sort an index which is in the current buffer between START and END. ;; Used on VMS, where the `sort' utility is not available. (defun texinfo-sort-region (start end) (require 'sort) (save-restriction (narrow-to-region start end) (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun))) ;; Subroutine for sorting an index. ;; At start of a line, return a string to sort the line under. (defun texinfo-sort-startkeyfun () (let ((line (buffer-substring (point) (save-excursion (end-of-line) (point))))) ;; Canonicalize whitespace and eliminate funny chars. (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line) (setq line (concat (substring line 0 (match-beginning 0)) " " (substring line (match-end 0) (length line))))) line)) ;;; @printindex (put 'printindex 'texinfo-format 'texinfo-format-printindex) (defun texinfo-format-printindex () (let ((indexelts (symbol-value (cdr (assoc (texinfo-parse-arg-discard) texinfo-indexvar-alist)))) opoint) (insert "\n* Menu:\n\n") (setq opoint (point)) (texinfo-print-index nil indexelts) (if (eq system-type 'vax-vms) (texinfo-sort-region opoint (point)) (shell-command-on-region opoint (point) "sort -fd" 1)))) (defun texinfo-print-index (file indexelts) (while indexelts (if (stringp (car (car indexelts))) (progn (insert "* " (car (car indexelts)) ": " ) (indent-to 32) (insert (if file (concat "(" file ")") "") (nth 1 (car indexelts)) ".") (indent-to 54) (insert (if (nth 2 (car indexelts)) (format " %d." (nth 2 (car indexelts))) "") "\n")) ;; index entries from @include'd file (texinfo-print-index (nth 1 (car indexelts)) (nth 2 (car indexelts)))) (setq indexelts (cdr indexelts)))) ;;; Glyphs: @equiv, @error, etc ;; @equiv to show that two expressions are equivalent ;; @error to show an error message ;; @expansion to show what a macro expands to ;; @point to show the location of point in an example ;; @print to show what an evaluated expression prints ;; @result to indicate the value returned by an expression (put 'equiv 'texinfo-format 'texinfo-format-equiv) (defun texinfo-format-equiv () (texinfo-parse-arg-discard) (insert "==")) (put 'error 'texinfo-format 'texinfo-format-error) (defun texinfo-format-error () (texinfo-parse-arg-discard) (insert "error-->")) (put 'expansion 'texinfo-format 'texinfo-format-expansion) (defun texinfo-format-expansion () (texinfo-parse-arg-discard) (insert "==>")) (put 'point 'texinfo-format 'texinfo-format-point) (defun texinfo-format-point () (texinfo-parse-arg-discard) (insert "-!-")) (put 'print 'texinfo-format 'texinfo-format-print) (defun texinfo-format-print () (texinfo-parse-arg-discard) (insert "-|")) (put 'result 'texinfo-format 'texinfo-format-result) (defun texinfo-format-result () (texinfo-parse-arg-discard) (insert "=>")) ;;; Definition formatting: @deffn, @defun, etc ;; What definition formatting produces: ;; ;; @deffn category name args... ;; In Info, `Category: name ARGS' ;; In index: name: node. line#. ;; ;; @defvr category name ;; In Info, `Category: name' ;; In index: name: node. line#. ;; ;; @deftp category name attributes... ;; `category name attributes...' Note: @deftp args in lower case. ;; In index: name: node. line#. ;; ;; Specialized function-like or variable-like entity: ;; ;; @defun, @defmac, @defspec, @defvar, @defopt ;; ;; @defun name args In Info, `Function: name ARGS' ;; @defmac name args In Info, `Macro: name ARGS' ;; @defvar name In Info, `Variable: name' ;; etc. ;; In index: name: node. line#. ;; ;; Generalized typed-function-like or typed-variable-like entity: ;; @deftypefn category data-type name args... ;; In Info, `Category: data-type name args...' ;; @deftypevr category data-type name ;; In Info, `Category: data-type name' ;; In index: name: node. line#. ;; ;; Specialized typed-function-like or typed-variable-like entity: ;; @deftypefun data-type name args... ;; In Info, `Function: data-type name ARGS' ;; In index: name: node. line#. ;; ;; @deftypevar data-type name ;; In Info, `Variable: data-type name' ;; In index: name: node. line#. but include args after name!? ;; ;; Generalized object oriented entity: ;; @defop category class name args... ;; In Info, `Category on class: name ARG' ;; In index: name on class: node. line#. ;; ;; @defcv category class name ;; In Info, `Category of class: name' ;; In index: name of class: node. line#. ;; ;; Specialized object oriented entity: ;; @defmethod class name args... ;; In Info, `Method on class: name ARGS' ;; In index: name on class: node. line#. ;; ;; @defivar class name ;; In Info, `Instance variable of class: name' ;; In index: name of class: node. line#. ;;; The definition formatting functions (defun texinfo-format-defun () (texinfo-push-stack 'defun nil) (setq fill-column (- fill-column 5)) (texinfo-format-defun-1 t)) (defun texinfo-end-defun () (setq fill-column (+ fill-column 5)) (texinfo-discard-command) (let ((start (nth 1 (texinfo-pop-stack 'defun)))) (texinfo-do-itemize start) ;; Delete extra newline inserted after header. (save-excursion (goto-char start) (delete-char -1)))) (defun texinfo-format-defunx () (texinfo-format-defun-1 nil)) (defun texinfo-format-defun-1 (first-p) (let ((parse-args (texinfo-format-parse-defun-args)) (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.22/lisp/texinfo.el100444 12120 1 67675 5473512246 14123 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)) ;;; 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]" '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 '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 "^@\\(f?table\\|enumerate\\|itemize\\|ifinfo\\|iftex\\|example\\|quotation\\|lisp\\|smallexample\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|ignore\\|group\\|tex\\|cartouche\\|end\\)" "Regexp for environment-like TexInfo list commands. Subexpression 1 is what goes into the corresponding `@end' statement.") ;; The following texinfo-insert-@end command not only inserts a SPC ;; after the @end, but tries to find out what belongs there. It is ;; not very smart: it does not understand nested lists. (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) (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-subsection-level-regexp "\\)")) 13) ;; ((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.22/lisp/texnfo-upd.el100444 12120 1 231515 5470027060 14532 0ustar rmsdaemon;;; Texinfo mode utilities for updating nodes and menus in Texinfo files. ;;; Copyright 1989, 1990, 1991, 1992 Free Software Foundation ;; Author: Robert J. Chassell ;; Maintainer: bug-texinfo@prep.ai.mit.edu ;; Keywords: maint, tex, docs ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; 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)) (texinfo-update-node t))) (message "Updating all menus in %s ... " (buffer-name)) (sleep-for 2) (push-mark (point-max) t) (goto-char (point-min)) (texinfo-make-menu t) (if master-menu-p (progn (message "Updating the master menu in %s... " (buffer-name)) (sleep-for 2) (texinfo-master-menu nil)))) (message "Done...updated all the menus. You may save the buffer."))) (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 (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)) (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." (if (search-forward "," (save-excursion (end-of-line) (point)) t) (progn (goto-char (1- (point))) (kill-line nil))) (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.22/lisp/text-mode.el100444 12120 1 12344 5463300003 14315 0ustar rmsdaemon;;; text-mode.el --- text mode, and its idiosyncratic commands. ;; Copyright (C) 1985, 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: ;; 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)) (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 () "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'." (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)))))) ;;; text-mode.el ends here emacs-19.22/lisp/thingatpt.el100444 12120 1 15164 5474462647 14445 0ustar rmsdaemon;;; thingatpt.el --- Get the `thing' at point ;; Copyright (C) 1991,1992,1993 Free Software Foundation, Inc. ;; Author: Mike Williams ;; Keywords: extensions, matching, mouse ;; Created: Thu Mar 28 13:48:23 1991 ;; Version: $Revision: 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. ;;; 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) ;;=== Version ============================================================= (defconst thing@pt-version (substring "$Revision: 1.2 $" 11 -2) "The revision number of thing@pt (as string). The complete RCS id is: $Id: thingatpt.el,v 1.2 1993/11/23 19:33:55 rms Exp $") ;;=== 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 ======================================================= ;;--- 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))))) ;;=== 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.22/lisp/time-stamp.el100444 12120 1 24151 5473264010 14476 0ustar rmsdaemon;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs ;;; Copyright 1989, 1993 Free Software Foundation, Inc. ;; Maintainer: Stephen Gildea ;; Time-stamp: <93/09/24 16:02:25 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: <93/06/18 10:26: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, add this code to your .emacs file: ;;; ;;; (if (not (memq 'time-stamp write-file-hooks)) ;;; (setq write-file-hooks ;;; (cons 'time-stamp write-file-hooks))) ;;; ;;; In Emacs 18 you will also need ;;; (autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t) ;;; Change Log: ;;; Originally based on the 19 Dec 88 version of ;;; date.el by John Sturdy ;;; Code: (defvar time-stamp-active t "*Non-nil to enable time-stamping of files. See the function time-stamp.") (defvar time-stamp-format '(time-stamp-yy/mm/dd time-stamp-hh:mm:ss user-login-name) "*A list of functions to call to generate the time stamp string. Each element of the list is called as a function and the results are concatenated together separated by spaces. Elements may also be strings, which are included verbatim. Spaces are not inserted around literal strings.") ;;; 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! See comment above. "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.") (defvar time-stamp-start "Time-stamp: \\\\?[\"<]+" ;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! See comment above. "Regexp marking the text after the time stamp. \\[time-stamp] deletes the text between the first match of time-stamp-start \(which see) and the following match of time-stamp-end on the same line, then writes the time stamp specified by time-stamp-format between them.") ;;;###autoload (defun time-stamp () "Update the time stamp string in the buffer. 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 first time-stamp-line-limit lines of the buffer (normally 8) are searched for the time stamp template, and if it is found, a new time stamp is written into it." (interactive) (if time-stamp-active (let ((case-fold-search nil)) (if (and (stringp time-stamp-start) (stringp time-stamp-end)) (save-excursion (goto-char (point-min)) (if (re-search-forward time-stamp-start (save-excursion (forward-line time-stamp-line-limit) (point)) t) (let ((start (point))) (if (re-search-forward time-stamp-end (save-excursion (end-of-line) (point)) t) (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 the time stamp (goto-char start) (if (search-forward "\t" end t) (untabify start end))))))) ;; don't signal an error in a write-file-hook (message "time-stamp-start or time-stamp-end is not a string")))) ;; be sure to return nil so can be used on write-file-hooks nil) (defun time-stamp-string () "Generate the new string to be inserted by \\[time-stamp]." (time-stamp-fconcat time-stamp-format " ")) (defun time-stamp-fconcat (list sep) "Similar to (mapconcat 'funcall LIST SEP) but LIST can have 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)) (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)) "Assoc list of months and their number.") (defconst time-stamp-month-full-names ["(zero)" "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"]) (defvar time-stamp-mail-host nil "Name of the host where the user receives mail. See the function time-stamp-mail-host-name.") ;;; Some useful functions to use in time-stamp-format ;;; Could generate most of a message-id with ;;; '(time-stamp-yymmdd "" time-stamp-hhmm "@" mail-host-name) (defun time-stamp-mail-host-name () "Return the name of the host where the user receives mail. This is the value of time-stamp-mail-host if bound and a string, otherwise the value of the function system-name." (or (and (boundp 'time-stamp-mail-host) (stringp time-stamp-mail-host) time-stamp-mail-host) (system-name))) (defun time-stamp-current-year () "Return the current year as a four-character string." (substring (current-time-string) -4)) ;;; 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 %02d, %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))))) (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-dd/mm/yy () "Return the current date as a string in \"dd/mm/yy\" form." (let ((date (current-time-string))) (format "%02d/%02d/%s" (string-to-int (substring date 8 10)) (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) (substring date -2)))) (defun time-stamp-mm/dd/yy () "Return the current date as a string in \"mm/dd/yy\" form." (let ((date (current-time-string))) (format "%02d/%02d/%s" (cdr (assoc (substring date 4 7) time-stamp-month-numbers)) (string-to-int (substring date 8 10)) (substring date -2)))) (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-hh:mm () "Return the current time as a string in \"hh:mm\" form." (substring (current-time-string) 11 16)) (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.22/lisp/time.el100444 12241 1 11143 5416450633 14040 0ustar rolanddaemon;;; time.el --- display time and load in mode line of Emacs. ;; Copyright (C) 1985, 1986, 1987, 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: ;;; 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. Default 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-nill 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.") ;;;###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 "") (setq display-time-process (start-process "display-time" nil (concat exec-directory "wakeup") (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 (save-excursion (set-buffer (other-buffer))) (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)) (defun display-time-filter (proc string) (let ((time (current-time-string)) (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 (or (getenv "LOGNAME") (getenv "USER") (user-login-name))))) hour am-pm-flag) (setq hour (read (substring time 11 13))) (if (not display-time-24hr-format) (progn (setq am-pm-flag (if (>= hour 12) "pm" "am")) (if (> hour 12) (setq hour (- hour 12)) (if (= hour 0) (setq hour 12)))) (setq am-pm-flag "")) (setq display-time-string (concat (format "%d" hour) (substring time 13 16) am-pm-flag load (if (and (file-exists-p mail-spool-file) ;; file not empty? (display-time-file-nonempty-p mail-spool-file)) " Mail" ""))) ;; Append the date if desired. (if display-time-day-and-date (setq display-time-string (concat (substring time 0 11) display-time-string)))) (run-hooks 'display-time-hook) ;; Force redisplay of all buffers' mode lines to be considered. (save-excursion (set-buffer (other-buffer))) (set-buffer-modified-p (buffer-modified-p)) ;; Do redisplay right now, if no input pending. (sit-for 0)) (defun display-time-file-nonempty-p (file) (< 0 (nth 7 (file-attributes (file-chase-links file))))) ;;; time.el ends here emacs-19.22/lisp/timer.el100444 13437 1 13756 5405344552 13710 0ustar jimbdaemon;;; timer.el --- run a function with args at some time in future ;; Copyright (C) 1990, 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 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: ;;; The name of the program to run as the timer subprocess. It should ;;; be in exec-directory. (defconst timer-program "timer") (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.") ;;;###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, 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: ") ;; 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)) ;; Don't search the exec path for the timer program; ;; we know exactly which one we want. (start-process "timer" nil (expand-file-name timer-program exec-directory))) 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)) (ding 'no-terminate) ; using error function in process filters is rude (message "%s for %s; couldn't set at \"%s\"" error (nth 2 token) do)))) (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? (if (or (not timer-alist) (eq stat 'exit)) () (ding 'no-terminate) (message "Timer exited abnormally. All events cancelled.")) ;; 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.22/lisp/timezone.el100444 12120 1 31607 5455431733 14264 0ustar rmsdaemon;;; Timezone package for GNU Emacs ;; Copyright (C) 1990, 1991, 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. ;;; 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 ("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" (let ((date (or date "")) (year nil) (month nil) (day nil) (time nil) (zone nil)) ;This may be nil. (cond ((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)))) (setq month (int-to-string (cdr (assoc (upcase ;; Don't use `match-end' in order to take 3 ;; letters from the beginning. (substring date (match-beginning month) (+ (match-beginning month) 3))) 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 (if (< year 100) (+ year 1900) 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.22/lisp/tpu-doc.el100444 12120 1 52230 5475321626 14001 0ustar rmsdaemon;;; tpu-doc.el --- Documentation for TPU-edt ;; Copyright (C) 1993 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. (defconst tpu-doc-revision "$Revision: 1.6 $" "TPU-edt documentation revision number.") ;; This is documentation for the TPU-edt editor for GNU emacs. Major ;; sections of this document are separated with lines that begin with ;; ";; %% ", where is what is discussed in that section. ;; %% Contents ;; % Introduction ;; % Terminal Support ;; % X-windows Support ;; % Differences Between TPU-edt and the Real Thing ;; % Starting TPU-edt ;; % TPU-edt Default Editing Keypad, Control and Gold Key Bindings ;; % Optional TPU-edt Extensions ;; % Customizing TPU-edt using the Emacs Initialization File ;; % Compiling TPU-edt ;; % Regular expressions in TPU-edt ;; % Etcetera ;; %% Introduction ;; TPU-edt is based on tpu.el by Jeff Kowalski. TPU-edt endeavors ;; to be even more like TPU's EDT emulation than the original tpu.el. ;; Considerable effort has been expended to that end. Still, emacs ;; is emacs and there are differences between TPU-edt and the real ;; thing. Please read the "Differences Between TPU-edt and the Real ;; Thing" and "Starting TPU-edt" sections before running TPU-edt. ;; %% Terminal Support ;; TPU-edt, like it's VMS cousin, works on VT-series terminals with ;; DEC style keyboards. VT terminal emulators, including xterm with ;; the appropriate key translations, work just fine too. ;; %% X-windows Support ;; Starting with version 19 of emacs, TPU-edt works with X-windows. ;; This is accomplished through a TPU-edt X keymap. The emacs lisp ;; program tpu-mapper.el creates this map and stores it in a file. ;; Tpu-mapper will be run automatically the first time you invoke ;; the X-windows version of emacs, or you can run it by hand. See ;; the commentary in tpu-mapper.el for details. ;; %% Differences Between TPU-edt and the Real Thing (not Coke (r)) ;; Emacs (version 18.58) doesn't support text highlighting, so selected ;; regions are not shown in inverse video. Emacs uses the concept of ;; "the mark". The mark is set at one end of a selected region; the ;; cursor is at the other. The letter "M" appears in the mode line ;; when the mark is set. The native emacs command ^X^X (Control-X ;; twice) exchanges the cursor with the mark; this provides a handy ;; way to find the location of the mark. ;; In TPU the cursor can be either bound or free. Bound means the ;; cursor cannot wander outside the text of the file being edited. ;; Free means the arrow keys can move the cursor past the ends of ;; lines. Free is the default mode in TPU; bound is the only mode ;; in EDT. Bound is the only mode in the base version of TPU-edt; ;; optional extensions add an approximation of free mode. ;; Like TPU, emacs uses multiple buffers. Some buffers are used to ;; hold files you are editing; other "internal" buffers are used for ;; emacs' own purposes (like showing you help). Here are some commands ;; for dealing with buffers. ;; Gold-B moves to next buffer, including internal buffers ;; Gold-N moves to next buffer containing a file ;; Gold-M brings up a buffer menu (like TPU "show buffers") ;; Emacs is very fond of throwing up new windows. Dealing with all ;; these windows can be a little confusing at first, so here are a few ;; commands to that may help: ;; Gold-Next_Scr moves to the next window on the screen ;; Gold-Prev_Scr moves to the previous window on the screen ;; Gold-TAB also moves to the next window on the screen ;; Control-x 1 deletes all but the current window ;; Control-x 0 deletes the current window ;; Note that the buffers associated with deleted windows still exist! ;; Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or ;; Do. Most of the commands available are emacs commands. Some TPU ;; commands are available, they are: replace, exit, quit, include, and ;; Get (unfortunately, "get" is an internal emacs function, so we are ;; stuck with "Get" - to make life easier, Get is available as Gold-g). ;; Support for recall of commands, file names, and search strings was ;; added to emacs in version 19. For version 18 of emacs, optional ;; extensions are available to add this recall capability (see "Optional ;; TPU-edt Extensions" below). The history of strings recalled in both ;; versions of emacs differs slightly from TPU/edt, but it is still very ;; convenient. ;; Help is available! The traditional help keys (Help and PF2) display ;; a three page help file showing the default keypad layout, control key ;; functions, and Gold key functions. Pressing any key inside of help ;; splits the screen and prints a description of the function of the ;; pressed key. Gold-PF2 invokes the native emacs help, with it's ;; zillions of options. Gold-Help shows all the current key bindings. ;; Thanks to emacs, TPU-edt has some extensions that may make your life ;; easier, or at least more interesting. For example, Gold-r toggles ;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work ;; on rectangles. Likewise, Gold-* toggles TPU-edt regular expression ;; mode. In regular expression mode Find, Find Next, and the line-mode ;; replace command work with regular expressions. [A regular expression ;; is a pattern that denotes a set of strings; like VMS wildcards.] ;; Emacs also gives TPU-edt the undo and occur functions. Undo does ;; what it says; it undoes the last change. Multiple undos in a row ;; undo multiple changes. For your convenience, undo is available on ;; Gold-u. Occur shows all the lines containing a specific string in ;; another window. Moving to that window, and typing ^C^C (Control-C ;; twice) on a particular line moves you back to the original window ;; at that line. Occur is on Gold-o. ;; Finally, as you edit, remember that all the power of emacs is at ;; your disposal. It really is a fantastic tool. You may even want to ;; take some time and read the emacs tutorial; perhaps not to learn the ;; native emacs key bindings, but to get a feel for all the things ;; emacs can do for you. The emacs tutorial is available from the ;; emacs help function: "Gold-PF2 t" ;; %% Starting TPU-edt ;; In order to use TPU-edt, the TPU-edt editor definitions, contained ;; in tpu-edt.el, need to be loaded when emacs is run. This can be ;; done in a couple of ways. The first is by explicitly requesting ;; loading of the TPU-edt emacs definition file on the command line: ;; prompt> emacs -l /path/to/definitions/tpu-edt.el ;; If TPU-edt is installed on your system, that is, if tpu-edt.el is in ;; a directory like /usr/local/emacs/lisp, along with dozens of other ;; .el files, you should be able to use the command: ;; prompt> emacs -l tpu-edt ;; If you like TPU-edt and want to use it all the time, you can load ;; the TPU-edt definitions using the emacs initialization file, .emacs. ;; Simply create a .emacs file in your home directory containing the ;; line: ;; (load "/path/to/definitions/tpu-edt") ;; or, if (as above) TPU-edt is installed on your system: ;; (load "tpu-edt") ;; Once TPU-edt has been loaded, you will be using an editor with the ;; interface shown in the next section (A section that is suitable for ;; cutting out of this document and pasting next to your terminal!). ;; %% TPU-edt Default Editing Keypad, Control and Gold Key Bindings ;; ;; _______________________ _______________________________ ;; | HELP | Do | | | | | | ;; |KeyDefs| | | | | | | ;; |_______|_______________| |_______|_______|_______|_______| ;; _______________________ _______________________________ ;; | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | ;; | | |Sto Tex| | key |E-Help | Find |Undel L| ;; |_______|_______|_______| |_______|_______|_______|_______| ;; |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | ;; | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| ;; |_______|_______|_______| |_______|_______|_______|_______| ;; |Move up| |Forward|Reverse|Remove | Del C | ;; | Top | |Bottom | Top |Insert |Undel C| ;; _______|_______|_______ |_______|_______|_______|_______| ;; |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | ;; |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | ;; |_______|_______|_______| |_______|_______|_______| | ;; | Line |Select | Subs | ;; | Open Line | Reset | | ;; |_______________|_______|_______| ;; Control Characters ;; ;; ^A toggle insert and overwrite ^L insert page break ;; ^B recall ^R remember, re-center ;; ^E end of line ^U delete to beginning of line ;; ^G cancel current operation ^V quote ;; ^H beginning of line ^W refresh ;; ^J delete previous word ^Z exit ;; ^K learn ^X^X exchange point and mark ;; ;; ;; Gold- Functions ;; ----------------------------------------------------------------- ;; W Write - save current buffer ;; K Kill buffer - abandon edits and delete buffer ;; ;; E Exit - save current buffer and ask about others ;; X eXit - save all modified buffers and exit ;; Q Quit - exit without saving anything ;; ;; G Get - load a file into a new edit buffer ;; I Include - include a file in this buffer ;; ;; B next Buffer - display the next buffer (all buffers) ;; N Next file buffer - display next buffer containing a file ;; M buffer Menu - display a list of all buffers ;; ;; U Undo - undo the last edit ;; C Recall - edit and possibly repeat previous commands ;; ;; O Occur - show following lines containing REGEXP ;; S Search and substitute - line mode REPLACE command ;; ;; ? Spell check - check spelling in a region or entire buffer ;; ;; R Toggle Rectangular mode for remove and insert ;; * Toggle regular expression mode for search and substitute ;; ;; V Show TPU-edt version ;; ----------------------------------------------------------------- ;; %% Optional TPU-edt Extensions ;; Several optional packages have been included in this distribution ;; of TPU-edt. The following is a brief description of each package. ;; See the {package}.el file for more detailed information and usage ;; instructions. ;; tpu-extras - TPU/edt scroll margins and free cursor mode. ;; tpu-recall - String, file name, and command history. ;; vt-control - VTxxx terminal width and keypad controls. ;; Packages are normally loaded from the emacs initialization file ;; (discussed below). If a package is not installed in the emacs ;; lisp directory, it can be loaded by specifying the complete path ;; to the package file. However, it is preferable to modify the ;; emacs load-path variable to include the directory where packages ;; are stored. This way, packages can be loaded by name, just as if ;; they were installed. The first part of the sample .emacs file ;; below shows how to make such a modification. ;; %% Customizing TPU-edt using the Emacs Initialization File ;; .emacs - a sample emacs initialization file ;; This is a sample emacs initialization file. It shows how to invoke ;; TPU-edt, and how to customize it. ;; The load-path is where emacs looks for files to fulfill load requests. ;; If TPU-edt is not installed in a standard emacs directory, the load-path ;; should be updated to include the directory where the TPU-edt files are ;; stored. Modify and un-comment the following section if TPU-ed is not ;; installed on your system - be sure to leave the double quotes! ;; (setq load-path ;; (append (list (expand-file-name "/path/to/tpu-edt/files")) ;; load-path)) ;; Load TPU-edt (load "tpu-edt") ;; Load the optional goodies - scroll margins, free cursor mode, command ;; and string recall. But don't complain if the file aren't available. (load "tpu-extras" t) (load "tpu-recall" t) ;; Uncomment this line to set scroll margins 10% (top) and 15% (bottom). ;(and (fboundp 'tpu-set-scroll-margins) (tpu-set-scroll-margins "10%" "15%")) ;; Load the vtxxx terminal control functions, but don't complain if ;; if the file is not found. (load "vt-control" t) ;; TPU-edt treats words like EDT; here's how to add word separators. ;; Note that backslash (\) and double quote (") are quoted with '\'. (tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$") ;; Emacs is happy to save files without a final newline; other Unix programs ;; hate that! This line will make sure that files end with newlines. (setq require-final-newline t) ;; Emacs has the ability to automatically run code embedded in files ;; you edit. This line makes emacs ask if you want to run the code. (if tpu-emacs19-p (setq enable-local-variables "ask") (setq inhibit-local-variables t)) ;; Emacs uses Control-s and Control-q. Problems can occur when using emacs ;; on terminals that use these codes for flow control (Xon/Xoff flow control). ;; These lines disable emacs' use of these characters. (global-unset-key "\C-s") (global-unset-key "\C-q") ;; top, bottom, bol, eol seem like a waste of Gold-arrow functions. The ;; following section re-maps up and down arrow keys to top and bottom of ;; screen, and left and right arrow keys to pan left and right (pan-left, ;; right moves the screen 16 characters left or right - try it, you'll ;; like it!). ;; Re-map the Gold-arrow functions (define-key GOLD-CSI-map "A" 'tpu-beginning-of-window) ; up-arrow (define-key GOLD-CSI-map "B" 'tpu-end-of-window) ; down-arrow (define-key GOLD-CSI-map "C" 'tpu-pan-right) ; right-arrow (define-key GOLD-CSI-map "D" 'tpu-pan-left) ; left-arrow (define-key GOLD-SS3-map "A" 'tpu-beginning-of-window) ; up-arrow (define-key GOLD-SS3-map "B" 'tpu-end-of-window) ; down-arrow (define-key GOLD-SS3-map "C" 'tpu-pan-right) ; right-arrow (define-key GOLD-SS3-map "D" 'tpu-pan-left) ; left-arrow ;; Re-map the Gold-arrow functions for X-windows TPU-edt (emacs version 19) (cond ((and tpu-emacs19-p window-system) (define-key GOLD-map [up] 'tpu-beginning-of-window) ; up-arrow (define-key GOLD-map [down] 'tpu-end-of-window) ; down-arrow (define-key GOLD-map [right] 'tpu-pan-right) ; right-arrow (define-key GOLD-map [left] 'tpu-pan-left))) ; left-arrow ;; The emacs universal-argument function is very useful for native emacs ;; commands. This line maps universal-argument to Gold-PF1 (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1 ;; Make KP7 move by paragraphs, instead of pages. (define-key SS3-map "w" 'tpu-paragraph) ; KP7 ;; TPU-edt assumes you have the ispell spelling checker; ;; Un-comment this line if you don't. ;(setq tpu-have-spell nil) ;; Display the TPU-edt version. (tpu-version) ;; End of .emacs - a sample emacs initialization file ;; After initialization with the .emacs file shown above, the editing ;; keys have been re-mapped to look like this: ;; _______________________ _______________________________ ;; | HELP | Do | | | | | | ;; |KeyDefs| | | | | | | ;; |_______|_______________| |_______|_______|_______|_______| ;; _______________________ _______________________________ ;; | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | ;; | | |Sto Tex| | U Arg |E-Help | Find |Undel L| ;; |_______|_______|_______| |_______|_______|_______|_______| ;; |Select |Pre Scr|Nex Scr| |Paragra| Sect |Append | Del W | ;; | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| ;; |_______|_______|_______| |_______|_______|_______|_______| ;; |Move up| |Forward|Reverse|Remove | Del C | ;; |Tscreen| |Bottom | Top |Insert |Undel C| ;; _______|_______|_______ |_______|_______|_______|_______| ;; |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | ;; |PanLeft|Bscreen|PanRigh| |ChngCas|Del EOL|SpecIns| Enter | ;; |_______|_______|_______| |_______|_______|_______| | ;; | Line |Select | Subs | ;; | Open Line | Reset | | ;; |_______________|_______|_______| ;; Astute emacs hackers will realize that on systems where TPU-edt is ;; installed, this documentation file can be loaded to produce the above ;; editing keypad layout. In fact, to get all the changes in the sample ;; initialization file, you only need a one line initialization file: ;; (load "tpu-doc") ;; wow! ;; %% Compiling TPU-edt ;; It is not necessary to compile (byte-compile in emacs parlance) ;; TPU-edt to use it. However, byte-compiled code loads and runs ;; faster, and takes up less memory when loaded. To byte compile ;; TPU-edt, use the following command. ;; emacs -batch -f batch-byte-compile tpu-edt.el ;; This will produce a file named tpu-edt.elc. This new file can be ;; used in place of the original tpu-edt.el file. In commands where ;; the file type is not specified, emacs always attempts to use the ;; byte-compiled version before resorting to the source. ;; %% Regular expressions in TPU-edt ;; Gold-* toggles TPU-edt regular expression mode. In regular expression ;; mode, find, find next, replace, and substitute accept emacs regular ;; expressions. A complete list of emacs regular expressions can be ;; found using the emacs "info" command (it's somewhat like the VMS help ;; command). Try the following sequence of commands: ;; DO info ;; m regex ;; Type "q" to quit out of info mode. ;; There is a problem in regular expression mode when searching for ;; empty strings, like beginning-of-line (^) and end-of-line ($). ;; When searching for these strings, find-next may find the current ;; string, instead of the next one. This can cause global replace and ;; substitute commands to loop forever in the same location. For this ;; reason, commands like ;; replace "^" "> " " to beginning of line> ;; replace "$" "00711" ;; may not work properly. ;; Commands like those above are very useful for adding text to the ;; beginning or end of lines. They might work on a line-by-line basis, ;; but go into an infinite loop if the "all" response is specified. If ;; the goal is to add a string to the beginning or end of a particular ;; set of lines TPU-edt provides functions to do this. ;; Gold-^ Add a string at BOL in region or buffer ;; Gold-$ Add a string at EOL in region or buffer ;; There is also a TPU-edt interface to the native emacs string ;; replacement commands. Gold-/ invokes this command. It accepts ;; regular expressions if TPU-edt is in regular expression mode. Given ;; a repeat count, it will perform the replacement without prompting ;; for confirmation. ;; This command replaces empty strings correctly, however, it has its ;; drawbacks. As a native emacs command, it has a different interface ;; than the emulated TPU commands. Also, it works only in the forward ;; direction, regardless of the current TPU-edt direction. ;; %% Etcetera ;; That's TPU-edt in a nutshell... ;; Please send any bug reports, feature requests, or cookies to the ;; author, Rob Riepel, at the address shown by the tpu-version command ;; (Gold-V). ;; Share and enjoy... Rob Riepel 7/93 ;;; tpu-doc.el ends here emacs-19.22/lisp/tpu-edt.el100444 12120 1 227647 5475321300 14035 0ustar rmsdaemon;;; tpu-edt.el --- Emacs emulating TPU emulating EDT ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Rob Riepel ;; Maintainer: Rob Riepel ;; Version: 3.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. ;;; Code: ;;; ;;; Revision and Version Information ;;; (defconst tpu-version "3.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 or GNU Emacs version 19.") (defconst tpu-gnu-emacs18-p (not tpu-emacs19-p) "Non-NIL if we are running GNU Emacs version 18.") (defconst tpu-lucid-emacs19-p (and tpu-emacs19-p (string-match "Lucid" emacs-version)) "Non-NIL if we are running Lucid Emacs version 19.") (defconst tpu-gnu-emacs19-p (and tpu-emacs19-p (not tpu-lucid-emacs19-p)) "Non-NIL if we are running GNU Emacs version 19.") ;;; ;;; Global Keymaps ;;; (defvar CSI-map (make-sparse-keymap) "Maps the CSI function keys on the VT100 keyboard. CSI is DEC's name for the sequence [.") (defvar SS3-map (make-sparse-keymap) "Maps the SS3 function keys on the VT100 keyboard. SS3 is DEC's name for the sequence O.") (defvar GOLD-map (make-keymap) "Maps the function keys on the VT100 keyboard preceeded by PF1. GOLD is the ASCII 7-bit escape sequence OP.") (defvar GOLD-CSI-map (make-sparse-keymap) "Maps the function keys on the VT100 keyboard preceeded by GOLD-CSI.") (defvar GOLD-SS3-map (make-sparse-keymap) "Maps the function keys on the VT100 keyboard preceeded by GOLD-SS3.") (defvar tpu-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 GNU emacs.")) ;;; ;;; Global Variables ;;; (defvar tpu-edt-mode nil "If non-nil, TPU-edt mode is active.") (defvar tpu-last-replaced-text "" "Last text deleted by a TPU-edt replace command.") (defvar tpu-last-deleted-region "" "Last text deleted by a TPU-edt remove command.") (defvar tpu-last-deleted-lines "" "Last text deleted by a TPU-edt line-delete command.") (defvar tpu-last-deleted-words "" "Last text deleted by a TPU-edt word-delete command.") (defvar tpu-last-deleted-char "" "Last character deleted by a TPU-edt character-delete command.") (defvar tpu-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 t "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 'minor-mode-alist "%n" 'mode-line-process (purecopy ")%]----") (purecopy '(-3 . "%p")) (purecopy "-%-"))) (or (assq 'tpu-newline-and-indent-p minor-mode-alist) (setq minor-mode-alist (cons '(tpu-newline-and-indent-p tpu-newline-and-indent-string) minor-mode-alist))) (or (assq 'tpu-rectangular-p minor-mode-alist) (setq minor-mode-alist (cons '(tpu-rectangular-p tpu-rectangle-string) minor-mode-alist))) (or (assq 'tpu-direction-string minor-mode-alist) (setq minor-mode-alist (cons '(tpu-direction-string tpu-direction-string) minor-mode-alist)))))) (defun tpu-update-mode-line nil "Make sure mode-line in the current buffer reflects all changes." (setq tpu-mark-flag (if (tpu-mark) "M" " ")) (cond (tpu-emacs19-p (force-mode-line-update)) (t (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)))) (cond (tpu-gnu-emacs19-p (add-hook 'activate-mark-hook 'tpu-update-mode-line) (add-hook 'deactivate-mark-hook 'tpu-update-mode-line)) (tpu-lucid-emacs19-p (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line) (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))) ;;; ;;; Match Markers - ;;; ;;; Set in: Search ;;; ;;; Used in: Replace, Substitute, Store-Text, Cut/Remove, ;;; Append, and Change-Case ;;; (defvar tpu-match-beginning-mark (make-marker)) (defvar tpu-match-end-mark (make-marker)) (defun tpu-set-match nil "Set markers at match beginning and end." ;; Add one to beginning mark so it stays with the first character of ;; the string even if characters are added just before the string. (setq tpu-match-beginning-mark (copy-marker (1+ (match-beginning 0)))) (setq tpu-match-end-mark (copy-marker (match-end 0)))) (defun tpu-unset-match nil "Unset match beginning and end markers." (set-marker tpu-match-beginning-mark nil) (set-marker tpu-match-end-mark nil)) (defun tpu-match-beginning nil "Returns the location of the last match beginning." (1- (marker-position tpu-match-beginning-mark))) (defun tpu-match-end nil "Returns the location of the last match end." (marker-position tpu-match-end-mark)) (defun tpu-check-match nil "Returns t if point is between tpu-match markers. Otherwise sets the tpu-match markers to nil and returns nil." ;; make sure 1- marker is in this buffer ;; 2- point is at or after beginning marker ;; 3- point is before ending marker, or in the case of ;; zero length regions (like bol, or eol) that the ;; beginning, end, and point are equal. (cond ((and (equal (marker-buffer tpu-match-beginning-mark) (current-buffer)) (>= (point) (1- (marker-position tpu-match-beginning-mark))) (or (< (point) (marker-position tpu-match-end-mark)) (and (= (1- (marker-position tpu-match-beginning-mark)) (marker-position tpu-match-end-mark)) (= (marker-position tpu-match-end-mark) (point))))) t) (t (tpu-unset-match) nil))) (defun tpu-show-match-markers nil "Show the values of the match markers." (interactive) (if (markerp tpu-match-beginning-mark) (let ((beg (marker-position tpu-match-beginning-mark))) (message "(%s, %s) in %s -- current %s in %s" (if beg (1- beg) nil) (marker-position tpu-match-end-mark) (marker-buffer tpu-match-end-mark) (point) (current-buffer))))) ;;; ;;; Utilities ;;; (defun tpu-caar (thingy) (car (car thingy))) (defun tpu-cadr (thingy) (car (cdr thingy))) (defun tpu-mark nil "TPU-edt version of the mark function. Return the appropriate value of the mark for the current version of emacs." (cond (tpu-lucid-emacs19-p (mark (not zmacs-regions))) (tpu-gnu-emacs19-p (and mark-active (mark (not transient-mark-mode)))) (t (mark)))) (defun tpu-set-mark (pos) "TPU-edt verion of the set-mark function. Sets the mark at POS and activates the region acording to the current version of emacs." (set-mark pos) (and tpu-lucid-emacs19-p pos (zmacs-activate-region))) (defun tpu-string-prompt (prompt history-symbol) "Read a string with PROMPT." (if tpu-emacs19-p (read-from-minibuffer prompt nil nil nil history-symbol) (read-string prompt))) (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, 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 U Undo - undo the last edit W Write - save current buffer X Exit - save all modified buffers and exit \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f *** No more help, use P to view previous screen") (defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol (defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol (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 2) (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) (setq trim-versions-without-asking t) (save-buffers-kill-emacs t)) (defun tpu-write-current-buffers nil "Save all modified buffers without exiting." (interactive) (save-some-buffers t)) (defun tpu-next-buffer nil "Go to next buffer in ring." (interactive) (switch-to-buffer (car (reverse (buffer-list))))) (defun tpu-next-file-buffer nil "Go to next buffer in ring that is visiting a file." (interactive) (let ((starting-buffer (buffer-name))) (switch-to-buffer (car (reverse (buffer-list)))) (while (and (not (equal (buffer-name) starting-buffer)) (not (buffer-file-name))) (switch-to-buffer (car (reverse (buffer-list))))) (if (equal (buffer-name) starting-buffer) (error "No other buffers.")))) (defun tpu-next-window nil "Move to the next window." (interactive) (if (one-window-p) (message "There is only one window on screen.") (other-window 1))) (defun tpu-previous-window nil "Move to the previous window." (interactive) (if (one-window-p) (message "There is only one window on screen.") (select-window (previous-window)))) ;;; ;;; Search ;;; (defun tpu-toggle-regexp nil "Switches in and out of regular expression search and replace mode." (interactive) (setq tpu-regexp-p (not tpu-regexp-p)) (tpu-set-search) (and (interactive-p) (message "Regular expression search and substitute %sabled." (if tpu-regexp-p "en" "dis")))) (defun tpu-regexp-prompt (prompt) "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set." (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt))) (if tpu-emacs19-p (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist) (read-string re-prompt)))) (defun tpu-search nil "Search for a string or regular expression. The search is performed in the current direction." (interactive) (tpu-set-search) (tpu-search-internal "")) (defun tpu-search-forward nil "Search for a string or regular expression. The search is begins in the forward direction." (interactive) (setq 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) (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) (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-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")))) ;;; ;;; 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") (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: ;; 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. ;; I don't know for a fact that the overhead associated with scroll ;; margin support is significant. If you find that it is, please send me ;; 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. ;;; Usage: ;; To use this file, simply load it after loading TPU-edt. After that, ;; 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. ;; (load "tpu-edt") ; Load the base TPU-edt ;; (load "tpu-extras") ; and the extras. ;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins. ;; Once the extras are loaded, scroll margins and cursor binding can be ;; changed with 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. ;;; Code: ;;; Revision Information (defconst tpu-extras-revision "$Revision: 1.6 $" "Revision number of the TPU-edt extras.") ;;; 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. (if tpu-gnu-emacs18-p (or (memq 'tpu-set-cursor-free edit-picture-hook) (setq edit-picture-hook (cons 'tpu-set-cursor-free edit-picture-hook))) (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))) (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.22/lisp/tpu-mapper.el100444 12120 1 34132 5474462346 14525 0ustar rmsdaemon;;; tpu-mapper.el --- Create a TPU-edt keymap file for x-windows emacs. ;; Copyright (C) 1993 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 (version 19) ;; using the following command. ;; emacs -q -l tpu-mapper.el ;; 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 loading 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")) ;; (load "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: ;;; ;;; Revision Information ;;; (defconst tpu-mapper-revision "$Revision: 1.5 $" "Revision number of TPU-edt x-windows emacs key mapper.") ;;; ;;; 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 tpu-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 tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) "Non-NIL if we are running Lucid Emacs version 19.") ;;; ;;; Key variables ;;; (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 nil 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) ;;; ;;; 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-gnu-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-gnu-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") (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end") (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)))) (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 and blow this pop stand ;;; (let ((file (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-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) ;;; tpu-mapper.el ends here emacs-19.22/lisp/tq.el100444 12120 1 10117 5257361670 13051 0ustar rmsdaemon;;; 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 *spurious*."))) (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.22/lisp/trace.el100444 12120 1 25212 5474467245 13533 0ustar rmsdaemon;;; trace.el --- tracing facility for Emacs Lisp functions ;; Copyright (C) 1993 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Created: 15 Dec 1992 ;; Version: trace.el,v 2.0 1993/05/18 00:41:16 hans Exp ;; 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) ;; For the odd case that ``' does not have an autoload definition in some ;; Emacs we autoload it here. It is only needed for compilation, hence, ;; I don't want to unconditionally `require' it: (if (not (fboundp '`)) (autoload '` "backquote")) (defconst trace-version "2.0") ;;;###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.22/lisp/two-column.el100444 74777 1 61422 5365710547 14712 0ustar ericdaemon;;; two-column.el --- minor mode for editing of two-column text ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer ;; 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 1, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; This package gives you the ability to edit text in a two-column format. ;; --8<---- two-column.el ----8<--------8<--------8<--------8<--------8<------- ;; Esperanto: English: ;; Minora modalo por samtempa dukolumna Minor mode for simultaneous ;; tajpado two-column editing ;; ^Ci dataro estas ero de GNU Emacs. This file is part of GNU Emacs. ;; 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. Neniu a^utoro a^u ANY WARRANTY. No author or ;; disdonanto akceptas respondecon al distributor accepts responsibility ;; iu ajn por la sekvoj de ^gia uzado, to anyone for the consequences of ;; a^u ^cu ^gi serveblas al iu celo, using it or for whether it serves ;; a^u e^c entute funkcias, se li ni any particular purpose or works at ;; estas skribinta tion. Vidu la GNU all, unless he says so in writing. ;; Emacs ^Generala Publika Licenco por Refer to the GNU Emacs General ;; plenaj detaloj. Public License for full details. ;; ^Ciu rajtas kopii, modifi kaj ree Everyone is granted permission to ;; disdoni GNU Emacs, sed nur sub la copy, modify and redistribute GNU ;; condi^coj priskribitaj en la GNU Emacs, but only under the conditions ;; Emacs ^Generala Publika Licenco. described in the GNU Emacs General ;; Kopio de tiu licenso estas supozata Public License. A copy of this ;; donita al vi kune kun GNU Emacs, por license is supposed to have been ;; ke vi sciu viajn rajtojn kaj given to you along with GNU Emacs so ;; respondecojn. ^Gi devus esti en you can know your rights and ;; dataro nomata COPYING. Inter responsibilities. It should be in a ;; alia^joj, la notico pri kopirajto file named COPYING. Among other ;; kaj ^ci notico devas esti gardata things, the copyright notice and ;; sur ^ciuj kopioj. this notice must be preserved on all ;; copies. ;; Tiu minora modalo ebligas al vi This minor mode allows you to ;; tajpi sendepende en du apudaj independently edit two adjacent ;; bufroj. Vi havas tri eblecojn por buffers. You have three ways to ;; eki ^gin. ^Ciu donas al vi start it up. Each gives you a ;; horizontale disigatan fenestron, horizontally split window similar to ;; simila al fina apareco de via the final outcome of your text: ;; teksto: ;; C-x 6 2 asocias novan bufron nomatan associates a new buffer called ;; same, sed kun 2C/ anta^u. the same, but with 2C/ ;; prepended. ;; C-x 6 b asocias alian bufron. Vi povas associates another buffer. ;; 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. ;; C-x 6 u disigas jam dukolumnan tekston unmerges a two-column text into ;; 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 unmerge this file from ;; ^ci dataron ekde la unua angla the first english word. ;; vorto. ;; Je ^cia flanko estas bufro, kiu On each side is a buffer that knows ;; konas la alian. Kun la ordonoj C-x about the other. With the commands ;; 6 SPC, C-x 6 DEL kaj C-x 6 RET oni C-x 6 SPC, C-x 6 DEL and C-x 6 RET ;; povas suben- a^u supreniri unu you can simultaneously scroll up or ;; ekranon, kaj subeniri linion, down by a screenfull and by a line ;; samtempe en la du bufroj. Al la alia in both buffers. Empty lines are ;; bufro estas aldonataj linioj se added to the other buffer if ;; necesas, por ke vi vidu la saman necessary, so that you see the same ;; parton. Per C-x 6 C-l vi povas part. With C-x 6 C-l you can ;; recentrigi la linion. Kiam vi nur recenter the line. When you only ;; plu havas unu el la du bufroj have one of the two buffers onscreen ;; surekrane vi revidos la alian per you can get the other back with C-x ;; denove C-x 6 2. 6 2 once more. ;; 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 malplenajn 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 ;; ma^joran modalon, la minoraj 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 minora two columns, you turn off the minor ;; modalo per C-x 6 k. mode with C-x 6 k. ;; An^stata^u tri `autoload' kaj tri | Instead of three `autoload' and ;; `global-set-key' vi povas uzi la | three `global-set-key' you can use ;; jenon en via dataro ~/.emacs, por | the following in your file ;; memstare ^car^gi la modalon: | ~/.emacs, to automatically load ;; | the mode: ;; (global-set-key "\C-x6" ;; '(lambda () (interactive) ;; (load-library "two-column") ;; (call-interactively ;; (cdr (assq (read-char) tc-mode-map))))) ;; Se vi ^satus havi la dukolumnajn | If you'd like to have the ;; ordonojn je funkciklavo , vi | two-column commands on function ;; povas uzi la jenon en via dataro | key , you can use the ;; ~/.emacs: | following in your file ~/.emacs: ;; (global-set-key [f2] (function ;; (lambda () ;; (interactive) ;; (load-library "two-column") ;; (global-set-key [f2] tc-mode-map) ;; (call-interactively ;; (cdr (assq (read-char) tc-mode-map)))))) ;; In addition to two-column editing of text, for example for writing a ;; bilingual text side-by-side as shown below in the file's prolog, other ;; interesting uses have been found for this minor mode: ;; ;; ;; You can separate the columns with {+} C-x 6 u or u if you prefer ;; any string that pleases you, by {+} handles these with a prefix argument ;; setting tc-separator. For {+} that enables you to declare the ;; example "{+} " if you like to {+} desired length of such a string. ;; amuse yourself. ;; ;; ;; keyword You can write any text corresponding to a ;; given keyword in a filled paragraph next to ;; it. Note that the width of the first column ;; may be less than window-min-width in the ;; result, but will be displayed at that width. ;; ;; another This is not a three- or multi-column mode. ;; The example in the file's prolog required ;; working on two columns and then treating the ;; result as one column in order to add the ;; third. ;; ;; ;; Programmers might like the ability to split off the comment column of ;; a file that looks like the following. The advantage is that with ;; (setq fill-prefix "-- ") you can run M-q (fill-paragraph) on the ;; comment. The problem is, code quickly gets rather wide, so you need ;; to use a narrower comment column, which is less interesting, unless ;; you have a 132-column screen. Code lines that reach beyond ;; comment-column are no problem, except that you won't always 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. ;; ;; Better yet, you can put the point before "This", type M-3 C-x 6 u ;; which makes "-- " the separator between a no-comments Ada buffer, and ;; a plain text comment buffer. When you put them back together, every ;; non-empty line of the 2nd column will again be preceded by "-- ". ;; ;; ;; The function key hack (which is one of the rare times when ;; function keys are mnemonic) at the end of the file's prolog requires ;; that the lisp/term/*.el for your terminal use the standard ;; conventions. Too bad that some don't (at least not in version 18.55). ;; The Sun one is hopelessly non-standard, and vt2[024]0 somehow forgot ;; to define thru . (It defines thru instead, but ;; that is not what we need on an X terminal.) If you want to use those, ;; you'll need another hack something like: ;; ;; (if (string= (system-name) "cix") ;; (progn ;; (load-library "term/vt200.el") ;; (define-key CSI-map "12~" (cons function-keymap ?\^b))) ;; (global-unset-key "\e[") ;; (define-key esc-map "[225z" (cons function-keymap ?\^b))) ;; ;; where "cix" is the non-sun machine I use. Actually I use the same X ;; terminal to connect to both machines, and I want to keep my ~/.emacs ;; identical on both. Bother, the two Emacses don't recognize the same ;; keys and assign different sequences to those they do! I sure hope all ;; this nonsense will stop with version 19 (or preferably soon) where I'd ;; like to be able to say (define-key some-map ' some-cmd), and see ;; rather than some unintelligible ESC-sequence in command key ;; sequences. ;;; Code: ;;;;; Set up keymap ;;;;; ;;;###autoload (defvar tc-mode-map nil "Keymap for commands for two-column mode.") ;;;###autoload (if tc-mode-map () (setq tc-mode-map (make-sparse-keymap)) (define-key tc-mode-map "1" 'tc-merge) (define-key tc-mode-map "2" 'tc-two-columns) (define-key tc-mode-map "b" 'tc-associate-buffer) (define-key tc-mode-map "e" 'tc-dissociate) (define-key tc-mode-map "\C-l" 'tc-recenter) (define-key tc-mode-map "o" 'tc-associated-buffer) (define-key tc-mode-map "s" 'tc-split) (define-key tc-mode-map "{" 'shrink-window-horizontally) (define-key tc-mode-map "}" 'enlarge-window-horizontally) (define-key tc-mode-map " " 'tc-scroll-up) (define-key tc-mode-map "\^?" 'tc-scroll-down) (define-key tc-mode-map "\C-m" 'tc-scroll-line)) ;;;###autoload (global-set-key "\C-x6" tc-mode-map) ;;;;; variable declarations ;;;;; ;; markers seem to be the only buffer-id not affected by renaming ;; a buffer. This nevertheless loses when a buffer is killed. (defvar tc-other nil "Marker to the associated buffer, if non-nil.") (make-variable-buffer-local 'tc-other) (put 'tc-other 'permanent-local t) (setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist)) ;; rearranged, so that the pertinent info will show in 40 columns (defvar tc-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 tc-separator "" "*A string inserted between the two columns when merging. This gets set locally by \\[tc-split].") (put 'tc-separator 'permanent-local t) (defvar tc-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 'tc-window-width) (put 'tc-window-width 'permanent-local t) (defvar tc-beyond-fill-column 4 "*Base for calculating `fill-column' for a buffer in two-column minor mode. The value of `fill-column' becomes `tc-window-width' for this buffer minus this value.") (defvar tc-mode-hook nil "Function called, if non-nil, whenever turning on two-column minor mode. It can get called by \\[tc-two-columns] (tc-two-columns), \\[tc-split] (tc-split) and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.") ;;;;; base functions ;;;;; ;; the access method for the other buffer. this tries to remedy against ;; lost local variables and lost buffers. (defun tc-other () (if tc-other (or (prog1 (marker-buffer tc-other) (setq mode-line-format tc-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 'tc-other) (kill-local-variable 'mode-line-format) nil)))) ;;;###autoload (defun tc-two-columns (&optional buffer) "Split current window vertically for two-column editing. When called the first time, associates a buffer with the current buffer. Both buffers are put in two-column minor mode and tc-mode-hook gets called on both. These buffers remember about one another, even when renamed. When called again, restores the screen layout with the current buffer first and the associated buffer to it's right. 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. You have the following commands at your disposal: \\[tc-two-columns] Rearrange screen \\[tc-associate-buffer] Reassociate buffer after changing major mode \\[tc-scroll-up] Scroll both buffers up by a screenfull \\[tc-scroll-down] Scroll both buffers down by a screenful \\[tc-scroll-line] Scroll both buffers up by one or more lines \\[tc-recenter] Recenter and realign other buffer \\[shrink-window-horizontally], \\[enlarge-window-horizontally] Shrink, enlarge current column \\[tc-associated-buffer] Switch to associated buffer \\[tc-merge] Merge both buffers These keybindings can be customized in your ~/.emacs by `tc-prefix' and `tc-mode-map'. The appearance of the screen can be customized by the variables `tc-window-width', `tc-beyond-fill-column', `tc-mode-line-format' and `truncate-partial-width-windows'." (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 tc-window-width (- (frame-width) window-min-width)))) (if (tc-other) (progn (other-window 1) (switch-to-buffer (tc-other)) (other-window -1) ; align buffers if necessary (tc-scroll-line 0)) ; set up minor mode linking two buffers (setq fill-column (- tc-window-width tc-beyond-fill-column) mode-line-format tc-mode-line-format) (run-hooks tc-mode-hook) (let ((other (point-marker))) (other-window 1) (switch-to-buffer (or buffer (generate-new-buffer (concat "2C/" (buffer-name))))) (or buffer (text-mode)) (setq fill-column (- tc-window-width tc-beyond-fill-column) mode-line-format tc-mode-line-format tc-other other other (point-marker)) (run-hooks tc-mode-hook) (other-window -1) (setq tc-other other)))) (defalias 'tc-mode 'tc-two-columns) ;;;###autoload (defun tc-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 \\[tc-two-columns] and `lisp/two-column.el' for further details." (interactive) (let ((b1 (current-buffer)) (b2 (or (tc-other) (read-buffer "Associate buffer: " (other-buffer))))) (save-excursion (setq tc-other nil) (set-buffer b2) (and (tc-other) (not (eq b1 (tc-other))) (error "Buffer already associated with buffer `%s'." (buffer-name (tc-other)))) (setq b1 (and (assq 'tc-window-width (buffer-local-variables)) tc-window-width))) ; if other buffer has a local width, adjust here too (if b1 (setq tc-window-width (- (frame-width) b1))) (tc-two-columns b2))) ;;;###autoload (defun tc-split (arg) "Unmerge a two-column text into two buffers in two-column minor mode. The text is unmerged at the cursor's column which becomes the local value of `tc-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 `tc-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 as you like them. You write the first line of each column with the separator you like and then unmerge that line. E.g.: First column's text sSs Second columns text \\___/\\ / \\ 5 character Separator You type M-5 \\[tc-split] with the point here See \\[tc-two-columns] and `lisp/two-column.el' for further details." (interactive "p") (and (tc-other) (if (y-or-n-p (concat "Overwrite associated buffer `" (buffer-name (tc-other)) "'? ")) (save-excursion (set-buffer (tc-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 'tc-separator) (setq tc-separator (buffer-substring (point) point) tc-window-width (current-column))) (tc-two-columns) (setq other (tc-other)) ; now we're ready to actually unmerge (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))))) ;;;###autoload (defun tc-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 (tc-other) (set-buffer (tc-other)) (or (not (tc-other)) (eq buffer (tc-other))) (if (and (not (buffer-modified-p)) (eobp) (bobp)) (kill-buffer nil) (kill-local-variable 'tc-other) (kill-local-variable 'tc-window-width) (kill-local-variable 'tc-separator) (kill-local-variable 'mode-line-format) (kill-local-variable 'fill-column)))) (kill-local-variable 'tc-other) (kill-local-variable 'tc-window-width) (kill-local-variable 'tc-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 ;;;###autoload (defun tc-merge () "Merges the associated buffer with the current buffer. They get merged at the column, which is the value of `tc-window-width', i.e. usually at the vertical window separator. This separator gets replaced with white space. Beyond that the value of 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 `tc-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) (or (tc-other) (error "You must first set two-column minor mode.")) (and (> (car (window-edges)) 0) ; not touching left edge of screen (eq (window-buffer (previous-window)) (tc-other)) (other-window -1)) (save-excursion (let ((b1 (current-buffer)) (b2 (tc-other)) 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 tc-window-width) (insert tc-separator string)) (next-line 1) ; add one if necessary (set-buffer b2)))) (if (< (window-width) (frame-width)) (enlarge-window 99999 t))) ;;;;; utility functions ;;;;; ;;;###autoload (defun tc-associated-buffer () "Switch to associated buffer." (interactive) (or (tc-other) (error "You must set two-column minor mode.")) (if (get-buffer-window (tc-other)) (select-window (get-buffer-window (tc-other))) (switch-to-buffer (tc-other)))) ;; It would be desirable to intercept anything that causes the current ;; window to scroll. Maybe a `scroll-hook'? ;;;###autoload (defun tc-scroll-line (arg) "Scroll current window upward by ARG lines. The associated window gets scrolled to the same line." (interactive "p") (or (tc-other) (error "You must set two-column minor mode.")) ; scroll-up has a bug on arg 0 at end of buffer (or (zerop arg) (scroll-up arg)) (setq arg (count-lines (point-min) (window-start))) ; too bad that pre 18.57 Emacs makes save-window-excursion restore ; the point. When it becomes extinct, we can simplify this. (if (get-buffer-window (tc-other)) (let ((window (selected-window))) (select-window (get-buffer-window (tc-other))) (setq arg (- arg (count-lines (point-min) (window-start)))) ; make sure that other buffer has enough lines (save-excursion (goto-char (point-max)) (insert-char ?\n (- arg (count-lines (window-start) (point-max)) -1))) (or (zerop arg) (scroll-up arg)) (select-window window)))) ;;;###autoload (defun tc-scroll-up (arg) "Scroll current window upward by ARG screens. The associated window gets scrolled to the same line." (interactive "p") (tc-scroll-line (* arg (- (window-height) next-screen-context-lines 1)))) ;;;###autoload (defun tc-scroll-down (arg) "Scroll current window downward by ARG screens. The associated window gets scrolled to the same line." (interactive "p") (tc-scroll-line (* arg (- next-screen-context-lines (window-height) -1)))) ;;;###autoload (defun tc-recenter (arg) "Center point in window. With ARG, put point on line ARG. This counts from bottom if ARG is negative. The associated window gets scrolled to the same line." (interactive "P") (setq arg (and arg (prefix-numeric-value arg))) (tc-scroll-line (- (count-lines (window-start) (point)) (cond ((null arg) (/ (window-height) 2)) ((< arg 0) (+ (window-height) arg)) ( arg))))) (defun enlarge-window-horizontally (arg) "Make current window ARG columns wider." (interactive "p") (enlarge-window arg t) (and (tc-other) (setq tc-window-width (+ tc-window-width arg)) (set-buffer (tc-other)) (setq tc-window-width (- tc-window-width arg)))) (defun shrink-window-horizontally (arg) "Make current window ARG columns narrower." (interactive "p") (enlarge-window-horizontally (- arg))) (provide 'two-column) ;;; two-column.el ends here emacs-19.22/lisp/uncompress.el100444 12120 1 5727 5354213500 14600 0ustar rmsdaemon;;; uncompress.el --- auto-decompression hook for visiting .Z files ;; 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: ;; 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. (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" 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))) (defun uncompress-while-visiting () "Temporary \"major mode\" used for .Z files, to uncompress the contents. 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)))) (message "Uncompressing...") (let ((buffer-read-only nil)) (shell-command-on-region (point-min) (point-max) "uncompress" 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. (if (file-exists-p (concat buffer-file-name ".Z")) (progn (setq buffer-file-name (concat buffer-file-name ".Z")) (insert-file-contents buffer-file-name t) (goto-char (point-min)) (setq error nil) t))) (provide 'uncompress) ;;; uncompress.el ends here emacs-19.22/lisp/underline.el100444 13437 1 4105 5354241033 14512 0ustar jimbdaemon;;; 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 "_")) (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 "_\\|_" end1 t) (delete-char -2))))) ;;; underline.el ends here emacs-19.22/lisp/undigest.el100444 12120 1 7451 5257333336 14234 0ustar rmsdaemon;;; undigest.el --- digest-cracking support for the RMAIL mail reader ;; Copyright (C) 1985, 1986 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: (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) (digest-name (mail-strip-quoted-names (or (save-restriction (search-forward "\n\n") (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"))))) (save-excursion (goto-char (point-max)) (skip-chars-backward " \t\n") (let ((count 10) found) ;; compensate for broken un*x digestifiers. Sigh Sigh. (while (and (> count 0) (not found)) (forward-line -1) (setq count (1- count)) (if (looking-at (concat "End of.*Digest.*\n" (regexp-quote "*********") "*" "\\(\n------*\\)*")) (setq found t))) (if (not found) (error "Message is not a digest")))) (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")))))) (setq error nil) (message "Message successfully undigestified") (let ((n rmail-current-message)) (rmail-forget-messages) (rmail-show-message n) (rmail-delete-forward))) (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.22/lisp/unrmail.el100444 12120 1 4305 5424366570 14056 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 mailbox files. 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 mailbox-format file TO-FILE." (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ") (let ((message-count 0) (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-output to-file 1 t)) (message "Writing messages to %s...done" to-file))) ;;; unrmail.el ends here emacs-19.22/lisp/unused.el100444 12120 1 2453 5235430330 13676 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.22/lisp/upd-copyr.el100444 12241 1 12522 5434456430 15027 0ustar rolanddaemon;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file ;;; Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc. ;; Author: Roland McGrath ;; Keywords: maint ;;; 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, 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: (defconst current-year (substring (current-time-string) -4) "String representing the current year.") (defvar current-gpl-version "2" "String representing the current version of the GPL.") ;;;###autoload (defvar replace-copying-with nil "*If non-nil, replace copying notices with this file.") (defvar inhibit-update-copyright nil "If nil, ask the user whether or not to update the copyright notice. If the user has said no, we set this to t locally.") ;;;###autoload (defun update-copyright (&optional replace ask-upd ask-year) "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." (interactive "*P") (save-excursion (save-restriction (widen) (goto-char (point-min)) ;; Handle abbreviated year lists like "1800, 01, 02, 03" ;; or "1900, '01, '02, '03". (if (re-search-forward (concat "\\(" (substring current-year 0 2) "\\)?" "\\([0-9][0-9]\\(,\\s \\)+\\)*'?" (substring current-year 2)) nil t) (or ask-upd (message "Copyright notice already includes %s." current-year)) (goto-char (point-min)) (if (and (not inhibit-update-copyright) (or (not ask-upd) ;; If implicit, narrow it down to things that ;; look like GPL notices. (prog1 (search-forward "is free software" nil t) (goto-char (point-min)))) (re-search-forward "[Cc]opyright[^0-9]*\\(\\([-, \t]*\\([0-9]+\\)\\)\\)+" nil t) (or (not ask-upd) (save-window-excursion (pop-to-buffer (current-buffer)) (save-excursion ;; Show the user the copyright. (goto-char (point-min)) (sit-for 0) (or (y-or-n-p "Update copyright? ") (progn (set (make-local-variable 'inhibit-update-copyright) t) nil)))))) (progn (setq replace (or replace (and ask-year (save-window-excursion (pop-to-buffer (current-buffer)) (save-excursion ;; Show the user the copyright. (goto-char (point-min)) (sit-for 0) (y-or-n-p "Replace copyright year? ")))))) (if replace (delete-region (match-beginning 1) (match-end 1)) (insert ", ")) (insert current-year) (message "Copyright updated to %s%s." (if replace "" "include ") current-year) (if replace-copying-with (let ((case-fold-search t) beg) (goto-char (point-min)) ;; Find the beginning of the copyright. (if (search-forward "copyright" nil t) (progn ;; Look for a blank line or a line ;; containing only comment chars. (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t) (forward-line 1) (with-output-to-temp-buffer "*Help*" (princ (substitute-command-keys "\ I don't know where the copying notice begins. Put point there and hit \\[exit-recursive-edit].")) (recursive-edit))) (setq beg (point)) (or (search-forward "02139, USA." nil t) (with-output-to-temp-buffer "*Help*" (princ (substitute-command-keys "\ I don't know where the copying notice ends. Put point there and hit \\[exit-recursive-edit].")) (recursive-edit))) (delete-region beg (point)))) (insert-file replace-copying-with)) (if (re-search-forward "; either version \\(.+\\), or (at your option)" nil t) (progn (goto-char (match-beginning 1)) (delete-region (point) (match-end 1)) (insert current-gpl-version)))) (or ask-upd (error "This buffer contains no copyright notice!")))))))) ;;;###autoload (defun ask-to-update-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." (update-copyright nil t t) ;; Be sure return nil; if a write-file-hook return non-nil, ;; the file is presumed to be already written. nil) (provide 'upd-copyr) ;;; upd-copyr.el ends here emacs-19.22/lisp/userlock.el100444 12120 1 11332 5432254063 14244 0ustar rmsdaemon;;; 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."))) (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."))) ;;; userlock.el ends here emacs-19.22/lisp/vc-hooks.el100644 12120 1 24250 5475633520 14161 0ustar rmsdaemon;;; vc-hooks.el --- resident support for version-control ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Version: 5.3 ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; 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 the commentary of vc.el. ;;; Code: (defvar vc-master-templates '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS) ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)) "*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), for files covered by version control don't get backups.") (defvar vc-rcs-status t "*If non-nil, revision and locks on RCS working file displayed in modeline. Otherwise, not displayed.") ;; 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 don't ;; want to recompute it even on every find. (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.") (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)) ;;; actual version-control code starts here (defun vc-registered (file) (let (handler handlers) (if (boundp 'file-name-handler-alist) (save-match-data (setq handlers file-name-handler-alist) (while (and (consp handlers) (null handler)) (if (and (consp (car handlers)) (stringp (car (car handlers))) (string-match (car (car handlers)) file)) (setq handler (cdr (car handlers)))) (setq handlers (cdr handlers))))) (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) (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-name (file) "Return the master name of a file, nil if it is not registered." (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-deduce (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-toggle-read-only () "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." (interactive) (if (vc-backend-deduce (buffer-file-name)) (vc-next-action nil) (toggle-read-only))) (define-key global-map "\C-x\C-q" 'vc-toggle-read-only) (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." (interactive (list buffer-file-name nil)) (let ((vc-type (vc-backend-deduce file))) (setq vc-mode (and vc-type (concat " " (or label (symbol-name vc-type)) (if (and vc-rcs-status (eq vc-type 'RCS)) (vc-rcs-status file))))) ;; Even root shouldn't modify a registered file without locking it first. (and vc-type (not buffer-read-only) (zerop (user-uid)) (require 'vc) (not (string-equal (user-login-name) (vc-locking-user file))) (setq buffer-read-only t)) ;; force update of mode line (set-buffer-modified-p (buffer-modified-p)) vc-type)) (defun vc-rcs-status (file) ;; Return string for placement in modeline by `vc-mode-line'. ;; If FILE is not registered under RCS, return nil. ;; If FILE is registered but not locked, return " REV" if there is a head ;; revision and " @@" otherwise. ;; If FILE is locked then return all locks in a string of the ;; form " LOCKER1:REV1 LOCKER2:REV2 ...", where "LOCKERi:" is empty if you ;; are the locker, and otherwise is the name of the locker followed by ":". ;; Algorithm: ;; 1. Check for master file corresponding to FILE being visited. ;; ;; 2. Insert the first few characters of the master file into a work ;; buffer. ;; ;; 3. Search work buffer for "locks...;" phrase; if not found, then ;; keep inserting more characters until the phrase is found. ;; ;; 4. Extract the locks, and remove control characters ;; separating them, like newlines; the string " user1:revision1 ;; user2:revision2 ..." is returned. ;; Limitations: ;; The output doesn't show which version you are actually looking at. ;; The modeline can get quite cluttered when there are multiple locks. ;; The head revision is probably not what you want if you've used `rcs -b'. (let ((master (vc-name file)) found) ;; If master file exists, then parse its contents, otherwise we return the ;; nil value of this if form. (if master (save-excursion ;; Create work buffer. (set-buffer (get-buffer-create " *vc-rcs-status*")) (setq buffer-read-only nil default-directory (file-name-directory master)) (erase-buffer) ;; Check if we have enough of the header. ;; If not, then keep including more. (while (not (or found (let ((s (buffer-size))) (goto-char (1+ s)) (zerop (car (cdr (insert-file-contents master nil s (+ s 8192)))))))) (beginning-of-line) (setq found (re-search-forward "^locks\\([^;]*\\);" nil t))) (if found ;; Clean control characters and self-locks from text. (let* ((lock-pattern (concat "[ \b\t\n\v\f\r]+\\(" (regexp-quote (user-login-name)) ":\\)?")) (locks (save-restriction (narrow-to-region (match-beginning 1) (match-end 1)) (goto-char (point-min)) (while (re-search-forward lock-pattern nil t) (replace-match (if (eobp) "" ":") t t)) (buffer-string))) (status (if (not (string-equal locks "")) locks (goto-char (point-min)) (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)") (concat "-" (buffer-substring (match-beginning 1) (match-end 1))) " @@")))) ;; Clean work buffer. (erase-buffer) (set-buffer-modified-p nil) status)))))) ;;; 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. (if buffer-file-name (vc-file-setprop buffer-file-name 'vc-backend nil)) (if (and (vc-mode-line buffer-file-name) (not vc-make-backup-files)) (progn (make-local-variable 'make-backup-files) (setq make-backup-files nil)))) (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-deduce buffer-file-name) (progn (require 'vc) (not (vc-error-occurred (vc-checkout buffer-file-name)))))) (add-hook 'find-file-not-found-hooks 'vc-file-not-found-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) )) (provide 'vc-hooks) ;;; vc-hooks.el ends here emacs-19.22/lisp/vc.el100444 12120 1 224207 5475635374 13073 0ustar rmsdaemon;;; vc.el --- drive a version-control system from within Emacs ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. ;; Author: Eric S. Raymond ;; Version: 5.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. ;;; 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. ;; ;; Supported version-control systems presently include SCCS and RCS; ;; your RCS version should be 5.6.2 or later for proper operation of ;; the lock-breaking code. ;; ;; The RCS code assumes strict locking. 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) (if (not (assoc 'vc-parent-buffer minor-mode-alist)) (setq minor-mode-alist (cons '(vc-parent-buffer vc-parent-buffer-name) minor-mode-alist))) ;; General customization (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-suppress-confirm nil "*If non-nil, treat user as expert; suppress yes-no prompts on some things.") (defvar vc-keep-workfiles t "*If non-nil, don't delete working files after registering changes.") (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-mistrust-permissions 'file-symlink-p "*Don't assume that permissions and ownership track version-control status.") (defvar vc-checkin-switches nil "*Extra switches passed to the checkin program by \\[vc-checkin].") (defvar vc-path (if (file-exists-p "/usr/sccs") '("/usr/sccs") nil) "*List of extra directories to search for version control commands.") (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'.") ;; Header-insertion hair (defvar vc-header-alist '((SCCS "\%W\%") (RCS "\$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.") ;; 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) (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) ;; File property caching (defun vc-file-clearprops (file) ;; clear all properties of a given file (setplist (intern file vc-file-prop-obarray) nil)) (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)) ;; Random helper functions (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 (okstatus command file &rest flags) "Execute a version-control command, notifying user and checking for errors. The command is successful if its exit status does not exceed OKSTATUS. Output from COMMAND goes to buffer *vc*. The last argument of the command is the master name of FILE; this is appended to an optional list of FLAGS." (setq file (expand-file-name file)) (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))) status) (set-buffer (get-buffer-create "*vc*")) (set (make-local-variable 'vc-parent-buffer) camefrom) (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name camefrom))) (erase-buffer) ;; This is so that command arguments typed in the *vc* buffer will ;; have reasonable defaults. (setq default-directory (file-name-directory file)) (mapcar (function (lambda (s) (and s (setq squeezed (append squeezed (list s)))))) flags) (if vc-file (setq squeezed (append squeezed (list vc-file)))) (let ((default-directory (file-name-directory (or file "./"))) (exec-path (if vc-path (append exec-path vc-path) exec-path))) (setq status (apply 'call-process command nil t nil squeezed))) (goto-char (point-max)) (forward-line -1) (if (or (not (integerp status)) (< okstatus status)) (progn (pop-to-buffer "*vc*") (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. (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-revert-buffer1 (&optional arg no-confirm) ;; Most of this was shamelessly lifted from Sebastian Kremer's rcs.el mode. ;; 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 ((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))))))) ;; the actual revisit (revert-buffer arg no-confirm) ;; 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-buffer-sync () ;; Make sure the current buffer and its working file are in sync (if (buffer-modified-p) (progn (or vc-suppress-confirm (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))) (error "Aborted")) (save-buffer)))) (defun vc-workfile-unchanged-p (file) ;; Has the given workfile changed since last checkout? (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) (lastmod (nth 5 (file-attributes file)))) (if checkout-time (equal lastmod checkout-time) (if (zerop (vc-backend-diff file nil)) (progn (vc-file-setprop file 'vc-checkout-time lastmod) t) (progn (vc-file-setprop file 'vc-checkout-time '(0 . 0)) nil )) ))) (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 (owner version (vc-file (vc-name file))) (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))) ;; 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)) (not (zerop (vc-backend-diff file nil)))) (if (save-window-excursion (pop-to-buffer "*vc*") (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)) ) (vc-checkout-writable-buffer file))) ;; a checked-out version exists, but the user may not own the lock ((not (string-equal owner (user-login-name))) (if comment (error "Sorry, you can't steal the lock on %s this way" file)) (vc-steal-lock file (and verbose (read-string "Version to steal: ")) owner)) ;; OK, user owns the lock on the file (t (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))) (progn (vc-backend-revert file) ;; DO NOT revert the file without asking the user! (vc-resynch-window file t nil)) ;; 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) ;; We've accepted a log comment, now do a vc-next-action using it on all ;; marked files. (set-buffer vc-parent-buffer) (dired-map-over-marks (save-window-excursion (let ((file (dired-get-filename))) (message "Processing %s..." file) (vc-next-action-on-file file nil comment) (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 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. 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. For checkin, a prefix argument lets you specify the version number to use." (interactive "P") (catch 'nogo (if vc-dired-mode (let ((files (dired-get-marked-files))) (if (= (length files) 1) (find-file-other-window (dired-get-filename)) (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) "Retrieve a writable copy of the latest version of the current buffer's file." (vc-checkout (or file (buffer-file-name)) t) ) ;;;###autoload (defun vc-register (&optional override comment) "Register the current file into your version-control system." (interactive "P") (if (vc-name buffer-file-name) (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) (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 (vc-revert-buffer1 t noquery) (vc-mode-line buffer-file-name)) (progn (delete-window) (kill-buffer (current-buffer)))))) (defun vc-start-entry (file rev comment msg action) ;; 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 parent-buffer (current one if no file). (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))) (vc-mode-line (or file " (no file)")) (vc-log-mode) (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)) (defun vc-checkout (file &optional writable) "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) (if (string-equal file buffer-file-name) (vc-resynch-window file t t)) ) (defun vc-steal-lock (file rev &optional owner) "Steal the lock on the current workfile." (interactive) (if (not owner) (setq owner (vc-locking-user file))) (if (not (y-or-n-p (format "Take the lock on %s:%s from %s? " file rev 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 "%s:%s" file rev) nil nil nil (list (list 'vc-finish-steal file rev))) (goto-char (point-max)) (insert (format "I stole the lock on %s:%s, " file rev) (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) (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'). COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment." (setq vc-log-after-operation-hook 'vc-checkin-hook) (vc-start-entry file rev comment "Enter a change comment." 'vc-backend-checkin)) ;;; 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)))) (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)) )) ;; OK, do it to it (if vc-log-operation (save-excursion (funcall vc-log-operation vc-log-file vc-log-version (buffer-string))) (error "No log operation is pending")) ;; 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)) ;; Now make sure we see the expanded headers (if buffer-file-name (vc-resynch-window buffer-file-name vc-keep-workfiles t)) (run-hooks vc-log-after-operation-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) "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) (setq unchanged (vc-workfile-unchanged-p buffer-file-name)) (if unchanged (message "No changes to %s since latest version." file) (vc-backend-diff file nil) ;; 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*") (pop-to-buffer "*vc*") (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*")) (cd file) (vc-file-tree-walk (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*")))) ;;;###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-deduce (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)) ) ))))) ;; The VC directory submode. Coopt Dired for this. ;; All VC commands get mapped into logical equivalents. (defvar vc-dired-prefix-map (make-sparse-keymap)) (define-key vc-dired-prefix-map "\C-xv" vc-prefix-map) (or (not (boundp 'minor-mode-map-alist)) (assq 'vc-dired-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'vc-dired-mode vc-dired-prefix-map) minor-mode-map-alist))) (defun vc-dired-mode () "The augmented Dired minor mode used in VC directory buffers. 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) (setq vc-mode " under VC")) (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. (forward-word 1) ;; skip over any extra field due to -ibs options (if x (setq x (concat "(" x ")"))) (if (re-search-forward "\\([0-9]+ \\).................\\( .*\\)" nil 0) (let ((rep (substring (concat x " ") 0 9))) (replace-match (concat "\\1" rep "\\2") t))) ) ;;; Note in Emacs 18 the following defun gets overridden ;;; with the symbol 'vc-directory-18. See below. ;;;###autoload (defun vc-directory (verbose) "Show version-control status of all files under the current directory." (interactive "P") (let (nonempty (dl (length default-directory)) (filelist nil) (userlist nil) dired-buf dired-buf-mod-count) (vc-file-tree-walk (function (lambda (f) (if (vc-registered f) (let ((user (vc-locking-user f))) (and (or verbose user) (setq filelist (cons (substring f dl) filelist)) (setq userlist (cons user userlist)))))))) (save-excursion ;; This uses a semi-documented feature of dired; giving a switch ;; argument forces the buffer to refresh each time. (dired (cons default-directory (nreverse filelist)) dired-listing-switches) (setq dired-buf (current-buffer)) (setq nonempty (not (zerop (buffer-size))))) (if nonempty (progn (pop-to-buffer dired-buf) (vc-dired-mode) (goto-char (point-min)) (setq buffer-read-only nil) (forward-line 1) ;; Skip header line (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 userlist)) (setq buffer-read-only t) (goto-char (point-min)) ) (message "No files are currently %s under %s" (if verbose "registered" "locked") default-directory)) )) ;; 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 (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)) ; Emacs 18 also lacks these. (or (boundp 'compilation-old-error-list) (setq compilation-old-error-list nil)) ;; Named-configuration support for SCCS (defun vc-add-triple (name file rev) (save-excursion (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-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 (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)) (goto-char (point-min)) (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname)) (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) "") ((let ((firstchar (aref name 0))) (and (>= firstchar ?0) (<= firstchar ?9))) name) (t (car (vc-master-info (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file) (list (concat name "\t:\t" file "\t\\(.+\\)")))) ))) ;; Named-configuration entry points (defun vc-locked-example () ;; Return an example of why the current directory is not ready to be snapshot ;; or nil if no such example exists. (catch 'vc-locked-example (vc-file-tree-walk (function (lambda (f) (if (and (vc-registered f) (vc-locking-user f)) (throw 'vc-locked-example f))))) nil)) ;;;###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 ((locked (vc-locked-example))) (if locked (error "File %s is locked" locked) (vc-file-tree-walk (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 ((locked (vc-locked-example))) (if locked (error "File %s is locked" locked) (vc-file-tree-walk (function (lambda (f) (and (vc-name f) (vc-error-occurred (vc-backend-checkout f nil name)))))) ))) ;; 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)) (progn (vc-backend-print-log buffer-file-name) (pop-to-buffer (get-buffer-create "*vc*")) (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." (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) (obuf (current-buffer)) (changed (vc-diff nil))) (if (and changed (or vc-suppress-confirm (not (yes-or-no-p "Discard changes? ")))) (progn (delete-window) (error "Revert cancelled")) (set-buffer obuf)) (if changed (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)) (let* ((target (concat (vc-latest-version (buffer-file-name)))) (yours (concat (vc-your-latest-version (buffer-file-name)))) (prompt (if (string-equal yours target) "Remove your version %s from master? " "Version %s was not your change. Remove it anyway? "))) (if (null (yes-or-no-p (format prompt target))) nil (vc-backend-uncheck (buffer-file-name) target) (if (or norevert (not (yes-or-no-p "Revert buffer to most recent remaining version? "))) (vc-mode-line (buffer-file-name)) (vc-checkout (buffer-file-name) nil))) )) (defun vc-rename-file (old new) "Rename file OLD to NEW, and rename its master file likewise." (interactive "fVC rename file: \nFRename to: ") (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-deduce 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) nil) ) ;;;###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-deduce 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 (mapcar (function (lambda (f) (file-relative-name (if (file-name-absolute-p f) f (concat odefault f))))) args)))) "done" "failed")))) ;; Functions for querying the master and lock files. (defun vc-match-substring (bn) (buffer-substring (match-beginning bn) (match-end bn))) (defun vc-parse-buffer (patterns &optional file properties) ;; Use PATTERNS to parse information out of the current buffer ;; by matching each regular expression in the list and returning \\1. ;; If a regexp has two tag brackets, assume the second is 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)) (if (string-match "\\\\(.*\\\\(" p) (let ((latest-date "") (latest-val)) (while (re-search-forward p nil t) (let ((date (vc-match-substring 2))) (if (string< latest-date date) (progn (setq latest-date date) (setq latest-val (vc-match-substring 1)))))) latest-val)) (prog1 (and (re-search-forward p nil t) (let ((value (vc-match-substring 1))) (if file (vc-file-setprop file (car properties) value)) value)) (setq properties (cdr properties))))) patterns) ) (defun vc-master-info (file fields &optional rfile properties) ;; Search for information in a master file. (if (and file (file-exists-p file)) (save-excursion (let ((buf)) (setq buf (create-file-buffer file)) (set-buffer buf)) (erase-buffer) (insert-file-contents file nil) (set-buffer-modified-p nil) (auto-save-mode nil) (prog1 (vc-parse-buffer fields rfile properties) (kill-buffer (current-buffer))) ) (if rfile (mapcar (function (lambda (p) (vc-file-setprop rfile p nil))) properties)) ) ) (defun vc-log-info (command file patterns &optional properties) ;; Search for information in log program output (if (and file (file-exists-p file)) (save-excursion (let ((buf)) (setq buf (get-buffer-create "*vc*")) (set-buffer buf)) (apply 'vc-do-command 0 command file nil) (set-buffer-modified-p nil) (prog1 (vc-parse-buffer patterns file properties) (kill-buffer (current-buffer)) ) ) (if file (mapcar (function (lambda (p) (vc-file-setprop file p nil))) properties)) ) ) (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." (setq file (expand-file-name file)) ;; ??? Work around bug in 19.0.4 (if (or (not vc-keep-workfiles) (eq vc-mistrust-permissions 't) (and vc-mistrust-permissions (funcall vc-mistrust-permissions (vc-backend-subdirectory-name file)))) (vc-true-locking-user file) ;; 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. The advantage of this ;; hack is that calls to the very expensive vc-fetch-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))) (cond ((string-match ".r-.r-.r-." (nth 8 attributes)) nil) ((and (= (nth 2 attributes) (user-uid)) (string-match ".rw.r-.r-." (nth 8 attributes))) (user-login-name)) (t (vc-true-locking-user file)))))) (defun vc-true-locking-user (file) ;; The slow but reliable version (vc-fetch-properties file) (vc-file-getprop file 'vc-locking-user)) (defun vc-latest-version (file) ;; Return version level of the latest version of FILE (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 (vc-fetch-properties file) (vc-file-getprop file 'vc-your-latest-version)) ;; Collect back-end-dependent stuff here ;; ;; Everything eventually funnels through these functions. 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) "Execute FORM1 or FORM2 depending on whether we're using SCCS or RCS." (list 'let (list (list 'type (list 'vc-backend-deduce f))) (list 'cond (list (list 'eq 'type (quote 'SCCS)) s) ;; SCCS (list (list 'eq 'type (quote 'RCS)) r) ;; RCS ))) (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-fetch-properties (file) ;; Re-fetch all properties associated with the given file. ;; Currently these properties are: ;; vc-locking-user ;; vc-locked-version ;; vc-latest-version ;; vc-your-latest-version (vc-backend-dispatch file ;; SCCS (progn (vc-master-info (vc-lock-file file) (list "^[^ ]+ [^ ]+ \\([^ ]+\\)" "^\\([^ ]+\\)") file '(vc-locking-user vc-locked-version)) (vc-master-info (vc-name file) (list "^\001d D \\([^ ]+\\)" (concat "^\001d D \\([^ ]+\\) .* " (regexp-quote (user-login-name)) " ") ) file '(vc-latest-version vc-your-latest-version)) ) ;; RCS (vc-log-info "rlog" file (list "^locks: strict\n\t\\([^:]+\\)" "^locks: strict\n\t[^:]+: \\(.+\\)" "^revision[\t ]+\\([0-9.]+\\).*\ndate: \\([ /0-9:]+\\);" (concat "^revision[\t ]+\\([0-9.]+\\)\n.*author: " (regexp-quote (user-login-name)) ";")) '(vc-locking-user vc-locked-version vc-latest-version vc-your-latest-version)) )) (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-deduce file)) vc-default-back-end (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS))))) (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) (t vc-default-back-end)))) (cond ((eq backend 'SCCS) (vc-do-command 0 "admin" file ;; 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 0 "get" file))) ((eq backend 'RCS) (vc-do-command 0 "ci" file ;; RCS (concat (if vc-keep-workfiles "-u" "-r") rev) (and comment (concat "-t-" comment)) file) ))) (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))) (message "Checking out %s..." filename) (vc-backend-dispatch file (vc-do-command 0 "get" file ;; SCCS (if writable "-e") (if workfile (concat "-G" workfile)) (and rev (concat "-r" (vc-lookup-triple file rev)))) (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 (vc-do-command 0 "/bin/sh" file "-c" (format "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)) (setq failed nil)) (and failed (file-exists-p filename) (delete-file filename)))) (vc-do-command 0 "co" file (if writable "-l") (and rev (concat "-r" rev)))) ) (or workfile (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) ) (defun vc-backend-checkin (file &optional 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. (message "Checking in %s..." file) (save-excursion ;; Change buffers to get local value of vc-checkin-switches. (set-buffer (or (get-file-buffer file) (current-buffer))) (vc-backend-dispatch file (progn (apply 'vc-do-command 0 "delta" file (if rev (concat "-r" rev)) (concat "-y" comment) vc-checkin-switches) (if vc-keep-workfiles (vc-do-command 0 "get" file)) ) (apply 'vc-do-command 0 "ci" file (concat (if vc-keep-workfiles "-u" "-r") rev) (concat "-m" comment) vc-checkin-switches) )) (vc-file-setprop file 'vc-locking-user nil) (message "Checking in %s...done" file) ) (defun vc-backend-revert (file) ;; Revert file to latest checked-in version. (message "Reverting %s..." file) (vc-backend-dispatch file (progn ;; SCCS (vc-do-command 0 "unget" file nil) (vc-do-command 0 "get" file nil)) (vc-do-command 0 "co" file "-f" "-u")) ;; RCS. This deletes the work file. (vc-file-setprop file 'vc-locking-user nil) (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 (vc-do-command 0 "unget" file "-n" (if rev (concat "-r" rev))) (vc-do-command 0 "get" file "-g" (if rev (concat "-r" rev))) ) (vc-do-command 0 "rcs" file "-M" (concat "-u" rev) (concat "-l" rev))) (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. Note: this code will have to get a lot ;; smarter when we support multiple branches. (message "Removing last change from %s..." file) (vc-backend-dispatch file (vc-do-command 0 "rmdel" file (concat "-r" target)) (vc-do-command 0 "rcs" file (concat "-o" target)) ) (message "Removing last change from %s...done" file) ) (defun vc-backend-print-log (file) ;; Print change log associated with FILE to buffer *vc*. (vc-do-command 0 (vc-backend-dispatch file "prs" "rlog") file) ) (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 0 "rcs" file (concat "-n" name ":")) ;; RCS ) ) (defun vc-backend-diff (file oldvers &optional newvers) ;; Get a difference report between two versions (if (eq (vc-backend-deduce file) 'SCCS) (setq oldvers (vc-lookup-triple file oldvers)) (setq newvers (vc-lookup-triple file newvers))) (apply 'vc-do-command 1 (or (vc-backend-dispatch file "vcdiff" "rcsdiff") (vc-registration-error file)) file "-q" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers)) (if (listp diff-switches) diff-switches (list diff-switches)) )) (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 ) )) ;; 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. vc-static-header-alist By default, version headers inserted in C files get stuffed in a static string area so that ident(RCS) 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 (func &rest args) "Walk recursively through default directory. Invoke FUNC f ARGS on each non-directory file f underneath it." (vc-file-tree-walk-internal default-directory func args) (message "Traversing directory %s...done" default-directory)) (defun vc-file-tree-walk-internal (file func args) (if (not (file-directory-p file)) (apply func file args) (message "Traversing directory %s..." file) (let ((dir (file-name-as-directory file))) (mapcar (function (lambda (f) (or (string-equal f ".") (string-equal f "..") (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. ;;; ;;; 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 ; rcs -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: ci will fail with a "no lock set by " message. ;;; 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: will revert the file to the last saved version and unlock it. ;;; 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: will register the caller's workfile as a delta with a ;;; null change comment (the -t- switch will be ignored). ;;; 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: will fail with a "no lock set by " message. ;;; 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: Checks in the user's version as an initial delta. ;;; SCCS: will fail with error ut4. ;;; ;;; This case is kind of nasty. It means 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 under RCS are the only one 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.22/lisp/version.el100666 12120 1 4076 5475620231 14100 0ustar rmsdaemon;;; version.el --- record version number of Emacs. ;;; Copyright (C) 1985, 1992 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: ;; The following line is modified automatically ;; by loading inc-version.el, each time a new Emacs is dumped. (defconst emacs-version "19.22.0" "\ Version numbers of this version of Emacs.") (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." (interactive "P") (let ((version-string (format "GNU Emacs %s of %s %s on %s (%s)" emacs-version (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 system-type))) (if here (insert version-string) (if (interactive-p) (message "%s" (emacs-version)) version-string)))) ;;; We hope that this alias is easier for people to find. (fset 'version 'emacs-version) ;;Local variables: ;;version-control: never ;;End: ;;; version.el ends here emacs-19.22/lisp/vi.el100444 13437 1 160426 5405344561 13223 0ustar jimbdaemon;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs. ;; 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}"))) (setq prefix-arg arg) ; prefix arg will be passed down (command-execute mode-cmd nil) ; may need to save mode-line-format etc (set-buffer-modified-p (buffer-modified-p))))) ; 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) (set-buffer-modified-p (buffer-modified-p))))) (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 "T 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") (set-buffer-modified-p (buffer-modified-p)) ; 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)))) (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) (set-buffer-modified-p (buffer-modified-p)) ; 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 () (interactive) (kill-region) (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 arg)) ((char-equal region ?s) (mark-sexp arg)) ((char-equal region ?b) (mark-whole-buffer)) ((char-equal region ?p) (mark-paragraph arg)) ((char-equal region ?P) (mark-page arg)) ((char-equal region ?f) (mark-c-function arg)) ((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.22/lisp/view.el100444 12120 1 42013 5474345015 13373 0ustar rmsdaemon;;; view.el --- peruse file or buffer without editing. ;; Copyright (C) 1985, 1989 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' major mode documented in the Emacs ;; user's manual. ;;; Code: (defvar view-mode-map nil) (if view-mode-map nil (setq view-mode-map (make-keymap)) (fillarray (nth 1 view-mode-map) 'View-undefined) (define-key view-mode-map "\C-c" 'view-exit) (define-key view-mode-map "\C-z" 'suspend-emacs) (define-key view-mode-map "q" 'view-exit) (define-key view-mode-map "-" 'negative-argument) (define-key view-mode-map "0" 'digit-argument) (define-key view-mode-map "1" 'digit-argument) (define-key view-mode-map "2" 'digit-argument) (define-key view-mode-map "3" 'digit-argument) (define-key view-mode-map "4" 'digit-argument) (define-key view-mode-map "5" 'digit-argument) (define-key view-mode-map "6" 'digit-argument) (define-key view-mode-map "7" 'digit-argument) (define-key view-mode-map "8" 'digit-argument) (define-key view-mode-map "9" 'digit-argument) (define-key view-mode-map "\C-u" 'universal-argument) (define-key view-mode-map "\e" nil) (define-key view-mode-map "\C-x" 'Control-X-prefix) (define-key view-mode-map "\e-" 'negative-argument) (define-key view-mode-map "\e0" 'digit-argument) (define-key view-mode-map "\e1" 'digit-argument) (define-key view-mode-map "\e2" 'digit-argument) (define-key view-mode-map "\e3" 'digit-argument) (define-key view-mode-map "\e4" 'digit-argument) (define-key view-mode-map "\e5" 'digit-argument) (define-key view-mode-map "\e6" 'digit-argument) (define-key view-mode-map "\e7" 'digit-argument) (define-key view-mode-map "\e8" 'digit-argument) (define-key view-mode-map "\e9" 'digit-argument) (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 "\177" '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 "\C-l" 'recenter) (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 "\C-@" '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" 'Helper-describe-bindings) (define-key view-mode-map "?" 'Helper-describe-bindings) (define-key view-mode-map (char-to-string help-char) 'Helper-help) (define-key view-mode-map "\C-n" 'next-line) (define-key view-mode-map "\C-p" 'previous-line) (define-key view-mode-map "\C-s" 'isearch-forward) (define-key view-mode-map "\C-r" 'isearch-backward) (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) ) ;;;###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-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))) (switch-to-buffer buf-to-view t) (view-mode 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-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 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-hook'." (interactive "bView buffer: ") (let ((old-buf (current-buffer))) (switch-to-buffer buffer-name t) (view-mode old-buf nil))) ;;;###autoload (defun view-buffer-other-window (buffer-name not-return) "View BUFFER in View mode in another window, returning to original buffer when done *only* if prefix argument NOT-RETURN is nil (which is the default). The usual Emacs commands are not available in View mode; instead, a special set of commands (mostly letters and punctuation) are defined for moving around in the buffer. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-hook'." (interactive "bView buffer:\nP") (let ((return-to (and not-return (current-window-configuration)))) (switch-to-buffer-other-window buffer-name) (view-mode return-to))) ;;;###autoload (defun view-mode (&optional prev-buffer action) "Major mode for viewing text but not editing it. 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). \\[Helper-help] 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 or C-c exit view-mode and return to previous buffer. Entry to this mode runs the normal hook `view-hook'. \\{view-mode-map}" ; Not interactive because dangerous things happen ; if you call it without passing a buffer as argument ; and they are not easy to fix. ; (interactive) (make-local-variable 'view-old-mode-line-buffer-identification) (setq view-old-mode-line-buffer-identification mode-line-buffer-identification) (make-local-variable 'view-old-buffer-read-only) (setq view-old-buffer-read-only buffer-read-only) (make-local-variable 'view-old-mode-name) (setq view-old-mode-name mode-name) (make-local-variable 'view-old-major-mode) (setq view-old-major-mode major-mode) (make-local-variable 'view-old-local-map) (setq view-old-local-map (current-local-map)) (make-local-variable 'view-old-Helper-return-blurb) (setq view-old-Helper-return-blurb (and (boundp 'Helper-return-blurb) Helper-return-blurb)) (setq buffer-read-only t) (setq mode-line-buffer-identification (list (if (buffer-file-name) "Viewing %f" "Viewing %b"))) (setq mode-name "View") (setq major-mode 'view-mode) (setq Helper-return-blurb (format "continue viewing %s" (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) (buffer-name)))) (make-local-variable 'view-exit-action) (setq view-exit-action action) (make-local-variable 'view-return-here) (setq view-return-here prev-buffer) (make-local-variable 'view-exit-position) (setq view-exit-position (point-marker)) (make-local-variable 'view-scroll-size) (setq view-scroll-size nil) (make-local-variable 'view-last-regexp) (setq view-last-regexp nil) (beginning-of-line) (setq goal-column nil) (use-local-map view-mode-map) (run-hooks 'view-hook) (view-helpful-message)) (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 mode-line-buffer-identification view-old-mode-line-buffer-identification) (setq major-mode view-old-major-mode) (setq mode-name view-old-mode-name) (use-local-map view-old-local-map) (setq buffer-read-only view-old-buffer-read-only) (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-helpful-message () (message (substitute-command-keys "Type \\[Helper-help] for help, \\[Helper-describe-bindings] for commands, \\[view-exit] to quit."))) (defun View-undefined () (interactive) (ding) (view-helpful-message)) (defun view-window-size () (1- (window-height))) (defun view-scroll-size () (min (view-window-size) (or view-scroll-size (view-window-size)))) (defvar view-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 (&optional 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 (or line 1)) (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") (if (and (pos-visible-in-window-p (point-max)) ;; Allow scrolling backward at the end of the buffer. (or (null lines) (> lines 0))) (view-exit) (setq lines (if lines (prefix-numeric-value lines) (view-scroll-size))) ;; (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)) (recenter -1) (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." (interactive "p\nsSearch forward (regexp): ") (if (> (length regexp) 0) (progn ;(view-last-command 'View-search-last-regexp-forward n) (view-search n regexp)))) (defun View-search-regexp-backward (n regexp) "Search backward from window start for Nth instance of REGEXP. Displays line found at center of window. REGEXP is remembered for searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." (interactive "p\nsSearch backward (regexp): ") (View-search-regexp-forward (- n) regexp)) (defun View-search-last-regexp-forward (n) "Search forward from window end for Nth instance of last regexp. Displays line found at center of window. Sets mark at starting position and pushes mark ring." (interactive "p") (View-search-regexp-forward n view-last-regexp)) (defun View-search-last-regexp-backward (n) "Search backward from window start for Nth instance of last regexp. Displays line found at center of window. Sets mark at starting position and pushes mark ring." (interactive "p") (View-search-regexp-backward n view-last-regexp)) (defun View-back-to-mark (&optional ignore) "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) (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) (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.22/lisp/vip.el100444 13437 1 271740 5405344572 13407 0ustar jimbdaemon;;; 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)) 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-refresh-mode-line () "Redraw mode line." (set-buffer-modified-p (buffer-modified-p))) (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) (vip-refresh-mode-line)))) (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))) (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.22/lisp/vms-patch.el100444 13437 1 15046 5376253015 14464 0ustar jimbdaemon;;; 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. Does not consider auto-save-visited-file-name; that is checked before calling this function. This is a separate function so your .emacs file or 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 your .emacs file or 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.22/lisp/vms-pmail.el100444 74777 1 10362 5352167712 14504 0ustar ericdaemon;;; 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.22/lisp/vmsproc.el100444 12120 1 11673 5257335337 14127 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.22/lisp/vmsx.el100444 12120 1 11703 5257335507 13424 0ustar rmsdaemon;;; vmsx.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"))) (defvar subprocess-command-to-buffer-tmpdir "SYS$SCRATCH:" "*Put temporary files from subprocess-command-to-buffer here.") (defun subprocess-command-to-buffer (command buffer) "Execute command and redirect output into buffer. 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 subprocess-command-to-buffer-tmpdir "OUTPUT-FOR-" (getenv "USER") ".LISTING"))) (while (file-attributes output-filename) (delete-file output-filename)) (send-command-to-subprocess 1 (concat "DEFINE/USER SYS$OUTPUT " output-filename "-NEW")) (send-command-to-subprocess 1 command) (send-command-to-subprocess 1 (concat "RENAME " output-filename "-NEW " output-filename)) (while (not (file-attributes output-filename)) (sleep-for 2)) (insert-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) ;;; vmsx.el ends here emacs-19.22/lisp/vt-control.el100444 12120 1 6544 5474462410 14520 0ustar rmsdaemon;;; vt-control.el --- Common VTxxx control functions ;; Copyright (C) 1993 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: ;;; Revision Information (defconst vt-revision "$Revision: 1.4 $" "Revision number of vt-control.") ;;; 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[\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[\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.22/lisp/vt100-led.el100444 13437 1 3654 5354241226 14155 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.22/lisp/window.el100444 12241 1 15157 5427403706 14423 0ustar rolanddaemon;;; window.el --- GNU Emacs window commands aside from those written in C. ;;; Copyright (C) 1985, 1989, 1992, 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. ;;; Code: (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) ;; 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) 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)))))) (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. 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)) new-w bottom switch) (setq new-w (split-window nil (and arg (prefix-numeric-value arg)))) (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. No arg means split equally." (interactive "P") (split-window nil (and arg (prefix-numeric-value arg)) 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 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 the only window of its frame." (interactive) (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)))))) (window-min-height 0) (buffer-read-only nil) (modified (buffer-modified-p)) (buffer (current-buffer))) (if (and (< 1 (count-windows)) (pos-visible-in-window-p (point-min) window)) (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 (1- n)))) (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.22/lisp/ws-mode.el100444 12120 1 57653 5467457427 14031 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 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 ;; this file, 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. ;;; 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" 'center-line) (define-key wordstar-C-o-map "\C-c" '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 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 center-paragraph () "Center each 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 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)) (center-line) (forward-line 1))))) (defun 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) \070) (setq ws-search-string string) (setq ws-search-direction t) (setq ws-last-cursorposition (point-marker)) (search-forward string)) ((equal (upcase direction) \066) (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.22/lisp/x-menu.el100444 12120 1 12143 5257336506 13637 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: (defmacro caar (conscell) (list 'car (list 'car conscell))) (defmacro cdar (conscell) (list 'cdr (list 'car conscell))) (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) "Adds 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) "Deletes from MENU the item named ITEM. x-menu-compute should be called before the menu is made 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) "Computes 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 (caar items-tail) (progn (setq items-head (cons (car items-tail) items-head)) (setq x-menu-item-width (max x-menu-item-width (length (caar 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") (caar 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.22/lisp/xscheme.el100444 12120 1 74767 5474462437 14112 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) ;;;###autoload (defun run-scheme (command-line) "Run an inferior Scheme 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) (switch-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) (xscheme-modeline-redisplay)) (defun xscheme-modeline-redisplay () (save-excursion (set-buffer (other-buffer))) (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)) ;;;; 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)) (xscheme-modeline-redisplay)) (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.22/lisp/yow.el100444 12241 1 4652 5446403531 13705 0ustar rolanddaemon;;; yow.el --- quote random zippyisms ;; Copyright (C) 1993 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: ;; 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") "Pertinent pinhead phrases.") ;;;###autoload (defun yow (&optional interactive) "Return or display a random Zippy quotation." (interactive "p") (let ((yow (cookie yow-file "Am I CONSING yet?..." "I have SEEN the CONSING!!"))) (cond ((not interactive) 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)))))) (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)) ; 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.22/lisp/abbrev.elc100666 13437 1 17673 5416156704 14206 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:04:51 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/abbrev.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (defalias 'abbrev-mode #[(arg) "„ ?‚Â!ÃVÄÅ !‡" [arg abbrev-mode prefix-numeric-value 0 set-buffer-modified-p buffer-modified-p] 2 "\ 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." "P"]) (defvar edit-abbrevs-map nil "\ Keymap used in edit-abbrevs.") (byte-code "„Á ÂÃÄ#ˆÂÅÄ#ˆÁ‡" [edit-abbrevs-map make-sparse-keymap define-key "" edit-abbrevs-redefine ""] 4) (defalias 'kill-all-abbrevs #[nil "‰… @J!ˆ A‰„Ã)‡" [abbrev-table-name-list tables clear-abbrev-table nil] 3 "\ Undefine all defined abbrevs." nil]) (defalias 'insert-abbrevs #[nil "ÀŠ ‰ƒÃ\n@Ä\"ˆ\nA‰„)`)!‡" [push-mark abbrev-table-name-list tables insert-abbrev-table-description t] 5 "\ Insert after point a description of all defined abbrevs. Mark is set after the inserted text." nil]) (defalias 'list-abbrevs #[nil "ÀÁ !‡" [display-buffer prepare-abbrev-list-buffer] 2 "\ Display a list of all defined abbrevs." nil]) (defalias (quote prepare-abbrev-list-buffer) #[nil "ŠÀÁ!qˆÂ ˆ ‰ƒÅ @Æ\"ˆ A‰„)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]) (defalias 'edit-abbrevs-mode #[nil "ÀÂÄ !‡" [edit-abbrevs-mode major-mode "Edit-Abbrevs" mode-name use-local-map edit-abbrevs-map] 2 "\ Major mode for editing the list of abbrev definitions. \\{edit-abbrevs-map}" nil]) (defalias 'edit-abbrevs #[nil "ÀÁ !‡" [switch-to-buffer prepare-abbrev-list-buffer] 2 "\ 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)." nil]) (defalias 'edit-abbrevs-redefine #[nil "ÀÁ!ˆÂÃ!‡" [define-abbrevs t set-buffer-modified-p nil] 2 "\ Redefine abbrevs according to current buffer contents." nil]) (defalias 'define-abbrevs #[(&optional arg) "ƒÁ ˆŠebˆm?…|ÂÃÄÅ#…|pÇ!Ä Ä\nÄ Ä Ä ÎyˆÎyˆl„pÇ!\nÇ! Ç! ÏÄxˆl?…YÇ! ÏÄxˆ\n   F B ‚3Ð \"ˆ.‚ )‡" [arg kill-all-abbrevs re-search-forward "^(" nil t buf read table abbrevs name hook exp count 1 " \n " define-abbrev-table] 4 "\ 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." "P"]) (defalias 'read-abbrev-file #[(&optional file quietly) "À ƒ GÂVƒ ‚ Ä #ˆÆĉ‡" [load file 0 abbrev-file-name nil quietly t save-abbrevs abbrevs-changed] 4 "\ 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." "fRead abbrev file: "]) (defalias 'quietly-read-abbrev-file #[(&optional file) "À Â\"‡" [read-abbrev-file file t] 3 "\ 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 '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 "\ 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." (list (read-file-name "Write abbrev file: " (file-name-directory (expand-file-name abbrev-file-name)) abbrev-file-name))]) (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 "\ 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." "p"]) (defalias 'add-global-abbrev #[(arg) "À  #‡" [add-abbrev global-abbrev-table "Global" arg] 4 "\ 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." "p"]) (defalias (quote add-abbrev) #[(table type arg) "ÁY…`ÁUƒ ‚Š[vˆ`){ÃÆÇ ƒ'È‚(É\n #! ƒHË  \"ƒHÍÇÎ Ë  \"#!…OÏ — #*‡" [arg 0 mark nil name exp read-string format "%s abbrev for \"%s\": " "Undefine %s abbrev: " type abbrev-expansion table y-or-n-p "%s expands to \"%s\"; redefine? " define-abbrev] 7]) (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 "\ 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." "p"]) (defalias 'inverse-add-global-abbrev #[(arg) "À  #‡" [inverse-add-abbrev global-abbrev-table "Global" arg] 4 "\ 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." "p"]) (defalias (quote inverse-add-abbrev) #[(table type arg) "À‰‰Š [vˆ`Åvˆ`‰{)ÆÇÈ #!Ê  \"ƒ4ÌÇÍ Ê  \"#!…CÎ — #ˆŠ\nbˆÏ )+‡" [nil exp nameloc name arg 1 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]) (defalias 'abbrev-prefix-mark #[(&optional arg) "„Á ˆÂ pÅc‡" [arg expand-abbrev point-marker abbrev-start-location abbrev-start-location-buffer "-"] 1 "\ 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." "P"]) (defalias 'expand-region-abbrevs #[(start end &optional noquery) "Šbˆd Z‰m?…AÆvˆ`‰d ZX…AÇŠÈvˆ`) {‰!ƒ  „;ÊËÌ \"!ƒ Í ˆ‚ ,‡" [start end nil string pnt lim 1 abbrev-expansion -1 noquery y-or-n-p format "Expand `%s'? " expand-abbrev] 4 "\ 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." "r\nP"]) emacs-19.22/lisp/ada.elc100666 74777 1 34255 5416156740 13504 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:05:19 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/ada.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁB\nBÁ‡" ["\\.ada$" ada-mode auto-mode-alist] 2) (defvar ada-mode-syntax-table nil "\ Syntax table in use in Ada-mode buffers.") (byte-code "À ÂÃÄ #ˆÂÅÄ #ˆÂÆÇ #ˆÂÈÉ #ˆÂÊË #ˆÂÌË #ˆÂÍË #ˆÂÎË #ˆÂÏË #ˆÂÐË #ˆÂÑË #ˆÂÒË #ˆÂÓË #ˆÂÔË #ˆÂÕË #ˆÂÖË #ˆÂ×Ë #ˆÂØË #ˆÂÙË #ˆÂÚË #ˆÂÛË #ˆÂÜË #ˆÂÝË #ˆÂÞß #ˆ  )À‡" [make-syntax-table table modify-syntax-entry 95 "_" 35 40 "()" 41 ")(" 36 "." 42 47 43 45 61 38 124 60 62 91 93 123 125 46 92 58 59 39 34 "\"" ada-mode-syntax-table] 4) (defvar ada-mode-map nil "\ Keymap used in Ada mode.") (byte-code "À  ÃÄ#ˆÂ ÅÆ#ˆÂ ÇÈ#ˆÂ ÉÊ#ˆÂ ËÌ#ˆÂ ÍÎ#ˆÂ ÏÐ#ˆÂ ÑÒ#ˆÂ ÓÔ#ˆÂ ÕÖ#ˆÂ ×Ø#ˆÂ ÙÚ#ˆÂ ÛÜ#ˆÂ ÝÞ#ˆÂ ßà#ˆÂ áâ#ˆÂ ãä#ˆÂ åæ#ˆÂ çè#ˆÂ éê#ˆÂ ëì#ˆÂ íî#ˆÂ ïð#ˆÂ ñò#ˆÂ óô#ˆÂ õö#ˆÂ ÷ø#ˆÂ ùú#ˆÂ ûü#ˆÂ ýþ#ˆÂ ÿ@#ˆÂ AB#ˆÂ CD#ˆÂ EF#ˆÂ GH#ˆÂ IJ#ˆÂ KL#ˆÂ MN#ˆ O)À‡" [make-sparse-keymap map define-key " " ada-newline "" backward-delete-char-untabify " " ada-tab " " ada-untab "<" ada-backward-to-same-indent ">" ada-forward-to-same-indent "h" ada-header "(" ada-paired-parens "-" ada-inline-comment "" ada-array "b" ada-exception-block "d" ada-declare-block "" ada-exception "c" ada-case " " ada-package-spec "k" ada-package-body "" ada-procedure-spec "p" ada-subprogram-body "" ada-function-spec "f" ada-for-loop "l" ada-loop "i" ada-if "I" ada-elsif "e" ada-else "" ada-private "" ada-record "" ada-subtype "s" ada-separate "" ada-type "t" ada-tabsize "w" ada-while-loop "" ada-when "x" ada-exit "C" ada-compile "B" ada-bind "E" ada-find-listing "L" ada-library-name "O" ada-options-for-bind ada-mode-map] 4) (defvar ada-indent 4 "\ *Value is the number of columns to indent in Ada-Mode.") (defalias 'ada-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÇÊ!ˆË\nÌ !ˆÇÎ!ˆÏPÇÑ!ˆÇÒ!ˆÓÇÔ!ˆÓÇÕ!ˆÖÇ×!ˆØÇÈ!ˆÉÇÙ!ˆÚÇÛ!ˆÜÇÝ!ˆÓÞß!‡" [kill-all-local-variables use-local-map ada-mode-map ada-mode major-mode "Ada" mode-name make-local-variable comment-column 41 end-comment-column 72 set-syntax-table ada-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 ada-mode-hook] 2 "\ This is a mode intended to support program development in Ada. Most control constructs and declarations of Ada can be inserted in the buffer by typing Control-C followed by a character mnemonic for the construct. \\\\[ada-array] array \\[ada-exception-block] exception block \\[ada-exception] exception \\[ada-declare-block] declare block \\[ada-package-spec] package spec \\[ada-package-body] package body \\[ada-procedure-spec] procedure spec \\[ada-subprogram-body] proc/func body \\[ada-function-spec] func spec \\[ada-for-loop] for loop \\[ada-if] if \\[ada-elsif] elsif \\[ada-else] else \\[ada-private] private \\[ada-loop] loop \\[ada-record] record \\[ada-case] case \\[ada-subtype] subtype \\[ada-separate] separate \\[ada-type] type \\[ada-tabsize] tab spacing for indents \\[ada-when] when \\[ada-while] while \\[ada-exit] exit \\[ada-paired-parens] paired parens \\[ada-inline-comment] inline comment \\[ada-header] header spec \\[ada-compile] compile \\[ada-bind] bind \\[ada-find-listing] find error list \\[ada-library-name] name library \\[ada-options-for-bind] options for bind \\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line having the same (or lesser) level of indentation. Variable `ada-indent' controls the number of spaces for indent/undent." nil]) (defalias 'ada-tabsize #[(s) "‰‡" [s ada-indent] 2 "\ Changes spacing used for indentation. The prefix argument is used as the new spacing." "p"]) (defalias 'ada-newline #[nil "À  ˆ j)‡" [current-indentation ada-cc newline] 1 "\ Start new line and indent to current tab stop." nil]) (defalias 'ada-tab #[nil "À ¥T _j‡" [current-indentation ada-indent] 2 "\ Indent to next tab stop." nil]) (defalias 'ada-untab #[nil "À Â\"‡" [backward-delete-char-untabify ada-indent nil] 3 "\ Delete backwards to previous tab stop." nil]) (defalias 'ada-go-to-this-indent #[(step indent-level) "yÁU…*ÂÃ!„ÂÄ!„ÂÅ!„ÂÆ!„Ç V…*‚‡" [step 0 looking-at "^[ ]*$" "^[ ]*--" "^<<[A-Za-z0-9_]+>>" "^[A-Za-z0-9_]+:" current-indentation indent-level] 2 "\ Move point repeatedly by STEP lines until the current line has given INDENT-LEVEL or less, or the start or end of the buffer is reached. Ignore blank lines, statement labels and block or loop names."]) (defalias 'ada-backward-to-same-indent #[nil "ÀÁ \"ˆÃ ‡" [ada-go-to-this-indent -1 current-indentation back-to-indentation] 3 "\ Move point backwards to nearest line with same indentation or less. If not found, point is left at the top of the buffer." nil]) (defalias 'ada-forward-to-same-indent #[nil "ÀÁ \"ˆÃ ‡" [ada-go-to-this-indent 1 current-indentation back-to-indentation] 3 "\ Move point forwards to nearest line with same indentation or less. If not found, point is left at the start of the last line in the buffer." nil]) (defalias 'ada-array #[nil "ÀcˆÁ ˆÂÃ!cˆÄˆÅcˆÁ ˆÂÆ!cˆÄ‡" ["array ()" backward-char read-string "index subtype[s]: " nil " of ;" "component-type: "] 2 "\ Insert array type definition. Uses the minibuffer to prompt for component type and index subtypes." nil]) (defalias 'ada-case #[nil "ÀcˆÁÂ!ñˆÄ ˆÄ ˆÅcˆÆˆÇ ˆÇ ˆÈ ‡" ["case " read-string "selector expression: " " is" ada-newline "end case;" 0 ada-tab ada-when] 2 "\ Build skeleton case statement. Uses the minibuffer to prompt for the selector expression. Also builds the first when clause." nil]) (defalias 'ada-declare-block #[nil "ÀÁ!Ãcˆ\nĘ„ ÅyˆÆÇ!ˆ\nȱˆÉÇ!ˆÊˆË ˆË ˆÌcˆË ˆË ˆ\nĘƒ;Ícˆ‚AÎ\nϱˆ)ÐˆÑ ‡" [read-string "[block name]: " ada-block-name "declare" "" 0 open-line 1 ":" next-line nil ada-newline "begin" "end;" "end " ";" -2 ada-tab] 3 "\ Insert a block with a declare part. Indent for the first declaration." nil]) (defalias 'ada-exception-block #[nil "ÀÁ!Ãcˆ\nĘ„ ÅyˆÆÇ!ˆ\nȱˆÉÇ!ˆÊˆË ˆË ˆÌcˆË ˆË ˆ\nĘƒ;Ícˆ‚AÎ\nϱˆ)ÐˆÑ ‡" [read-string "[block name]: " block-name "begin" "" 0 open-line 1 ":" next-line nil ada-newline "exception" "end;" "end " ";" -2 ada-tab] 3 "\ Insert a block with an exception part. Indent for the first line of code." nil]) (defalias 'ada-exception #[nil "À ˆÁcˆÂ ˆÃ ‡" [ada-untab "exception" ada-newline ada-tab] 1 "\ Insert an indented exception part into a block." nil]) (defalias 'ada-else #[nil "À ˆÁcˆÂ ˆÃ ‡" [ada-untab "else" ada-newline ada-tab] 1 "\ Add an else clause inside an if-then-end-if clause." nil]) (defalias 'ada-exit #[nil "ÀcˆÁÂ!‰Ę„Å ±ˆ)ÁÆ!‰Ę„5ÈÉ\"ƒ/űˆ‚5ʱˆ)Ëc‡" ["exit" read-string "[name of loop to exit]: " ada-loop-name "" " " "[exit condition]: " ada-exit-condition string-match "^ *[Ww][Hh][Ee][Nn] +" " when " ";"] 4 "\ Insert an exit statement, prompting for loop name and condition." nil]) (defalias 'ada-when #[nil "À ˆÁcˆÂÃ!ıˆÅ ˆÆ ‡" [ada-untab "when " read-string "'|'-delimited choice list: " " =>" ada-newline ada-tab] 2 "\ Start a case statement alternative with a when clause." nil]) (defalias 'ada-for-loop #[nil "ÀcˆÁÂ!‰Ę?‰ƒ#ÆyˆÇÈ!ˆ ɱˆÊÈ!ˆÈˆÁË!̱ˆÁÍ!αˆÏ ˆÏ ˆÐcˆ ƒCÑ ±ˆÒcˆ*ÆˆÓ ‡" ["for " read-string "[loop name]: " ada-loop-name "" ada-loop-is-named 0 open-line 1 ":" next-line "loop variable: " " in " "range: " " loop" ada-newline "end loop" " " ";" ada-tab] 3 "\ Build a skeleton for-loop statement, prompting for the loop parameters." nil]) (defalias 'ada-header #[nil "À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"] 5 "\ Insert a comment block containing the module title, author, etc." nil]) (defalias 'ada-if #[nil "ÀcˆÁÂ!ñˆÄ ˆÄ ˆÅcˆÆˆÇ ‡" ["if " read-string "condition: " " then" ada-newline "end if;" 0 ada-tab] 2 "\ Insert skeleton if statment, prompting for a boolean-expression." nil]) (defalias 'ada-elsif #[nil "À ˆÁcˆÂÃ!ıˆÅ ˆÆ ‡" [ada-untab "elsif " read-string "condition: " " then" ada-newline ada-tab] 2 "\ Add an elsif clause to an if statement, prompting for the boolean-expression." nil]) (defalias 'ada-loop #[nil "ÀcˆÁÂ!‰Ę?‰ƒ\"ÆyˆÇÈ!ˆ ɱˆÈyˆÈˆÊ ˆÊ ˆËcˆ ƒ4Ì ±ˆÍcˆ*ƈΠ‡" ["loop " read-string "[loop name]: " ada-loop-name "" ada-loop-is-named 0 open-line 1 ":" ada-newline "end loop" " " ";" ada-tab] 3 "\ Insert a skeleton loop statement. The exit statement is added by hand." nil]) (defalias 'ada-package-spec #[nil "ÀcˆÁÂ!‰ıˆÅ ˆÅ ˆÆ DZˆÈˆÉ )‡" ["package " read-string "package name: " ada-package-name " is" ada-newline "end " ";" 0 ada-tab] 4 "\ Insert a skeleton package specification." nil]) (defalias 'ada-package-body #[nil "ÀcˆÁÂ!‰ıˆÅ ˆÅ ˆÆcˆÅ ˆÇ ȱˆÉˆÊ )‡" ["package body " read-string "package name: " ada-package-name " is" ada-newline "begin" "end " ";" -1 ada-tab] 4 "\ Insert a skeleton package body -- includes a begin statement." nil]) (defalias 'ada-private #[nil "À ˆÁcˆÂ ˆÃ ‡" [ada-untab "private" ada-newline ada-tab] 1 "\ Undent and start a private section of a package spec. Reindent." nil]) (defalias 'ada-get-arg-list #[nil "ÀcˆiÁÂ! ŘƒÆÇ!‚0ÈÉ \"ƒ, cˆÊ ˆ jˆÁË!‚ ̱*‡" [" (" read-string "[arguments]: " ada-args ada-arg-indent "" backward-delete-char 2 string-match ";$" newline "next argument: " ")"] 3 "\ Read from the user a procedure or function argument list. Add parens unless arguments absent, and insert into buffer. Individual arguments are arranged vertically if entered one at a time. Arguments ending with `;' are presumed single and stacked."]) (defalias 'ada-function-spec #[nil "ÀcˆÁÂ!cˆÃ ˆÄcˆÁÅ!c‡" ["function " read-string "function name: " ada-get-arg-list " return " "result type: "] 2 "\ Insert a function specification. Prompts for name and arguments." nil]) (defalias 'ada-procedure-spec #[nil "ÀcˆÁÂ!cˆÃ ‡" ["procedure " read-string "procedure name: " ada-get-arg-list] 2 "\ Insert a procedure specification, prompting for its name and arguments." nil]) (defalias 'get-ada-subprogram-name #[nil "ŠÀÂÃÄÅ#ƒ1ÆÇ!„ÆÈ!ƒ,iÉvˆ`\nËvˆ`\n{ )B‚4Ì ‚4Í B*‡" [0 ada-proc-indent re-search-backward "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>" "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>" 2 p2 -1 get-ada-subprogram-name "NAME?"] 4 "\ Return (without moving point or mark) a pair whose CAR is the name of the function or procedure whose spec immediately precedes point, and whose CDR is the column number where the procedure/function keyword was found."]) (defalias 'ada-subprogram-body #[nil "ÀcˆÁ à ˆ\nAjˆÄ ˆÅcˆÄ ˆÄ ˆÆ\n@DZˆ)ÈˆÉ ‡" [" is" get-ada-subprogram-name ada-subprogram-name-col newline ada-newline "begin" "end " ";" -2 ada-tab] 3 "\ Insert frame for subprogram body. Invoke right after `ada-function-spec' or `ada-procedure-spec'." nil]) (defalias 'ada-separate #[nil "ÀcˆÁ ˆÂ ˆÃcˆÁ ˆÄ ‡" [" is" ada-newline ada-tab "separate;" ada-untab] 1 "\ Finish a body stub with `is separate'." nil]) (defalias 'ada-record #[nil "ÀcˆÁ ˆÁ ˆÂcˆÃˆÄ ‡" ["record" ada-newline "end record;" 0 ada-tab] 1 "\ Insert a skeleton record type declaration." nil]) (defalias 'ada-subtype #[nil "ÀÁÂ!ñˆÄ ˆÅÆ!‡" ["subtype " read-string "subtype name: " " is ;" backward-char message "insert subtype indication."] 3 "\ Start insertion of a subtype declaration, prompting for the subtype name." nil]) (defalias 'ada-type #[nil "ÀÁÂ!±ˆÁÃ!‰Ř„Æ Ç±ˆ)ÈcˆÉÊ!‡" ["type " read-string "type name: " "discriminant specs: " disc-part "" "(" ")" " is " message "insert type definition."] 4 "\ Start insertion of a type declaration, prompting for the type name." nil]) (defalias (quote ada-while-loop) #[nil "ÀcˆÁÂ!‰Ę?‰ƒ#ÆyˆÇÈ!ˆ ɱˆÊÈ!ˆÈˆÁË!̱ˆÍ ˆÍ ˆÎcˆ ƒ<Ï ±ˆÐcˆ*ÆˆÑ ‡" ["while " read-string "loop name: " ada-loop-name "" ada-loop-is-named 0 open-line 1 ":" next-line "entry condition: " " loop" ada-newline "end loop" " " ";" ada-tab] 3 nil nil]) (defalias 'ada-paired-parens #[nil "ÀcˆÁ ‡" ["()" backward-char] 1 "\ Insert a pair of round parentheses, placing point between them." nil]) (defalias 'ada-inline-comment #[nil "Àˆi Vƒ  ˆi Wƒ jˆÄc‡" [nil end-comment-column newline comment-column " -- "] 2 "\ Start a comment after the end of the line, indented at least `comment-column' spaces. If starting after `end-comment-column', start a new line." nil]) (defalias 'ada-display-comment #[nil "ÀcˆÁ‡" ["--\n-- \n--" 0] 1 "\ Inserts three comment lines, making a display comment." nil]) (defvar ada-lib-dir-name "lib" "\ *Current Ada program library directory.") (defvar ada-bind-opts "" "\ *Options to supply for binding.") (defalias 'ada-library-name #[(ada-lib-name) "‰‡" [ada-lib-name ada-lib-dir-name] 2 "\ Specify name of Ada library directory for later compilations." "DName of Ada library directory: "]) (defalias 'ada-options-for-bind #[nil "ÀÁ!‰‡" [read-string "-m and -i options for `ada-bind': " ada-bind-opts] 2 "\ Specify options, such as -m and -i, needed for `ada-bind'."]) (defalias 'ada-compile #[(arg) "„Á‚ ÂÄ ÆÇ È Ê °!*‡" [arg "" "-n " ada-init buffer-name ada-source-file compile "adacomp " "-l " ada-lib-dir-name " "] 7 "\ Save the current buffer and compile it into the current program library. Initialize the library if a prefix arg is given." "P"]) (defalias 'ada-find-listing #[nil "ÀÁ ÂÃOÄP!ˆÅÆ!‡" [find-file-other-window buffer-name 0 -4 ".lis" search-forward "*** ERROR"] 4 "\ Find listing file for ada source in current buffer, using other window." nil]) (defalias 'ada-bind #[nil "ÀÁ\nà R!‡" [compile "adabind " ada-bind-opts " " ada-lib-dir-name] 5 "\ Bind the current program library, using the current binding options." nil]) emacs-19.22/lisp/add-log.elc100666 13437 13 17423 5474617537 14015 0ustar jimbuser;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:46:22 1993 ;;; from file /home/fsf/rms/e19/lisp/add-log.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (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 (user-full-name) "\ *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 (byte-code "À Á Q‡" [user-login-name "@" system-name] 3) "\ *Electronic mail address of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by `user-login-name', followed by an `@' character, followed by the value returned by `system-name'.") (defalias (quote change-log-name) #[nil "† Â=ƒ Çć" [change-log-default-name system-type vax-vms "$CHANGE_LOG$.TXT" "ChangeLog"] 2]) (defalias 'prompt-for-change-log-name #[nil "À ÂÃÄÅ \"Æ #!)‡" [change-log-name default expand-file-name read-file-name format "Log file (default %s): " nil] 5 "\ Prompt for a change log name."]) (defalias 'find-change-log #[(&optional file-name) "„ †\nƒÃÄ\n!!†  =ƒ%ÁÆ žƒ%‡Ç!ƒ1ÈÉ \"Ä!È!‰Ê  Í !„nÎ !„nÃÏà !!! à ! ˜„nÈÐÉ ! \" ‚?Í !„|Î !ƒ *ÑÁ!Lˆ‡" [file-name change-log-default-name buffer-file-name file-name-directory file-chase-links default-directory buffer-local-variables 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 "\ Find a change log file for \\[add-change-log-entry] and return the name. Optional arg FILE-NAME is a name to try first. If FILE-NAME is nil, use the value of `change-log-default-name' if non-nil. Failing that, use \"ChangeLog\" in the current directory. If the file does not exist in the named directory, successive parent directories are tried. Once a file is found, `change-log-default-name' is set locally in the current buffer to the complete file name."]) (defalias 'add-change-log-entry #[(&optional whoami file-name other-window new-entry) "ƒÁ \"ÁÄ \"†Ç ȉ \n Ì ! ƒN ˜„NÏÐÑÒ !!P\"ƒHÓ•ÈO‚LÔ! ƒc š„cÖ !ˆ‚h× !ˆÙ=„rÙ ˆÚ ˆebˆÛÑÜ ÓÝO!ÞÑ !ßÑ !°!ƒ”àyˆ‚žÜ á ß â±ˆÛã!ƒ«äÈwˆ‚¯åà!ˆ`\nebˆæç\nè#ƒÊ ƒA cˆ‚A)„æÑê P!ëP\nè#ƒæì!ˆÓyˆm„üÛí!ƒü`Šàyˆ`)|ˆ‚æîcˆïyˆð ˆ‚AàyˆÛñ!ƒàyˆ‚ m„-Ûí!ƒ-`Šàyˆ`)|ˆ‚òcˆïyˆ3jˆê †>ô±ˆ ƒbÚ ˆŠÓyˆÛõ!)ƒXô‚Yö÷ ø±‚pŠÓyˆÛù!)?…púc+‡" [whoami read-input "Full name: " add-log-full-name "Mailing address: " add-log-mailing-address add-log-current-defun-function add-log-current-defun nil entry paragraph-end defun 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 "* " "\\(\\s \\|[(),:]\\)" "^\\s *$\\|^\\s \\*" "^\\s *$" "\n\n" -2 indent-relative-maybe "\\sW" "\n\n\n" left-margin "" "\\s *$" " " "(" "): " "\\s *\\(\\*\\s *\\)?$" ": "] 7 "\ 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." (list current-prefix-arg (prompt-for-change-log-name))]) (defalias 'add-change-log-entry-other-window #[(&optional whoami file-name) "À \nÃ#‡" [add-change-log-entry whoami file-name t] 4 "\ 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'." (byte-code "…Á D‡" [current-prefix-arg prompt-for-change-log-name] 2)]) (defalias 'change-log-mode #[nil "À ˆÁ ˆÂÄÆÈ Ê !ˆÌÍ!Î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 *$\\|^ " paragraph-separate "^\\s *$\\|^ \\|^\\sw" page-delimiter "^\\<\\|^ " version-control never adaptive-fill-regexp "\\s *" run-hooks change-log-mode-hook] 2 "\ 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'." nil]) (defvar change-log-mode-map nil "\ Keymap for Change Log major mode.") (byte-code "„ Á ÂÃÄ#ˆÁ‡" [change-log-mode-map make-sparse-keymap define-key "ñ" change-log-fill-paragraph] 4) (defalias 'change-log-fill-paragraph #[(&optional justify) "ÁP\nÁPà !*‡" [paragraph-separate "\\|^\\s *\\s(" paragraph-start fill-paragraph justify] 3 "\ Fill the paragraph, but preserve open parentheses at beginning of lines. Prefix arg means justify as well." "P"]) (defvar add-log-current-defun-header-regexp "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ ]*[:=]" "\ *Heuristic regexp used by `add-log-current-defun' for unknown major modes.") (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ˆ`ÆÃ!ˆ`{‚+`Ëßà…+Šbˆo„ŠÇyˆÈá!)ƒÇyˆ‚`Y)…+`V…+`ÖÃ!ˆ`{*‚¬ â>ƒKãäËå#…¬Í”bˆ`Tˈ`{‚¬ æ=ƒaãçËå#…¬ÔÕ{‚¬ è=ƒ•é ˆå*ëìËå#…‘ëíËå#ƒ‡ÇuˆÓËxˆ‚ŠËˆ`ÆÇ!ˆ`{)‚¬Ë*ˈã.`ïZå#…«ÔÕ{)*‡" [location major-mode (emacs-lisp-mode lisp-mode scheme-mode) 1 beginning-of-defun end-of-defun forward-sexp -1 looking-at "\\s(" " " nil (c-mode (quote c++-mode)) 0 2 92 "[ ]*#[ ]*define[ ]" search-forward "define" " " (c-mode (quote c++-mode)) "{\\|\\(\\s *$\\)" backward-sexp tem beg "[ \n]" (byte-code "ŠÀyˆÁÀ!ˆÂyˆ`ÄÅ!)… Y‡" [1 backward-sexp 0 tem looking-at "DEFUN\\b" location] 2) ((error)) down-list 34 " ," (byte-code "ÀÁ!ˆÂÁ!ˆÃÄxˆÅ‡" [down-list 1 backward-up-list " " nil t] 2) ((error)) "[^\n ]" (TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode) re-search-backward "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" t texinfo-mode "^@node[ ]+\\([^,]+\\)," 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 "\ Return name of function definition point is in, or nil. Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), Texinfo (@node titles), 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."]) (provide (quote add-log)) emacs-19.22/lisp/advice.elc100666 12120 1 143555 5474617754 14076 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:48:42 1993 ;;; from file /home/fsf/rms/e19/lisp/advice.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÁÃ\"ˆÄÅ!„ÆÅÇ\"ˆÈ À‡" [provide advice-preload require "advice.el" fboundp \` autoload "backquote" "2.1" ad-version] 3) (defconst ad-emacs19-p (byte-code "ÀÁ!ƒ\n † \nÙ?‡" [boundp epoch::version emacs-version "19"] 2) "\ Non-NIL if we run Emacs version 19 or higher. This will be true for GNU Emacs-19 as well as Lemacs.") (defconst ad-lemacs-p (byte-code "…Á \"‡" [ad-emacs19-p string-match "Lucid" emacs-version] 3) "\ Non-NIL if we run Lucid's version of Emacs-19.") (defvar ad-start-advice-on-load t "\ *Non-NIL will start advice magic when this file gets loaded. Also see function `ad-start-advice'.") (defvar ad-activate-on-definition nil "\ *Non-NIL means automatic advice activation at function definition. Set this variable to t if you want to enable forward advice (which is automatic advice activation of a previously undefined function at the point the function gets defined/loaded/autoloaded). The value of this variable takes effect only during the execution of `ad-start-advice'. If non-NIL it will enable definition hooks regardless of the value of `ad-enable-definition-hooks'.") (defvar ad-redefinition-action (quote warn) "\ *Defines what to do with redefinitions during 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-definition-hooks nil "\ *List of hooks to be run after a function definition. The variable `ad-defined-function' will be bound to the name of the currently defined function when the hook function is run.") (defvar ad-enable-definition-hooks nil "\ *Non-NIL will enable hooks to be run on function definition. Setting this variable is a noop unless the value of `ad-activate-on-definition' (which see) is NIL.") (defvar ad-use-jwz-byte-compiler (fboundp (quote eval-when-compile)) "\ *Non-NIL means Jamie Zawinski's v19 byte-compiler will be used. If you use a v18 Emacs and don't use jwz's optimizing byte-compiler (the normal case) then this variable should be NIL, because otherwise enabling definition hooks (e.g., for forward advice) will redefine the `byte-code' subr which will lead to some performance degradation for byte-compiled code.") (byte-code "ÀÁ!„ÁÂKMˆÃÁÄÂÄN#ˆÃÁÅÂÅN#ˆÀÆ!„&ÆÇKMˆÈÉÊ\"ˆÈËÌ\"‡" [fboundp ad-real-fset fset put byte-compile byte-opcode ad-real-byte-code byte-code defalias ad-substitute-tree #[(sUbTrEe-TeSt fUnCtIoN tReE) ":ƒ, @!ƒ\n@!‚$@:ƒ\"à \n@#‚$@à \nA#B‡ !ƒ6\n!‡‡" [tReE sUbTrEe-TeSt fUnCtIoN ad-substitute-tree] 5] ad-copy-tree #[(tree) ":ƒÁ@!ÁA!B‡‡" [tree ad-copy-tree] 3]] 5) (defalias 'ad-dolist '(macro . #[(varform &rest body) "ÀÁ\nA@D\n@DÃÄÅ\n@ÆECÈC$\nAA@F Ê˃+ÌÍ E‚- )‡" [let ad-dO-vAr varform append (while ad-dO-vAr) setq (car ad-dO-vAr) 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)] 7 "\ A Common-Lisp-style dolist iterator with the following syntax: (ad-dolist ( []) {body-form}*) which will iterate over the list yielded by binding to the current head at every iteration. If 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 [])."])) (byte-code "ÀÁÂ\"ˆÃÄN„ÅÃÄÆ#ˆÇÈ!„ÉÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"ˆÎÄN„5ÅÎÄÆ#ˆÀÐÑ\"ˆÀÒÓ\"ˆÀÔÕ\"ˆÀÖ×\"ˆÀØÙ\"ˆÀÚÛ\"ˆÀÜÝ\"ˆÀÞß\"‡" [defalias ad-do-return (macro . #[(value) "ÀÁ\nE‡" [throw (quote ad-dO-eXiT) value] 3]) ad-dolist lisp-indent-hook put 1 boundp ad-advised-functions nil ad-pushnew-advised-function (macro . #[(function) "ÀÁÂà DÅEDÆÅÇÈà DDÅEEE‡" [if not assoc symbol-name function ad-advised-functions setq cons list] 8]) ad-pop-advised-function (macro . #[(function) "ÀÁÂÃÄ DÁEÁEE‡" [setq ad-advised-functions delq assoc symbol-name function] 6]) ad-do-advised-functions (macro . #[(varform &rest body) "ÀÁ\n@Ã\nA@EÄ\n@ÅÆ\n@DDED#‡" [append (ad-dolist) varform ad-advised-functions setq intern car body] 8]) ad-get-advice-info (macro . #[(function) "À ÂE‡" [get function (quote ad-advice-info)] 3]) ad-set-advice-info (macro . #[(function advice-info) "À  F‡" [put function (quote ad-advice-info) advice-info] 4]) ad-copy-advice-info (macro . #[(function) "ÀÁ\nÃED‡" [ad-copy-tree get function (quote ad-advice-info)] 4]) ad-is-advised (macro . #[(function) "À D‡" [ad-get-advice-info function] 2]) 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] ad-get-advice-info-field (macro . #[(function field) "ÀÁ\nà DED‡" [cdr assq field ad-get-advice-info function] 5]) ad-set-advice-info-field #[(function field value) "ÁN…\nÁNžƒ\nÁNž ¡‡ÁN\n BC¤‡" [function ad-advice-info field value] 3] ad-is-active #[(function) "À ÂNžA‡" [active function ad-advice-info] 3]] 4) (defalias 'ad-make-advice #[(name protect enable definition) " \n F‡" [name protect enable definition] 4 "\ 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 ({}*) [docstring] [(interactive ...)] {body-form}*)"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÑÒ!„1ÓÀÔÕ\"ˆÀÖ×\"ˆÀØÙ\"ˆÀÚÛ\"ˆÀÜÝ\"ˆÀÞß\"ˆÀàá\"ˆÀâã\"ˆÀäå\"ˆÑæ!„kçè\"&Àéê\"ˆÀëì\"ˆÀíî\"ˆÑï!„ƒð/Àñò\"ˆÀóô\"ˆÀõö\"‡" [defalias ad-advice-name (macro . #[(advice) "À D‡" [car advice] 2]) ad-advice-protected (macro . #[(advice) "ÀÁ\nE‡" [nth 1 advice] 3]) ad-advice-enabled (macro . #[(advice) "ÀÁ\nE‡" [nth 2 advice] 3]) ad-advice-definition (macro . #[(advice) "ÀÁ\nE‡" [nth 3 advice] 3]) ad-advice-set-enabled #[(advice flag) "AA  ‡" [advice flag] 2] ad-class-p #[(thing) " >‡" [thing ad-advice-classes] 2] ad-name-p #[(thing) "…9‡" [thing] 1] ad-position-p #[(thing) "À !† Â>‡" [natnump thing (first last)] 2] boundp ad-advice-classes (before around after activation deactivation) ad-has-enabled-advice #[(function class) "ÀÁ‡" [ad-dO-eXiT (byte-code " ÂNžAɃ\" @Æ 8ƒÇÈÉ\"ˆ A‰„ *Ç" [class function ad-advice-info nil advice ad-dO-vAr 2 throw ad-dO-eXiT t] 4)] 2] ad-has-redefining-advice #[(function) "ÁN…ÂÃ\"†ÂÄ\"†ÂÅ\"‡" [function ad-advice-info ad-has-enabled-advice before around after] 3] ad-has-any-advice #[(function) "ÁN… ÂÇ" [function ad-advice-info ad-dO-eXiT (byte-code "Á‰ƒ @‰ ÅNžAƒÆÇÈ\"ˆ A‰„*Á‡" [ad-advice-classes nil class ad-dO-vAr function ad-advice-info throw ad-dO-eXiT t] 4)] 2] 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] ad-make-origname #[(function) "ÀÁ \"!‡" [intern format "ad-Orig-%s" function] 4] ad-get-orig-definition (macro . #[(function) "ÀÁ ÄEDCÅE‡" [let origname ad-get-advice-info-field function (quote origname) (if (fboundp origname) (symbol-function origname))] 5]) ad-set-orig-definition (macro . #[(function definition) "ÀÁ\nE‡" [ad-real-fset (ad-get-advice-info-field function (quote origname)) definition] 3]) ad-clear-orig-definition (macro . #[(function) "ÀÁ\nÃED‡" [fmakunbound ad-get-advice-info-field function (quote origname)] 4]) 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] ad-advice-class-completion-table mapcar #[(class) "À !C‡" [symbol-name class] 2] ad-read-advice-class #[(function &optional prompt default) "†Á†ÃÄ \"ÆÇÈ †Ê# ÌÍ$‰Ïšƒ+‚/Ð!)‡" [default ad-dO-eXiT (byte-code "Á‰ƒ @‰ Å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] 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] ad-read-advice-specification #[(&optional prompt) "À !Ã\n!Å\n \"\n E+‡" [ad-read-advised-function prompt function ad-read-advice-class class ad-read-advice-name name] 3] ad-last-regexp "" ad-read-regexp #[(&optional prompt) "À † ĚƒÄ‚ÅÆ \"P!‰Äšƒ\" ‚$‰)‡" [read-from-minibuffer prompt "Regular expression: " ad-last-regexp "" format "(default \"%s\") " regexp] 6] ad-find-advice (macro . #[(function class name) "À  EE‡" [assq name ad-get-advice-info-field function class] 5]) ad-advice-position #[(function class name) " \nÃNžAž \nÃNžA … G >GZ*‡" [name class function ad-advice-info found-advice advices] 4]] 3) (defalias 'ad-find-some-advice #[(function class name) "ÁN… ÂÄÅ)‡" [function ad-advice-info nil found-advice ad-dO-eXiT (byte-code "Á‰ƒ. @ Å=„\n =ƒÆǃ'ÉÆ\"ˆ A‰„*Á‡" [ad-advice-classes nil advice-class ad-dO-vAr class any ad-dO-eXiT (byte-code " ÂNžAɃ5 @;ƒ!ÇÈ @!\"„) @=ƒ.ÉÊ \"ˆ 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 "\ 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 (quote ad-enable-advice-internal) #[(function class name flag) "ÁN…v ʼ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]) (defalias 'ad-enable-advice #[(function class name) "ÁNƒÂ Å$Æ=…ÇÈ $‡ÇÉ\"‡" [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 "\ Enables the advice of FUNCTION with CLASS and NAME." (ad-read-advice-specification "Enable advice of: ")]) (defalias 'ad-disable-advice #[(function class name) "ÁNƒÂ Å$Æ=…ÇÈ $‡ÇÉ\"‡" [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 "\ Disables the advice of FUNCTION with CLASS and NAME." (ad-read-advice-specification "Disable advice of: ")]) (defalias (quote ad-enable-regexp-internal) #[(regexp class flag) "À\nɃ) @Æ @! Ç  \n$† À\\ A‰„\n* )‡" [0 matched-advices ad-advised-functions nil advised-function ad-dO-vAr intern ad-enable-advice-internal class regexp flag] 7]) (defalias 'ad-enable-regexp #[(regexp) "À ÂÃ#tƒÅÆ \"ˆ )‡" [ad-enable-regexp-internal regexp any t matched-advices message "%d matching advices enabled"] 4 "\ Enables all advices with names that contain a match for REGEXP. All currently advised functions will be considered." (list (ad-read-regexp "Enable advices via regexp: "))]) (defalias 'ad-disable-regexp #[(regexp) "À ÂÃ#tƒÅÆ \"ˆ )‡" [ad-enable-regexp-internal regexp any nil matched-advices message "%d matching advices disabled"] 4 "\ Disables all advices with names that contain a match for REGEXP. All currently advised functions will be considered." (list (ad-read-regexp "Disable advices via regexp: "))]) (defalias 'ad-remove-advice #[(function class name) "ÁNƒ+\n ÁNžAž‰ƒ#Å Æ Á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 "\ 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." (ad-read-advice-specification "Remove advice of: ")]) (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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„ÇÈÉ\"ÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"ˆÀÐÑ\"ˆÀÒÓ\"ˆÀÔÕ\"ˆÖ×!„DÖØ!ƒD×ØMˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÅó!„Žô3Àõö\"ˆÀ÷ø\"ˆÀùú\"ˆÀûü\"ˆÀýþ\"ˆÀÿ@\"ˆÀAB\"‡" [defalias ad-macrofy (macro . #[(definition) "ÀÁ\nE‡" [cons (quote macro) definition] 3]) ad-lambdafy (macro . #[(definition) "À D‡" [cdr definition] 2]) 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) ad-special-form-p (macro . #[(definition) "À ÂE‡" [memq definition ad-special-forms] 3]) ad-interactive-p (macro . #[(definition) "À D‡" [commandp definition] 2]) ad-subr-p (macro . #[(definition) "À D‡" [subrp definition] 2]) ad-macro-p (macro . #[(definition) "ÀÁ\nDÃE‡" [eq car-safe definition (quote macro)] 3]) ad-lambda-p (macro . #[(definition) "ÀÁ\nDÃE‡" [eq car-safe definition (quote lambda)] 3]) ad-advice-p (macro . #[(definition) "ÀÁ\nDÃE‡" [eq car-safe definition (quote advice)] 3]) fboundp byte-code-function-p compiled-function-p ad-v19-compiled-p (macro . #[(definition) "ÀÁÂà DÀÅ DÃÆ DDEEE‡" [and ad-emacs19-p or byte-code-function-p definition ad-macro-p ad-lambdafy] 9]) ad-v19-compiled-code (macro . #[(compiled-definition) "ÀÁ\nDÃ\nD\nF‡" [if ad-macro-p compiled-definition ad-lambdafy] 4]) ad-lambda-expression #[(definition) "¢Á=ƒ ‡¢Â=ƒA‡¢Ã=ƒA‡Ä‡" [definition lambda macro advice nil] 2] ad-arglist #[(definition &optional name) "ƒ(Á\n!„\n¢Ã=ƒ(Á\nA!ƒ(\n¢Ã=ƒ$\nA‚%\nÄH‡\n:ƒ3Å\n!A@‡Æ\n!…ZƒCÈ!‡ÉÊ\n\"ËÌ\"ˆÈÍΔΕO!!‡" [ad-emacs19-p byte-code-function-p definition macro 0 ad-lambda-expression subrp name ad-subr-arglist format "%s" string-match "^#]+\\)>$" intern 1] 5] ad-define-subr-args (macro . #[(subr arglist) "À Âà DF‡" [put subr (quote ad-subr-arglist) list arglist] 5]) ad-undefine-subr-args (macro . #[(subr) "À ÂÃF‡" [put subr (quote ad-subr-arglist) nil] 4]) ad-subr-args-defined-p (macro . #[(subr) "À ÂE‡" [get subr (quote ad-subr-arglist)] 3]) ad-get-subr-args (macro . #[(subr) "ÀÁ\nÃED‡" [car get subr (quote ad-subr-arglist)] 4]) ad-subr-arglist #[(subr-name) "ÁNƒ ÁN@‡\n…Ã!‰ƒ3ÅÆ \"ƒ3ÇÁÈ É”É•#@C#ˆÁN@‚4Ê)‡" [subr-name ad-subr-arglist ad-emacs19-p documentation doc string-match "[\n ]*\narguments: ?\\((.*)\\)\n?\\'" put read-from-string 1 (&rest ad-subr-args)] 8] ad-docstring #[(definition) "ƒÁ\n!„\n¢Ã=ƒÁ\nA!ƒÄÅÆ‚%Ç\n!AA@‰;„3É!…5)‡" [ad-emacs19-p byte-code-function-p definition macro nodoc (byte-code "¢Á=ƒ A‚ ÂH‡" [definition macro 4] 2) ((error)) ad-lambda-expression docstring natnump] 4] ad-interactive-form #[(definition) "ƒ0Á\n!„\n¢Ã=ƒ0Á\nA!ƒ0Ä\n!…CÅ\n¢Ã=ƒ+\nA‚,\nÆHD‡\n¢Ç=„>\n¢È=…CÄÉ\n!!‡" [ad-emacs19-p byte-code-function-p definition macro commandp interactive 5 advice lambda ad-lambda-expression] 3] ad-body-forms #[(definition) "ƒ3Á\n!„\n¢Ã=ƒ3Á\nA!ƒ3\n¢Ã=ƒ$\nA‚%\nÄ\nÅH\nÆH\nÇHFC‡\n:…UÈ\n!ƒBÅ‚CÉÊ\n!ƒMÅ‚NÉ\\Ë\n!AA›‡" [ad-emacs19-p byte-code-function-p definition macro byte-code 1 2 3 ad-docstring 0 ad-interactive-form ad-lambda-expression] 5] ad-compiled-p #[(definition) "ƒÁ\n!†\n¢Ã=ƒÁ\nA!†Ä\n!@¢Å>‡" [ad-emacs19-p byte-code-function-p definition macro ad-body-forms (byte-code ad-real-byte-code)] 2] ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$" ad-make-advised-definition-docstring #[(function) "ÀÁ !\"‡" [format "$ad-doc: %s$" prin1-to-string function] 4] ad-advised-definition-p #[(definition) "¢Á=„¢Â=„Ã!…#Ä!‰;…\"Æ \")‡" [definition lambda macro ad-compiled-p ad-docstring docstring string-match ad-advised-definition-docstring-regexp] 4] ad-definition-type #[(definition) "¢Á=ƒ Á‡Â!ƒ >ƒćŇ¢Æ=„&Ç!ƒ(ȇ¢É=…0ɇ" [definition macro subrp ad-special-forms special-form subr lambda ad-compiled-p function advice] 2] ad-has-proper-definition #[(function) "9…Á!…K¢Â=?‡" [function fboundp autoload] 2] ad-real-definition #[(function) "À !… K‰9ƒÃ\n!‚\n)‡" [ad-has-proper-definition function definition ad-real-definition] 3] ad-real-orig-definition #[(function) "ÁN…ÂÃÁNžA!‡" [function ad-advice-info ad-real-definition origname] 4] ad-is-compilable #[(function) "À !… K¢Â=„ K¢Ã=…Ä K!?‡" [ad-has-proper-definition function lambda macro ad-compiled-p] 2]] 3) (defalias 'ad-compile-function #[(function) "À !…#ÂÃÄ\"ˆÃ !†# K¢Å=…# ÅÆÇ K!!BM‡" [ad-is-compilable function require byte-compile "bytecomp" macro byte-compile-lambda ad-lambda-expression] 5 "\ Byte-compiles FUNCTION (or macro) if it is not yet compiled." "aByte-compile function: "]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"‡" [defalias ad-real-byte-codify #[(function) "À !ˆ K ƒÄ\n!†+\n¢Å=ƒÄ\nA!†+Æ\n!…+Ç\n!@È )‡" [ad-compile-function function definition ad-emacs19-p byte-code-function-p macro ad-compiled-p ad-body-forms ad-real-byte-code] 2] ad-prognify #[(forms) "GÁXƒ\n@‡ÂB‡" [forms 1 progn] 2] ad-parse-arglist #[(arglist) "ÀÀÀÄ >A@‰ƒÆÄÆ !>A!Ç >A‰ƒ.ÆÇÆ !>A!‚0  \n E+‡" [nil required optional rest &rest arglist reverse &optional] 5] ad-retrieve-args-form #[(arglist) "À !Ã\n8ÅÆÇÈ\n@\"ÇÉ\nA@\" …!ÊË D ÌFC$*‡" [ad-parse-arglist arglist parsed-arglist 2 rest append (list) mapcar #[(req) "ÀÁ\nD\nÃF‡" [list quote req (quote required)] 4] #[(opt) "ÀÁ\nD\nÃF‡" [list quote opt (quote optional)] 4] list quote (quote rest)] 8] ad-arg-binding-field #[(binding field) "Á=ƒ \n@‡Ã=ƒ\nA@‡Ä=…\nAA@‡" [field name binding value type] 2] ad-list-access #[(position list) "ÁUƒ\n‡ÃUƒÄ\nD‡Å\nE‡" [position 0 list 1 cdr nthcdr] 3] ad-element-access #[(position list) "ÁUƒ\n D‡ÄUƒÂÅ DD‡Æ E‡" [position 0 car list 1 cdr nth] 3] ad-access-argument #[(arglist index) "À !Ã\n@\nA@\"Å\n8 GWƒ  8‚-…- GZD+‡" [ad-parse-arglist arglist parsed-arglist append reqopt-args 2 rest-arg index] 3] ad-get-argument #[(arglist index) "À \n\"‰:ƒÄ @ A@\"‚ )‡" [ad-access-argument arglist index argument-access ad-element-access] 4] 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] ad-get-arguments #[(arglist index) "À !Ã\n@\nA@\"Å\n8Ç GWƒ%ÃÊ ›\"ƒEƒ:ËE‚EÌ GZ\",‡" [ad-parse-arglist arglist parsed-arglist append reqopt-args 2 rest-arg nil args-form index (list) nconc ad-list-access] 4] ad-set-arguments #[(arglist index values-form) "ÀÁ‰Å\"‰ƒX 9ƒ&ÈÉ Ê\"#\nB‚M @ÀUƒ9Ë A@Ì Ê\"E‚GÍÌ @S A@\"Ì Ê\"E\nBÁT T‚\n„fÎÏ#‚„\nGÐUƒvÑÒÓ\n@#‚„ÔÕÊDCC×\n!ÊC$+‡" [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] (lambda (form) values-form) append (let) values-form reverse] 6] 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]] 3) (defalias 'ad-map-arglists #[(source-arglist target-arglist) "À !Ã\n@\nA@\"Å\n8À!Ã@A@\" Å8\n…/\n Ì Ã ƒ>΂?ÏÐD ƒOà C\"‚`ÑÒà \n…^ G ›\"\"\".‡" [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 "\ 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))"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"‡" [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] ad-make-single-advice-docstring #[(advice class) "ÀÁ\n8!ÄÅ\n@ ƒÇ‚È †È%)‡" [ad-docstring 3 advice advice-docstring format "%s (%s):%s%s" class "\n" ""] 6] ad-make-advised-docstring #[(function) "À !ÃÄ\n …?…Ç#‰†Éƒ#Ê‚$ËÌÍÎ\n!!ÏÐÑÉ#°*‡" [ad-real-orig-definition function origdef apply documentation ad-emacs19-p ad-lemacs-p (t) origdoc "" "\n\n" "\n" "This " symbol-name ad-definition-type " is advised with the following advice(s):" mapconcat #[(class) "ÀÁ \"Å#‡" [mapconcat #[(advice) "ÀÁ\n \"P‡" ["\n\n" ad-make-single-advice-docstring advice class] 4] ad-get-enabled-advices function class ""] 5] ad-advice-classes] 10] 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] 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] ad-make-advised-definition #[(function) "ÁN…ðÂ!…ðÃ!ÅÁNžAÆ !È ! \n> ¢Ì= Î \"Ð!†;Ò! ƒKÔ‚u†uÕ !†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] ad-assemble-advised-definition #[(type args docstring interactive orig &optional befores arounds afters) "À‰‰‰‰À‰ƒI@‰A@ƒ6 ƒ6ÉÊË !DÌÍ8!\"C‚@É ÌÍ8!\"A‰„*ÎÏEÑ!À‰ƒ€@‰A@ƒjÓÔÕÖËÌÍ8!!#A‰„]* ƒ“ ƒ“ÊË ! EC‚˜É C\"À‰ƒØ@‰A@ƒÅ\nƒÅÉÊË\n!DÌÍ8!\"C‚ÏÉ\nÌÍ8!\"A‰„¤*ÉÙ>…âÚÛC…îC…öCÉß\nà=ƒá‚ÏC#C&â \"-‡" [nil definition after-forms around-form-protected around-form before-forms befores advice ad-dO-vAr append unwind-protect ad-prognify ad-body-forms 3 setq ad-return-value orig reverse arounds t ad-substitute-tree #[(form) "Á=‡" [form ad-do-it] 2] (lambda (form) around-form) 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] ad-make-hook-form #[(function hook-name) "ÀÁ \"\"‰…ÆÇÈ \"!)‡" [mapcar #[(advice) "ÀÁ\n8!‡" [ad-body-forms 3 advice] 3] ad-get-enabled-advices function hook-name hook-forms ad-prognify apply append] 6] ad-get-cache-definition (macro . #[(function) "ÀÁ\nÃED‡" [car ad-get-advice-info-field function (quote cache)] 4]) ad-get-cache-id (macro . #[(function) "ÀÁ\nÃED‡" [cdr ad-get-advice-info-field function (quote cache)] 4]) ad-set-cache (macro . #[(function definition id) "À Âà EF‡" [ad-set-advice-info-field function (quote cache) cons definition id] 6])] 3) (defalias 'ad-clear-cache #[(function) "À ÂÃ#‡" [ad-set-advice-info-field function cache nil] 4 "\ 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." (list (ad-read-advised-function "Clear cached definition of: "))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias ad-make-cache-id #[(function) "À ! ÃNžA@ÆÇÈ É\"\"ÆÊÈ Ë\"\"ÆÌÈ Í\"\"Î !Ï \"Ï !šƒ3Ђ7Ï \"Î !Á=…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] ad-get-cache-class-id #[(function class) "À ÂNžAA Å=ƒ @‚\" Æ=ƒ A@‚\"Ç 8)‡" [cache function ad-advice-info cache-id class before around 2] 3] 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] ad-cache-id-verification-code #[(function) "À ÂNžAAÃÆ @Ç ÂNžA\"ƒšÈ‰ƒšÆÉ 8Ê ÂNžA\"ƒšË‰ƒšÆÌ 8Í ÂNžA\"ƒšÎ‰ƒšÏ !À ÂNžA@Ò 8Ó!=ƒ™Ô‰ƒ™Õ 8Ö=ƒt× \"‚wÕ 8×!šƒ™Ø‰ƒ™Ù 8ƒ—Ú!Ú!šƒ™Û* *‡" [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] ad-verify-cache-id #[(function) "À !Â=‡" [ad-cache-id-verification-code function verified] 2] ad-preactivate-advice #[(function advice class position) "À !‰…\n KÄ ÅN!ÈŽÉ \n  $ˆÍ  \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 "À  #ˆ ƒ Mˆ‚Æ !ˆÀ‡" [put function ad-advice-info old-advice-info function-defined-p old-definition fmakunbound] 4)) ad-add-advice advice class position ad-enable-advice ad-clear-cache ad-activate nil ad-is-active cache] 6] ad-activate-advised-definition #[(function compile) "À !…  ÃNžA@ †Å !Mˆƒ!Ç !ˆ ƒ> K=?…UÈ Â K ÃNžAAB#‚UÉ !ˆÈ  KÊB#ˆÈ  KË !B#)‡" [ad-verify-cache-id function cache ad-advice-info verified-cached-definition ad-make-advised-definition compile ad-compile-function ad-set-advice-info-field ad-clear-cache nil ad-make-cache-id] 7]] 3) (defalias 'ad-handle-definition #[(function) "À ÂNžAÃ!…K)Ä !… K‰ƒf …r =?…rÇ !?…rÉ>„AÊË Ì#‚rÍ=ƒO M‚rÀ ÂNžA MˆÎ=…rÏÐ \"‚r …rÀ ÂNžA M*‡" [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 warn message "ad-handle-definition: `%s' got redefined"] 5 "\ 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-activate #[(function &optional compile) "ÁN„ ÂÃ\"‡Ä!ˆÅÁNžAÆ !… K)…JÇ!„,È!‡É!ƒGÊ \"ˆÌÍÎ#ˆÏÐÑ\"!ˆ‡Ò!‡" [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 "\ 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. With an argument (compile is non-NIL) the resulting function (or a compilable cached definition) will also be compiled. 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." (list (ad-read-advised-function "Activate advice of: ") current-prefix-arg)]) (defalias 'ad-deactivate #[(function) "ÁN„ ÂÃ\"‡Ä!…TÅ!ˆÆÁNžAÇ!…'K)„0ÂÈ\"‡ÆÁNžAÇ!…CK)MˆÉÊË#ˆÌÍÎ\"!ˆ‡" [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-set-advice-info-field active nil eval ad-make-hook-form deactivation] 4 "\ 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'." (list (ad-read-advised-function "Deactivate advice of: " (quote ad-is-active)))]) (defalias 'ad-update #[(function &optional compile) "À !… †Ä K!\"‡" [ad-is-active function ad-activate compile ad-compiled-p] 4 "\ Update the advised definition of FUNCTION if its advice is active. With a prefix argument or if the current definition is compiled compile the resulting advised definition." (list (ad-read-advised-function "Update advised definition of: " (quote ad-is-active)))]) (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 "\ Deactivates FUNCTION and then removes all its advice information. If FUNCTION was not advised this will be a noop." (list (ad-read-advised-function "Unadvise function: "))]) (defalias 'ad-recover #[(function) "ÁN…IÂÁNžAÃ\n!…\nK)ƒ5ÂÁNžAÃ\n!…)\nK)MˆÄÂÁNžA!ˆÅÁÆ#ˆÇÈÉ!\n\"\n\"‰\n‡" [function ad-advice-info origname fboundp fmakunbound put nil delq assoc symbol-name ad-advised-functions] 4 "\ 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." (list (intern (completing-read "Recover advised function: " obarray nil t)))]) (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 compile] 5 "\ Activates functions with an advice name containing a REGEXP match. With prefix argument compiles resulting advised definitions." (list (ad-read-regexp "Activate via advice regexp: ") current-prefix-arg)]) (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 "\ Deactivates functions with an advice name containing REGEXP match." (list (ad-read-regexp "Deactivate via advice regexp: "))]) (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 "\ Updates functions with an advice name containing a REGEXP match. With prefix argument compiles resulting advised definitions." (list (ad-read-regexp "Update via advice regexp: ") current-prefix-arg)]) (defalias 'ad-activate-all #[(&optional compile) "Á‰ƒ @Ä\n@!Å\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-activate] 3 "\ Activates all currently advised functions. With prefix argument compiles resulting advised definitions." "P"]) (defalias 'ad-deactivate-all #[nil "Á‰ƒ @Ä\n@!Å\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-deactivate] 3 "\ Deactivates all currently advised functions." nil]) (defalias 'ad-update-all #[(&optional compile) "Á‰ƒ @Ä\n@!Å\n\"ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-update compile] 4 "\ Updates all currently advised functions. With prefix argument compiles resulting advised definitions." "P"]) (defalias 'ad-unadvise-all #[nil "Á‰ƒ @Ä\n@!Å\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ad-unadvise] 3 "\ Unadvises all currently advised functions." nil]) (defalias 'ad-recover-all #[nil "Á‰ƒ @Ä\n@!ÅÆLj A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern ignore-errors (ad-recover function) ((error))] 4 "\ Recovers all currently advised functions. Use in emergencies." nil]) (byte-code "ÀÁ!„ÂÀ‡" [boundp ad-defadvice-flags (("protect") ("disable") ("activate") ("compile") ("preactivate"))] 2) (defalias 'defadvice '(macro . #[(function args &rest body) "À !„ Âà \"ˆ @Æ !„ÂÇ \"‚ A@À!„/ÂÉ\"‚? AAÊ @!…? @ A @<…L @ A ÍÎ \"ÐÑ>Ò>?ÓÔÕ D#$Ø>…{Ù   $ÓÛÜÝ DÝDÝ DÝ D¯C…»ÞÝ D@¢ß=ƒ®àÁ@ADD‚³Á@DÝA@DFCá>…ÐâÝ Dã>…ÎäECÝ DC%.‡" [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‚\"Æ \"ƒÇ !‚\"ÈÉ\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 append (advice) lambda body advice preactivate ad-preactivate-advice preactivation (progn) ad-add-advice quote ad-set-cache macro ad-macrofy activate ad-activate compile t] 8 "\ Defines a piece of advice for FUNCTION (a symbol). (defadvice ( [] [] {}*) [ [] [] ] {}* ) ::= name of the function to be advised ::= before | around | after | activation | deactivation ::= non-NIL symbol that names this piece of advice ::= first | last | (optional, defaults to `first', see also `ad-add-advice') ::= 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. ::= protect | disable | activate | compile | preactivate All flags can be specified with unambiguous initial substrings. ::= optional documentation for this piece of advice ::= optional interactive form to be used for the advised function. The first one found in before/around/after advices will be used. ::= 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 the 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 (with a v18 byte-compiler put the defadvice into the body of a defun). Look at the file advice.el for comprehensive documentation."])) (defalias 'ad-with-originals '(macro . #[(functions &rest body) "ÀÂà \"Æ ÇÈÇÉÀÂÊ \" #DÀÂÌ \"\"E*‡" [-1 index mapcar #[(function) "TÁÂÃ\"!ÄÅDDD‡" [index intern format "ad-oRiGdEf-%d" symbol-function quote function] 4] functions current-bindings let append unwind-protect (progn) #[(function) "TÁ DÄÅ DD8@EE‡" [index ad-real-fset quote function or ad-get-orig-definition current-bindings] 6] body #[(function) "TÁ D 8@E‡" [index ad-real-fset quote function current-bindings] 4]] 9 "\ 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."])) (byte-code "ÀÁN„ ÂÀÁÃ#ˆÄÅ!„ÆƇ" [ad-with-originals lisp-indent-hook put 1 boundp ad-defined-function nil] 4) (defalias 'ad-activate-defined-function #[(&optional function) "„\n ƒ\n ÂN…Ã!…ÄÅK!\"‡" [function ad-defined-function ad-advice-info ad-real-definition ad-activate ad-compiled-p] 4 "\ Activates the advice of an advised and defined FUNCTION. If the current definition of FUNCTION is byte-compiled then the advised definition will be compiled too. FUNCTION defaults to the value of `ad-defined-function'."]) (byte-code "„ÁÂÃÄC#ˆÁÅÃÆC#ˆÇÈÉ\"ˆÊÈK!ƒ!È ˆËÌ!„*Í ËÎ!„3ÏËÐ!„<ÑËÒ!„EÓËÔ!„ÕÖ× !× S\\!#×!ÙP×!ÜÝÞÜÝÞ° +Çßà\"ˆÇáâ\"‡" [ad-emacs19-p put documentation ad-subr-arglist (fun1) fset (sym newdef) defalias ad-execute-defadvices #[nil "ÀÁÂÃÄ$ˆÅÁÆÇÈBÉB#ˆÀÊËÃÄ$ˆÅÊÆÇÌBÍB#ˆÀÎÏÃÄ$ˆÅÎÆÐÑB#ˆÀÒÓÃÄ$ˆÅÒÆÔÕB#ˆÀÖ×ÃÄ$ˆÅÖÆØÙB#ˆÀÚÛÃÄ$ˆÅÚÆÜÝB#ˆÚ‡" [ad-add-advice defun (ad-definition-hooks nil t (advice lambda nil "Whenever a function gets re/defined with `defun' all hook functions\nin `ad-definition-hooks' will be run after the re/definition with\n`ad-defined-function' bound to the name of the function." (let ((ad-defined-function (ad-get-arg 0))) (run-hooks (quote ad-definition-hooks))))) after first ad-set-advice-info-field cache macro #[(&rest ad-subr-args) "ÀÂà B! @ÆÇ!ˆ)È )D‡" [nil ad-return-value eval ad-Orig-defun ad-subr-args ad-defined-function run-hooks ad-definition-hooks quote] 3 "$ad-doc: defun$"] (nil nil (ad-definition-hooks) special-form t nil) defmacro (ad-definition-hooks nil t (advice lambda nil "Whenever a macro gets re/defined with `defmacro' all hook functions\nin `ad-definition-hooks' will be run after the re/definition with\n`ad-defined-function' bound to the name of the function." (let ((ad-defined-function (ad-get-arg 0))) (run-hooks (quote ad-definition-hooks))))) #[(&rest ad-subr-args) "ÀÂà B! @ÆÇ!ˆ)È )D‡" [nil ad-return-value eval ad-Orig-defmacro ad-subr-args ad-defined-function run-hooks ad-definition-hooks quote] 3 "$ad-doc: defmacro$"] (nil nil (ad-definition-hooks) special-form t nil) fset (ad-definition-hooks nil t (advice lambda nil "Whenever a function gets re/defined with `fset' all hook functions\nin `ad-definition-hooks' will be run after the re/definition with\n`ad-defined-function' bound to the name of the function. This advice was\nmainly created to handle forward-advice for byte-compiled files created\nby jwz's byte-compiler used in Lemacs.\nCAUTION: If you need the primitive `fset' behavior either deactivate\n its advice or use `ad-real-fset' instead!" (let ((ad-defined-function (ad-get-arg 0))) (run-hooks (quote ad-definition-hooks))))) #[(sym newdef) "À \" ÆÇ!ˆ) )‡" [nil ad-return-value ad-Orig-fset sym newdef ad-defined-function run-hooks ad-definition-hooks] 3 "$ad-doc: fset$"] (nil nil (ad-definition-hooks) subr t nil) defalias (ad-definition-hooks nil t (advice lambda nil "Whenever a function gets re/defined with `defalias' all hook functions\nin `ad-definition-hooks' will be run after the re/definition with\n`ad-defined-function' bound to the name of the function. This advice was\nmainly created to handle forward-advice for byte-compiled files created\nby jwz's byte-compiler used in GNU Emacs-19." (let ((ad-defined-function (ad-get-arg 0))) (ad-with-originals (defalias) (run-hooks (quote ad-definition-hooks)))))) #[(sym newdef) "À \" ÆKÈŽÆÉÆÊNžA Ë !…\" K)†(MˆÌÍ!ˆ+ )‡" [nil ad-return-value ad-Orig-defalias sym newdef ad-defined-function defalias ad-oRiGdEf-0 ((byte-code "À M‡" [defalias ad-oRiGdEf-0] 2)) origname ad-advice-info fboundp run-hooks ad-definition-hooks] 4 "$ad-doc: defalias$"] (nil nil (ad-definition-hooks) subr t nil) define-function (ad-definition-hooks nil t (advice lambda nil "Whenever a function gets re/defined with `define-function' all hook\nfunctions in `ad-definition-hooks' will be run after the re/definition with\n`ad-defined-function' bound to the name of the function." (let ((ad-defined-function (ad-get-arg 0))) (ad-with-originals (define-function) (run-hooks (quote ad-definition-hooks)))))) #[(sym newdef) "À \" ÆKÈŽÆÉÆÊNžA Ë !…\" K)†(MˆÌÍ!ˆ+ )‡" [nil ad-return-value ad-Orig-define-function sym newdef ad-defined-function define-function ad-oRiGdEf-0 ((byte-code "À M‡" [define-function ad-oRiGdEf-0] 2)) origname ad-advice-info fboundp run-hooks ad-definition-hooks] 4 "$ad-doc: define-function$"] (nil nil (ad-definition-hooks) subr t nil) 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))))))))) #[(function &optional raw) "À \"‰;ƒ0Å \"ƒ0Ç È”È•#@‰ÉNƒ/Ê ! „/Ë !) )‡" [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] ad-compiled-p boundp byte-constant 192 byte-constant-limit 64 byte-constant2 129 byte-fset 77 ad-byte-code-fset-regexp format "[%s-%s]" char-to-string constant-reference "[-ÿ][-ÿ]" constant2-reference fset-opcode "\\(" "\\|" "\\)" ad-find-fset-in-byte-code #[(code constants start) "À \n #ĉ‰ƒq\n HUƒ/\n T‰H\n T‰HÈ_\\ T‚:\n H Z T\n HUƒY\n T‰H\n T‰HÈ_\\ T‚c\n H Z T\nH\n H E‚rÄ+‡" [string-match ad-byte-code-fset-regexp code start nil code-index name-index byte-constant2 256 byte-constant constants] 5] ad-scan-byte-code-for-fsets #[(ad-code ad-constants) "ÀÁKMˆÂÃć" [byte-code ad-real-byte-code ignore-errors (byte-code "À AA@#‰ƒ2 @9ƒÅ @!ƒ @K A@=ƒ @ÇÈ!ˆ)‚ÉÊKM)‡" [(0 0 0) fset-args ad-find-fset-in-byte-code ad-code ad-constants fboundp ad-defined-function run-hooks ad-definition-hooks byte-code ad-advised-byte-code] 4) ((error))] 3]] 11) (defalias 'ad-advised-byte-code-definition #[(ad-cOdE ad-cOnStAnTs ad-dEpTh) "À \n # ƒÅ \n\"ˆ‡" [ad-real-byte-code ad-cOdE ad-cOnStAnTs ad-dEpTh load-in-progress ad-scan-byte-code-for-fsets] 4 "\ Modified version of `byte-code' subr used by the advice package. `byte-code' has been modified to allow automatic activation of forward advice for functions that are defined in byte-compiled files generated by jwz's byte-compiler (as standardly used in v19s). See `ad-real-byte-code' for original documentation."]) (byte-code "ÀÁ!ˆÂÁKM‡" [ad-real-byte-codify ad-advised-byte-code-definition ad-advised-byte-code] 2) (defalias 'ad-recover-byte-code #[nil "ÀÁKM‡" [byte-code ad-real-byte-code] 2 "\ Recovers the real `byte-code' functionality." nil]) (byte-code "ÀÁ!ˆÂÃ!„ ÂÅ!„À‡" [ad-real-byte-codify ad-recover-byte-code boundp ad-orig-max-lisp-eval-depth max-lisp-eval-depth ad-orig-max-specpdl-size max-specpdl-size] 2) (defalias 'ad-adjust-stack-sizes #[(&optional reset) "ƒ\n  ‰‡ Å_ \nÆ¥Å_\\‰‡" [reset ad-orig-max-lisp-eval-depth max-lisp-eval-depth ad-orig-max-specpdl-size max-specpdl-size 3 5] 3 "\ Increases stack sizes for the advised `byte-code' function. When called with a prefix argument the stack sizes will be reset to their original values. Calling this function should only be necessary if you get stack overflows because you run highly recursive v18 compiled code in a v19 Emacs with definition hooks enabled." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÃ!‡" [defalias ad-enable-definition-hooks #[nil "ÀÁ‰ƒ @Ä\nÅÆ#ˆÇ\nÈ\"ˆ A‰„* …8ÊË!ˆÊÌ!ˆÍËKMˆ?…8Ï ‡" [(defun defmacro fset defalias define-function) nil definer ad-dO-vAr ad-enable-advice after ad-definition-hooks ad-activate compile ad-use-jwz-byte-compiler ad-real-byte-codify ad-advised-byte-code ad-scan-byte-code-for-fsets byte-code ad-emacs19-p ad-adjust-stack-sizes] 5] ad-disable-definition-hooks #[nil "À ˆÁ‰ƒ @Å ÆÇ#ˆÈ !ˆ A‰„ * ?…)ÊË!‡" [ad-recover-byte-code (defun defmacro fset defalias define-function) nil definer ad-dO-vAr ad-disable-advice after ad-definition-hooks ad-update ad-emacs19-p ad-adjust-stack-sizes reset] 5] ad-real-byte-codify] 3) (defalias 'ad-start-advice #[nil "ÀÁÂÃ#ˆÄÁÅ\"ˆ„ƒÇ ˆ‚È ˆƒ6É\n>ƒ/\n‚;É\nB‚;ËÉ\n\"‰\n‡" [ad-enable-advice documentation after ad-advised-docstring ad-activate compile ad-activate-on-definition ad-enable-definition-hooks ad-disable-definition-hooks ad-activate-defined-function ad-definition-hooks delq] 4 "\ Redefines some primitives to start the advice magic. If `ad-activate-on-definition' is t then advice information will automatically get activated whenever an advised function gets defined or redefined. This will enable goodies such as forward advice and automatically enable function definition hooks. If its value is nil but the value of `ad-enable-definition-hooks' is t then definition hooks will be enabled without having automatic advice activation, otherwise function definition hooks will be disabled too. If definition hooks are enabled then functions stored in `ad-definition-hooks' are run whenever a function gets defined or redefined." nil]) (defalias 'ad-stop-advice #[nil "À ˆÁÂÃÄ#ˆÅÂ!ˆÆ ˆÇÈ \"‰ ‡" [ad-recover-byte-code ad-disable-advice documentation after ad-advised-docstring ad-update ad-disable-definition-hooks delq ad-activate-defined-function ad-definition-hooks] 4 "\ Undefines some primitives to stop the advice magic. This can also be used to recover from advice related emergencies." nil]) (ad-real-byte-codify (quote ad-stop-advice)) (defalias 'ad-recover-normality #[nil "À ˆÁ ˆÂ‰‡" [ad-recover-byte-code ad-recover-all nil ad-advised-functions] 2 "\ Undoes all advice related redefinitions and unadvises everything. Use only in REAL emergencies." nil]) (byte-code "ÀÁ!ˆ\nƒÃÄK!ƒÅ ˆÆÇ!‡" [ad-real-byte-codify ad-recover-normality ad-start-advice-on-load ad-compiled-p ad-execute-defadvices ad-start-advice provide advice] 2) emacs-19.22/lisp/allout.elc100666 13437 1 164072 5416157425 14262 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:10:28 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/allout.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (provide (quote outline)) (defvar outline-header-prefix "." "\ * Leading string for greater than level 0 topic headers.") (make-variable-buffer-local (quote outline-header-prefix)) (defvar outline-header-subtraction (byte-code "GS‡" [outline-header-prefix] 1) "\ * Leading string for greater than level 0 topic headers.") (byte-code "ÀÁ!ˆÂÃ!„ ÄÀÃ!‡" [make-variable-buffer-local outline-header-subtraction boundp outline-primary-bullet "*"] 2) (defvar outline-plain-bullets-string "" "\ * 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, ']', among any bullets. You must run 'set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation.") (byte-code "ÁPÃÂ!‡" [outline-primary-bullet "+-:.;," outline-plain-bullets-string make-variable-buffer-local] 2) (defvar outline-distinctive-bullets-string "" "\ * The bullets used for distinguishing outline topics. These bullets are not offered among the regular rotation, and are not changed when automatically rebulleting, as when shifting the level of a topic. See 'outline-plain-bullets-string' for the other kind of bullets. DO NOT include the close-square-bracket, ']', among any bullets. You must run 'set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation.") (byte-code "ÀÂÁ!‡" ["=>([{}&!?#%\"X@$~" outline-distinctive-bullets-string make-variable-buffer-local] 2) (defvar outline-numbered-bullet nil "\ * Bullet signifying outline prefixes which are to be numbered. Leave it nil if you don't want any numbering, or set it to a string with the bullet you want to be used.") (byte-code "ÀÂÁ!‡" ["#" outline-numbered-bullet make-variable-buffer-local] 2) (defvar outline-file-xref-bullet "@" "\ * 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-stylish-prefixes t "\ *A true value for this var makes the topic-prefix creation and modification functions vary the prefix bullet char according to level. Otherwise, only asterisks ('*') and distinctive bullets are used. This is how an outline can look with stylish prefixes: * Top level .* A topic . + One level 3 subtopic . . One level 4 subtopic . + Another level 3 subtopic . . A level 4 subtopic . #2 A distinguished, numbered level 4 subtopic . ! A distinguished ('!') level 4 subtopic . #4 Another numbered level 4 subtopic This would be an outline with stylish prefixes inhibited: * Top level .* A topic .! A distinctive (but measly) subtopic . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*' 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 t.") (make-variable-buffer-local (quote outline-stylish-prefixes)) (defvar outline-old-style-prefixes nil "\ *Setting this var causes the topic-prefix creation and modification functions to make only asterix-padded prefixes, so they look exactly like the old style prefixes. Both old and new style prefixes are always respected by the topic maneuvering functions.") (make-variable-buffer-local (quote outline-old-style-prefixes)) (defvar outline-enwrap-isearch-mode "isearch-mode.el" "\ * Set this var to the name of the (non-compiled) elisp code for isearch-mode, if you have Dan LaLiberte's 'isearch-mode' stuff and want isearches to reveal hidden stuff encountered in the course of a search, and reconceal it if you go past. Set it nil if you don't have the package, or don't want to use this feature.") (defvar outline-use-hanging-indents t "\ * Set this var non-nil if you have Kyle E Jones' filladapt stuff, and you want outline to fill topics as hanging indents to the bullets.") (make-variable-buffer-local (quote outline-use-hanging-indents)) (defvar outline-reindent-bodies t "\ * Set this var non-nil if you want topic depth adjustments to reindent hanging bodies (ie, bodies lines indented to beginning of heading text). The performance hit is small. Avoid this strenuously when using outline mode on program code. It's great for text, though.") (make-variable-buffer-local (quote outline-reindent-bodies)) (defvar outline-mode-keys nil "\ Assoc list of outline-mode-keybindings, for common reference in setting up major and minor-mode keybindings.") (byte-code "À‡" [(("" 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-current-children) ("" outline-show-current-subtree) ("" outline-hide-current-subtree) ("" outline-show-current-entry) ("!" outline-show-all) (" " open-sibtopic) ("." open-subtopic) ("," open-supertopic) ("'" outline-shift-in) (">" outline-shift-in) ("<" outline-shift-out) (" " outline-rebullet-topic) ("b" outline-rebullet-current-heading) ("#" outline-number-siblings) (" " outline-kill-line) ("" outline-yank) ("ù" outline-yank-pop) (" " outline-kill-topic) ("@" outline-resolve-xref) ("c" outline-copy-exposed)) outline-mode-keys nil] 1) (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 (quote outline-regexp)) (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 composed from the elements of 'outline-plain-bullets-string' and 'outline-distinctive-bullets-string'.") (make-variable-buffer-local (quote outline-bullets-string)) (defvar outline-line-boundary-regexp nil "\ 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 (quote outline-line-boundary-regexp)) (defvar outline-bob-regexp nil "\ Like outline-line-boundary-regexp, this is an outline-regexp for outline headers at the beginning of the buffer. (match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local (quote outline-line-bob-regexp)) (defalias 'outline-reset-header-lead #[(header-lead) "‰GSà ‡" [header-lead outline-header-prefix outline-header-subtraction set-outline-regexp] 2 "\ * Reset the leading string used to identify topic headers." "sNew lead 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 "\ * Set the topic-header leading string to specified string. Useful when for encapsulating outline structure in programming language comments. Returns the leading string." "P"]) (defalias 'set-outline-regexp #[nil "ÀÂÃDĉ‰‰‰ ‰\nƒhÀË\n@J‰ GWƒ_ H  Í=ƒC΂T Ï=ƒNÀ‚TÐÑ !!PT‰‚*\nA‰\n„.\nGGSÕÖ ×Ù°ÛÜQÞÜQ‰‡" ["" outline-bullets-string outline-plain-bullets-string outline-distinctive-bullets-string nil new-string index cur-char-string cur-len cur-string strings 0 cur-char 45 "--" 93 regexp-quote char-to-string outline-plain-bullets-string-len outline-header-prefix outline-header-subtraction "\\(\\" "[ ]*[" "]\\)\\|\\" outline-primary-bullet "+\\| " outline-regexp "\\([\n ]\\)\\(" "\\)" outline-line-boundary-regexp "\\(\\`\\)\\(" outline-bob-regexp] 8 "\ Generate proper topic-header regexp form for outline functions, from outline-plain-bullets-string and outline-distinctive-bullets-string." nil]) (defvar outline-mode-map nil "\ ") (byte-code "„9Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÁ‡" [outline-mode-map make-sparse-keymap text-mode-map 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] 4) (defvar outline-minor-mode nil "\ Non-nil if using Outline mode as a minor mode of some other mode.") (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÇC\"ÈÉ!„Ê  „/Ë  Ì ÍÎÍ\"#ˆÁž„?Á BBʇ" [make-variable-buffer-local outline-minor-mode put permanent-local t append minor-mode-alist (outline-minor-mode " Outl") boundp outline-minor-mode-map nil make-sparse-keymap define-key "" lookup-key outline-mode-map minor-mode-map-alist] 6) (defalias 'outline-minor-mode #[(&optional arg) "„ ?‚Â!ÃV‰ƒÄÆÇ!‡È‰‡" [arg outline-minor-mode prefix-numeric-value 0 t selective-display run-hooks outline-minor-mode-hook nil] 3 "\ 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." "P"]) (defalias 'minor-bind-keys #[(keys-assoc) "À †Á ‰‰‰ƒK@@ @A@Ê !‰9„/Â Ê ! E BË #ˆA‰„Ì!ˆ -‡" [current-local-map make-sparse-keymap nil prevailing-func unbinding-registry new-func key local-map keys-assoc curr-key local-key-binding define-key use-local-map] 6 "\ Establish BINDINGS assoc list in current buffer, returning a list for subsequent use by minor-unbind-keys to resume overloaded local bindings." nil]) (defalias 'minor-relinquish-keys #[(unbinding-registry) "À‰‰‰‰ƒG@‰@ A@ AA@Ç ! šƒ:\nƒ3È \n\"ˆ‚>É !ˆ‚> BA‰„ -‡" [nil curr-relinquish curr-resume curr-key curr-item residue unbinding-registry local-key-binding local-set-key local-unset-key] 6 "\ Given registry of MODAL-BINDINGS, as produced by minor-bind-keys, resume the former local keybindings of those keys that retain the local bindings set by minor-bind-keys. Changed local bindings are left alone, so other minor (user or modal) bindings are not disrupted. Returns a list of those registrations which were not, because of tampering subsequent to the registration by minor-bind-keys, resumed." nil]) (defvar outline-minor-prior-keys nil "\ Former key bindings assoc-list, for resumption from outline minor-mode.") (make-variable-buffer-local (quote outline-minor-prior-keys)) (defalias 'outline-minor-bind-keys #[nil "À !‰‡" [minor-bind-keys outline-mode-keys outline-minor-prior-keys] 2 "\ Establish outline-mode keybindings as MINOR modality of current buffer."]) (defalias 'outline-minor-relinquish-keys #[nil "À !‡" [minor-relinquish-keys outline-minor-prior-keys] 2 "\ Resurrect local keybindings as they were before outline-minor-bind-keys."]) (defvar outline-mode-prior-settings nil "\ For internal use by outline mode, registers settings to be resumed on mode deactivation.") (make-variable-buffer-local (quote outline-mode-prior-settings)) (defalias 'outline-resumptions #[(name &optional value) " žÂ ƒ# „Æ!…JCD B @L‚^ ??…^ A@‰ƒ9 @Lˆ‚=Ç!ˆÂ ƒY @ =„R @B A‰„D‰)*‡" [name outline-mode-prior-settings nil prior-capsule on-list value boundp makunbound rebuild] 4 "\ Registers information for later reference, or performs resumption of outline-mode specific values. First arg is NAME of variable affected. optional second arg is list containing outline-mode-specific VALUE to be impose 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."]) (defvar outline-mode nil "\ Allout outline mode minor-mode flag.") (make-variable-buffer-local (quote outline-mode)) (defalias 'outline-mode #[(&optional toggle) "ÀÁ!…  … <ƒ @† ‰…+ 9†+Ä !…+ ÅU?‰„R\n„9 ƒRÇ ˆÈÉ!ˆÈÊ!ˆÈË!ˆÈÌ!ˆÍ‰‚Á\n?…ÁÎ ˆÈÉÏ\"ˆÈÊÐ\"ˆÁž„qÒBÓ ˆÔË!ˆÈË Õ×RC\"ˆÔÌ!ˆÈÌ Õ×RC\"ˆƒœÙ ˆƒºÀÛ!ƒºÜÝQÞBBBàá!ˆâ‰+‡" [boundp outline-mode active toggle natnump 0 explicit-activation outline-minor-relinquish-keys outline-resumptions selective-display indent-tabs-mode paragraph-start paragraph-separate nil outline-minor-bind-keys (t) (nil) minor-mode-alist (outline-mode " Outline") set-outline-regexp make-local-variable "\\|^\\(" outline-regexp "\\)" outline-enwrap-isearch-mode outline-enwrap-isearch outline-use-hanging-indents filladapt-prefix-table "\\(" "\\) " filladapt-hanging-list filladapt-hanging-list-prefixes run-hooks outline-mode-hook t] 7 "\ Set minor mode for editing outlines with selective display. Look below the description of the bindings for explanation of the terminology use in outline-mode commands. (Note - this is not a proper minor mode, because it does affect key bindings. It's not too improper, however, because it does resurrect any bindings which have not been tampered with since it changed them.) Exposure Commands Movement Commands C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading C-c C-i outline-show-current-children C-c C-p outline-previous-visible-heading C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level C-c ! outline-show-all C-c C-b outline-backward-current-level outline-hide-current-leaves C-c C-e outline-end-of-current-entry C-c C-a outline-beginning-of-current-entry Topic Header Generation Commands C-c open-sibtopic Create a new sibling after current topic C-c . open-subtopic ... an offspring of current topic C-c , open-supertopic ... a sibling of the current topic's parent Level and Prefix Adjustment Commands 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, all others set suitable according to depth C-c b 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. Killing and Yanking - all keep siblings numbering reconciled as appropriate C-k outline-kill-line Regular kill line, but respects numbering ,etc C-c C-k outline-kill-topic Kill current topic, including offspring 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 outline sans all hidden stuff to another buffer whose name is derived from the current one - \"XXX exposed\" M-x outlinify-sticky Activate outline mode for current buffer and establish -*- outline -*- mode specifier as well as file local vars to automatically set exposure. Try it. Terminology Topic: A basic cohesive component of an emacs outline, which can be closed (made hidden), opened (revealed), generated, traversed, and shifted as units, using outline-mode functions. A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below). Exposure: Hidden (~closed~) topics are represented by ellipses ('...') at the end of the visible SUPERTOPIC which contains them, rather than by their actual text. Hidden topics are still susceptible to editing and regular movement functions, they just are not displayed normally, effectively collapsed into the ellipses which represent them. Outline mode provides the means to selectively expose topics based on their NESTING. SUBTOPICS of a topic can be hidden and subsequently revealed based on their DEPTH relative to the supertopic from which the exposure is being done. The BODIES of a topic do not generally become visible except during exposure of entire subtrees (see documentation for '-current-subtree'), or when the entry is explicitly exposed with the 'outline-show-entry' function, or (if you have a special version of isearch installed) when encountered by incremental searches. The CURRENT topic is the more recent visible one before or including the text cursor. Header: The initial portion of an outline topic. It is composed of a topic header PREFIX at the beginning of the line, followed by text to the end of the EFFECTIVE LINE. Body: Any subsequent lines of text following a topic header and preceding the next one. This is also referred to as the entry for a topic. Prefix: The text which distinguishes topic headers from normal text lines. There are two forms, both of which start at the beginning of the topic header (EFFECTIVE) line. The length of the prefix represents the DEPTH of the topic. The fundamental sort begins either with solely an asterisk ('*') or else dot ('.') followed by zero or more spaces and then an outline BULLET. [Note - you can now designate your own, arbitrary HEADER-LEAD string, by setting the variable 'outline-header-prefix'.] The second form is for backwards compatibility with the original emacs outline mode, and consists solely of asterisks. Both sorts are recognized by all outline commands. The first sort is generated by outline topic production commands if the emacs variable outline-old-style-prefixes is nil, otherwise the second style is used. Bullet: An outline prefix bullet is one of the characters on either of the outline bullet string vars, 'outline-plain-bullets-string' and 'outline-distinctive-bullets-string'. (See their documentation for more details.) The default choice of bullet for any prefix depends on the DEPTH of the topic. Depth and Nesting: The length of a topic header prefix, from the initial character to the bullet (inclusive), represents the depth of the topic. A topic is considered to contain the subsequent topics of greater depth up to the next topic of the same depth, and the contained topics are recursively considered to be nested within all containing topics. Contained topics are called subtopics. Immediate subtopics are called 'children'. Containing topics are supertopicsimmediate supertopics are 'parents'. Contained topics of the same depth are called siblings. Effective line: The regular ascii text in which form outlines are saved are manipulated in outline-mode to engage emacs' selective-display faculty. The upshot is that the effective end of an outline line can be terminated by either a normal Unix newline char, , or the special outline-mode eol, ^M. This only matters at the user level when you're doing searches which key on the end of line character." "P"]) (defvar outline-recent-prefix-beginning 0 "\ Buffer point of the start of the last topic prefix encountered.") (make-variable-buffer-local (quote outline-recent-prefix-beginning)) (defvar outline-recent-prefix-end 0 "\ Buffer point of the end of the last topic prefix encountered.") (make-variable-buffer-local (quote outline-recent-prefix-end)) (defalias 'outline-flag-region #[(from to flag) "À ÆUƒÇ‚Æ È%)‡" [nil buffer-read-only subst-char-in-region from to flag 10 13 t] 6 "\ Hides or shows lines from FROM to TO, according to FLAG. Uses emacs selective-display, where text is show if FLAG put at beginning of line is `\\n' (newline character), while text is hidden if FLAG is `\\^M' (control-M). returns nil iff no changes were effected."]) (defalias (quote outline-flag-current-subtree) #[(flag) "ŠÀ ˆÁ` ˆ` #)‡" [outline-back-to-current-heading outline-flag-region outline-end-of-current-subtree flag] 4]) (defalias 'outline-hide-current-entry #[nil "À ˆŠÁ` ˆ`Ã#)‡" [outline-back-to-current-heading outline-flag-region outline-end-of-current-entry 13] 4 "\ Hide the body directly following this heading." nil]) (defalias 'outline-show-current-entry #[(&optional arg) "ƒÁ ‡ŠÂ`à ˆ`Ä#)‡" [arg outline-hide-current-entry outline-flag-region outline-end-of-current-entry 10] 4 "\ Show body directly following this heading, or hide it if repeat count." "P"]) (defalias 'outline-show-entry #[nil "ŠÀ ˆÁo„`S‚` ˆ`Ã#)‡" [outline-goto-prefix outline-flag-region outline-pre-next-preface 10] 4 "\ Like outline-show-current-entry, but reveals an entry that is nested within hidden topics." nil]) (defalias 'outline-hide-current-entry-completely #[nil "ŠÀ ˆÁo„`S‚` ˆÃÄ!ƒ`‚`SÅ#)‡" [outline-goto-prefix outline-flag-region outline-pre-next-preface looking-at " " 13] 4 "\ Like outline-hide-current-entry, but conceal topic completely." nil]) (defalias 'outline-show-current-subtree #[nil "ÀÁ!‡" [outline-flag-current-subtree 10] 2 "\ Show everything after this heading at deeper levels." nil]) (defalias 'outline-hide-current-subtree #[(&optional just-close) "ŠÀˆÁ ˆÀˆ`)ÃÄ!ˆ\nŠ\nbˆÀˆ`)U…- ?…-ÆÇÈ\"…-É )‡" [nil outline-goto-prefix orig-eol outline-flag-current-subtree 13 just-close outline-up-current-level 1 t outline-hide-current-subtree] 3 "\ Hide everything after this heading at deeper levels, or if it's already closed, and optional arg JUST-CLOSE is nil, hide the current level." nil]) (defalias 'outline-show-current-branches #[nil "ÀÁ!‡" [outline-show-current-children 1000] 2 "\ Show all subheadings of this heading, but not their bodies." nil]) (defalias 'outline-hide-current-leaves #[nil "À ˆÁ` ˆ`\"‡" [outline-back-to-current-heading outline-hide-region-body outline-end-of-current-subtree] 3 "\ Hide all body after this heading at deeper levels." nil]) (defalias 'outline-show-current-children #[(&optional level) "„ÁŠŒÂyˆà ˆÄ \\`Å ˆ`T}ˆebˆm?…KÆ …KÄ XƒŠ`TÈuˆhÉ>ƒ@ÈuˆÊ`Ë#ˆ*‚*‡" [level 1 0 outline-back-to-current-heading outline-recent-depth outline-end-of-current-subtree outline-next-heading end -1 (10 13) outline-flag-region 10] 4 "\ Show all direct subheadings of this heading. Optional LEVEL specifies how many levels below the current level should be shown." "p"]) (defalias 'outline-show-all #[nil "ÀedÁ#‡" [outline-flag-region 10] 4 "\ Show all of the text in the buffer." nil]) (defalias 'outline-hide-bodies #[nil "Àed\"‡" [outline-hide-region-body] 3 "\ Hide all of buffer except headings." nil]) (defalias 'outline-hide-region-body #[(start end) "ŠŒ }ˆebˆm?…+Â`à ˆ`Ä#ˆm„ ÅÆ!ƒ%Ç‚&Èuˆ‚ *‡" [start end outline-flag-region outline-pre-next-preface 13 looking-at "[\n ][\n ]" 2 1] 4 "\ Hide all body lines in the region, but not headings."]) (defalias 'outline-expose #[(spec &rest followers) "ŠÀ ˆ`Á ƒz 9ƒ& Å=ƒÆ ˆ Ç=ƒzÈ ˆ‚z §ƒK ÉUƒ8ÊË!ˆ‚zÉ VƒDÊ ˆ [Ì !ˆ‚z <ƒzÍ @!ˆÎÏ Ð\\!ƒzÑ „z A‰ƒz\n„zÍ @!ˆÒ ?‚c+…•Ò …•Í@!ˆA‰„€Á‡" [outline-goto-prefix nil done start-point spec * outline-show-current-subtree + outline-show-current-branches 0 outline-hide-current-subtree t outline-show-current-children outline-expose outline-descend-to-depth outline-current-depth 1 outline-hidden-p outline-next-sibling followers] 4 "\ Dictate wholesale exposure scheme for current topic, according to SPEC. SPEC is either a number or a list of specs. Optional successive args dictate exposure for subsequent siblings of current topic. Numbers, the symbols '*' and '+', and the null list dictate different exposure depths for the corresponding topic. Numbers indicate the depth to open, with negative numbers first forcing a close, and then opening to their absolute value. Positive numbers jsut reopen, and 0 just closes. '*' completely opens the topic, including bodies, and '+' shows all the sub headers, but not the bodies. 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, as the SPEC as a whole does for the parent topic. Optional FOLLOWER elements dictate exposure for subsequent siblings of the parent topic." "xExposure spec: "]) (defalias 'outline-exposure '(macro . #[(&rest spec) "ÀÁ \"B‡" [outline-expose mapcar #[(x) "À D‡" [quote x] 2] spec] 4 "\ Literal frontend for 'outline-expose', passes arguments unevaluated, so you needn't quote them."])) (defalias 'outline-recent-depth #[nil "À \nZ Z]‡" [1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction] 3 "\ 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-prefix #[nil " {‡" [outline-recent-prefix-beginning outline-recent-prefix-end] 2 "\ 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-bullet #[nil "S{‡" [outline-recent-prefix-end] 2 "\ 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-on-current-heading-p #[nil "ŠÀyˆÁ\n!…À•À”‰)‡" [0 looking-at outline-regexp outline-recent-prefix-end outline-recent-prefix-beginning] 2 "\ Return prefix beginning point if point is on same line as current visible topic's header line."]) (defalias 'outline-hidden-p #[nil "ŠÀÁeÂ#… ÃÄ!)‡" [re-search-backward "[\n ]" t looking-at " "] 4 "\ True if point is in hidden text." nil]) (defalias 'outline-current-depth #[nil "ŠÀ ƒÁ\n Z Z]‚Å)‡" [outline-back-to-current-heading 1 outline-recent-prefix-end outline-recent-prefix-beginning outline-header-subtraction 0] 3 "\ Return the depth to which the current containing visible topic is nested in the outline."]) (defalias 'outline-depth #[nil "ŠÀ ƒ Á ‚``Ä)‡" [outline-goto-prefix outline-recent-depth outline-recent-prefix-end outline-recent-prefix-beginning 0] 1 "\ Like outline-current-depth, but respects hidden as well as visible topics."]) (defalias 'outline-get-current-prefix #[nil "ŠÀ …Á )‡" [outline-goto-prefix outline-recent-prefix] 1 "\ Topic prefix of the current topic."]) (defalias 'outline-get-bullet #[nil "ŠÀ …Á )‡" [outline-goto-prefix outline-recent-bullet] 1 "\ Return bullet of containing topic (visible or not)."]) (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 "\ Return bullet of current (visible) topic heading, or none if none found."]) (defalias 'outline-get-prefix-bullet #[(prefix) "À \n\"…\nÕSÕO‡" [string-match outline-regexp prefix 0] 3 "\ Return the bullet of the header prefix string PREFIX."]) (defalias 'outline-goto-prefix #[nil "ŠÀyˆo)„hÁ>ƒ !ƒÀ•À”b‰‡ÆÈÉ#ƒ0Ê•Ê”b‰‡Â !…>À•À”b‰‡" [0 (10 13) looking-at outline-regexp outline-recent-prefix-end outline-recent-prefix-beginning re-search-backward outline-line-boundary-regexp nil 1 2] 4 "\ Put point at beginning of outline prefix for current topic, visible or not. Returns a list of char address of the beginning of the prefix and the end of it, or nil if none."]) (defalias 'outline-end-of-prefix #[nil "À ??….Á •bˆÃÄ!ƒÅuˆ‚l„'ÃÆ!ƒ'ÅuˆÇ !ˆ)È ‡" [outline-goto-prefix match-data 0 looking-at "[0-9]" 1 "\\s-" store-match-data outline-current-depth] 2 "\ Position cursor at beginning of header text."]) (defalias 'outline-back-to-current-heading #[nil "ÀyˆÁ †Âà Å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 "\ Move to heading line of current visible topic, or beginning of heading if already on visible heading line."]) (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 "\ Skip forward to just before the next heading line. Returns that character position."]) (defalias 'outline-end-of-current-subtree #[nil "À ˆ`Á Ä ˆm„Á \nVƒÄ ˆ‚ m„#ÅuˆhÆ>…+Åu*‡" [outline-back-to-current-heading outline-recent-depth level opoint outline-next-heading -1 (10 13)] 2 "\ Put point at the end of the last leaf in the currently visible topic." nil]) (defalias 'outline-beginning-of-current-entry #[nil "À ‡" [outline-end-of-prefix] 1 "\ Position the point at the beginning of the body of the current topic." nil]) (defalias 'outline-end-of-current-entry #[nil "À ˆÁ o„ÂÃ!ƒÄuˆ‡" [outline-show-entry outline-pre-next-preface looking-at "^$" -1] 3 "\ Position the point at the end of the current topic's entry." nil]) (defalias 'outline-ascend-to-depth #[(depth) "ÁVƒ; Xƒ;` Wƒ&`‰ƒ&Ä ƒ&Å „Æ Uƒ5bˆ‚9 bˆÈ)‡t…AÉ ‡" [depth 0 outline-depth last-good outline-beginning-of-level outline-previous-heading outline-recent-depth outline-recent-prefix-beginning nil outline-end-of-prefix] 2 "\ Ascend to depth DEPTH, returning depth if successful, nil if not."]) (defalias 'outline-descend-to-depth #[(depth) "`À À ÃVƒ Å U„Æ ƒ Å W„À ÃVƒ1Å Uƒ1 ‚5\nbˆÇ*‡" [outline-depth start-depth start-point 0 depth outline-recent-depth outline-next-heading nil] 2 "\ Descend to depth DEPTH within current topic, returning depth if successful, nil if not."]) (defalias 'outline-up-current-level #[(arg &optional dont-complain) "À ˆÁ Á ÃVƒ. ÅVƒ.o„.Á \nW„$ÆÃ!„Ç  ÃZ‚) ÅXƒ:‚JtƒAÉ ˆ\n?…JËÌ!tƒQÉ ˆ‡" [outline-back-to-current-heading outline-recent-depth present-level 1 arg 0 outline-previous-visible-heading outline-current-depth outline-recent-prefix-beginning outline-end-of-prefix dont-complain error "Can't ascend past outermost level."] 2 "\ Move to the heading line of which the present line is a subheading. With argument, move up ARG levels. Don't return an error if second, optional argument DONT-COMPLAIN, is non-nil." "p"]) (defalias 'outline-next-visible-heading #[(arg) "ÁWƒ Áyˆ‚ˆÃÄ ÆQÂÇ$…'È ˆÉ•\nÉ”‰ ‡" [arg 0 nil re-search-forward "^\\(" outline-regexp "\\)" go outline-end-of-prefix 1 outline-recent-prefix-end outline-recent-prefix-beginning] 5 "\ Move to the next visible heading line. With argument, repeats, backward if negative." "p"]) (defalias 'outline-previous-visible-heading #[(arg) "À [!‡" [outline-next-visible-heading arg] 2 "\ 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)." "p"]) (defalias 'outline-next-heading #[(&optional backward) "…o?…MƒÁ ˆ‚oƒm„Âuˆƒ1à ÅÆ#„9Ç!‚6É ÅÆ#…MÊ•†@  Ê”†I ‰ b‡" [backward outline-goto-prefix 1 re-search-backward outline-line-boundary-regexp nil 0 looking-at outline-bob-regexp re-search-forward 2 outline-recent-prefix-end outline-recent-prefix-beginning] 4 "\ Move to the heading for the topic (possibly invisible) before this one. Optional arg BACKWARD means search for most recent prior heading. Returns the location of the heading, or nil if none found."]) (defalias 'outline-previous-heading #[nil "ÀÁ!‡" [outline-next-heading t] 2 "\ Move to the next (possibly invisible) heading line. Optional repeat-count arg means go that number of headings. Return the location of the beginning of the heading, or nil if not found."]) (defalias 'outline-next-sibling #[(&optional backward) "…o?…MÁ `ƒo‚m„1ƒ%Æ ‚'Ç ƒ1È V„m„HÁ ÉVƒHÈ UƒH\n‚L bˆÂ+‡" [backward outline-depth nil last-good start-point start-depth outline-previous-heading outline-next-heading outline-recent-depth 0 outline-recent-prefix-beginning] 3 "\ Like outline-forward-current-level, but respects invisible topics. Go backward if optional arg BACKWARD is non-nil. Return depth if successful, nil otherwise."]) (defalias 'outline-previous-sibling #[(&optional arg) "ÀÁ!‡" [outline-next-sibling t] 2 "\ Like outline-forward-current-level, but goes backwards and respects invisible topics. Optional repeat count means go number backward. Note that the beginning of a level is (currently) defined by this implementation to be the first of previous successor topics of equal or greater depth. Return depth if successful, nil otherwise."]) (defalias 'outline-beginning-of-level #[nil "ÀÁ!‡" [outline-end-of-level backward] 2 "\ Go back to the first sibling at this level, visible or not."]) (defalias 'outline-end-of-level #[(&optional backward) "À „Á tƒ ˆ‡" [outline-previous-sibling outline-recent-depth outline-end-of-prefix] 2 "\ Go to the last sibling at this level, visible or not."]) (defalias 'outline-forward-current-level #[(arg &optional backward) "À ˆ ƒ ÂWƒ ?Ä !‚ ‚ʼnÂVƒ2Ç !ƒ2S‰‚tƒ9È ˆÂVƒQÉÊ ƒJË‚KÌÍ #‚RÎ)‡" [outline-back-to-current-heading arg 0 backward abs 1 amt outline-next-sibling outline-end-of-prefix error "This is the %s topic on level %d." "first" "last" outline-current-depth t] 5 "\ Position the point at the next heading of the same level, taking optional repeat-count. Returns that position, else nil if is not found." "p"]) (defalias 'outline-backward-current-level #[(arg) "ÀŽÁ\nÃ\")‡" [((outline-end-of-prefix)) outline-forward-current-level arg t] 3 "\ Position the point at the previous heading of the same level, taking optional repeat-count. Returns that position, else nil if is not found." "p"]) (defvar outline-search-reconceal nil "\ Used for outline isearch provisions, to 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.") (defconst outline-search-quitting nil "\ Variable used by isearch-terminate/outline-provisions and isearch-done/outline-provisions to distinguish between a conclusion and cancellation of a search.") (defalias 'outline-enwrap-isearch #[nil "?†ÁÂ!?…RÁÃ!ƒÁÄ!„ÅÆÇ…RÂÁÈ!ƒ+ÈK†3ÁÉ!…3ÉKMˆÈÊMˆÉÊMˆËÌKMˆÌÍMˆÎÏKMˆÏÐMˆÑÒ!‡" [outline-enwrap-isearch-mode fboundp real-isearch-terminate isearch-mode isearch-quote-char error (load-library outline-enwrap-isearch-mode) ((file-error (byte-code "ÀÁ\nA@\nAA@#ˆÃÄ!ˆÅ‰‡" [message "Skipping isearch-mode provisions - %s '%s'" error sit-for 1 nil outline-enwrap-isearch-mode] 4))) isearch-quit isearch-abort isearch-terminate/outline-provisions real-isearch-done isearch-done isearch-done/outline-provisions real-isearch-update isearch-update isearch-update/outline-provisions make-variable-buffer-local outline-search-reconceal] 3 "\ Impose isearch-mode wrappers so isearch progressively exposes and reconceals hidden topics when working in outline mode, but works elsewhere. The function checks to ensure that the rebindings are done only once."]) (defalias 'outline-isearch-arrival-business #[nil "ÀÁ!…- …- …*ŠÃ ÅÆ#ƒÆuˆÂ ƒ$`‚&`CÇ ˆ)‰‡" [boundp outline-mode outline-hidden-p re-search-backward outline-line-boundary-regexp nil 1 outline-show-entry outline-search-reconceal] 4 "\ Do outline business like exposing current point, if necessary, registering 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."]) (defalias 'outline-isearch-advancing-business #[nil "ÀÁ!…# …#\n…#Š\n<ƒ\n@bˆÃ ‚\"\nbˆÄ )‡" [boundp outline-mode outline-search-reconceal outline-hide-current-entry outline-hide-current-entry-completely] 2 "\ Do outline business like deexposing current point, if necessary, according to reconceal state registration."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias isearch-terminate/outline-provisions #[nil "ÀÁ!ƒ ƒ\nƒà ˆÄÅÈ *‡" [boundp outline-mode outline-enwrap-isearch-mode outline-isearch-advancing-business t nil outline-search-reconceal outline-search-quitting real-isearch-terminate] 2 nil nil] isearch-done/outline-provisions #[(&optional nopush) "ÀÁ!ƒI ƒI\nƒIŠ ƒ7 <„7ÄÅ!ˆÆÇ!ˆÈÉ S!ˆÊ ƒ1Ë ˆ‚&Ë ˆÌ ˆÍ ˆ)ÀÎ!ƒF„IË ˆƒSÐ!‡Ð ‡" [boundp outline-mode outline-enwrap-isearch-mode outline-search-reconceal message "(exposing destination)" sit-for 0 outline-ascend-to-depth outline-current-depth outline-hidden-p outline-show-current-children outline-show-current-entry outline-isearch-arrival-business outline-search-quitting nopush real-isearch-done] 2 nil nil]] 3) (defalias 'isearch-update/outline-provisions #[nil "ÀÁ!ƒ ƒ\n„à ‡Ä ˆÃ ˆ ƒÆ ‡ ?…%Ä ‡" [boundp outline-mode outline-enwrap-isearch-mode real-isearch-update outline-isearch-advancing-business isearch-success outline-isearch-arrival-business] 2 "\ Wrapper around isearch which exposes and conceals hidden outline portions encountered in the course of searching."]) (defalias 'outline-solicit-alternate-bullet #[(depth &optional current-bullet) "†Á\n!ÄÅÆ #ÈÉ\"Ê#‰ ̘ƒ\" ‚$ *‡" [current-bullet outline-bullet-for-depth depth default-bullet solicit-char-in-string format "Select bullet: %s ('%s' default): " outline-bullets-string string-sans-char 92 t choice ""] 6 "\ Prompt for and return a bullet char as an alternative to the current one, but offer one suitable for current depth DEPTH as default."]) (defalias 'outline-sibling-index #[(&optional depth) "ŠƒÁXƒÁ‚=ƒ Uƒ,ÃÅ ƒ' T‚ )‚=Æ Wƒ<Ç!ˆÈ ‚=Á)‡" [depth 0 outline-depth 1 index outline-previous-sibling outline-recent-depth outline-ascend-to-depth outline-sibling-index] 2 "\ Item number of this prospective topic among it's 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-distinctive-bullet #[(bullet) "ÀÁ\n! \"‡" [string-match regexp-quote bullet outline-distinctive-bullets-string] 3 "\ True if bullet is one of those on outline-distinctive-bullets-string."]) (defalias 'outline-numbered-type-prefix #[(&optional prefix) "… ƒ !‚à ˜‡" [outline-numbered-bullet prefix outline-get-prefix-bullet outline-get-bullet] 3 "\ True if current header prefix bullet is numbered bullet."]) (defalias 'outline-bullet-for-depth #[(&optional depth) "ƒÁ\nà ÅZ]¦H!‡‡" [outline-stylish-prefixes char-to-string outline-plain-bullets-string 0 depth 2 outline-plain-bullets-string-len outline-primary-bullet] 5 "\ Return outline topic bullet suited to DEPTH, or for current depth if none specified."]) (defalias 'outline-make-topic-prefix #[(&optional prior-bullet new depth solicit number-control index) "ÀÀÀ † Å  ÈXƒÉ\n‚õ ƒ3Ì Í\n!\"ÉÉ‚õÌ ÎZÏ\"ƒaÑ !…Z…Q??…Z˜)‚õƒ“ƒ“?‰?‰ƒ{‚õƒ˜„‚õ× !‚õƒÍ Å XƒÍƒÍ „ÍŠ Å Y„´Ù !ˆÚ )‰…ɘ…ɉ)†õƒòÝ!ƒòƒí˜ƒí ?‰ƒò†õ× ! \n…!ßàƒ§ƒ‚ ƒá !T‚ á \"R.‡" [nil body numbering denumbering depth outline-depth outline-header-prefix header-lead 1 "" 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 current-bullet outline-bullet-for-depth new outline-ascend-to-depth outline-get-bullet sibling-bullet prior-bullet outline-distinctive-bullet bullet-char format "%d" outline-sibling-index] 8 "\ Generate a topic prefix suitable for optional arg DEPTH, or current depth if not specified. 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 require this function counting back the index for each successive sibling)."]) (defalias 'open-topic #[(relative-depth &optional before) "À \\ÃÄ!…ʼn?ÅÅ Š ÊWƒ&Ë\n!ˆ‚/ ÌY„/Í ˆÎ  Š…L ÊX„EÐ\n!…LÑ …L)`)ÅÅ„bˆ ÊV„sŠÕyˆÃÖ!)†Š ÌU…Š†Š\nÌU†ŠŠ× )?ƒ£Í ˆoØ „£o„£Ù ˆ\n XƒÍ À UƒÍƒÇÚƒÁÛ‚ÂÌ!ˆ‚ýÜ ˆ‚ýÅˆ× ˆnƒÝÝÞÅß#ˆŠà ˆÎ  V…ïÕyˆÃÖ!)ƒúÌyˆÚÌ!ˆÅˆo„რۂ Ì!ˆâãß\n#äP!ˆåÅ\nʼnß%ˆÅ.‡" [outline-current-depth relative-depth depth looking-at "^$" nil before opening-on-blank opening-numbered ref-depth 0 outline-ascend-to-depth 1 outline-back-to-current-heading outline-recent-depth outline-numbered-bullet outline-descend-to-depth outline-numbered-type-prefix ref-topic dbl-space doing-beginning -1 "^\\s-*$" outline-pre-next-preface outline-previous-sibling outline-previous-heading open-line 2 outline-end-of-current-subtree re-search-backward "[^ \n]" t outline-next-heading newline insert-string outline-make-topic-prefix " " outline-rebullet-heading] 6 "\ 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 preceding sibling, and then open forward from there."]) (defalias 'open-subtopic #[(arg) "ÀÁ V\"‡" [open-topic 1 0 arg] 4 "\ 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." "p"]) (defalias 'open-sibtopic #[(arg) "ÀÁ‰\nV\"‡" [open-topic 0 arg] 4 "\ 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." "p"]) (defalias 'open-supertopic #[(arg) "ÀÁ V\"‡" [open-topic -1 0 arg] 4 "\ 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." "p"]) (defalias 'outline-reindent-body #[(old-depth new-depth) "ŠŒÀ ˆÁuˆÂ TÄ\"ÂTÄ\"ÇPÉÊËÌ#…6Í!?…6Í !ƒÏ!ˆ‚,‡" [outline-goto-prefix 1 make-string old-depth 32 old-spaces-expr new-depth "\\1" new-spaces-expr re-search-forward "[\n ]" nil t looking-at outline-regexp replace-match] 4 "\ Reindent body lines which were indented at old-depth to new-depth. Note that refill of indented paragraphs is not done, and tabs are not accommodated. ('untabify' your outline if you want to preserve hanging body indents.)"]) (defalias 'outline-rebullet-current-heading #[(arg) "ŠÀ ˆÁ ˆÂ ?ĉ‰Å%)‡" [outline-back-to-current-heading outline-end-of-prefix outline-rebullet-heading arg nil t] 6 "\ Like non-interactive version 'outline-rebullet-heading', but work on (only) visible heading containing point. With repeat count, solicit for bullet." "P"]) (defvar current-bullet nil "\ Variable local to outline-rebullet-heading,but referenced by outline-make-topic-prefix, also. Should be resolved with explicitly parameterized communication between the two, if suitable.") (defalias 'outline-rebullet-heading #[(&optional solicit new-depth number-control index do-successors) "À \n†   ‰ÇZ{ÉÊ\n   & \nUƒ8‰GSÊO˜„^ |ˆ bˆƒY˜ƒYÐÑ!ƒYÒ”Ò•|ˆÓ!ˆƒn\n U„nÕ \n\"ˆ…¢Š× …¡ §ƒ… T‚ ?…Ø  Ù ƒtÚÊ\n  Ê%ˆ‚t).‡" [outline-depth current-depth new-depth outline-recent-prefix-beginning mb outline-recent-prefix-end me 1 current-bullet outline-make-topic-prefix nil solicit number-control index new-prefix outline-numbered-bullet looking-at "[0-9]+" 0 insert-string outline-reindent-bodies outline-reindent-body do-successors outline-next-sibling outline-sibling-index outline-numbered-type-prefix outline-rebullet-heading] 8 "\ 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 topic's 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-topic #[(arg) "ilŠ\n„Â\n<ƒ\n@\nÃU„ ÄÅ!ˆÆ ˆÇ \n\\ÃXƒ0ÈÉ!ˆÊ\n!ˆ\nÃU„>ÄË!ˆ)Ìà \n\\]!*‡" [was-eol start-col arg 0 message "Shifting..." outline-back-to-current-heading outline-recent-depth error "Attempt to shift topic below level 1" outline-rebullet-topic-grunt "Shifting... done." move-to-column] 4 "\ 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." "P"]) (defalias 'outline-rebullet-topic-grunt #[(&optional relative-depth starting-depth starting-point index do-successors) "†Á  †  ?†&ÁU„$?…&È ÁW †2`ƒI ƒIÁ \\VƒIÊË!ˆ Uƒ|ÌÍ \\ÍÍ%ˆÁÎ ˆm„Š Ï WƒŠTÐ T $ˆ‚` WƒŠÐ $ˆ…ĪÁU„²Ï U„ªÏ \\Uƒ²Ì͉‰‰Ò%ˆ bˆÁU?…ÃÌ͉‰‰Ò%.‡" [relative-depth 0 outline-depth 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 outline-next-heading outline-recent-depth outline-rebullet-topic-grunt do-successors t] 6 "\ 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-number-siblings #[(&optional denumber) "ŠÀ ˆÁ ˆ\n?… Ã\nĚŅ9ÉÊÅÊ%ˆƒ0TË ‰„Ê,‡" [outline-back-to-current-heading outline-beginning-of-level denumber 1 (16) t more use-bullet index outline-rebullet-heading nil outline-next-sibling] 7 "\ 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." "P"]) (defalias 'outline-shift-in #[(arg) "À !‡" [outline-rebullet-topic arg] 2 "\ Decrease prefix depth of current heading and any topics collapsed within it." "p"]) (defalias 'outline-shift-out #[(arg) "À [!‡" [outline-rebullet-topic arg] 2 "\ Decrease prefix depth of current heading and any topics collapsed within it." "p"]) (defalias 'outline-kill-line #[(&optional arg) "ÀÁ!ƒ ƒ\nƒnƒà !„Å!‡Ç ‰ Å!ˆÊË!ˆŠÃ !„7Ì ˆÇ VƒCÍ Ç ËVƒ]Í  Vƒ]Î S‰ !„C\n…pÏ!…pÐÑщÒ%+‡" [boundp outline-mode outline-numbered-bullet looking-at outline-regexp kill-line arg outline-depth depth ascender sit-for 0 outline-next-heading outline-recent-depth outline-ascend-to-depth outline-descend-to-depth outline-rebullet-heading nil t] 7 "\ Kill line, adjusting subsequent lines suitably for outline mode." "*P"]) (defalias 'outline-kill-topic #[nil "À  Ä ˆm„ÅuˆÆ `\"ˆÇÈ!ˆŠ …,Ê !…,ËÌ Ì‰Í%+‡" [outline-back-to-current-heading beg outline-recent-depth depth outline-end-of-current-subtree 1 kill-region sit-for 0 outline-numbered-bullet outline-descend-to-depth outline-rebullet-heading nil t] 6 "\ Kill topic together with subtopics." nil]) (defalias 'outline-yank #[(&optional arg) "ÀÂÃ!ƒ „À !‡`ʼnlƒ0ŠÉyˆÊ !)ƒ0É•É”ZÀ !ˆÌ ˆƒõÊÍ ÎQ!ƒõϔϕ‰S{ZZÅÖÖŠŒØ }ˆdbˆÊÙ!ƒÚÛ!ˆebˆdbˆƒ¶Ü ˆÝÞ S!„ŠßÞ `#ˆ)o?‰ƒ‡~ˆÛuˆ`}ˆ‚‡*à!\"ƒÍŠÉyˆ`)|ˆ‚ì‰\\|ˆÊâ!ƒâÚÏ!ˆ‚ÕÊã!ƒìÚÏ!ˆbˆ.‚þÊ !Ì ˆ…$…åÉ!ˆŠbˆæ …çÅÞ Å‰Ö%)+‡" [yank this-command boundp outline-mode arg nil established-depth topic-yanked beginning 0 looking-at outline-regexp exchange-dot-and-mark "\\(" "\\)" 1 yanked-beg yanked-end yanked-bullet yanked-depth depth-diff done t more mark "^$" delete-char -1 outline-back-to-current-heading outline-ascend-to-depth outline-depth outline-rebullet-topic-grunt string-match outline-distinctive-bullets-string "[0-9]" " " outline-numbered-bullet sit-for outline-goto-prefix outline-rebullet-heading] 7 "\ Like regular yank, except 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. If these two 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 from 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. Outline-yank-pop is used with outline-yank just as normal yank-pop is used with normal yank in non-outline buffers." "*P"]) (defalias 'outline-yank-pop #[(&optional arg) "Á=„\nÂÃ!ˆÁ`Å |ˆÆ!ˆÈ ‡" [last-command yank error "Previous command was not a yank" this-command mark rotate-yank-pointer arg outline-yank] 2 "\ Just like yank-pop, but works like outline-yank when popping topics just after fresh outline prefixes. Adapts level of popped stuff to level of fresh prefix." "*p"]) (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 "\ Pop to file associated with current heading, if it has an xref bullet (according to setting of 'outline-file-xref-bullet')." nil]) (defvar next-entry-exists nil "\ Used by outline-to-entry-end, dunno why.") (defalias 'outline-to-entry-end #[(&optional include-sub-entries curr-entry-level) "À ÂÃ#‰ƒ ƒŠÆyˆÇ V)„ ƒ$Æyˆ`‡db‡" [re-search-forward outline-regexp nil t next-entry-exists include-sub-entries 0 outline-depth curr-entry-level] 4 "\ Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil. CURR-ENTRY-LEVEL is an integer representing the length of the current level string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil, CURR-ENTRY-LEVEL is not needed."]) (defalias 'outline-copy-exposed #[(&optional workbuf) "„ Á ÂPpÄ!„Å!ˆÆ!ˆÇ ˆÈ !ˆÉÊË\"ˆeb)‡" [workbuf buffer-name " exposed" buf get-buffer generate-new-buffer pop-to-buffer erase-buffer insert-buffer replace-regexp " [^ \n]*" ""] 3 "\ Duplicate buffer to other buffer, sans hidden stuff. Without repeat count, this simple-minded function just generates the new buffer by concatenating the current buffer name with \" exposed\", and doing a 'get-buffer' on it." nil]) (defalias 'outlinify-sticky #[(&optional arg) "ÀÁ!ˆ\nƒ\n;ƒÃ\n!ˆ‚Kà ‚K Ń'ÃÆ!‚K ǃ4ÃÈ!‚K É=ƒAÃÊ!‚K Ë=ƒKÃÌ!ÍÎ\nƒWЂXÑP#ÍÔ\nƒi‚jÑÕÖ×ØÙÚ& ŠebˆÜ!„”Þ\n„‹‚’Íß#!ˆdbˆÞÍàáâã&!ˆÞÍäåæç$!ˆ\nƒ¼ÞÍèé\n#!ˆÞÍêëìíîïð&!ˆÞÍñ\"!+‡" [outline-mode t arg outline-lead-with-comment-string major-mode (emacs-lisp-mode lisp-mode) ";;;_" (awk-mode csh-mode sh-mode perl-mode) "#" c++-mode "//_" c-mode "/*_" format "%s%s" outline-header-prefix " " "" outline-primary-bullet lead-prefix "%s%s %s\n%s %s\n %s %s %s" "Local emacs vars." "'(This topic sets initial outline exposure" "of the file when loaded by emacs," "Encapsulate it in comments if" "file is a program" "otherwise ignore it," lead-line looking-at outline-regexp insert-string "%s%s\n" "\n\n%s\n%s %s %s\n%s %s " "local" "variables:" "eval:" "%s\n %s\n %s\n" "(condition-case err" "(save-excursion" "(outline-mode t)" " (%s \"%s\")\n" "outline-lead-with-comment-string" " %s %s\n %s %s\n %s %s" "(message \"Adjusting '%s' visibility\"" "(buffer-name))" "(goto-char 0)" "(outline-exposure -1 0))" "(error (message " "\"Failed file var 'allout' provisions\")))" "\n%s End: )\n"] 10 "\ Activate outline mode and establish file eval to set initial exposure. Invoke with a string argument to designate a string to prepend to topic prefixs, or with a universal argument to be prompted for the string to be used. Suitable defaults are provided for lisp, emacs-lisp, c, c++, awk, sh, csh, and perl modes." "P"]) (defalias 'solicit-char-in-string #[(prompt string &optional do-defaulting) "Á\n„EÄÅ \"ˆÆÇÉ )!Ê\n \"„> ƒ/\n͘ƒ/Ή‚\nÏ ΰÁ‰‚ÄÎ!ˆ‚\n*‡" [prompt nil got new-prompt message "%s" char-to-string t cursor-in-echo-area read-char string-match string do-defaulting " " "" " ...pick from: "] 6 "\ Solicit (with first arg PROMPT) choice of a character from string STRING. Optional arg DO-DEFAULTING indicates to accept empty input (CR)."]) (defalias 'string-sans-char #[(string char) "Á˜ƒÁ‡ÂH UƒÄÅÆO \"‡ÂÅOÄÅÆO \"P‡" [string "" 0 char string-sans-char 1 nil] 5 "\ Return a copy of STRING that lacks all instances of CHAR."]) emacs-19.22/lisp/ange-ftp.elc100666 12120 1 253433 5475264250 14327 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:23:35 1993 ;;; from file /home/fsf/rms/e19/lisp/ange-ftp.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote comint)) (defvar ange-ftp-name-format (quote ("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*\\):\\(.*\\)" 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).") (defvar ange-ftp-multi-msgs "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-" "\ *Regular expression matching messages from the ftp process that start a multiline reply.") (defvar ange-ftp-good-msgs "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark" "\ *Regular expression matching messages from the ftp process that indicate that the action that was initiated has completed successfully.") (defvar ange-ftp-skip-msgs (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|" "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye") "\ *Regular expression matching messages from the ftp process 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 messages from the FTP process that indicate something has gone drastically wrong attempting the action that was initiated and 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 messages from the rlogin / telnet process that indicates that logging in to the gateway machine has gone wrong.") (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 a password of user@host when logging in as the anonymous user. If a string then use that as the password. If nil then prompt the user for a password.") (defvar ange-ftp-dumb-unix-host-regexp nil "\ *If non-nil, if the host being ftp'd to matches this regexp then the FTP process uses the 'dir' command to get directory information.") (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 ".*" "\ *If a host being FTP'd to matches this regexp then the ftp process is started locally, otherwise the FTP process is started on `ange-ftp-gateway-host' instead.") (defvar ange-ftp-gateway-program-interactive nil "\ *If non-nil then the gateway program is expected to connect to the gateway machine and eventually give a shell prompt. Both telnet and rlogin do something like this.") (defvar ange-ftp-gateway-program (byte-code "Á=ƒ‡Ç" [system-type hpux "remsh" "rsh"] 2) "\ *Name of program to spawn a shell on the gateway machine. Valid candidates are rsh (remsh on hp-ux), telnet and rlogin. See also the gateway variable above.") (defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *" "\ *Regexp used to detect that the logging-in sequence is completed on the gateway machine and that 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 (byte-code "Á=ƒ‡Ç" [system-type hpux "stty -onlcr -echo\n" "stty -echo nl\n"] 2) "\ *Command to use after logging in to the gateway machine to stop the terminal echoing each command and to strip out trailing ^M characters.") (defvar ange-ftp-smart-gateway nil "\ *If the gateway FTP is smart enough to use proxy server, then don't bother telnetting etc, just issue a user@host command instead.") (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 on gateway machine. Some AT&T folks claim to use something called `pftp' here.") (defvar ange-ftp-ftp-program-args (quote ("-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 nil "\ *Non-nil means make backup files for \"magic\" remote files.") (defvar ange-ftp-retry-time 5 "\ *Number of seconds to wait before retrying if a 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.") (require (quote backquote)) (defalias 'ange-ftp-make-hashtable #[(&optional size) "À †ÂÃ\"‡" [make-vector size 31 0] 3 "\ Make an obarray suitable for use as a hashtable. SIZE, if supplied, should be a prime number."]) (defalias 'ange-ftp-map-hashtable #[(fun tbl) "ÀÁ\n\"‡" [mapatoms #[(sym) " ÂN ÃN\"‡" [fun sym key val] 4] tbl] 3 "\ Call FUNCTION on each key and value in HASHTABLE."]) (defalias 'ange-ftp-make-hash-key '(macro . #[(key) "ÀÁ\nD\nÃ\nDF‡" [if stringp key prin1-to-string] 5 "\ Convert KEY into a suitable key for a hashtable."])) (defalias 'ange-ftp-get-hash-entry #[(key tbl) "À ;ƒ\n ‚  ! \"‰… ÅN)‡" [intern-soft key prin1-to-string tbl sym val] 4 "\ Return the value associated with KEY in HASHTABLE."]) (defalias 'ange-ftp-put-hash-entry #[(key val tbl) "À ;ƒ\n ‚  ! \"Å Æ#ˆÅ Á #)‡" [intern key prin1-to-string tbl sym put val] 4 "\ Record an association between KEY and VALUE in HASHTABLE."]) (defalias 'ange-ftp-del-hash-entry #[(key tbl) "G ! SÅÆ\"ˆ ÇYƒ# HIˆ S‰‚+‡" [tbl len ange-ftp-make-hashtable new-tbl i ange-ftp-map-hashtable #[(k v) " š†  #‡" [k key ange-ftp-put-hash-entry v new-tbl] 4] 0] 5 "\ Copy all symbols except KEY in HASHTABLE and return modified hashtable."]) (defalias 'ange-ftp-hash-entry-exists-p #[(key tbl) "À ;ƒ\n ‚  ! \"‡" [intern-soft key prin1-to-string tbl] 3 "\ Return whether there is an association for KEY in TABLE."]) (defalias 'ange-ftp-hash-table-keys #[(tbl) "ÀÁ \"Ä\"‡" [sort all-completions "" tbl string-lessp] 4 "\ Return a sorted list of all the active keys in TABLE, as strings."]) (byte-code "À‡" ["$Revision: 1.37 $" ange-ftp-version nil] 1) (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.") (byte-code "À ÂÄÅ!„ ÆÄÇ!„ÆÄÈ!„ÆÄÉ!„(Æ ÄÊ!„1Æ\nÄË!„:Æ ÄÌ!„CÆ ÄÍ!„LÆ ÄÎ!„UÆÄÏ!„^ÆÄÐ!„gÆÑÒÓÔ#‡" [ange-ftp-make-hashtable ange-ftp-expand-dir-hashtable "^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 put ftp-error error-conditions (ftp-error file-error error)] 4) (defalias 'ange-ftp-save-match-data '(macro . #[(&rest body) "ÀÁ!ÂÅ ÆDCÇÈ BÊ DEE*‡" [make-symbol "match-data" nil case-fold-search original let (match-data) unwind-protect progn body store-match-data] 6 "\ Execute the BODY forms, restoring the global value of the match data. Also makes matching case-sensitive within BODY."])) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put ange-ftp-save-match-data lisp-indent-hook 0 edebug-form-hook (&rest form)] 4) (defalias 'ange-ftp-message #[(fmt &rest args) "ÀÁ\n #ÄÅ !‰GYƒ!ÈÉZÊOPËÌ\"*‡" [apply format fmt args window-width minibuffer-window max msg "> " 3 nil message "%s"] 5 "\ 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-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 "\ 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-set-user #[(host user) "À \n #‡" [ange-ftp-put-hash-entry host user ange-ftp-user-hashtable] 4 "\ For a given HOST, set or change the default USER." "sHost: \nsUser: "]) (defalias 'ange-ftp-get-user #[(host) "À ˆÁ\n \"‰†1 ;ƒ ‚* ƒ(ÆÈÉÊ\n\"Ë \")‚*Ë ‰Ì\n \"ˆ)‡" [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 "\ Given a HOST, return the default USER."]) (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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias ange-ftp-generate-passwd-key (macro . #[(host user) "À  F‡" [concat host "/" user] 4]) ange-ftp-lookup-passwd (macro . #[(host user) "ÀÁ\n EÄE‡" [ange-ftp-get-hash-entry ange-ftp-generate-passwd-key host user ange-ftp-passwd-hashtable] 4])] 3) (defalias 'ange-ftp-set-passwd #[(host user passwd) "À  Q #‡" [ange-ftp-put-hash-entry host "/" user passwd ange-ftp-passwd-hashtable] 4 "\ For a given HOST and USER, set or change the associated PASSWORD." (list (read-string "Host: ") (read-string "User: ") (ange-ftp-read-passwd "Password: "))]) (defalias 'ange-ftp-get-host-with-passwd #[(user) "À ˆÁ‡" [ange-ftp-parse-netrc found-one (byte-code "ÀÁ\n\"ˆÃ ÅŽÀÆ\"ˆ*ȇ" [ange-ftp-map-hashtable #[(host val) "À  Q \"…ÅÆ \"‡" [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 "\ Given a USER, return a host we know the password for."]) (defalias 'ange-ftp-get-passwd #[(host user) "À ˆÁ\nà Q \"†t;ƒ\"ƒ\" ˜ƒ\"‡ Ș„. ɘƒC\nƒC\n;ƒ<\n‡Ë ÌÍ Q‡Î !‰ƒaÐÑÒ \n %Áà Q \"\"‚hÐÑÓ \n#!Õ\n #ˆ*‡" [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-login-name "@" system-name 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 "\ Return the password for specified HOST and USER, asking user if necessary."]) (defalias 'ange-ftp-set-account #[(host user account) "À  Q #‡" [ange-ftp-put-hash-entry host "/" user account ange-ftp-account-hashtable] 4 "\ For a given HOST and USER, set or change the associated ACCOUNT password." (list (read-string "Host: ") (read-string "User: ") (ange-ftp-read-passwd "Account password: "))]) (defalias 'ange-ftp-get-account #[(host user) "À ˆÁ\nà Q \"†;… ˜…‡" [ange-ftp-parse-netrc ange-ftp-get-hash-entry host "/" user ange-ftp-account-hashtable ange-ftp-default-user ange-ftp-default-account] 4 "\ Given a HOST and USER, return the FTP account."]) (defalias 'ange-ftp-chase-symlinks #[(file) "À !‰ƒÄ !ƒ ‚Å ! P‚) ‡" [nil temp ange-ftp-real-file-symlink-p file file-name-absolute-p file-name-directory] 2 "\ Return the filename that FILE references, following all symbolic links."]) (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 "\ 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."]) (defalias 'ange-ftp-parse-netrc-group #[nil "Àyˆ`ÁÂdÃÄ$ˆ`ʼn‰‰ ‰\nbˆËÌ \" ËÍ \"ËÎ \"ËÏ \" ƒaƒaÐ \"ˆÑ #ˆƒšÒ #ˆ‚š\nbˆÓÔ Õ#ƒšËÍ \"ËÎ \"ËÏ \"ƒˆƒ‘ƒš b.‡" [0 re-search-forward "machine\\|default" end 2 nil account password login machine 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" t ange-ftp-default-user ange-ftp-default-password ange-ftp-default-account] 7 "\ Extract the values for the tokens `machine', `login', `password' and `account' in the current buffer. If successful, record the information found."]) (defalias 'ange-ftp-parse-netrc #[nil "ÀÁ\n!!Ä !‰…yÆ 8š?…yÈ  ÊŽ „5Ì 8Í =ƒiÎÏÐ 8\"ƒiŠÑÒ!qˆÓ !ˆ Õ !×Ø!ˆÙÚ\"ˆÜebˆm„aÝ ˆ‚WÞp!ˆ)‚rßà\n\"ˆáâ!ˆÆ 8‰**‡" [ange-ftp-chase-symlinks ange-ftp-real-expand-file-name ange-ftp-netrc-filename file ange-ftp-real-file-attributes attr 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 default-directory normal-mode t mapcar funcall find-file-hooks nil ange-ftp-parse-netrc-group kill-buffer ange-ftp-message "%s either not owned by you or badly protected." sit-for 1] 5 "\ 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." 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 "\ Return a list of prefixes of the form 'user@host:' to be used when completion is done in the root directory."]) (defalias 'ange-ftp-ftp-name-component '(macro . #[(n ns name) "ÀÁ EDCÅÆÇÉÊFEE‡" [let elt nth n ns if (match-beginning elt) substring name (match-beginning elt) (match-end elt)] 8 "\ Extract the Nth ftp file name component from NS."])) (byte-code "ÀÁ!„ÂÀÃ!„Äć" [boundp ange-ftp-ftp-name-arg "" 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)) string-match ange-ftp-name-format ns elt host user 2 0 ange-ftp-get-user] 4 "\ 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."]) (defalias 'ange-ftp-replace-name-component #[(fullname name) "À ÂŽÃ @ \"…' AÇ8 É”O\n •ËOQ**‡" [match-data match-data ((store-match-data match-data)) string-match ange-ftp-name-format fullname ns 2 elt 0 name nil] 5 "\ Take a FULLNAME that matches according to ange-ftp-name-format and replace the name component with NAME."]) (defalias 'ange-ftp-repaint-minibuffer #[nil "ÀÁ!‡" [message nil] 2 "\ Clear any existing minibuffer message; let the minibuffer contents show."]) (defalias 'ange-ftp-ftp-process-buffer #[(host user) "À  İ‡" ["*ftp " user "@" host "*"] 5 "\ Return the name of the buffer that collects output from the ftp process connected to the given HOST and USER pair."]) (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 "\ 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."]) (defalias 'ange-ftp-set-buffer-mode #[nil ";…Á!…ÂÃ!ˆ Å!‡" [buffer-file-name ange-ftp-ftp-name make-local-variable make-backup-files ange-ftp-make-backup-files auto-save-mode ange-ftp-auto-save] 2 "\ Set correct modes for the current buffer if visiting a remote file."]) (defalias 'ange-ftp-kill-ftp-process #[(buffer) "„pÁ † \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 "\ 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." "bKill FTP process associated with buffer: "]) (defalias 'ange-ftp-quote-string #[(string) "ÀÁÂà \"\"‡" [apply concat mapcar #[(char) "ÁX„ÂV„ÃU„ÄUƒÅÄ\"‡Å!‡" [char 32 126 34 92 vector] 3] string] 5 "\ Quote any characters in STRING that may confuse the ftp process."]) (defalias (quote 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]) (defalias 'ange-ftp-process-handle-line #[(line proc) "À \n\"ƒÃÄ\nŔŕO!Æ\"‰‡À\n\"ƒ ɇÀ\n\n\"ƒ3Ë É \n‰‡À\n\"ƒHÐ!ˆË \n‰‡À\n\"ƒUɉ‡ƒ\\ɇË \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-fatal-msgs delete-process proc ange-ftp-multi-msgs ange-ftp-process-multi-skip] 5 "\ 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-log-string #[(proc str) "pÁŽÂÄ !qˆ`Æ !UŠÆ !bˆcˆÆ !`“ˆ) …+Æ !b+‡" [old-buffer ((set-buffer old-buffer)) nil moving process-buffer proc process-mark str] 3 "\ For a given PROCESS, log the given STRING at the end of its associated buffer."]) (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 "\ Set the size of the next FTP transfer in bytes."]) (defalias 'ange-ftp-process-handle-hash #[(str) "Á‰”OÁ•ÂOPÁ•Á”Z \\ ƒf ƒfÆ Ç =„fÈÉ!„f\n„fË _Í\"ÁUƒIÐÑ #ˆ‚eÒ_¥‰=„dÐÕ #ˆ))‡" [str 0 nil ange-ftp-hash-mark-count ange-ftp-process-msg ange-ftp-process-verbose selected-window minibuffer-window boundp search-message cursor-in-echo-area ash ange-ftp-hash-mark-unit -6 kbytes ange-ftp-xfer-size ange-ftp-message "%s...%dk" 100 percent ange-ftp-last-percent "%s...%d%%"] 5 "\ Remove hash marks from STRING and display count so far."]) (defalias 'ange-ftp-call-cont #[(cont result line) "…<ƒ@Á=„Â@ A$‡ \"‡" [cont lambda apply result line] 5 "\ 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."]) (defalias 'ange-ftp-process-filter #[(proc str) "À !pÄ !…ÄÅŽÆ ÈŽÀ !qˆ ƒ1\nƒ1ËÌ \"ƒ1Î ! Ï  \"ˆ\nƒP PËÑ\"ƒPÒ Ó\"ˆ\nƒŠËÓ\"ƒŠÔ‰”OÔ•ÖOË×\"ƒ€Ô•ÖO‚mØ \"ˆ)‚P\n?…ÃÔƒ®ƒ®ƒ®ÝÞ\"ˆß ˆÖ …à !Ö â!##)+*‡" [process-buffer proc old-buffer buffer buffer-name ((set-buffer old-buffer)) match-data match-data ((store-match-data match-data)) ange-ftp-hash-mark-unit ange-ftp-process-busy string-match "^#+$" str ange-ftp-process-handle-hash ange-ftp-process-log-string 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 "\ Build up a complete line of output from the ftp PROCESS and pass it on to ange-ftp-process-handle-line to deal with."]) (defalias 'ange-ftp-process-sentinel #[(proc str) "À ÂŽÃ !ÆÇ \"ƒ( ȔȕO ɔɕO\n Ì\n \"ˆ*)͉*‡" [match-data match-data ((store-match-data match-data)) process-name proc name string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)*" 1 2 host user ange-ftp-wipe-file-entries nil ange-ftp-ls-cache-file] 4 "\ When ftp process changes state, nuke all file-entries in cache."]) (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 "\ Returns whether to access this host via a normal (non-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 "\ Returns whether to access this host via a smart gateway."]) (byte-code "ÀÁ!„ÂÀÃ!„ÄÅ!ÀÆ!„‡" [boundp ange-ftp-tmp-name-files nil ange-ftp-tmp-name-hashtable ange-ftp-make-hashtable 10 ange-ftp-pid] 2) (defalias 'ange-ftp-get-pid #[nil "ÀÁ!ÂÃO‰‡" [make-temp-name "" 1 nil ange-ftp-pid] 3 "\ Half-hearted attempt to get the current process's id."]) (defalias 'ange-ftp-make-tmp-name #[(host) "À !ƒ\n\n‚  †Æ È Ê Ê ÍÎ  $ Ï \"‰ >„=Ò !ƒR T‰ ÓVƒ ÔPÈ ‚ B -‡" [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 "\ This routine will return the name of a new file."]) (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅÃÆ!„ÇÀÈÉ\"ˆÀÊË\"‡" [defalias ange-ftp-del-tmp-name #[(temp) "ÀÁ\n \" \"ÅÆLJ" [delq intern temp ange-ftp-tmp-name-hashtable ange-ftp-tmp-name-files nil (ange-ftp-real-delete-file temp) ((error))] 4] boundp ange-ftp-gwp-running t ange-ftp-gwp-status nil ange-ftp-gwp-sentinel #[(proc str) "À‰‡" [nil ange-ftp-gwp-running] 2] ange-ftp-gwp-filter #[(proc str) "À ÂŽÃ \"ˆÆÇ \"ƒ!È É\nË !)ÍP\"‚ZÆÎ \"ƒ8È Ï Ë !\"ÍP\"‚ZÆ \"ƒKÑ !ˆÒ‰‚ZÆ \"…ZÒɉ*‡" [match-data match-data ((store-match-data match-data)) ange-ftp-process-log-string proc str 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]] 3) (defalias 'ange-ftp-gwp-start #[(host user name args) "À !à ‰ $ÇÈ Ê# Ì!ˆÍÎ\"ˆÏÐ\"ˆÑ!`Ò“ˆÓÒÖ× \"ˆƒEØ!ˆ‚8„RÙÜ#ˆÖÝ \"ˆÓÒÞ\"ˆƒqØ!ˆ‚d„~Ùà#ˆÓÒÞá âQ\"ˆ+‡" [ange-ftp-get-user ange-ftp-gateway-host gw-user 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-mark nil t 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 "\ Login to the gateway machine and fire up an ftp process."]) (defalias 'ange-ftp-raw-send-cmd #[(proc cmd &optional msg cont nowait) "À !Â>…±ŠÃ !qˆ ƒʼnÈ ˆ*‚É\nÉ ÌÅ ÅÓÕØPƒQƒQÚÛ\"ˆdbˆ`Å“ˆÝ ߎàá\"ƒuÓ‰•Oⱈ‚ycˆ*#`Å“ˆä \"ˆå !`Å“ˆ&?…° ƒ¥Å‰È !ˆ*‚“?…°  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 "\ 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-nslookup-host #[(host) "ƒ?Á‰ $ Æ !ˆŠÇ !qˆÈ !É>ƒ&Ê !ˆ‚ebˆËÌÍÎ#ƒ7ϔϕ{Ðp!ˆ) *‡ ‡" [ange-ftp-nslookup-program 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 t 1 kill-buffer] 5 "\ Attempt to resolve the given HOSTNAME using nslookup if possible." "sHost: "]) (defalias 'ange-ftp-start-process #[(host user name) "À !‰ƒ ‚ Æ C\"É\n\nƒD ƒ0Ì  $\n‚NÏЉÆD\"$\n‚NÏЉ$\nÓ\n!ˆŠÔ\n!qˆÕ ˆ)Ö\n×\"ˆØ\nÙ\"ˆÚ\n!ˆ\n,‡" [ange-ftp-use-gateway-p host use-gateway ange-ftp-gateway-ftp-program-name ange-ftp-ftp-program-name ftp-prog append ange-ftp-ftp-program-args args nil proc ange-ftp-gateway-program-interactive ange-ftp-gwp-start user name apply start-process ange-ftp-gateway-program ange-ftp-gateway-host 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] 8 "\ 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 (quote 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] 3 nil nil]) (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 "\ 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-normal-login #[(host user pass account proc) "À ÂÃÄ !\"ÂÆ \"#‰@„È  ÊAP#ˆÀ ÂË   $ÂÎ ##‰@†PÏ  Ð#ˆÑ  Ð#ˆÈ  ÒAP#)‡" [ange-ftp-raw-send-cmd proc format "open %s" ange-ftp-nslookup-host host "Opening FTP connection to %s" result ange-ftp-error user "OPEN request failed: " "user \"%s\" %s %s" pass account "Logging in as user %s@%s" ange-ftp-set-passwd nil ange-ftp-set-account "USER request failed: "] 8 "\ Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT. PROC is the process to the FTP-client."]) (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.") (defalias (quote ange-ftp-guess-hash-mark-size) #[(proc) "…HŠÁ\n!qˆÃ\nÄ\"‰@ AÈ  ÊŽË \"…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]) (defalias 'ange-ftp-get-process #[(host user) "À \n\"Ä !‰ƒÆ !Ç>ƒ ‚[ÈÉ \n\"!ÈÊ \n\"!  Í \n #Î !ƒBÏ \n  %ˆ‚LÐ \n  %ˆÑ !ˆÒ \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-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 "\ Return the process object for a FTP process connected to HOST and logged in as USER. Create a new process if needed."]) (byte-code "ÀÁ!„ÂÀÃ!„‡" [boundp ange-ftp-host-cache nil ange-ftp-host-type-cache] 2) (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 "\ 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."]) (defvar ange-ftp-fix-name-func-alist nil "\ 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 "\ 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-dumb-host-types (quote (dumb-unix)) "\ List of host types that can't take UNIX ls-style listing options.") (defalias 'ange-ftp-send-cmd #[(host user cmd &optional msg cont nowait) "@A@ \n ĉ‰‰ \n    ƒºÎ8Ï\n \" Ð=ƒ|žA†>Ò ! Ó8Ô=ƒeÕÖ \"ƒeÕ×\"„e ØP >„ºÚ ÛÜ # ‚ºžA††Ò Þ>ƒ—  ! ‚º ß>ƒ§ !‚º à=ƒº  ! !á !‰  …Êâ P…Óâ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 "\ 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."]) (byte-code "ÀÁPÃÅLJ" ["^[-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 "^[-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 nil] 2) (defalias 'ange-ftp-guess-host-type #[(host user) "À !  ÄR‰Ç=ƒ³È  ÊŽË \"‰ @ Î „GÐÑ!ˆÒÓ!ˆÔÕ A\"ƒÖ !ˆ Ø‚Ô \"ƒ]Û !ˆ Ü‚Ô \"ƒ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 "\ Guess at the the host type of HOST by doing a pwd, and examining the directory syntax."]) (defalias 'ange-ftp-dumb-unix-host #[(host) "…Á ÃŽÄ \"*‡" [ange-ftp-dumb-unix-host-regexp match-data match-data ((store-match-data match-data)) string-match host] 3 "\ Returns whether HOST's FTP server doesn't like 'ls' or 'dir' commands to take switch arguments."]) (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 "\ Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp." (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) (defvar ange-ftp-parse-list-func-alist nil "\ 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.") (defalias 'ange-ftp-ls #[(file lsargs parse &optional no-error wildcard) "À !Ã\n!‰ƒ' @ A@ÇÈ 8! Ê\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 "\ 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."]) (byte-code "ÀÁPÇ" [" \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct" "\\|Nov\\|Dec\\) +[0-3]?[0-9] " ange-ftp-date-regexp nil] 2) (defvar ange-ftp-add-file-entry-alist nil "\ 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 "\ 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.") (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 "\ Add a 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 "\ Delete the file entry for file NAME, if its directory info exists."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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]) 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])] 3) (defvar ange-ftp-dl-dir-regexp nil "\ Regexp matching directories which are listed in dl format. This regexp shouldn't be anchored with a trailing $ so that it will match subdirectories as well.") (defalias 'ange-ftp-add-dl-dir #[(dir) "…Á\n\"?…ÃÄ\n!…ÅR‰‡" [ange-ftp-dl-dir-regexp string-match dir "^" regexp-quote "\\|"] 4 "\ Interactively adds a DIR to ange-ftp-dl-dir-regexp." (list (read-string "Directory: " (let ((name (or (buffer-file-name) default-directory))) (and name (ange-ftp-ftp-name name) (file-name-directory name)))))]) (defalias (quote ange-ftp-dl-parser) (quote (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ˆÆ ;…\"ÈÉ\"ʉ‰‰   ʈ`ÒyˆÓÕ#…WÖÊwˆ×wˆÖwˆ`{)‰ ƒÒyˆØÊwˆg‰Ù= Ú=ƒ•ÈÛ \"ƒ Ò•ÊO  Ò‰”O ‚˜Ü ‚˜Ê ƒ ܘ„ÃÝ!ƒÞ= ?…ÇÈßŔŕ{à”à•{á”á•{Q\"\"# ƒØÈä \"„ÿ ƒåÈå \"„ÿ\"ƒòÈæ \"„ÿ#ƒÈç \"ƒ ÒèO *é  † #ˆÅyˆ‚2éêÕ#ˆéëÕ#ˆ.‚«Ãì!ƒ:Ê‚«mƒBÊ‚«ÓÊÕ#ƒiÒyˆÆ ;…[ÈÉ\"ʉ‰‰   ʈ`ÒyˆÓÕ#…ÖÊwˆ×wˆÖwˆ`{)‰ ƒTÒyˆØÊwˆg‰Ù= Ú=ƒÎÈÛ \"ƒÈ Ò•ÊO  Ò‰”O ‚ÑÜ ‚ÑÊ ƒ@ ܘ„@ÃÝ!ƒ@Þ= ?…ÈßŔŕ{à”à•{á”á•{Q\"\"# ƒÈä \"„8 ƒÈå \"„8\"ƒ+Èæ \"„8#ƒ?Èç \"ƒ? ÒèO *é  †J #ˆÅ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 "\ 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."]) (defalias 'ange-ftp-set-files #[(directory files) "… Á ! #‡" [files ange-ftp-put-hash-entry file-name-as-directory directory ange-ftp-files-hashtable] 4 "\ For a given DIRECTORY, set or change the associated FILES hashtable."]) (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 "\ 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-file-part '(macro . #[(name) "ÀÁ DDCÄE‡" [let file file-name-nondirectory name (if (string-equal file "") "." file)] 4 "\ Given NAME, return the file part that can be used for looking up the file's entry in a hashtable."])) (defalias 'ange-ftp-allow-child-lookup '(macro . #[(dir file) "ÀÁ DÄ DÆÇFÈED‡" [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)))))] 6 "\ 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."])) (defalias 'ange-ftp-file-entry-p #[(name) "À ! !Ä \"Ç !‰ɘƒÊ‚)ƒ0Ë\"‚}  Î !Ð@!‰Ò=ƒ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 "" "." 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 "\ Given NAME, return whether there is a file entry for it."]) (defalias 'ange-ftp-get-file-entry #[(name) "À ! !Ä \"Ç !‰ɘƒÊ‚)ƒ0Ä\"‚}  Í !Ï@!‰Ñ=ƒ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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias ange-ftp-internal-delete-file-entry #[(name &optional dir-p) "ƒÁ\n!Ã\n \"ˆÅ\n!ÆÇ\n! \"‰…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] 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]] 3) (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@ šƒ š†#Ç  #*)‡" [ange-ftp-ftp-name key parsed u h host user ange-ftp-put-hash-entry val new-tbl] 5]] 3 "\ Replace the file entry information hashtable with one that doesn't have any entries for the given HOST, USER pair."]) (defalias 'ange-ftp-set-binary-mode #[(host user) "À \nÃ#‰@„Å \nÆ AP#‚(ŠÇÈ \n\"!qˆÉ\nË\"‰ ))‡" [ange-ftp-send-cmd host user (type "binary") result ange-ftp-error "BINARY failed: " process-buffer ange-ftp-get-process ash ange-ftp-binary-hash-mark-size -4 ange-ftp-hash-mark-unit] 6 "\ Tell the ftp process for the given HOST & USER to switch to binary mode."]) (defalias 'ange-ftp-set-ascii-mode #[(host user) "À \nÃ#‰@„Å \nÆ AP#‚(ŠÇÈ \n\"!qˆÉ\nË\"‰ ))‡" [ange-ftp-send-cmd host user (type "ascii") result ange-ftp-error "ASCII failed: " process-buffer ange-ftp-get-process ash ange-ftp-ascii-hash-mark-size -4 ange-ftp-hash-mark-unit] 6 "\ Tell the ftp process for the given HOST & USER to switch to ascii mode."]) (defalias (quote ange-ftp-cd) #[(host user dir) "À \nà DÅ$‰@†Ç \nÈAP#)‡" [ange-ftp-send-cmd host user cd dir "Doing CD" result ange-ftp-error "CD failed: "] 6]) (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 "\ 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-expand-dir #[(host user dir) "À \n\"‰ ž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 "\ Return the result of doing a PWD in the current FTP session to machine HOST logged in as user USER and cd'd to directory DIR."]) (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 "\ Take a string and short-circuit //, /. and /.."]) (defalias 'ange-ftp-expand-file-name #[(name &optional default) "À ÂŽÃ !Å=ƒ1ÆÇ \"ƒ È•SÉO‰‚.ÆÊ \"ƒ1 È•SÉO‰„ à !Ë=ƒ?Ì !‚mà !Å=ƒMÍ !‚m GÈUƒ`͆\\!‚mÍІi! P!*‡" [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 "\ Documented as original."]) (defvar ange-ftp-file-name-as-directory-alist nil "\ Association list of ( TYPE . FUNC ) pairs, where FUNC converts a filename to a directory name for the operating system TYPE.") (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 "\ Documented as original."]) (defalias 'ange-ftp-file-name-directory #[(name) "À !‰ƒ(Ã\n8Å ÇŽÈÉ \"*ƒ ‚$Ê Ë !\")‚+Ë !)‡" [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 "\ Documented as original."]) (defalias 'ange-ftp-file-name-nondirectory #[(name) "À !‰ƒ%Ã\n8Å ÇŽÈÉ \"*ƒÊ‚!Ë !)‚(Ë !)‡" [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 "\ 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 "\ Documented as original."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"‡" [defalias ange-ftp-binary-file #[(file) "À ÂŽÃ \"*‡" [match-data match-data ((store-match-data match-data)) string-match ange-ftp-binary-file-name-regexp file] 3] ange-ftp-write-region #[(start end filename &optional append visit) "À ! !‰ƒ² @ A@ÆÇ 8!É !\nË !  ƒ-Í‚.ÎÐ !ÒŽÓÔ Õ ØŽÙ\nÜ%ˆ, ƒZÞ \"ˆß\n!‰ ƒmá â 8#ˆ)ã \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 binary append put cmd ange-ftp-abbreviate-filename abbr ((byte-code "À !ˆ\nƒ à \"ˆÀ‡" [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\"" ange-ftp-set-buffer-mode set-buffer-modified-p ange-ftp-message "Wrote %s" ange-ftp-add-file-entry] 8] ange-ftp-insert-file-contents #[(filename &optional visit beg end) "À ˆÁ\n!Ã\n!‰ƒÍ ƒ\nÇ\n!„-È ÊË\n! \"ˆÇ\n!ƒÄ @ A@ÏÐ 8!Ò !Ô\n!Ö\n!ÈÙŽƒ^Ú \"ˆÛ Ü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 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 "Opening input file:" "FTP Error: %s not arrived or readable" file-error] 8] ange-ftp-expand-symlink #[(file dir) "À !ƒ  \"‡Ä \"‡" [file-name-absolute-p file ange-ftp-replace-name-component dir expand-file-name] 3] 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] 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] 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] ange-ftp-directory-files #[(directory &optional full match &rest v19-args) "À ! !ƒ^à !ˆÄÅ !!Ɖ Ê !Ë  ÍŽ ƒ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] ange-ftp-file-attributes #[(file) "À ! !‰ƒ™Ä !‰ŘƒÆ‚ )ÇÈ !! \nË\n \"…• @ A@Ì 8Í\n \";ƒ[Ò!ƒ[ÓÈ !\"‚]Ô‰‰ÕÖ×Ô;ƒnØ‚xƒwÙ‚xÚÛPÜÝÞßà\"ßà\"¤ßàá!\"¤\"Ô¯ ,*‚œâ !)‡" [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] 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] ange-ftp-file-readable-p #[(file) "À ! !ƒà !‡Ä !‡" [expand-file-name file ange-ftp-ftp-name file-exists-p ange-ftp-real-file-readable-p] 2] ange-ftp-file-executable-p #[(file) "À ! !ƒà !‡Ä !‡" [expand-file-name file ange-ftp-ftp-name file-exists-p ange-ftp-real-file-executable-p] 2] ange-ftp-delete-file #[(file) "À ! !‰ƒG @ A@ÆÇ 8!É !\nË Ì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: "] 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] 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] ange-ftp-copy-file-internal #[(filename newname ok-if-already-exists keep-date &optional msg cont nowait) "À !À\n!Ã\n!ƒÀÄ !\n\"Å !Å\n!‰„?„?È \n \n$ˆ …UÌ ÍÎ#‚U…G@…RA@…_ÑÒ8!Ô !…n@…yA@…†ÑÒ8!Ô\n \"Ú !†—Ú\n!ÜÜ ƒª §ƒ²ß\nà §#ˆƒ.á!„ÃÉâ!ƒÕã\"ˆäå†ã\nE&†ƒûƒûçè\"‚çé#ê \n& +¯+&‚SêÍÜ \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 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] 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ƒè ƒÖÍ!ƒ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] ange-ftp-cf2 #[(result line newname t-host t-user binary temp1 temp2 cont) "ÀŽ ƒ$ÂŽ „ „ÅÆÇÈÉ \"\nE\"ˆË\n!)‚0 …0Í \nÎ#)‡" [((byte-code "ƒÁ!ˆ\nƒÁ\n!ˆÃ #‡" [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] ange-ftp-copy-file #[(filename newname &optional ok-if-already-exists keep-date) "À \n ʼnt&‡" [ange-ftp-copy-file-internal filename newname ok-if-already-exists keep-date nil] 8 nil "fCopy file: \nFCopy %s to file: \np"]] 3) (defalias 'ange-ftp-rename-remote-to-remote #[(filename newname f-parsed t-parsed binary) "@A@ @ A@‰ ˜ƒp \n˜ƒpÆÇ8!ÆÇ 8! Ê E Ì !Ì \"Ñ  ÒÓ#$‰@„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 "\ Rename remote file FILE to remote file NEWNAME."]) (defalias 'ange-ftp-rename-local-to-remote #[(filename newname) "À !À \"ÅÆ\n #È ÉÊ%ˆÊ Ì !,‡" [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 "\ Rename local FILENAME to remote file NEWNAME."]) (defalias 'ange-ftp-rename-remote-to-local #[(filename newname) "À !À \"ÅÆ\n #È ÉÊ%ˆÊ Ì !,‡" [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 "\ Rename remote file FILENAME to local file NEWNAME."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"‡" [defalias ange-ftp-rename-file #[(filename newname &optional ok-if-already-exists) "À !À\n!à !Ã\n! „ …Æ ! „% ƒ8ƒ0§ƒ8É\nʧ#ˆ ƒR ƒKË \n %‚cÌ \n\"‚c ƒ]Í \n\"‚cÎ \n#+‡" [expand-file-name filename newname ange-ftp-ftp-name f-parsed t-parsed ange-ftp-binary-file binary 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] 6 nil "fRename file: \nFRename %s to file: \np"] ange-ftp-file-entry-active-p #[(sym) "ÁN‰;?†Âà \"!)‡" [sym val file-exists-p ange-ftp-expand-symlink ange-ftp-this-dir] 5] 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] 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] ange-ftp-file-name-completion #[(file dir) "À !Ã\n!ƒDÄ\n!ˆ ÆšƒÆ‚^Ç\n!È\n! ÊË Í#Ï ÑŽÒ  \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] ange-ftp-file-name-completion-1 #[(file tbl dir predicate) "À \n #‰…? Å=ƒ$ÆÇ \"!ƒ ÉP‚?Å‚?À \n #Å=ƒ>ÆÇ \"!ƒ> ÉP‚? )‡" [try-completion file tbl predicate bestmatch t file-directory-p expand-file-name dir "/"] 5] 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] ange-ftp-make-directory #[(dir &optional parents) "ƒÁ !!Å !„Æ \"ˆ)Å !ƒ!ÇÈ \"‡É !‰\nƒ‚\n@ \nA@ ÍÎ !Ï=ƒHÐÑ\n8!‚NÒÑ\n8!!Ô !Ö  ×DØÙ\"$‰@„zÛ  ØÜ 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: ")))] ange-ftp-delete-directory #[(dir) "À !ƒ` !‰ƒ[ @ A@ÆÇ !È=ƒ&ÉÊ 8!‚+ËÊ 8!! Í !Ï Ð DÑÒ\"$‰@„SÔ ÑÕ 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] ange-ftp-file-local-copy #[(file) "À !Ã\n!‰…&Å @!Ç\n!É\nÊËÌÍ\n\"%ˆ**‡" [expand-file-name file fn1 ange-ftp-ftp-name pa1 ange-ftp-make-tmp-name tmp1 ange-ftp-binary-file bin1 ange-ftp-copy-file-internal t nil format "Getting %s"] 9] ange-ftp-load #[(file &rest args) "À !ƒ !ÄŽÅÆ #*‡ÅÈ #‡" [ange-ftp-ftp-name file ange-ftp-file-local-copy copy ((delete-file copy)) apply load args ange-ftp-real-load] 4] ange-ftp-unhandled-file-name-directory #[(filename) "À !‡" [file-name-directory ange-ftp-tmp-name-template] 2]] 3) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊ \"„\"Ì B ÉÍ \"„0Î B Ï>„=ÏBÑÒÓÔ#ˆÑÕÓÖ#ˆÑ×ÓØ#ˆÑÙÓÚ#ˆÑÛÓÜ#ˆÑÝÓÞ#ˆÑßÓà#ˆÑáÓâ#ˆÑãÓä#ˆÑåÓæ#ˆÑçÓè#ˆÑéÓê#ˆÑëÓì#ˆÑíÓî#ˆÑïÓð#ˆÑñÓò#ˆÑóÓô#ˆÑõÓö#ˆÑ÷Óø#ˆÑùÓú#ˆÑûÓü#ˆÑýÓþ#ˆÑÿÓ@#ˆÑAÓB#ˆÑCÓD#ˆÑEÓF#ˆÑGÓH#ˆÑIÓJ#ˆÑKÓL#ˆÑMÓN#ˆÑOÓÁ#ˆÑPÓQ#ˆÑRÓS#ˆÑTÓU#ˆÀVW\"ˆÀXY\"ˆÀZ[\"ˆÀ\\]\"ˆÀ^_\"ˆÀ`a\"ˆÀbc\"ˆÀde\"ˆÀfg\"ˆÀhi\"ˆÀjk\"ˆÀlm\"ˆÀno\"ˆÀpq\"ˆÀrs\"ˆÀtu\"ˆÀvw\"ˆÀxy\"ˆÀz{\"ˆÀ|}\"ˆÀ~\"ˆÀ€\"ˆÀ‚ƒ\"ˆÀ„…\"ˆÀ†‡\"ˆÀˆ‰\"ˆÀŠ‹\"ˆÀŒ\"ˆÀŽ\"ˆÀF\"ˆÀN‘\"‡" [defalias ange-ftp-dired-compress-file #[(name) "À !‰ƒCÅ @!žA‰ƒCÇ ÉŽ !*‰\n@ \nA@  ƒ:Í  \"‚?Î  \"+‚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] ange-ftp-compress #[(file nfile) "À !Ã\n@!Ã\n@!Æ !Æ! ÊË\" ÊÍ \"ÏŽÐ ÑÒ %ˆƒ=ÔÕ\"ˆÖ``ÒÑÒØÊÙ #&ˆƒ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] ange-ftp-uncompress #[(file nfile) "À !Ã\n@!Ã\n@!Æ !Æ! ÊË\" ÊÍ \"ÏŽÐ ÑÒ %ˆƒ=ÔÕ\"ˆÖ``ÒÑÒØÊÙ #&ˆƒ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] ange-ftp-hook-function #[(operation &rest args) "ÁN‰ƒÃ\n \"‚Åà \"))‡" [operation ange-ftp fn apply args nil file-name-handler-alist] 4] 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 load ange-ftp-load file-truename identity vc-registered null ange-ftp-real-file-name-directory #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-name-directory args] 3] ange-ftp-real-file-name-nondirectory #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-name-nondirectory args] 3] ange-ftp-real-file-name-as-directory #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-name-as-directory args] 3] ange-ftp-real-directory-file-name #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply directory-file-name args] 3] ange-ftp-real-expand-file-name #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply expand-file-name args] 3] ange-ftp-real-make-directory #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply make-directory args] 3] ange-ftp-real-delete-directory #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply delete-directory args] 3] ange-ftp-real-insert-file-contents #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply insert-file-contents args] 3] ange-ftp-real-directory-files #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply directory-files args] 3] ange-ftp-real-file-directory-p #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-directory-p args] 3] ange-ftp-real-file-writable-p #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-writable-p args] 3] ange-ftp-real-file-readable-p #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-readable-p args] 3] ange-ftp-real-file-executable-p #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-executable-p args] 3] ange-ftp-real-file-symlink-p #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-symlink-p args] 3] ange-ftp-real-delete-file #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply delete-file args] 3] ange-ftp-real-read-file-name-internal #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply read-file-name-internal args] 3] ange-ftp-real-verify-visited-file-modtime #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply verify-visited-file-modtime args] 3] ange-ftp-real-file-exists-p #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-exists-p args] 3] ange-ftp-real-write-region #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply write-region args] 3] ange-ftp-real-backup-buffer #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply backup-buffer args] 3] ange-ftp-real-copy-file #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply copy-file args] 3] ange-ftp-real-rename-file #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply rename-file args] 3] ange-ftp-real-file-attributes #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-attributes args] 3] ange-ftp-real-file-name-all-completions #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-name-all-completions args] 3] ange-ftp-real-file-name-completion #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-name-completion args] 3] ange-ftp-real-insert-directory #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply insert-directory args] 3] ange-ftp-real-file-name-sans-versions #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply file-name-sans-versions args] 3] ange-ftp-real-shell-command #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply shell-command args] 3] ange-ftp-real-load #[(&rest args) "ÀÂà \")‡" [nil file-name-handler-alist apply load args] 3] #[(file switches &optional wildcard full) "À ! ! ƒ. ƒ#Æ !ÈÉ !\nˉÌ%)‚*È \n #c‚6Î \n  $*‡" [ange-ftp-abbreviate-filename file ange-ftp-ftp-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] #[(dir) "ÀÁ\n!!… ɇ" [ange-ftp-ftp-name expand-file-name dir nil ange-ftp-ls-cache-file] 3]] 4) (defvar ange-ftp-sans-version-alist nil "\ Alist of mapping host type into function to remove file version numbers.") (defalias (quote ange-ftp-file-name-sans-versions) #[(file keep-backup-version) "À ! !ɉƒ!Ç@!Ç@!žA ƒ-  \"‚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]) (defvar ange-ftp-remote-shell-file-name (byte-code "Á>ƒ‡Ç" [system-type (hpux usg-unix-v) "remsh" "rsh"] 2) "\ Name of command to run a remote shell, for ange-ftp.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉ\nž„!Ë\nB\nÉ >„.É B ÀÍÎ\"ˆÉž„@ÐBÑÒ!„IÓÀÔÕ\"‡" [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\"" ange-ftp-remote-shell-file-name ange-ftp-message "Remote command '%s' ..."] 6] 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] ange-ftp-call-chmod #[(args) "GÁWƒ ÂÃ\"ˆ@ÅÆA\"ˆ)lj‡" [args 2 error "ange-ftp-call-chmod: missing mode and/or filename: %s" mode mapcar #[(file) "À ! !‰…A @ A@ÆÇ 8!É !\nË Ì EÎÏ\n\"$‰@†@Ñ ÎÒ 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] 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] vms ange-ftp-fix-name-func-alist (vms . ange-ftp-fix-name-for-vms) ange-ftp-dumb-host-types 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] ange-ftp-fix-dir-name-func-alist (vms . ange-ftp-fix-dir-name-for-vms) boundp ange-ftp-vms-host-regexp nil ange-ftp-vms-host #[(host) "…Á ÃŽÄ \"*‡" [ange-ftp-vms-host-regexp match-data match-data ((store-match-data match-data)) string-match host] 3]] 3) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅž„ÇBÀÈÉ\"ˆÅ\nž„)Ë\nB\nÀÌÍ\"ˆÅž„;ÏBÀ‡" [defalias ange-ftp-parse-vms-filename #[nil "À ÂÃ#… Ĕĕ{‡" [re-search-forward ange-ftp-vms-filename-regexp nil t 0] 4] 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] vms ange-ftp-parse-list-func-alist (vms . ange-ftp-parse-vms-listing) 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\"… ĉ‡" [string-match regexp sym key t versions] 4]] 4] ange-ftp-delete-file-entry-alist (vms . ange-ftp-vms-delete-file-entry) 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à \n\"… Æ\nǔǕO!]‰)‡" [sym key name string-match regexp version string-to-int 1] 5] ";" int-to-string] 6] ange-ftp-add-file-entry-alist (vms . ange-ftp-vms-add-file-entry)] 3) (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 "\ Mark HOST as the name of a machine running VMS." (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) (byte-code "ÀÁÂ\"ˆÃ ž„Å BÀÆÇ\"ˆÃž„!ÉBÀÊË\"ˆÃ ž„3Í B ÀÎÏ\"ˆÐž„EÒBÀÓÔ\"ˆÐž„WÖBÐ>„dÐBØÙ!„mÚÀÛÜ\"ˆÀÝÞ\"ˆÐž„„àBÚ‡" [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] vms ange-ftp-file-name-as-directory-alist (vms . ange-ftp-vms-file-name-as-directory) 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] ange-ftp-make-compressed-filename-alist (vms . ange-ftp-vms-make-compressed-filename) ange-ftp-vms-sans-version #[(name) "À ÂŽÃÄ \"ƒ Ɖ”O‚ *‡" [match-data match-data ((store-match-data match-data)) string-match ";[0-9]+$" name 0] 3] ange-ftp-sans-version-alist (vms . ange-ftp-vms-sans-version) 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] mts ange-ftp-fix-name-func-alist (mts . ange-ftp-fix-name-for-mts) 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] 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 ange-ftp-mts-host #[(host) "…Á ÃŽÄ \"*‡" [ange-ftp-mts-host-regexp match-data match-data ((store-match-data match-data)) string-match host] 3] 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] ange-ftp-parse-list-func-alist (mts . ange-ftp-parse-mts-listing)] 3) (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 "\ Mark HOST as the name of a machine running MTS." (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) (byte-code "ÀÁÂ\"ˆÃ ž„Å BÃ>„ÃBÀÇÈ\"ˆÃ ž„.Ê B À‡" [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] cms ange-ftp-fix-name-func-alist (cms . ange-ftp-fix-name-for-cms) ange-ftp-dumb-host-types 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] ange-ftp-fix-dir-name-func-alist (cms . ange-ftp-fix-dir-name-for-cms)] 3) (defvar ange-ftp-cms-host-regexp nil "\ Regular expression to match hosts running the CMS operating system.") (defalias (quote ange-ftp-cms-host) #[(host) "…Á ÃŽÄ \"*‡" [ange-ftp-cms-host-regexp match-data match-data ((store-match-data match-data)) string-match host] 3]) (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 "\ Mark HOST as the name of a CMS host." (list (read-string "Host: " (let ((name (or (buffer-file-name) default-directory))) (and name (car (ange-ftp-ftp-name name))))))]) (byte-code "ÀÁÂ\"ˆÃ ž„Å BÀÆÇ\"ˆÃž„!ÉBÊË!‡" [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] cms ange-ftp-parse-list-func-alist (cms . ange-ftp-parse-cms-listing) ange-ftp-cms-make-compressed-filename #[(name &optional reverse) "ÀÁ\n\"ƒÃ\nÄÅOD‡Æ\nÇPD‡" [string-match "-Z$" name nil 0 -2 t "-Z"] 4] ange-ftp-make-compressed-filename-alist (cms . ange-ftp-cms-make-compressed-filename) provide ange-ftp] 3) emacs-19.22/lisp/appt.elc100666 74777 1 15424 5472116626 13721 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Nov 16 04:29:57 1993 ;;; from file /home/fsf/rms/e19/lisp/appt.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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 10 "\ *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 5 "\ *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.") (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 1 "\ *Number of minutes to wait between checking the appointment list.") (defalias 'appt-check #[nil "ÁU„Âà A@Ä¥\"ÅU…/ÆÇ ŠÊË ÌÍO!ÊË ÏÐO!Ä_\\‰ÁUƒSƒLƒLÕ ˆ‚SÖÕ ˆ)…-…-@@@‰Z ƒŠWƒŠA‰ƒj@@@‚jWƒ¨\\Vƒ¨TZ Ý X…, ÅY…,ƒÚßà!\"ˆ!ŔŕOâ @A@#ˆ‚ñ#ƒèäå@A@\"ˆ&ƒñçÁ!ˆ(ƒßà!\"ˆ!ŔŕOé êë°!Šì qˆ)íî !ˆïÅ!ˆ ÅU…,A‰).‡" [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 appt-visible message "%s" appt-audible beep appt-display-mode-line "App't in " " min. " " " other-buffer set-buffer-modified-p buffer-modified-p sit-for] 6 "\ 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. This function is run from the loadst process for display time. Therefore, you need to have `(display-time)' in your .emacs file."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias appt-disp-window #[(min-to-app new-time appt-msg) "ÀÁ!ˆÂ‹‡" [require electric ((byte-code "À ÁÂà !8U„Ä ˆÅ ˆpÇÈ!q Ê Ì ΰÐ !ˆÑ!ˆÓÔ !!ˆÕÖ!ˆƒDØÙ!ˆÚ!ˆƒRØÙ!ˆÜ !*‡" [frame-height 3 window-edges selected-window appt-select-lowest-window split-window this-buffer get-buffer-create "appt-buf" appt-disp-buf "-------------------- Appointment in " min-to-app " minutes. " new-time " %-" mode-line-format pop-to-buffer insert-string appt-msg shrink-window-if-larger-than-buffer get-buffer-window set-buffer-modified-p nil appt-audible beep 1 sit-for appt-display-duration kill-buffer] 5))] 2] 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]] 3) (defalias 'appt-add #[(new-appt-time new-appt-msg) "ÀÁ\n\"„ ÃÄ!ˆ\nÅQÈ\n!C‰ CB\nË \nC\" Í !‰ +‡" [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 "\ Add an appointment for the day at TIME and issue MESSAGE. The time should be in either 24 hour format or am/pm format." "sTime (hh:mm[am/pm]): \nsMessage: "]) (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 nil tmp-appt-msg-list message ""] 3 "\ Delete an appointment from the list of appointments." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias appt-make-list #[nil "ÀŠ\nƒ{\nɃzÆÇ @@\"ƒzÈ @A!ÉÊO ÌÍ \"ƒr ΔΕOΕ GWƒI ΕÐ\\ÀO‚KÃÌÑ \"ˆÒ ΔΕO!C‰CB  Õ C\"+‚#) A‰„*Ö !×Ø ÙÚO!×Ø ÜÝO!ß_\\ @@@! …¼! W…¼ A‰ƒ  @@@!‚ -‡" [nil appt-time-msg-list diary-entries-list "" new-time-string entry-list calendar-date-equal calendar-current-date prin1-to-string 2 -2 time-string string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?.*" 0 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] 5] appt-sort-list #[(appt-list) "À\nƒ:\n@‰@@\nA‰ƒ+ @@@W„$ @‰@@ A‰„Æ C\"Ç \n\"+‚ )‡" [nil order-list appt-list element element-time tmp-list append delq] 4]] 3) (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 "\ Convert hour:min[am/pm] format to minutes from midnight."]) (byte-code "ÀÀ‡" [appt-check display-time-hook] 1) emacs-19.22/lisp/apropos.elc100666 74777 1 11217 5416160060 14421 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:15:11 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/apropos.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar apropos-do-all nil "\ *Whether `apropos' and `super-apropos' should do everything that they can. Makes them run 2 or 3 times slower. Set this non-nil if you have a fast machine.") (defalias 'apropos #[(regexp &optional do-all pred) "†  \"‰„ÆÇ \"ˆ‚%È !ˆÉÊ Ë $‘ˆ )‡" [apropos-do-all do-all apropos-internal regexp pred apropos-accumulate message "No apropos matches for `%s'" apropos-get-doc "*Help*" apropos-print-matches nil] 7 "\ Show all symbols whose names contain matches for REGEXP. If optional argument DO-ALL is non-nil, does more (time-consuming) work such as showing key bindings. Optional argument PRED is called with each symbol, and if it returns nil, the symbol is not shown. Returns list of symbols and documentation found." "sApropos (regexp): \nP"]) (defalias (quote apropos-get-doc) #[(list) "Á‰‰‰:ƒE @Æ\n!…Ç\n!È\nÉ\" …* ÊËÌ \"O …6 ÊËÌ \"O \n E ˆ A‰‚ ,‡" [list nil symbol var-doc fn-doc p fboundp documentation documentation-property variable-documentation 0 string-match "\n"] 6]) (defalias 'super-apropos #[(regexp &optional do-all) "† ‰‰‰Ç!‰„\"ÉÊ\"ˆ‚5 ƒ*ËÌ!ˆÍÎÂÏ $‘ˆ,‡" [apropos-do-all do-all nil item var-doc fn-doc apropos-accumulate super-apropos-check-doc-file regexp message "No apropos matches for `%s'" mapatoms super-apropos-accumulate "*Help*" apropos-print-matches t] 7 "\ Show symbols whose names/documentation contain matches for REGEXP. If optional argument DO-ALL is non-nil, does more (time-consuming) work such as showing key bindings and documentation that is not stored in the documentation file. Returns list of symbols and documentation found." "sSuper Apropos: \nP"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias super-apropos-check-doc-file #[(regexp) " PÃ\nÄ\"ÆÆÆ Æ\nŠ qˆÄ Ì !ˆebˆÍÆÄ#ƒ}ÏÐ!ˆ`TfÑ=ƒ<Ò‚=ÓÓuˆÔ !`ÕÐÆÖ#ƒU`S‚V`{ \nž‰„qƉE‰\nB\n›  ˆ‚#)\n.‡" [data-directory internal-doc-file-name doc-file find-file-noselect t doc-buffer nil type symbol doc sym-list buffer-read-only bury-buffer re-search-forward regexp search-backward "" 70 1 2 read search-forward move item] 6] super-apropos-accumulate #[(symbol) "À  !\"ƒ+Ä !‰AÆ !† A@ ˆ AAÇ !†&È 8 ˆ‚^Æ !‰ ƒDÀ  \"ƒDÄ !A  ˆÇ !‰\nƒ^À \n\"ƒ^Ä !AA\n ˆË‡" [string-match regexp symbol-name symbol apropos-get-accum-item item safe-documentation safe-documentation-property 2 fn-doc var-doc nil] 5] apropos-print-matches #[(matches &optional regexp spacing do-all) "À Â\"‰pɉ‰ Š\nqˆ „\"ËÌ!ˆ :ƒÜ @‰@ A  ƒAo„AÎ ˆË !ˆƒdÐ !ƒd„dŠqˆÑ \"ˆ)ÓƒÔ›‰„xÐ !ƒÕÖ×\"ˆ ƒŒËØÙ Ú#!ˆ‚ËÛ!ˆÎ ˆA@‰ƒ¯ËÜ!ˆËƒ¬Ý !‚­ !ˆn„¶Î ˆÞ8‰ƒÒËß!ˆËƒÏÝ !‚Ð !ˆn„\"Î ˆ‚\".Ó‡" [sort matches #[(a b) "@ @™‡" [a b] 2] nil tem symbol keys-done item old-buffer p standard-output princ "No matches found." spacing terpri do-all commandp apropos-match-keys regexp t 3 indent-to 30 1 mapconcat key-description ", " "(not bound to any keys)" " Function: " substitute-command-keys 2 " Variable: "] 7] apropos-match-keys #[(alist &optional regexp) "À Á… Â!Âà !\"ÅÅÅÅ Å\nÅ Å :ƒ¬ @A @@ A@Í=ƒEA¢;ƒUA‰‚G:ƒ&@:ƒñ@A @@\n :ƒ€ A9ƒ€ A  9ƒ£ƒ£ÏÐ !\"ƒ£ ž‰ ƒ£Ò!„®\n¨„¼ÓÔ\n!\"‰\n‚ÆÕ\n!P‰\nƒ£ƒæÖ\n\"‰ ƒæ §„æ  =ƒ£ \nÅB¤ˆ‚£Ò@!ƒ£×@@G‰Wƒ¢H \n :ƒ+ A9ƒ+ A  9ƒ™ƒ™ÏÐ !\"ƒ™ ž‰ ƒ™Ò!„Y\n¨„gÓÔ\n!\"‰\n‚qÕ\n!P‰\nƒ™ƒ‘Ö\n\"‰ ƒ‘ §„‘  =ƒ™ \nÅB¤ˆT‰‚+A‰‚W. ‡" [current-local-map append accessible-keymaps current-global-map maps nil map sequence i command key local item keymap regexp string-match symbol-name alist vectorp vconcat vector char-to-string lookup-key 0 len vec] 5] apropos-get-accum-item #[(symbol) " ž†‰E B ž‡" [symbol apropos-accumulate nil] 3]] 3) (defalias 'safe-documentation #[(function) "9ƒÁ!ƒK‚‰‚¢Ã=ƒ A:??…:@Ä>??…:Å8‰;…:‡" [function fboundp 0 macro (lambda autoload) 2] 3 "\ Like documentation, except it avoids calling `get_doc_string'. Will return nil instead."]) (defalias 'safe-documentation-property #[(symbol) "ÁN‰§?… ‡" [symbol variable-documentation] 3 "\ Like documentation-property, except it avoids calling `get_doc_string'. Will return nil instead."]) emacs-19.22/lisp/array.elc100666 74777 1 53667 5431755512 14104 0ustar ericdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Aug 10 13:30:49 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/array.el ;;; emacs version 19.18.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'array-cursor-in-array-range #[nil " ¦ Y†+ _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 "\ Returns t if the cursor is in a valid array cell. Its ok to be on a row number line."]) (defalias 'array-current-row #[nil "À …\nÁ\n \"T‡" [array-cursor-in-array-range floor buffer-line lines-per-row] 3 "\ Return the array row 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 "\ Return the array column of the field in which the cursor is located."]) (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 "\ Set `array-row' and `array-column' to their current values or to the optional arguments A-ROW and A-COLUMN."]) (defalias 'array-update-buffer-position #[nil "À i‰‡" [current-line buffer-line buffer-column] 2 "\ Set buffer-line and buffer-column to their current values."]) (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 "\ Display the row and column in which the cursor is positioned." nil]) (defalias 'array-display-local-variables #[nil "Àp!Âà !ˆÅ ˆÆÇÈ \"!ˆÆÇÉÊ !\"!ˆÆÇÌÊ !\"!ˆÆÇÎÊ!\"!ˆÆÇÐÊ!\"!ˆÆÇÒÊ!\"!ˆÆÇÔÊ!\"!ˆÆÇÖÊ!\"!‘)‡" [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 "\ Display the current state of the local variables in the minibuffer." nil]) (defalias 'array-beginning-of-field #[(&optional go-there) "‰ ¦Z ƒÄ\n!‚\n)‡" [buffer-column field-width goal-column go-there move-to-column-untabify] 3 "\ Return the column of the beginning of the current field. Optional argument GO-THERE, if non-nil, means 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 "\ Return the column of the end of the current array field. If optional argument GO-THERE is non-nil, go there too."]) (defalias 'array-move-to-cell #[(a-row a-column) " S_\nƒ  ÄÅ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] 5 "\ 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-row #[(a-row) " S_\n¦\\ ‰ ¦Z‰\nZyˆÇ !ˆ *‡" [lines-per-row a-row buffer-line buffer-column field-width goal-column goal-line move-to-column-untabify] 5 "\ 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-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] 6 "\ 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-one-row #[(sign) "À Á †\nÂÃ! Uƒ ÈUƒ ÂÉ!‚B ÈUƒ3ÊUƒ3ÂË!‚B _yˆÍ !ˆ \\*‡" [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 "\ 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-column #[(sign) "À †ÁÂ!‰ Uƒ ÆUƒÁÇ!‚m ÆUƒ- ÈUƒ-ÁÉ!‚m ÈUƒK \n¦ÆUƒKÈyˆË \nS_!ˆ‚j ÆUƒ` \n¦ÍUƒ`Æyˆ‚jËÎ  _\\!ˆ \\)‡" [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 "\ 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-normalize-cursor #[nil "iÁŠÂÃ!ˆ`)SwˆÄ )‡" [buffer-column " " array-end-of-field t array-maybe-scroll-horizontally] 3 "\ 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-maybe-scroll-horizontally #[nil "À Á  Yƒ \n\\XƒÅ‚5 \n\\Vƒ,Æ Z\nÇ¥Z!‚5È Z\nÇ¥\\!*‡" [window-hscroll window-width w-width w-hscroll buffer-column nil scroll-left 2 scroll-right] 4 "\ If necessary, scroll horizontally to keep the cursor in view."]) (defalias 'array-next-row #[(&optional arg) "À ià !ÅUƒÆ !ˆ‚%ÇÈÉ †ÊË! \\ \"!ˆ*Í ‡" [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 "\ Move down one array row, staying in the current array column. If optional ARG is given, move down ARG array rows." "p"]) (defalias 'array-previous-row #[(&optional arg) "À [!‡" [array-next-row arg] 2 "\ Move up one array row, staying in the current array column. If optional ARG is given, move up ARG array rows." "p"]) (defalias 'array-forward-column #[(&optional arg) "À ià !ÅUƒÆ !ˆ‚%ÇÈÉ †ÊË! \\ \"!ˆ*Í ‡" [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 "\ 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." "p"]) (defalias 'array-backward-column #[(&optional arg) "À [!‡" [array-forward-column arg] 2 "\ 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." "p"]) (defalias 'array-goto-cell #[(a-row a-column) "ÀÁ\n \"Á \"\"ˆÆ ‡" [array-move-to-cell limit-index a-row max-row a-column max-column array-normalize-cursor] 5 "\ Go to array row A-ROW and array column A-COLUMN." "nArray row: \nnArray column: "]) (defalias 'array-field-string #[nil "ŠÀÁ!ˆ`)ŠÂÁ!ˆ`){‡" [array-beginning-of-field t array-end-of-field] 3 "\ Return the field string at the current cursor location."]) (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 "\ 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-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 "\ 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-to-row #[(a-row) " ZÃ\n!‰ÅU?…\n ¥ ÅV…@Ç!ˆÈ ˆÉ\n`ŠËÉ!ˆ`)|ˆ cˆ)Í!ˆ S‰‚+‡" [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 "\ 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-column #[(a-column) " ZÃ\n!‰ÅU?…\n ¥ ÅV…@Ç!ˆÈ ˆÉ\n`ŠËÉ!ˆ`)|ˆ cˆ)Í!ˆ S‰‚+‡" [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 "\ 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-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 "\ Copy the current field into the cell at A-ROW, A-COLUMN. Leave point at the beginning of the field."]) (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 "\ Copy the current field one array row down. If optional ARG is given, copy down through ARG array rows." "p"]) (defalias 'array-copy-up #[(&optional arg) "À [!‡" [array-copy-down arg] 2 "\ Copy the current field one array row up. If optional ARG is given, copy up through ARG array rows." "p"]) (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 "\ Copy the current field one array column to the right. If optional ARG is given, copy through ARG array columns to the right." "p"]) (defalias 'array-copy-backward #[(&optional arg) "À [!‡" [array-copy-forward arg] 2 "\ Copy the current field one array column to the left. If optional ARG is given, copy through ARG array columns to the left." "p"]) (defalias 'array-copy-column-forward #[(&optional arg) "À ˆÁ ˆ\n„ÃÄ!ˆÅÆ!ˆÇ WƒOTÊ\n\"ˆÀ ˆË  Í!Ï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 "\ 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." "p"]) (defalias 'array-copy-column-backward #[(&optional arg) "À [!‡" [array-copy-column-forward arg] 2 "\ Copy the entire current column one column to the left. If optional ARG is given, copy through ARG columns to the left." "p"]) (defalias 'array-copy-row-down #[(&optional arg) "À ˆÁ ˆ\n„ÃÄ!ˆ\nÅUƒ\"ÇUƒ\"ÃÈ!ˆ‚¸\n Uƒ7ÅUƒ7ÃÊ!ˆ‚¸ŠË\nÅ\"ˆ`)ŠË\n \"ˆÅyˆ`){ \nÏ\\ \"‰ZÒ!‰ÔU?…t¥ÔVƒ«\\ËÅ\"ˆÖ`ŠË \"ˆÅ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 "\ Copy the entire current row one row down. If optional ARG is given, copy through ARG rows down." "p"]) (defalias 'array-copy-row-up #[(&optional arg) "À [!‡" [array-copy-row-down arg] 2 "\ Copy the entire current array row into the row above. If optional ARG is given, copy through ARG rows up." "p"]) (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 "\ Copy the field at mark into every cell between mark and point." nil]) (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 "\ Create the template of an array." nil]) (defalias 'array-reconfigure-rows #[(new-columns-per-line new-rows-numbered) "À ƒ$\nÃYƒ\n Xƒʼn‚ÆÇÈÉ \"!!‚)\nË=ƒ2À\n‚D\nÌ=ƒ?Å\n‚DÍÎ!\nÏÐ!ˆÑ ˆÒp!ÔÕ!  !\"#Ã$å ˆæed#ˆqˆebˆ$Xƒ2ƒ–\n„¹„ \nƒ¹ƒ±\n„±çÃ!ˆ‚¹èÈé$\"!ˆ\nUƒÒƒËÂÌêZyˆ‚)ëS\"êëS\n\"ê,-././Wƒð.T#_!ˆçÃ!ˆ.T‰.‚ëêyˆ,-Wƒ%ð!\n_!ˆñ ˆ,T‰,‚ Ã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 "\ 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." "nColumns per line: \ncRows numbered? (y or n) "]) (defalias 'array-expand-rows #[nil "À Â\"‡" [array-reconfigure-rows max-column 110] 3 "\ Expand the rows so each fits on one line and remove row numbers." nil]) (defalias (quote limit-index) #[(index limit) "ÁWƒÁ‡\nVƒ\n‡‡" [index 1 limit] 2]) (defalias 'xor #[(pred1 pred2) "„ …… ?‡" [pred1 pred2] 1 "\ Returns the logical exclusive or of predicates PRED1 and PRED2."]) (defalias 'current-line #[nil "ŠÀyˆÁe`\")‡" [0 count-lines] 3 "\ Return the current buffer line at point. The first line is 0."]) (defalias 'move-to-column-untabify #[(column) "Á!Uƒ †\nƒÃÄ!‡Å ˆÁ!‡" [column move-to-column respect-tabs error "There is a TAB character in the way." untabify-backward] 3 "\ Move to COLUMN on the current line, untabifying if necessary. Return COLUMN."]) (defalias 'untabify-backward #[nil "Š`ÁÂ!ˆÃ`\"*‡" [start backward-char 1 untabify] 3 "\ Untabify the preceding tab."]) (defvar array-mode-map nil "\ Keymap used in array mode.") (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) (defalias 'array-mode #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÀÊ!ˆÀË!ˆÀÌ!ˆÀÍ!ˆÎ Ï ˆÐÒŠÔ qˆ)ÕÖ !ˆ×Ø!ˆÙÚ!ˆÛÛÝ!ˆßà!‡" [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 other-buffer set-buffer-modified-p buffer-modified-p sit-for 0 make-variable-buffer-local truncate-lines t overwrite-mode use-local-map array-mode-map run-hooks array-mode-hook] 2 "\ 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'." nil]) (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 "\ Initialize the variables associated with the array in this buffer."]) (defalias 'array-init-max-row #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Number of array rows: " max-row] 3 "\ Initialize the value of max-row."]) (defalias 'array-init-max-column #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Number of array columns: " max-column] 3 "\ Initialize the value of max-column."]) (defalias 'array-init-columns-per-line #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Array columns per line: " columns-per-line] 3 "\ Initialize the value of columns-per-line."]) (defalias 'array-init-field-width #[(&optional arg) "† ÁÂÃ!!‰‡" [arg string-to-int read-input "Field width: " field-width] 3 "\ Initialize the value of field-width."]) (defalias 'array-init-rows-numbered #[(&optional arg) "†ÁÂ!‰‡" [arg y-or-n-p "Rows numbered? " rows-numbered] 2 "\ Initialize the value of rows-numbered."]) (defalias 'array-init-line-length #[(&optional arg) "† \n_‰‡" [arg field-width columns-per-line line-length] 2 "\ Initialize the value of line-length."]) (defalias 'array-init-lines-per-row #[(&optional arg) "†Á\nS \" ƒÅ‚Æ\\‰‡" [arg floor max-column columns-per-line rows-numbered 2 1 lines-per-row] 3 "\ Initialize the value of lines-per-row."]) emacs-19.22/lisp/asm-mode.elc100666 12120 1 7712 5416160161 14254 0ustar rmsdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:16:16 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/asm-mode.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar asm-comment-char 59 "\ *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 (quote asm-mode-abbrev-table) nil) (defvar asm-mode-map nil "\ Keymap for Asm mode.") (byte-code "„%Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÊ#ˆÌÍ!„.Î ÌÏ!„7ÎÌÐ!„@η" [asm-mode-map make-sparse-keymap define-key ";" asm-comment ":" asm-colon " " tab-to-tab-stop "\n" asm-newline " " boundp asm-code-level-empty-comment-pattern nil asm-flush-left-empty-comment-pattern asm-inline-empty-comment-pattern] 4) (defalias 'asm-mode #[nil "À ˆÁ\n!ˆÃÅÉÊ!ˆË \nÌ\n!ˆÍÎ!ˆÏÑ\n#ˆÏÒÓ\n#ˆÔÕ!!É×!ˆØPÉÙ!ˆÚPÛÜQÞ‰ßR ቉߰\")Éã!ˆä#Éå!ˆæ%çè!ˆé*Íë!‡" [kill-all-local-variables use-local-map asm-mode-map "Assembler" mode-name asm-mode major-mode asm-mode-abbrev-table local-abbrev-table make-local-variable asm-mode-syntax-table make-syntax-table set-syntax-table run-hooks asm-mode-set-comment-hook modify-syntax-entry asm-comment-char "<" 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 auto-fill-mode 1 " " fill-prefix asm-mode-hook] 5 "\ 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-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} " nil]) (defalias 'asm-colon #[nil "ŠÀyˆÁÂ!ƒ à ˆ)ÄcˆÅ ‡" [0 looking-at "[ ]+\\(\\sw\\|\\s_\\)+$" delete-horizontal-space ":" tab-to-tab-stop] 2 "\ Insert a colon; if it follows a label, delete the label's indentation." nil]) (defalias 'asm-newline #[nil "lƒÀ ˆÁcˆÂ ‡" [delete-horizontal-space "\n" tab-to-tab-stop] 1 "\ Insert LFD + fill-prefix, to bring us back to code-indent level." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias asm-line-matches #[(pattern &optional withcomment) "ŠÀyˆÁ\n!)‡" [0 looking-at pattern] 2] asm-pop-comment-level #[nil "ÀˆÁ ˆh\nUƒÃÄ!ˆ‚Á ˆn?…!ÅyˆÆÄ!‡" [nil delete-horizontal-space asm-comment-char delete-backward-char 1 0 open-line] 2]] 3) (defalias 'asm-comment #[nil "ÀÁ!ƒ ˆÃ ˆ ±ˆ‚[ÀÆÇ \"!ƒ#È ˆ‚[À !ƒ0 cˆ‚[À\n!ƒCË ˆ ‰ ±ˆ‚[À !ƒXË ˆÃ ˆ ±ˆ‚[ cˆÍ‡" [asm-line-matches "^[ ]*$" delete-horizontal-space tab-to-tab-stop asm-comment-char comment-start format "^[^%c]+$" 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 "\ 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." nil]) emacs-19.22/lisp/assoc.elc100666 74777 1 7637 5421570215 14044 0ustar ericdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Jul 16 14:16:45 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/assoc.el ;;; emacs version 19.16.10. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'asort #[(alist-symbol key) "ÁÂÃ!!Ä\"L‡" [alist-symbol sort copy-alist eval #[(a b) "@ š‡" [a key] 2]] 5 "\ 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 'aelement #[(key value) " BC‡" [key value] 2 "\ 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 'aheadsym #[(alist) "@@‡" [alist] 1 "\ Return the key symbol at the head of ALIST."]) (defalias 'anot-head-p #[(alist key) "À !\nš?‡" [aheadsym alist key] 2 "\ 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 'aput #[(alist-symbol key &optional value) "À \n\"ÃÆ \"ˆÈ!‰„ L‚9É \"ƒ- ¤L‚9\nƒ8 @ ‚9 *‡" [aelement key value nil alist elem asort alist-symbol eval anot-head-p] 4 "\ 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 'adelete #[(alist-symbol key) "À \n\"ˆÃ !‰„Å‚ Æ \n\"ƒ ‚ AL)‡" [asort alist-symbol key eval alist nil anot-head-p] 4 "\ 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 'aget #[(alist key &optional keynil-p) "À ! „ Â2Ä \"ˆÆ\n \"ƒÂ2\n@A†2ƒ+Â2\n@@†2Ã)‡" [copy-alist alist copy nil asort key anot-head-p keynil-p] 3 "\ 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 'amake #[(alist-symbol keylist &optional valuelist) "@A @ A „Æ #ˆ‚(È \n#ˆÆ #ˆ,É!‡" [keylist valuelist valcdr valcar keycdr keycar aput alist-symbol amake eval] 4 "\ 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."]) (provide (quote assoc)) emacs-19.22/lisp/autoinsert.elc100666 74777 1 3016 5416160170 15113 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:16:24 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/autoinsert.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar auto-insert-alist (quote (("\\.tex$" . "tex-insert.tex") ("\\.c$" . "c-insert.c") ("\\.h$" . "h-insert.c") ("[Mm]akefile" . "makefile.inc") ("\\.bib$" . "tex-insert.tex"))) "\ A list specifying text to insert by default into a new file. Elements look like (REGEXP . FILENAME); if the new file's name matches REGEXP, then the file FILENAME is inserted into the buffer. Only the first matching element is effective.") (defvar auto-insert-directory "~/insert/" "\ *Directory from which auto-inserted files are taken.") (defalias 'insert-auto-insert-files #[nil "Á\n!à „-ƒ-Ç@@ \"ƒ%@A‰‚\nA‚ …S P Ê !ƒIË !ˆÌÃ!‚RÍÎ \"ˆÏÐ!)+‡" [auto-insert-alist file-name-sans-versions buffer-file-name nil insert-file name alist string-match auto-insert-directory file file-readable-p insert-file-contents set-buffer-modified-p message "Auto-insert: file %s not found" sleep-for 1] 4 "\ Insert default contents into a new file. Matches the visited file name against the elements of `auto-insert-alist'."]) (byte-code "À BÀ‡" [insert-auto-insert-files find-file-not-found-hooks] 2) emacs-19.22/lisp/autoload.elc100666 74777 1 14740 5432646533 14566 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 13 04:14:18 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/autoload.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (defalias 'make-autoload #[(form file) "¢‰Â>…F Ã=ĉA‰@AA‰@‰;ƒ,A‚.ÄÈÉD\n @¢Ë=…CÉÌD¯+)‡" [form car (defun defmacro) defmacro nil doc name macrop autoload quote file interactive macro] 8 "\ Turn FORM, a defun or defmacro, into an autoload for source file FILE. Returns nil if FORM is not a defun or defmacro."]) (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 " \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.") (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#‡" [put autoload doc-string-elt 3 defun defvar defconst defmacro] 4) (defalias 'generate-file-autoloads #[(file) "pÀÁ\n!ÄÅ \"ƒ Ɖ”O‚ )À‰‰Ç\n!À \n   Ð\n!Ñ\n!ÓÑ!!‰G‰GWƒ^ÆO˜ƒ^ÀO+×Ø\n\"ˆŠÙŽÚ\n!qˆŠŒ~ˆebˆm„aÛÀwˆÜÝ!!ƒKß!ˆàÀwˆá\nlƒ8âp!ãyˆ$å$ \"&$¢çN'&ƒ¼$A@B‚À$&'ƒ-'&8;ƒ-'S&›‰(A)(À¡ˆêë\"ˆá,íî&\"ˆ)êï\"ˆêð)@!ãÀO\"ˆ)A„êñ\"ˆ‚$êò\"ˆêð)A!ãÀO\"ˆó!ˆ*‚4ô&\"ˆ+‚s`5ãyˆê5`{\"ˆ)‚sÜö!ƒWãyˆ‚s÷ã!ˆãyˆ‚s,\nƒ8cˆùú \nûü\n!8¯\"ˆó!ˆý\nþ±ˆbˆ?cˆ×@\n\".‡" [nil file-name-nondirectory file name string-match "\\.elc?$" 0 get-file-buffer output-end visited done-any float-output-format 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 " looking-at regexp-quote generate-autoload-cookie search-forward " " t 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" prin1-to-string ")" " " terpri print begin ";" forward-sexp generate-autoload-section-header prin1 autoloads 5 file-attributes ";;; Generated autoloads from " "\n" generate-autoload-section-trailer "Generating autoloads for %s...done"] 9 "\ 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." "fGenerate autoloads for 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.") (defalias 'update-file-autoloads #[(file) "À !ÃÄ\n\"ƒ\nʼn”O‚\n)ÆÇ ! \nŠË !qˆË !qˆŠŒ~ˆebˆÍÆÏ#ƒ´ÆÐÑÓ8\n˜ƒ°Å”Ô8ÕÖ !8ƒhÚ!„ž<ƒžGÓUƒž@@V„–@@UƒžA@A@YƒžÛÜ \"ˆ‚¬Í!ˆ`|ˆÞ !ˆÏ +)‚2) „ØŠË !qˆŠŒ~ˆebˆÍÆÏ#+ƒØà‹ˆÞ !ˆ)tƒàá ˆ?…óÇ !‰…óâ!,‡" [file-name-nondirectory file name string-match "\\.elc?$" 0 nil get-file-buffer existing-buffer done 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." generate-autoload-section-trailer generate-file-autoloads generate-autoload-cookie ((byte-code "Àp!ˆÁÂÃÄÅ\"!!‘ˆÇ ˆÈy‡" [switch-to-buffer "*Help*" princ substitute-command-keys format "Move point to where the autoload section\nfor %s should be inserted.\nThen do \\[exit-recursive-edit]." file recursive-edit 0] 6)) save-buffer kill-buffer] 5 "\ Update the autoloads for FILE in `generated-autoload-file' (which FILE might bind in its local variables)." "fUpdate autoloads for file: "]) (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 "Library \"%s\" (load file \"%s\") doesn't exist. Remove its autoload section? " 2 (byte-code "ÀÁÂà 8\"ʼ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 "\ Update sections of the current buffer generated by \\[update-file-autoloads]." nil]) (defalias 'update-directory-autoloads #[(dir) "ÀÁ ÄÅ#\"ˆt…ŠÆ!qˆÈ )‡" [mapcar update-file-autoloads directory-files dir nil "\\.el$" find-file-noselect generated-autoload-file save-buffer] 6 "\ Run \\[update-file-autoloads] on each .el file in DIR." "DUpdate autoloads for directory: "]) (defalias 'batch-update-autoloads #[nil "„ÁÂ!ˆÃ  ƒÇȈ A‰„ÉÊ!ˆËÌ!ˆÍƒ.΂/Ï!*‡" [noninteractive error "batch-update-autoloads is to be used only with -batch" nil command-line-args-left args lost file (byte-code "ÀÁ‡" [lossage (byte-code "ÀÁ\n@!!ƒÃ\n@!ˆ‚Ä\n@!ˆÀ‡" [file-directory-p expand-file-name args update-directory-autoloads update-file-autoloads] 3) ((error (byte-code "ÀÁ\n@ #ˆÄÆÇÈ\"‡" [message ">>Error processing %s: %s" args lossage t lost throw file nil] 4)))] 3) save-some-buffers t message "Done" kill-emacs 1 0] 3 "\ 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\""]) (provide (quote autoload)) emacs-19.22/lisp/awk-mode.elc100666 74777 1 3577 5416160217 14440 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:16:47 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/awk-mode.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar awk-mode-syntax-table nil "\ Syntax table in use in Awk-mode buffers.") (byte-code "„dÁ ÂÃÄ#ˆÂÅÆ#ˆÂÈÆ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÌ#ˆÂÎÌ#ˆÂÏÌ#ˆÂÐÌ#ˆÂÑÌ#ˆÂÒÌ#ˆÂÓÌ#ˆÂÔÌ#ˆÂÕÌ#ˆÂÖ×#ˆÁ‡" [awk-mode-syntax-table make-syntax-table modify-syntax-entry 92 "\\" 10 "> " emacs-lisp-mode-syntax-table 12 35 "< " 47 "." 42 43 45 61 37 60 62 38 124 39 "\""] 4) (defvar awk-mode-abbrev-table nil "\ Abbrev table in use in Awk-mode buffers.") (define-abbrev-table (quote awk-mode-abbrev-table) nil) (defalias 'awk-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍP ËÏ!ˆ ËÐ!ˆÑËÒ!ˆÓËÔ!ˆÑËÕ!ˆÖË×!ˆØËÙ!ˆÚËÛ!ˆÜËÝ!ˆÞßà!‡" [kill-all-local-variables 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 awk-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 "\ 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." nil]) emacs-19.22/lisp/backquote.elc100666 13437 1 11663 5471634064 14715 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 03:05:08 1993 ;;; from file /home/fsf/rms/e19/lisp/backquote.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defalias 'bq-push '(macro . #[(v l) "À  EE‡" [setq l cons v] 5 "\ Pushes evaluated first form onto second unevaluated object a list-value atom"])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias bq-caar (macro . #[(l) "À‰ DD‡" [car l] 3]) bq-cadr (macro . #[(l) "ÀÁ\nDD‡" [car cdr l] 3]) bq-cdar (macro . #[(l) "ÀÁ\nDD‡" [cdr car l] 3])] 3) (defconst backquote-unquote (quote (\,)) "\ *A list of all objects that stimulate unquoting in `. Memq test.") (defconst backquote-splice (quote (\,@)) "\ *A list of all objects that stimulate splicing in `. Memq test.") (defalias '\` '(macro . #[(form) "À !‡" [bq-make-maker form] 2 "\ (` FORM) is a macro that expands to code to construct FORM. Note that this is very slow in interpreted code, but fast if you compile. FORM is one or more nested lists, which are `almost quoted': They are copied recursively, with non-lists used unchanged in the copy. (` a b) == (list 'a 'b) constructs a new list with two elements, `a' and `b'. (` a (b c)) == (list 'a (list 'b 'c)) constructs two nested new lists. However, certain special lists are not copied. They specify substitution. Lists that look like (, EXP) are evaluated and the result is substituted. (` a (, (+ x 5))) == (list 'a (+ x 5)) Elements of the form (,@ EXP) are evaluated and then all the elements of the result are substituted. This result must be a list; it may be `nil'. As an example, a simple macro `push' could be written: (defmacro push (v l) (` (setq (, l) (cons (,@ (list v l)))))) or as (defmacro push (v l) (` (setq (, l) (cons (, v) (, l))))) LIMITATIONS: \"dotted lists\" are not allowed in FORM. The ultimate cdr of each list scanned by ` must be `nil'. (This does not apply to constants inside expressions to be substituted.) Substitution elements are not allowed as the cdr of a cons cell. For example, (` (A . (, B))) does not work. Instead, write (` (A (,@ B))). You cannot construct vectors, only lists. Vectors are treated as constants. BEWARE BEWARE BEWARE Inclusion of (,ATOM) rather than (, ATOM) or of (,@ATOM) rather than (,@ ATOM) will result in errors that will show up very late."])) (defalias 'bq-make-maker #[(form) "ÀÁ‰ÀÆÇÈ !\"ˆ\n…A\nÊ=ƒ,\n šƒ' ‚( D‚A GËUƒ>\n žA@ !‚A\n B,‡" [nil 0 state ec qc tailmaker mapcar bq-iterative-list-builder reverse form quote 1 bq-singles] 4 "\ Given argument FORM, a `mostly quoted' object, produces a maker. See backquote.el for details"]) (byte-code "ÀÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"ˆÂÉÊ\"ˆË ÍÏÂÑÒ\"ˆÂÓÔ\"ˆÂÕÖ\"ˆÂ×Ø\"ˆÂÙÚ\"ˆÂÛÜ\"ˆÂÝÞ\"ˆÂßà\"ˆÂáâ\"ˆÂãä\"ˆÂåæ\"ˆÂçè\"ˆÂéê\"ˆÂëì\"ˆÂíî\"ˆïð!‡" [((quote bq-quotecar) (append car) (list bq-make-list) (cons bq-id)) bq-singles defalias bq-id (lambda (x) x) bq-quotecar #[(x) "À @D‡" [quote x] 2] bq-make-list #[(x) "À B‡" [list x] 2] bq-iterative-list-builder #[(form) ":„ \nžA@!‡@ >ƒ žA@A@!‡@ >ƒ0 žA@A@!‡Ç!‰<ƒO@É=ƒO \nžA@A@!‚W žA@!)‡" [form state bq-quotefns backquote-unquote bq-evalfns backquote-splice bq-splicefns bq-make-maker newform quote] 3] ((nil bq-splicenil) (append bq-spliceappend) (list bq-splicelist) (quote bq-splicequote) (cons bq-splicecons)) bq-splicefns ((nil bq-evalnil) (append bq-evalappend) (list bq-evallist) (quote bq-evalquote) (cons bq-evalcons)) bq-evalfns ((nil bq-quotenil) (append bq-quoteappend) (list bq-quotelist) (quote bq-quotequote) (cons bq-quotecons)) bq-quotefns bq-quotecons #[(form) "@<ƒ@@Á=ƒÁ\n@A@DDA@D‚*ÃÁ\nD@EA@Dĉ‡" [tailmaker quote form list append state] 3] bq-quotequote #[(form) " B‰‡" [form tailmaker] 2] bq-quotelist #[(form) "À D\nB‰‡" [quote form tailmaker] 2] bq-quoteappend #[(form) "<ƒ@<ƒ@@Á=ƒ@A\n@A@B ‡Á\nCDB‰‡" [tailmaker quote form] 3] bq-quotenil #[(form) "C‰‡" [form tailmaker quote state] 2] bq-evalcons #[(form) "À \n@E\nA@Dɇ" [list form tailmaker append state] 3] bq-evalquote #[(form) "GÁWƒ\nÃÄ\"Bʼn‡Å\nDÇDDȉ‡" [tailmaker 3 form mapcar #[(x) "À D‡" [quote x] 2] list state quote append] 4] bq-evallist #[(form) " B‰‡" [form tailmaker] 2] bq-evalappend #[(form) "<ƒ@<ƒ@@Á=ƒ@\n@AB¡‡GÃUƒ+\nBĉ‡Á\nDB‰‡" [tailmaker list form 1 cons state] 3] bq-evalnil #[(form) "C‰‡" [form tailmaker list state] 2] bq-splicecons #[(form) "Á\n@\nA@EDɇ" [form cons tailmaker append state] 4] bq-splicequote #[(form) "Á\nDDɇ" [form quote tailmaker append state] 3] bq-splicelist #[(form) "Á\nBDɇ" [form list tailmaker append state] 3] bq-spliceappend #[(form) " B‰‡" [form tailmaker] 2] bq-splicenil #[(form) "À\nC‰‡" [append state form tailmaker] 2] provide backquote] 3) emacs-19.22/lisp/bib-mode.elc100666 74777 1 12221 5416160246 14416 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:17:10 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/bib-mode.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (byte-code "ÀÁ!„\n !Ä ÅÆ#ˆÄ ÇÈ#ˆÄ ÉÊ#ˆÄ ËÌ#‡" [boundp bib-mode-map copy-keymap text-mode-map define-key " " return-key-bib "" unread-bib "" mark-bib "`" abbrev-mode] 4) (defvar bib-mode-abbrev-table nil "\ Abbrev table used in Bib mode") (defalias 'addbib #[nil "À !ˆdbˆÂ ‡" [find-file bib-file bib-mode] 2 "\ Set up editor to add to troff bibliography file specified by global variable `bib-file'. See description of `bib-mode'." nil]) (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 "\ 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} " nil]) (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 "))) "\ Describes bibliographic database format. A line beginning with the car of an entry is followed by one beginning with the cdr. ") (defalias (quote bib-find-key) #[(slots) "„oƒ\nÁ‡ÂÃ!ˆÄ !‡Æ@@!ƒ@A‡ÄA!‡" [slots "" previous-line 1 bib-find-key bib-assoc looking-at] 2]) (defvar bib-auto-capitalize t "\ *True to automatically capitalize appropriate fields in Bib mode.") (byte-code "À‡" ["%[AETCBIJR]" bib-capitalized-fields nil] 1) (defalias 'return-key-bib #[nil "lƒ^À‰‰‰ÅyˆÆÇ!‰„ ÀˆÈ ˆÉyˆÀˆ`Åyˆ`Ê ! „H ƒHÆ !ƒHŠÎ`Ï\\ \"ˆ)\nbˆ ƒ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 "\ Magic when user hits return, used by `bib-mode'." nil]) (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 "\ Set mark at beginning of current or previous bib entry, point at end." nil]) (defalias 'unread-bib #[nil "À ˆÁ\n!ƒÃÁ\n!Ä `#‡ÅÄ `\n#‡" [mark-bib get-file-buffer unread-bib-file append-to-buffer mark append-to-file] 4 "\ Append current or previous entry to file of unread papers named by variable `unread-bib-file'." nil]) (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).") (byte-code "ÀÁ!„  ÄQÀ‡" [boundp capitalize-title-stop-regexp "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)"] 3) (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 "\ Like `capitalize-region', but don't capitalize stop words, except the first." "r"]) (defalias 'capitalize-title #[(s) "ŠÀÁ!qˆÂ ˆ cˆÄed\"ˆÅ )‡" [get-buffer-create "$$$Scratch$$$" erase-buffer s capitalize-title-region buffer-string] 3 "\ Like `capitalize', but don't capitalize stop words, except the first."]) (provide (quote bib-mode)) emacs-19.22/lisp/bibtex.elc100666 74777 1 74320 5433136702 14224 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Aug 14 06:26:05 1993 ;;; from file /home/fsf/rms/e19/lisp/bibtex.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ÄÃÅ\"ˆÂÆ!„ÄÆÇ\"ˆÀ‡" [provide bibtex fboundp tex-insert-quote autoload "tex-mode" sort-subr "sort"] 3) (defalias 'string-equalp #[(s1 s2) "9ƒ Á!‚ \n9ƒÁ\n!‚\n‰G GU…' – –˜*‡" [s1 symbol-name s2 ss2 ss1] 4 "\ Like string= except differences in case are ignored."]) (defalias 'put-string-on-kill-ring #[(string) " B‰G\nVƒ\nS ›Ã¡ˆ ‰‡" [string kill-ring kill-ring-max nil kill-ring-yank-pointer] 3 "\ Make STRING be the first element of the kill ring."]) (defvar bibtex-clean-entry-zap-empty-opts t "\ *If non-nil, bibtex-clean-entry will delete all empty optional fields.") (defvar bibtex-include-OPTcrossref t "\ *If non-nil, all entries 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 that user want to have as always present when making a bibtex entry. One possibility is for ``keywords''. Entries can be either strings or conses, in which case the car should be string and the cdr the value to be inserted.") (byte-code "ÀÁ!„B ÄÅÆ #ˆÄÇÈ #ˆÄÉÊ #ˆÄËÌ #ˆÄÍÌ #ˆÄÎÏ #ˆÄÐÑ #ˆÄÒÑ #ˆÄÓÔ #ˆ )À‡" [boundp bibtex-mode-syntax-table make-syntax-table st modify-syntax-entry 34 "\"" 36 "$$ " 37 "< " 39 "w " 64 92 "\\" 12 "> " 10 126 " "] 4) (defvar bibtex-mode-abbrev-table nil "\ ") (byte-code "ÀÁÂ\"ˆÃÄ!„ëÅ ÇÈÉ#ˆÇÊË#ˆÇÌÍ#ˆÇÎÏ#ˆÇÐÑ#ˆÇÒÓ#ˆÇÔÕ#ˆÇÖ×#ˆÇØÙ#ˆÇÚÛ#ˆÇÜÝ#ˆÇÞß#ˆÇàá#ˆÇâã#ˆÇäå#ˆÇæç#ˆÇèé#ˆÇêë#ˆÇìí#ˆÇîé#ˆÇïð#ˆÇñò#ˆÇóô#ˆÇõö#ˆÇ÷ø#ˆÇùú#ˆÇûü#ˆÇýþ#ˆÇÿ@#ˆÇAB#ˆ)‡" [define-abbrev-table bibtex-mode-abbrev-table nil boundp bibtex-mode-map make-sparse-keymap km define-key " " bibtex-find-text "\n" bibtex-next-field "\"" bibtex-remove-double-quotes "" bibtex-clean-entry "?" describe-mode "" bibtex-pop-previous "" bibtex-pop-next " " bibtex-kill-optional-field "" bibtex-empty-field "\"" tex-insert-quote "$" ispell-bibtex-entry "" beginning-of-bibtex-entry "…" end-of-bibtex-entry "" bibtex-entry "" bibtex-Article "" bibtex-Book "" bibtex-InProceedings " " bibtex-InBook "i" bibtex-InCollection "I" " " bibtex-Manual "m" bibtex-MastersThesis "M" bibtex-Misc "" bibtex-remove-OPT "" bibtex-PhdThesis "p" bibtex-Proceedings "P" bibtex-preamble "" bibtex-TechReport "" bibtex-string "" bibtex-Unpublished] 4) (defvar bibtex-pop-previous-search-point nil "\ Next point where bibtex-pop-previous should start looking for a similar entry.") (defvar bibtex-pop-next-search-point nil "\ Next point where bibtex-pop-next should start looking for a similar entry.") (defvar bibtex-entry-field-alist (quote (("Article" (("author" "title" "journal" "year") ("volume" "number" "pages" "month" "note")) (("author" "title") ("journal" "year" "volume" "number" "pages" "month" "note"))) ("Book" (("author" "title" "publisher" "year") ("editor" "volume" "number" "series" "address" "edition" "month" "note"))) ("Booklet" (("title") ("author" "howpublished" "address" "month" "year" "note"))) ("InBook" (("author" "title" "chapter" "publisher" "year") ("editor" "pages" "volume" "number" "series" "address" "edition" "month" "type" "note")) (("author" "title" "chapter") ("publisher" "year" "editor" "pages" "volume" "number" "series" "address" "edition" "month" "type" "note"))) ("InCollection" (("author" "title" "booktitle" "publisher" "year") ("editor" "volume" "number" "series" "type" "chapter" "pages" "address" "edition" "month" "note")) (("author" "title") ("booktitle" "publisher" "year" "editor" "volume" "number" "series" "type" "chapter" "pages" "address" "edition" "month" "note"))) ("InProceedings" (("author" "title" "booktitle" "year") ("editor" "volume" "number" "series" "pages" "organization" "publisher" "address" "month" "note")) (("author" "title") ("editor" "volume" "number" "series" "pages" "booktitle" "year" "organization" "publisher" "address" "month" "note"))) ("Manual" (("title") ("author" "organization" "address" "edition" "year" "month" "note"))) ("MastersThesis" (("author" "title" "school" "year") ("address" "month" "note" "type"))) ("Misc" (nil ("author" "title" "howpublished" "year" "month" "note"))) ("PhdThesis" (("author" "title" "school" "year") ("address" "month" "type" "note"))) ("Proceedings" (("title" "year") ("editor" "volume" "number" "series" "publisher" "organization" "address" "month" "note"))) ("TechReport" (("author" "title" "institution" "year") ("type" "number" "address" "month" "note"))) ("Unpublished" (("author" "title" "note") ("year" "month"))))) "\ List of (entry-name (required optional) (crossref-required crossref-optional)) tripples. If the third element is nil, then the first pair can be used. Required and optional are lists of strings. All entry creation functions use this variable to generate entries, and bibtex-entry ensures the entry type is valid. This variable can be used for example to make bibtex manipulate a different set of entry types, e.g. a crossreference document of organization types.") (defalias 'bibtex-cfield #[(name text) "À  İ‡" [",[ \n]*\\(" name "\\)[ \n]*=[ \n]*\\(" text "\\)"] 5 "\ Create a regexp for a bibtex field of name NAME and text 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 "\"[^\"]*[^\\\\]\"\\|\"\"") "\ 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 "\\)" "\\([ \n]+#[ \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 "^[ ]*\\(" bibtex-reference-type "\\)[ ]*[({]\\(" bibtex-field-name "\\)") "\ Regexp defining format of the header line of a bibtex reference entry") (defconst bibtex-type-in-head 1 "\ The regexp subexpression number of the type part in bibtex-reference-head") (defconst bibtex-key-in-head 2 "\ The regexp subexpression number of the key part in bibtex-reference-head") (defconst bibtex-reference (concat bibtex-reference-head "\\([ \n]*" bibtex-field "\\)*" "[ \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 "^[ ]*@[sS][tT][rR][iI][nN][gG][ \n]*[({][ \n]*\\(" bibtex-field-name "\\)[ \n]*=[ \n]*\\(" bibtex-field-text "\\)[ \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.") (defalias 'bibtex-current-entry-label #[(&optional include-cite kill) "ŠÀ ˆÁ\nŠÃ ˆ`)\"ˆ ” •{ƒ ÇÈ \"‚!  \nƒ-Ë !ˆ +‡" [beginning-of-bibtex-entry re-search-forward bibtex-reference-head end-of-bibtex-entry bibtex-key-in-head key include-cite format "\\cite{%s}" val kill put-string-on-kill-ring] 3 "\ Return the label of the bibtex entry containing, or preceding point. Optional argument INCLUDE-CITE, if true means put a '\\cite{}' around the returned value. Second optional argument KILL, if true, means place the returned value in the kill buffer. Interactively; providing prefix argument makes INCLUDE-CITE true, and kill is true by default. Rationale: The intention is that someone will write a function that can be bound to a mouse key so that people entering TeX can just mouse on the bibtex entry and have the citation key inserted at the current point (which will almost certainly be in some other buffer). In the interim this function is marginally useful for keyboard binding and is not bound by default. Suggested binding is ^C-k." (list current-prefix-arg t)]) (defalias 'bibtex-mode #[nil "À ˆÁ\n!ˆÃ !ˆÅÇÁ\n!ˆ \nËÌ!ˆÍ ÎÏ!ˆÏ\\ÒÓ!‡" [kill-all-local-variables set-syntax-table bibtex-mode-syntax-table use-local-map bibtex-mode-map bibtex-mode major-mode "BibTeX" mode-name bibtex-mode-abbrev-table local-abbrev-table make-local-variable paragraph-start "^[ \n ]*$" auto-fill-mode 1 bibtex-text-alignment left-margin run-hooks bibtex-mode-hook] 2 "\ 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] removes the double-quotes around the text of the current field. \\[bibtex-empty-field] replaces the text of the current field with the default \"\". The command \\[bibtex-clean-entry] cleans the current entry, i.e. (i) removes double-quotes 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 dot 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: find-bibtex-duplicates find-bibtex-entry-location hide-bibtex-entry-bodies sort-bibtex-entries validate-bibtex-buffer Variables: bibtex-clean-entry-zap-empty-opts bibtex-entry-field-alist bibtex-include-OPTannote bibtex-include-OPTcrossref bibtex-include-OPTkey bibtex-maintain-sorted-entries bibtex-mode-user-optional-fields Fields: address Publisher's address annote Long annotation used for annotated bibliographies (begins sentence) author Name(s) of author(s), in BibTeX name format booktitle Book title when the thing being referenced isn't the whole book. For book entries, the title field should be used instead. chapter Chapter number crossref The database key of the entry being cross referenced. edition Edition of a book (e.g., \"second\") editor Name(s) of editor(s), in BibTeX name format. If there is also an author field, then the editor field should be for the book or collection that the work appears in howpublished How something strange has been published (begins sentence) institution Sponsoring institution journal Journal name (macros are provided for many) key Alphabetizing and labeling key (needed when no author or editor) month Month (macros are provided) note To help the reader find a reference (begins sentence) number Number of a journal or technical report organization Organization (sponsoring a conference) pages Page number or numbers (use `--' to separate a range) publisher Publisher name school School name (for theses) series The name of a series or set of books. An individual book will will also have it's own title title The title of the thing being referenced type Type of a technical report (e.g., \"Research Note\") to be used instead of the default \"Technical Report\" volume Volume of a journal or multivolume work year Year---should contain only numerals --------------------------------------------------------- Entry to this mode calls the value of bibtex-mode-hook if that value is non-nil." nil]) (defalias 'bibtex-move-outside-of-entry #[nil "`dU„`eU„ÀÁ!„ ˆÃ ˆÄÅdÆ#‡" [looking-at "[ \n]*@" backward-paragraph forward-paragraph re-search-forward "[ \n]*" t] 4 "\ Make sure we are outside of a bib entry"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias ispell-abstract #[nil "À ˆÁÂ!ˆÃ`ŠÄ ˆ`)\"‡" [beginning-of-bibtex-entry re-search-forward "^[ ]*[OPT]*abstract[ ]*=" ispell-region forward-sexp] 3 nil nil] beginning-of-bibtex-entry #[nil "ÀÁÂÃ#‡" [re-search-backward "^@" nil move] 4 nil nil] skip-whitespace-and-comments #[nil "À ÂŽÃÄ!ƒÅ•b‚ÃÆ!… ÇÈ!… ‚*‡" [match-data md ((store-match-data md)) looking-at "\\s>+\\|\\s +" 0 "\\s<" re-search-forward "\\s>"] 2]] 3) (defalias 'end-of-bibtex-entry #[nil "À ˆÁˆÂ ˆÃÅ ˆÅ )‡" [skip-whitespace-and-comments nil beginning-of-bibtex-entry t parse-sexp-ignore-comments forward-sexp] 1 "\ If inside an entry, move to the end of it, otherwise move to the end of the next entry." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias ispell-bibtex-entry #[nil "ÀÁ ˆ` ˆ`\"‡" [ispell-region beginning-of-bibtex-entry end-of-bibtex-entry] 3 nil nil] narrow-to-bibtex-entry #[nil "ŠÀ ˆ`Á ˆ`})‡" [beginning-of-bibtex-entry end-of-bibtex-entry] 2 nil nil] beginning-of-first-bibtex-entry #[nil "ebˆÀÁÂÃ#ƒÄyˆÂ‡oƒmƒ‡ÅÆ!‡" [re-search-forward "^@" nil move 0 message "Warning: No bibtex entries found!"] 4]] 3) (defalias 'hide-bibtex-entry-bodies #[(&optional arg) "ŠÀ ˆÁ  ƒÆ`dÇÈÉ%ˆ‚,ŠÊËdÉ#)ƒ,ŠÌÍÎ\"ˆ)‚ ?Ð !+‡" [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[^@]" replace-regexp "\n\\([^@]\\)" " \\1" selective-display set-buffer-modified-p] 6 "\ Hide all lines between first and last bibtex entries not beginning with @. With argument, show all text." "P"]) (defvar bibtex-sort-ignore-string-entries nil "\ *If true, bibtex @STRING entries are ignored when determining ordering of the buffer (e.g. sorting, locating alphabetical position for new entries, etc.)") (defalias 'sort-bibtex-entries #[nil "ŒÀ ˆ`ŠdbˆÁ ˆÂ ˆ`)}ˆÃÄÅƃ È‚!ÉÊ%)‡" [beginning-of-first-bibtex-entry beginning-of-bibtex-entry end-of-bibtex-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-*" string-equalp "@string" 1 nil] 4] #[nil "ÀÁ!ˆÂ‡" [re-search-forward "{\\s-*" nil] 2] #[nil "ÀÁ!‡" [search-forward ","] 2]] 6 "\ 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." nil]) (defalias 'map-bibtex-entries #[(fun) "À ˆÁÂÃÄ#…& ƒÆÇȔɔ{\"„\nɔɕ{!ˆ‚‡" [beginning-of-bibtex-entry re-search-forward "^@[^{]*{[ ]*\\([^, ]*\\)" nil t bibtex-sort-ignore-string-entries string-equalp "@string{" 0 1 fun] 4 "\ Call FUN for each bibtex entry starting with the current, 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."]) (defalias 'find-bibtex-entry-location #[(entry-name) "À‰à ˆÄņÆ *‡" [nil point previous beginning-of-first-bibtex-entry done (map-bibtex-entries #[(current) " ˜ƒ\nÂÃ!‡ ƒ ™ƒE ` ™…RÆ ˆÇÈ! \"‰ ¨ƒ? ÊUƒ?ËÌ #ˆÍÎ!ˆ)ÏÐÎ\"‡ ˜ƒOÂÑ!‡ÂÒ!‡" [entry-name current error "Entry duplicates existing!" previous point beginning-of-bibtex-entry string-match regexp-quote idx 0 message "Warning: Entry %s may be a duplicate of %s!" ding t throw done "Duplicate here with previous!" "Entries out of order here!"] 5]) end-of-bibtex-entry] 2 "\ Searches from beginning of current buffer looking for place to put the bibtex entry named ENTRY-NAME. Buffer is assumed to be in sorted order, without duplicates (see \\[sort-bibtex-entries]), if it is not, an error will be signalled." "sBibtex entry key: "]) (defalias 'validate-bibtex-buffer #[nil "`ÁÂÃÄ#ƒ'ÅŠÆ ˆ`)`\"È8‰ „#ÊË!ˆ*‚bˆÌÍÃÄ#ƒ\\ÎÏ!„*ÐhÑ\"„*ÎÒ!„*ŠŒ`Óyˆ`}ˆÎÔ!*„*ÊÕ!ˆ‚*bˆÌÖÃÄ#ƒnÊ×!ˆ‚_bˆØÙ!)‡" [point re-search-forward ".@" nil t parse-partial-sexp beginning-of-bibtex-entry foo 3 in-a-string error "At sign (@) out of place!" search-forward "\"" looking-at "[,}][ ]*$" char-equal 34 "[ ]*\n}" 0 "^[ ]*[a-zA-Z]+[ ]*=[ ]*\"$" "Quote out of place, or missing \",\" or \"}\"!" "}[ ]+$" "Brace not last char of line!" message "Bibtex buffer appears o.k."] 5 "\ Find some typical errors in bibtex files. 1. At signs (@) not as first char of a line. 2. Double quotes (\") inside strings. 3. Closing braces (}) not the last character of a line." nil]) (defalias 'find-bibtex-duplicates #[nil "`ÁÂÃÄ\"!ˆbˆÅÆ!)‡" [point find-bibtex-entry-location make-string 10 255 message "No duplicates found!"] 4 "\ Searches forward in current buffer looking for duplicate bibtex entries. Buffer is assumed to be sorted, see \\[sort-bibtex-entries]" nil]) (defalias (quote assoc-string-equalp) #[(thing alist) "À \n\"†\nƒà \n@@\"„\nA‰„ \n@‡" [assoc thing alist string-equalp] 4]) (defvar bibtex-maintain-sorted-entries nil "\ *If true, bibtex-mode will attempt to maintain all bibtex entries in sorted order. Note that this is more a property of a file than a personal preference and as such should normally be set via a file local variable entry.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"‡" [defalias bibtex-entry #[(entry-type &optional required optional) "„A „A \"‰Æœ Èœ „ÊË!ˆ ƒ6 ƒ6 Íœ Æœ‚@͜Ɯ+…LÏÐÑ \"!‰ƒWÓ!ˆÔ ˆÕ Ö±ˆƒicˆŠ×Ø\"ˆ ƒxÙÚ!ˆƒÙÜ!ˆ×Ù \"ˆ×Ù\"ˆƒ•Ùß!ˆàcˆ)ƒ¢áâ!ˆãä!)‡" [required optional assoc-string-equalp 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 bibtex-maintain-sorted-entries read-string format "%s key: " key find-bibtex-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 t run-hooks bibtex-add-entry-hook] 5 nil (byte-code "ÀÂà ÅÀ$)C‡" [t completion-ignore-case completing-read "Entry Type: " bibtex-entry-field-alist nil] 6)] bibtex-make-field #[(e-t) ":ƒ\n@‚ :ƒA‚ÁÄcˆ jˆ ƱˆjˆÈ\n;ƒ1É‚2Ê\n\"cˆ*ˇ" [e-t "" value name ",\n" bibtex-name-alignment " = " bibtex-text-alignment format "\"%s\"" "%s" nil] 3 nil "sBibTeX entry type: "] bibtex-make-optional-field #[(e-t) ":ƒÁ@PAB‚ÁPÂ!‡" [e-t "OPT" bibtex-make-field] 2 nil "sOptional BibTeX entry type: "] bibtex-Article #[nil "ÀÁ!‡" [bibtex-entry "Article"] 2 nil nil] bibtex-Book #[nil "ÀÁ!‡" [bibtex-entry "Book"] 2 nil nil] bibtex-Booklet #[nil "ÀÁ!‡" [bibtex-entry "Booklet"] 2 nil nil] bibtex-InBook #[nil "ÀÁ!‡" [bibtex-entry "InBook"] 2 nil nil] bibtex-InCollection #[nil "ÀÁ!‡" [bibtex-entry "InCollection"] 2 nil nil] bibtex-InProceedings #[nil "ÀÁ!‡" [bibtex-entry "InProceedings"] 2 nil nil] bibtex-Manual #[nil "ÀÁ!‡" [bibtex-entry "Manual"] 2 nil nil] bibtex-MastersThesis #[nil "ÀÁ!‡" [bibtex-entry "MastersThesis"] 2 nil nil] bibtex-Misc #[nil "ÀÁ!‡" [bibtex-entry "Misc"] 2 nil nil] bibtex-PhdThesis #[nil "ÀÁ!‡" [bibtex-entry "PhdThesis"] 2 nil nil] bibtex-Proceedings #[nil "ÀÁ!‡" [bibtex-entry "Proceedings"] 2 nil nil] bibtex-TechReport #[nil "ÀÁ!‡" [bibtex-entry "TechReport"] 2 nil nil] bibtex-Unpublished #[nil "ÀÁ!‡" [bibtex-entry "Unpublished"] 2 nil nil] bibtex-string #[nil "À ˆÁcˆÂÃ!ˆÄu‡" [bibtex-move-outside-of-entry "@string{ = \"\"}\n" previous-line 1 8] 2 nil nil] bibtex-preamble #[nil "À ˆÁcˆÂÃ!ˆÄu‡" [bibtex-move-outside-of-entry "@Preamble{}\n" previous-line 1 10] 2 nil nil]] 3) (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 "\ Finds end of text of next BibTeX field; with arg, to its beginning" "P"]) (defalias 'bibtex-find-text #[(arg) "À ˆÁ ˆ\nƒ ”bˆÄÅ!…#Æu‡ •bˆhÇU…#Èu‡" [bibtex-inside-field bibtex-enclosing-field arg bibtex-text-in-field looking-at "\"" 1 34 -1] 2 "\ Go to end of text of current field; with arg, go to beginning." "P"]) (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 "\ Removes the 'OPT' starting optional arguments and goes to end of text" nil]) (defalias 'bibtex-inside-field #[nil "ÀˆÁÀxˆhÂUƒÃuˆhÄU…Åu‡" [nil " " 44 -2 34 -1] 2 "\ Try to avoid point being at end of a bibtex field." nil]) (defalias 'bibtex-remove-double-quotes #[nil "ŠÀ ˆÁ ˆ\n”\n• bˆÅuˆÆÇ!ƒÈÉ!ˆ bˆÆÇ!…)ÈÉ!+‡" [bibtex-inside-field bibtex-enclosing-field bibtex-text-in-field stop start -1 looking-at "\"" delete-char 1] 2 "\ Removes \"\" around string." nil]) (defalias 'bibtex-kill-optional-field #[nil "À ˆÁ ˆ\n”bˆÃ•Ã”ÆÇ!ƒ$ bˆÈÉwˆÊ \"‚'ËÌ!*‡" [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 "\ Kill the entire enclosing optional BibTeX field" nil]) (defalias 'bibtex-empty-field #[nil "À ˆÁ ˆ\n”bˆÃ`\n•\"ˆÄcˆÅÆ!‡" [bibtex-inside-field bibtex-enclosing-field bibtex-text-in-field kill-region "\"\"" bibtex-find-text t] 3 "\ Delete the text part of the current field, replace with empty text" nil]) (defalias 'bibtex-pop-previous #[(arg) "À ˆŠÁ ˆ\n”\n• ” •Ä bˆÊËÌ!ƒ+`ÌG\\‚,`{ \"Ð=„MÑ=„MÒ ˆÓ”Ó•bˆÖe×$ƒ”•{Ó•Ó”Ú ˆ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 looking-at "OPT" bibtex-field-text matching-entry last-command bibtex-pop-previous bibtex-pop-next bibtex-enclosing-reference 0 bibtex-pop-previous-search-point bibtex-pop-next-search-point re-search-backward t arg bibtex-text-in-cfield bibtex-flash-head error "No previous matching BibTeX field." this-command] 5 "\ 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)." "p"]) (defalias 'bibtex-pop-next #[(arg) "À ˆŠÁ ˆ\n”\n• ” •Ä bˆÊËÌ!ƒ+`ÌG\\‚,`{ \"Ð=„MÑ=„MÒ ˆÓ”Ó•bˆÖd×$ƒ”•{Ó•Ó”Ú ˆ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 looking-at "OPT" bibtex-field-text matching-entry last-command bibtex-pop-next bibtex-pop-previous bibtex-enclosing-reference 0 bibtex-pop-previous-search-point bibtex-pop-next-search-point re-search-forward t arg bibtex-text-in-cfield bibtex-flash-head error "No next matching BibTeX field." this-command] 5 "\ 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)." "p"]) (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 "\ Flash at BibTeX reference head before point, if exists. (Moves point)."]) (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 "\ Search for BibTeX field enclosing point. Point moves to end of field; also, use match-beginning and match-end to parse the field."]) (defalias 'bibtex-enclosing-reference #[nil "`ÁÂÃ)‡" [old-point errname (bibtex-enclosing-regexp bibtex-reference) ((search-failed (byte-code "bˆÁÂ!‡" [old-point error "Can't find enclosing BibTeX reference."] 2)))] 3 "\ Search for BibTeX reference enclosing point. Point moves to end of reference; also, use match-beginning and match-end to parse the reference."]) (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 "\ 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?]" "sRegexp: "]) (defalias 'bibtex-clean-entry #[nil "À ˆ`Œ ŠÂ ˆ`)}ˆÃ dÅÆ$ƒÉǔǕ”• ” •\n    bˆÐÑ!ƒqƒq bˆÐÓ!ƒV|ˆ‚Ä bˆÔÑG!ˆÕÖ!ˆ× ˆjˆbˆ‚Ä bˆÐÙ!ƒ•\nbˆÔÚ!ˆ bˆÔÆ!ˆbˆÛuˆ‚ÄÐÓ!ƒÀÆuˆ ‰Ü\\{Ñš„Ä ‰Ü\\{Ýš„ÄÞß  {\"ˆ‚Äbˆ.‚) bˆÂ ˆŠàÆ!ˆáˆhâ=ƒâãÆ!ˆ)ä )‡" [beginning-of-bibtex-entry start end-of-bibtex-entry re-search-forward bibtex-field t 1 0 bibtex-name-in-field bibtex-text-in-field end-text begin-text end-name begin-name end-field begin-field looking-at "OPT" bibtex-clean-entry-zap-empty-opts "\"\"" delete-char search-forward "=" delete-horizontal-space bibtex-text-alignment "\"[0-9]+\"" -1 -2 3 "opt" error "Mandatory field ``%s'' is empty" previous-line nil 44 backward-delete-char skip-whitespace-and-comments] 6 "\ 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." nil]) (byte-code "À ÂÃÄÃ!B#ˆÀ ÅÆ#ˆÀ ÇÈ#ˆÀ ÉÊ#ˆÀ ËÌ#ˆÀ ÍÎ#ˆÀ ÏÐ#ˆÀ ÑÒ#ˆÀ ÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀ ÙÚ#ˆÀ ÛÜ#ˆÀ ÝÞ#ˆÀ ßà#ˆÀ áâ#ˆÀ ãä#ˆÀ åæÄæ!B#ˆÀ çè#ˆÀ éê#ˆÀ ëì#ˆÀ íî#ˆÀ ïð#ˆÀ ñò#ˆÀ óô#ˆÀ õö#ˆÀ ÷ø#ˆÀ ùú#‡" [define-key bibtex-mode-map [menu-bar entry-types] "Entry Types" make-sparse-keymap [menu-bar entry-types bibtex-InProceedings] (" article in conference Proceedings " . bibtex-InProceedings) [menu-bar entry-types bibtex-Article] (" Article in journal " . bibtex-Article) [menu-bar entry-types bibtex-Book] (" Book " . bibtex-Book) [menu-bar entry-types bibtex-Booklet] (" Booklet " . bibtex-Booklet) [menu-bar entry-types bibtex-InProceedings] (" Conference " . bibtex-InProceedings) [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-TechReport] (" Technical Report " . bibtex-TechReport) [menu-bar entry-types bibtex-Manual] (" technical Manual " . bibtex-Manual) [menu-bar entry-types bibtex-Proceedings] (" conference Proceedings " . bibtex-Proceedings) [menu-bar entry-types bibtex-InBook] (" a chapter in a Book " . bibtex-InBook) [menu-bar entry-types bibtex-InCollection] (" an article in a Collection " . bibtex-InCollection) [menu-bar entry-types bibtex-Misc] (" miscellaneous " . bibtex-Misc) [menu-bar entry-types bibtex-Unpublished] (" unpublished " . bibtex-Unpublished) [menu-bar entry-types bibtex-string] (" string " . bibtex-string) [menu-bar entry-types bibtex-preamble] (" preamble " . bibtex-preamble) [menu-bar move/edit] "Bibtex Edit" [menu-bar move/edit bibtex-next-field] (" next field " . bibtex-next-field) [menu-bar move/edit bibtex-find-text] (" to 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] (" remove quotes " . bibtex-remove-double-quotes) [menu-bar move/edit bibtex-clean-entry] (" clean up entry " . bibtex-clean-entry) [menu-bar move/edit find-bibtex-duplicates] (" find duplicates " . find-bibtex-duplicates) [menu-bar move/edit sort-bibtex-entries] (" sort entries " . sort-bibtex-entries) [menu-bar move/edit validate-bibtex-buffer] (" validate entries " . validate-bibtex-buffer)] 6) emacs-19.22/lisp/blackbox.elc100666 74777 1 22624 5427044247 14541 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Sun Aug 1 18:50:15 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/blackbox.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (defvar blackbox-mode-map nil "\ ") (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) (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 "\ 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 " nil]) (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 "\ 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." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"‡" [defalias bb-init-board #[(num-balls) "ÀÁ!ˆÂ‰ S‰ÆYƒ'ÀÇ!ÀÇ!BÈ \"„ B‚ *‡" [random t nil pos board num-balls 0 8 bb-member] 3] bb-insert-board #[nil "À‰à ˆÄcˆÅ\nS‰ÆYƒÇcˆ‚ Ä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] bb-right #[nil "ÁU?…ÂuˆT‰‡" [bb-x 8 2] 2 nil nil] bb-left #[nil "ÁU?…ÂÃ!ˆS‰‡" [bb-x -1 backward-char 2] 2 nil nil] bb-up #[nil "ÁU?…ÂÃ!ˆS‰‡" [bb-y -1 previous-line 1] 2 nil nil] bb-down #[nil "ÁU?…ÂÃ!ˆT‰‡" [bb-y 8 next-line 1] 2 nil nil] bb-eol #[nil "À B!‡" [8 bb-x bb-goto bb-y] 3 nil nil] bb-bol #[nil "À B!‡" [-1 bb-x bb-goto bb-y] 3 nil nil] bb-romp #[nil "ÁU„ ÂUƒ ÁU†( ÂU†(Ä \"ƒ$Å \"‡Æ \"‡" [bb-x -1 8 bb-y bb-outside-box bb-trace-ray bb-place-ball] 3 nil nil] bb-place-ball #[(x y) " BÃ\n \"ƒÅ\n \"ÆÇ!‚\n BÆÈ!)‡" [x y coord bb-member bb-balls-placed bb-delete bb-update-board "-" "O"] 3] bb-trace-ray #[(x y) "ÀÁ\n‰ÃUƒ Ä‚\nÅUƒÂƉÃUƒ$Ä‚0ÅUƒ/Â0Æ%‰É=ƒFÊË!ˆ T‰ ‚€\nBšƒ]ÊÍ!ˆ T‰ ‚€TÊÏÐ\"!ˆŠÑ!ˆÊÏÐ\"!ˆ) Ò\\‰ )‡" [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] 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]] 3) (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 "\ Finish the game and report score." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias bb-show-bogus-balls #[(balls-placed board) "À \nÃ#ˆÀ\n Ä#‡" [bb-show-bogus-balls-2 balls-placed board "x" "o"] 4] 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] bb-outside-box #[(x y) "ÁU†ÂU† ÁU† ÂU‡" [x -1 8 y] 2] bb-goto #[(pos) "@Á_AÂ_Ã\\\\b‡" [pos 2 22 26] 3] bb-update-board #[(c) "À GS!ˆÄ G!ˆ cˆÂÅ!)‡" [nil buffer-read-only backward-char c delete-char 1] 2]] 3) (defalias 'bb-member #[(elt list) "ÀÁÂà \"B!‡" [eval or mapcar #[(x) " š‡" [x elt] 2] list] 5 "\ Returns non-nil if ELT is an element of LIST."]) (defalias 'bb-delete #[(item list) " @šƒ\n A‡ @ A\"B‡" [item list bb-delete] 4 "\ Deletes ITEM from LIST and returns a copy."]) emacs-19.22/lisp/bookmark.elc100666 12120 1 71121 5463261771 14405 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Oct 26 13:52:56 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/bookmark.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„\nÁÂMˆÀÃ!„ÃÄMˆÅÆ!9„0ÇÉÊ#ˆÇËÌ#ˆÇÍÎ#ˆÀ‡" [fboundp defalias fset frame-height screen-height key-binding "r" define-key ctl-x-map "rb" bookmark-jump "rm" bookmark-set "rl" list-bookmarks] 4) (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.") (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-locate "r" bookmark-rename "d" bookmark-delete "l" bookmark-load "w" bookmark-write "s" bookmark-save] 4) (defvar bookmark-alist nil "\ Association list of bookmarks. You probably don't want to change the value of this alist yourself; instead, let the various bookmark functions do it for you.") (byte-code "ÀÁ!„ÂÃÄÅ\"‡" [boundp bookmarks-already-loaded nil add-hook kill-emacs-hook #[nil "ÀÁ!…\n…ÃÄ!…Å ‡" [featurep bookmark bookmark-alist bookmark-time-to-save-p t bookmark-save] 2]] 3) (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 (quote bookmark-current-bookmark)) (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-file, which is `~/.emacs-bkmrks' by default.") (defvar bookmark-alist-modification-count 0 "\ Number of modifications to bookmark list since it was last saved.") (defvar bookmark-file "~/.emacs-bkmrks" "\ *File in which to save bookmarks by default.") (defvar bookmark-version-control (quote nospecial) "\ This variable controls whether or not to make numbered backups of the master 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-search-size 500 "\ Length of the context strings recorded on either side of a bookmark.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÅŇ" [boundp bookmark-current-point 0 bookmark-yank-point bookmark-current-buffer nil] 2) (defalias 'bookmark-set #[(&optional parg) "À „ ÁÂ!ˆÃ ˆ``p†Èp! ÊËÌ \"ÍÎ!ÑÒÓ#ˆÑÔÕ#ˆÑÖ×#ˆ)#‰Ù˜ƒO Ú\"ˆÜÝ!ƒeŠÞ‹ˆ) b*‡" [bookmark-buffer-file-name error "Buffer not visiting a file or directory." bookmark-try-default-file bookmark-current-point bookmark-yank-point bookmark-current-buffer bookmark-current-bookmark buffer-name default read-from-minibuffer format "Set bookmark (%s): " nil copy-keymap minibuffer-local-map now-map define-key "" bookmark-yank-word "" bookmark-insert-current-file-name "" bookmark-insert-current-bookmark str "" bookmark-make parg get-buffer "*Bookmark List*" ((list-bookmarks))] 8 "\ Set a bookmark named NAME inside a file. 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-v inserts the name of the current file being visited. 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 behaves like C-v and 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.)" "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"‡" [defalias bookmark-insert-current-bookmark #[nil "Šqˆ )‰ƒ\nc‚à )‡" [bookmark-current-buffer bookmark-current-bookmark str bookmark-insert-current-file-name] 2 nil nil] bookmark-insert-current-file-name #[nil "ŠqˆÁ )‰ÃÄ\n\"TÅOc)‡" [bookmark-current-buffer bookmark-buffer-file-name str string-match "\\(/[^/]*\\)/*$" nil] 5 nil nil] bookmark-yank-word #[nil "Šqˆ bˆ`ŠÂvˆ`‰){)‰c)‡" [bookmark-current-buffer bookmark-yank-point 1 string] 4 nil nil] bookmark-make #[(parg str) "À \n\"ƒ „À \n\"Ä C¡ˆ‚ Ä D\nB TÇ …,È ‡" [assoc str bookmark-alist parg bookmark-make-cell bookmark-current-bookmark bookmark-alist-modification-count bookmark-time-to-save-p bookmark-save] 3] bookmark-make-cell #[nil "À d`Z Y…`` \\{`eZ Y…`` Z{`F‡" [bookmark-buffer-file-name bookmark-search-size] 5] bookmark-buffer-file-name #[nil "†ÁÂ!…\n…\n;ƒ\n‡\n@‡" [buffer-file-name boundp dired-directory] 2] bookmark-try-default-file #[nil "?… ?…Âà !!…ŠƉ#ˆÆ‰‡" [bookmarks-already-loaded bookmark-alist file-readable-p expand-file-name bookmark-file bookmark-load t] 4] bookmark-maybe-sort-alist #[nil "… Á !Ä\"‰‡" [bookmark-sort-flag sort copy-alist bookmark-alist #[(x y) "@ @™‡" [x y] 2]] 3]] 3) (defalias 'bookmark-jump #[(str) "À !‰…Ã\n@!…\nAb)‡" [bookmark-jump-noselect str cell switch-to-buffer] 3 "\ 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." (byte-code "À ˆ à \"ƒ †ÃÆp! \"…Æp!ȃ,ÉÊ\"‚-Ë ÌÍ$Ϙƒ>+C‡" [bookmark-try-default-file bookmark-completion-ignore-case completion-ignore-case assoc bookmark-current-bookmark bookmark-alist buffer-name default completing-read format "Jump to bookmark (%s): " "Jump to bookmark: " nil 0 str ""] 5)]) (defalias (quote bookmark-jump-noselect) #[(str) "À \n\"A@Ä @!‰ A@ AA@ AAA@ Ê !„_ ËP Ê !…5 )†Z ÍP Ê !…G )†Z ÎP Ê !…Y )‰ƒ˜ŠÏ !qˆ bˆƒ|ÐdÑ#ƒ|Ò!ˆƒŽÔeÑ#ƒŽuˆ p`)B‚·Ö ˆ×Ø!Ù ÚR!ƒ²Û !ˆÜ !‚·ÝÞ!ˆß.‡" [assoc str bookmark-alist whereto-list expand-file-name file orig-file forward-str behind-str place file-exists-p ".Z" altname ".gz" ".z" find-file-noselect search-forward t backward-char bookmark-search-size search-backward bookmark-current-bookmark ding y-or-n-p file-name-nondirectory " nonexistent. Relocate \"" "\"? " bookmark-relocate bookmark-jump-noselect message "Bookmark not relocated, but deleting it would be a good idea." nil] 6]) (defalias 'bookmark-relocate #[(str) "À \n\"‰A@@ÅÆÇÈ \"É !\"!\n A@\n +‡" [assoc str bookmark-alist bmrk bmrk-filename expand-file-name read-file-name format "Relocate %s to: " file-name-directory newloc] 6 "\ 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." (byte-code " ˆÃÄ ÆÇ$)C‡" [bookmark-completion-ignore-case completion-ignore-case bookmark-try-default-file completing-read "Bookmark to relocate: " bookmark-alist nil 0] 5)]) (defalias 'bookmark-locate #[(str &optional no-insertion) "À \n\"A@@ ƒ ‚ c)‡" [assoc str bookmark-alist where no-insertion] 3 "\ Insert the name of the file associated with BOOKMARK. Optional second arg NO-INSERTION means merely return the filename as a string." (byte-code " ˆÃÄ ÆÇ$)C‡" [bookmark-completion-ignore-case completion-ignore-case bookmark-try-default-file completing-read "Insert bookmark location: " bookmark-alist nil 0] 5)]) (defalias 'bookmark-rename #[(old &optional new) "``pà \"†*ÇÈÉÊ ! Í ÎÏ#ˆÍ ÐÑ#ˆ )#‰ ˆÕÖ!ƒBŠ×‹ˆ)TÙ …NÚ *‡" [bookmark-current-point bookmark-yank-point bookmark-current-buffer assoc old bookmark-alist new read-from-minibuffer "New name: " nil copy-keymap minibuffer-local-map now-map define-key "" bookmark-yank-word "" bookmark-insert-current-file-name str cell bookmark-current-bookmark get-buffer "*Bookmark List*" ((list-bookmarks)) bookmark-alist-modification-count bookmark-time-to-save-p bookmark-save] 9 "\ 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, and C-v inserts the name of the file." (byte-code " ˆÃÄ ÆÇ$)C‡" [bookmark-completion-ignore-case completion-ignore-case bookmark-try-default-file completing-read "Old bookmark name: " bookmark-alist nil 0] 5)]) (defalias 'bookmark-insert #[(str) "`ŠÀ !@qˆed{)\ncˆÄ ˆ b*‡" [bookmark-jump-noselect str str-to-insert orig-point push-mark] 3 "\ 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." (byte-code " ˆÃÄ ÆÇ$)C‡" [bookmark-completion-ignore-case completion-ignore-case bookmark-try-default-file completing-read "Insert bookmark contents: " bookmark-alist nil 0] 5)]) (defalias 'bookmark-delete #[(str) "À \n\"Ä \n\"À \n\"„Æ)ÇÈ!ƒŠÉ‹ˆ)\nT\nË …+Ì ‡" [assoc str bookmark-alist will-go delq bookmark-current-bookmark nil get-buffer "*Bookmark List*" ((list-bookmarks)) bookmark-alist-modification-count bookmark-time-to-save-p bookmark-save] 3 "\ 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)." (byte-code " ˆÃÄ ÆÇ%)C‡" [bookmark-completion-ignore-case completion-ignore-case bookmark-try-default-file completing-read "Delete bookmark: " bookmark-alist nil 0 bookmark-current-bookmark] 6)]) (defalias (quote bookmark-time-to-save-p) #[(&optional last-time) "ƒ ÂV… ‡ §ƒ Y‡Ä‡" [last-time bookmark-alist-modification-count 0 bookmark-save-flag nil] 2]) (defalias 'bookmark-write #[nil "À ˆÁÂ!‡" [bookmark-try-default-file bookmark-save t] 2 "\ Write bookmarks to a file (for which the user will be prompted interactively). Don't use this in Lisp programs; use bookmark-save instead." nil]) (defalias 'bookmark-save #[(&optional parg file) "À ˆ „\n„à !ˆ‚9 „!\nƒ!Ã\n!ˆ‚9 ƒ5\n„5ÅÆ!Ã\n!ˆ)‚9Ã\n!ˆÇ‰‡" [bookmark-try-default-file parg file bookmark-write-file bookmark-file read-file-name "File to save bookmarks in: " 0 bookmark-alist-modification-count] 2 "\ Save currently defined bookmarks. Saves by default in the file defined by the variable `bookmark-file'. With a prefix arg, save it in file FILE. 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-file'." "P"]) (defalias (quote bookmark-write-file) #[(file) "ŠÀ‹)‡" [((byte-code "ÁYƒ ÂÃÄ \"!ˆÆÈ !)qˆebˆed|ˆÉ\np\"ˆ „,Æ‚D Ì=ƒ7Ì‚D Í=ƒC‚DÏÐ !ˆÑp!)‡" [baud-rate 9600 message format "Saving bookmarks to file %s." file nil enable-local-variables find-file-noselect print bookmark-alist bookmark-version-control never nospecial version-control t write-file kill-buffer] 4))] 1]) (defalias 'bookmark-load #[(file &optional revert no-msg) "À ! !ƒ!ŠÃ‹ˆ ?… ÆY…ÇÈÉ \"!)‡ÊÈË \"!‡" [expand-file-name file file-readable-p ((byte-code "„ ÂYƒÃÄÅ\"!ˆÇÉ!)qˆebˆÊed{!@‰ <ƒX „9 T ‚<Î Ï  ?…G\"ÑÒ!ƒ`ŠÓ ˆ)‚`ÔÄÕ\"!ˆ)Öp!‡" [no-msg baud-rate 9600 message format "Loading bookmarks from %s..." file nil enable-local-variables find-file-noselect read-from-string blist revert bookmark-alist-modification-count 0 append bookmark-alist get-buffer "*Bookmark List*" list-bookmarks 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 "\ 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-bkmrks', is maintained automatically by Emacs; you shouldn't need to load it explicitly." (byte-code "À ˆÁÂà \"Å Æ$C‡" [bookmark-try-default-file read-file-name format "Load bookmarks from: (%s) " bookmark-file "~/" confirm] 5)]) (byte-code "ÀÁ!„ÂÀÃ!„‡" [boundp Bookmark-menu-bookmark-column nil Bookmark-menu-hidden-bookmarks] 2) (defvar Bookmark-menu-file-column 30 "\ *Column at which to display filenames in a buffer listing bookmarks. You can toggle whether files are shown with \\\\[Bookmark-menu-toggle-filenames].") (defvar Bookmark-menu-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-menu-toggle-filenames nil)") (byte-code "ÀÁ!„ „ªÃ Ä Å\"ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÒ#ˆÆ ÔÕ#ˆÆ Ö×#ˆÆ ØÙ#ˆÆ ÚÛ#ˆÆ ÜÝ#ˆÆ Þß#ˆÆ àÛ#ˆÆ áÛ#ˆÆ âã#ˆÆ äã#ˆÆ åæ#ˆÆ çè#ˆÆ éê#ˆÆ ëì#ˆÆ íî#ˆÆ ïð#ˆÆ ñò#ˆÆ óô#ˆõö÷ø#ˆùúû\"‡" [boundp Bookmark-menu-mode-map nil make-keymap suppress-keymap t define-key "q" Bookmark-menu-quit "v" Bookmark-menu-select "w" Bookmark-menu-locate "2" Bookmark-menu-2-window "1" Bookmark-menu-1-window "j" Bookmark-menu-this-window "f" "o" Bookmark-menu-other-window "" Bookmark-menu-switch-other-window "s" Bookmark-menu-save "k" Bookmark-menu-delete "" Bookmark-menu-delete-backwards "x" Bookmark-menu-execute " " "d" " " next-line "n" "p" previous-line "" Bookmark-menu-backup-unmark "?" describe-mode "u" Bookmark-menu-unmark "m" Bookmark-menu-mark "l" Bookmark-menu-load "r" Bookmark-menu-rename "t" Bookmark-menu-toggle-filenames put Bookmark-menu-mode mode-class special defalias edit-bookmarks list-bookmarks] 4) (defalias 'list-bookmarks #[nil "À ˆÁÂÃ!!ˆÄde|ˆebˆÆcˆÇ ˆ‰ ƒ2Ê @@ËQcˆ A‰ „ *ebˆÌyˆÍ ˆ…DÎÏ!‡" [bookmark-try-default-file switch-to-buffer get-buffer-create "*Bookmark List*" nil buffer-read-only "% Bookmark\n- --------\n" bookmark-maybe-sort-alist bookmark-alist lst " " "\n" 2 bookmark-menu-mode Bookmark-menu-toggle-filenames t] 4 "\ 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." nil]) (defalias 'bookmark-menu-mode #[nil "À ˆÁ\n!ˆÃÃÆÈ ÊË!‡" [kill-all-local-variables use-local-map Bookmark-menu-mode-map t truncate-lines buffer-read-only bookmark-menu-mode major-mode "Bookmark Menu" mode-name run-hooks bookmark-menu-mode-hook] 2 "\ 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-menu-mark] -- mark bookmark to be displayed. \\[Bookmark-menu-select] -- select bookmark of line point is on. Also show bookmarks marked using m in other windows. \\[Bookmark-menu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). \\[Bookmark-menu-locate] -- display (in minibuffer) location of this bookmark. \\[Bookmark-menu-1-window] -- select this bookmark in full-frame window. \\[Bookmark-menu-2-window] -- select this bookmark in one window, together with bookmark selected before this one in another window. \\[Bookmark-menu-this-window] -- select this bookmark in place of the bookmark menu buffer. \\[Bookmark-menu-other-window] -- select this bookmark in another window, so the bookmark menu bookmark remains visible in its window. \\[Bookmark-menu-switch-other-window] -- switch the other window to this bookmark. \\[Bookmark-menu-rename] -- rename this bookmark (prompts for new name). \\[Bookmark-menu-delete] -- mark this bookmark to be deleted, and move down. \\[Bookmark-menu-delete-backwards] -- mark this bookmark to be deleted, and move up. \\[Bookmark-menu-execute] -- delete marked bookmarks. \\[Bookmark-menu-save] -- save the current bookmark list in the default file. With a prefix arg, prompts for a file to save in. \\[Bookmark-menu-load] -- load in a file of bookmarks (prompts for file.) \\[Bookmark-menu-unmark] -- remove all kinds of marks from current line. With prefix argument, also move up one line. \\[Bookmark-menu-backup-unmark] -- back up a line and remove marks."]) (defalias 'Bookmark-menu-toggle-filenames #[(&optional parg) "ƒ Áà ˆÄ‰‡\nƒÅ ˆÁ‰‡Ã ˆÄ‰‡" [parg nil Bookmark-menu-toggle-filenames Bookmark-menu-show-filenames t Bookmark-menu-hide-filenames] 2 "\ Toggle whether filenames are shown in the bookmark list. Optional argument SHOW means show them unconditionally." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias Bookmark-menu-show-filenames #[(&optional force) "?… ?…ŠÂ‹)‡" [force Bookmark-menu-toggle-filenames ((byte-code "ebˆÀyˆÁÁ`dW…2Ä ‰\nBÆÈ\"ˆ`Áˆ`|ˆÉcˆÊ !ˆËyˆ)‚\n)‡" [2 nil Bookmark-menu-hidden-bookmarks buffer-read-only Bookmark-menu-bookmark bmrk move-to-column Bookmark-menu-file-column t " " bookmark-locate 1] 4))] 1] Bookmark-menu-hide-filenames #[(&optional force) "?… … ŠÂ‹)‡" [force Bookmark-menu-toggle-filenames ((byte-code "ebˆÀyˆ ŸŠebˆÂÃ!ˆÄÅ!ˆi)ŠÇ …7ÉÊ\"ˆË ˆ @cˆ AÅyˆ‚*‡" [2 Bookmark-menu-hidden-bookmarks search-forward "Bookmark" backward-word 1 Bookmark-menu-bookmark-column nil buffer-read-only move-to-column t kill-line] 3))] 1] Bookmark-menu-check-position #[nil "Àe`\"ÁWƒebˆÁyˆÂ‡nƒmƒÃyˆÂ‡Â‡" [count-lines 2 t -1] 3] Bookmark-menu-bookmark #[nil "À ƒ\nŠÁ‹ˆ)\nƒà ˆŠÄ‹)‡" [Bookmark-menu-check-position ((byte-code "ebˆÀÁ!ˆÂÃ!ˆiÀ‡" [search-forward "Bookmark" backward-word 1 Bookmark-menu-bookmark-column] 2)) Bookmark-menu-toggle-filenames Bookmark-menu-hide-filenames ((byte-code "Àyˆ uˆ`ˆ`{ ƒÃÄ!ˆ‡" [0 Bookmark-menu-bookmark-column nil Bookmark-menu-toggle-filenames t] 3))] 1]] 3) (defalias 'Bookmark-menu-mark #[nil "ÀyˆÁ …ÂÄÅ!ˆÆcˆÅy)‡" [0 Bookmark-menu-check-position nil buffer-read-only delete-char 1 62] 2 "\ Mark bookmark on this line to be displayed by \\\\[Bookmark-menu-select] command." nil]) (defalias 'Bookmark-menu-select #[nil "À …xÁ p‰ebˆÇÈÂÉ#ƒ<Á Â\nËÌ!ˆÍcˆ) ˜„ >„ B‚ ŸÎ S GT¥Ï ˆÐ!ˆÑ !ˆ GÒš?…w ƒtÓ \"ˆÔÕ!ˆÐ @!ˆ A‰„_ÔÕ!,‡" [Bookmark-menu-check-position Bookmark-menu-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 0 split-window other-window 1] 5 "\ Select this line's bookmark; also display bookmarks marked with `>'. You can mark bookmarks with the \\\\[Bookmark-menu-mark] command." nil]) (defalias 'Bookmark-menu-save #[(parg) "ŠÀ‹)‡" [((bookmark-save parg))] 1 "\ Save the current list into a bookmark file. With a prefix arg, prompts for a file to save them in." "P"]) (defalias 'Bookmark-menu-load #[nil "À … ŠÁ‹)‡" [Bookmark-menu-check-position ((byte-code "ÀÁ!‡" [call-interactively bookmark-load] 2))] 1 "\ Load a bookmark file and rebuild list." nil]) (defalias 'Bookmark-menu-1-window #[nil "À …Á !ˆÃÄ !ˆÅ ‡" [Bookmark-menu-check-position bookmark-jump Bookmark-menu-bookmark bury-buffer other-buffer delete-other-windows] 2 "\ Select this line's bookmark, alone, in full frame." nil]) (defalias 'Bookmark-menu-2-window #[nil "À …$Á pÂÆ ˆÇÈ !ˆÉ !@\nË\n!ˆ)Ì !+‡" [Bookmark-menu-check-position Bookmark-menu-bookmark t pop-up-windows menu bmrk delete-other-windows switch-to-buffer other-buffer bookmark-jump-noselect buff pop-to-buffer bury-buffer] 3 "\ Select this line's bookmark, with previous buffer in second window." nil]) (defalias 'Bookmark-menu-this-window #[nil "À … Á !‡" [Bookmark-menu-check-position bookmark-jump Bookmark-menu-bookmark] 2 "\ Select this line's bookmark in this window." nil]) (defalias 'Bookmark-menu-other-window #[nil "À …Á !@Ä !)‡" [Bookmark-menu-check-position bookmark-jump-noselect Bookmark-menu-bookmark buff switch-to-buffer-other-window] 2 "\ Select this line's bookmark in other window, leaving bookmark menu visible." nil]) (defalias 'Bookmark-menu-switch-other-window #[nil "À …Á !@Ä !)‡" [Bookmark-menu-check-position bookmark-jump-noselect Bookmark-menu-bookmark buff display-buffer] 2 "\ Make the other window select this line's bookmark. The current window remains selected." nil]) (defalias 'Bookmark-menu-quit #[nil "pÁ !ˆÃ!)‡" [buffer switch-to-buffer other-buffer bury-buffer] 2 "\ Quit the bookmark menu." nil]) (defalias 'Bookmark-menu-unmark #[(&optional backup) "ÀyˆÁ …ÂÄÅ!ˆÆcˆ)ƒÈ‚Åy‡" [0 Bookmark-menu-check-position nil buffer-read-only delete-char 1 " " backup -1] 2 "\ Cancel all requested operations on bookmark on this line and move down. Optional ARG means move up." "P"]) (defalias 'Bookmark-menu-backup-unmark #[nil "ÀyˆÁ …  ˆÀy‡" [-1 Bookmark-menu-check-position Bookmark-menu-unmark] 1 "\ Move up and cancel all requested operations on bookmark on line above." nil]) (defalias 'Bookmark-menu-delete #[nil "ÀyˆÁ …ÂÄÅ!ˆÆcˆÅy)‡" [0 Bookmark-menu-check-position nil buffer-read-only delete-char 1 68] 2 "\ Mark bookmark on this line to be deleted by \\\\[Bookmark-menu-execute] command." nil]) (defalias 'Bookmark-menu-delete-backwards #[nil "À ˆÁyˆÂ … Ãy‡" [Bookmark-menu-delete -2 Bookmark-menu-check-position 1] 1 "\ Mark bookmark on this line to be deleted by \\\\[Bookmark-menu-execute] command and then move up one line" nil]) (defalias 'Bookmark-menu-execute #[nil "‰ƒ  ˆÃebˆÄyˆÃÆÇdÈ#ƒ#É B‚ÊË \"ˆ)Ì ˆebˆÍyˆ ‰…;ÀÈ!)‡" [Bookmark-menu-toggle-filenames hide-em Bookmark-menu-hide-filenames nil 1 deaders re-search-forward "^D" t Bookmark-menu-bookmark mapcar #[(str) "ÀÁ\n \" \"‰‡" [delq assoc str bookmark-alist] 4] list-bookmarks 2] 5 "\ Delete bookmarks marked with \\\\[Buffer-menu-delete] commands." nil]) (defalias 'Bookmark-menu-rename #[nil "À …Á `Ä !ˆÅ ˆ\nb*‡" [Bookmark-menu-check-position Bookmark-menu-bookmark thispoint bmrk bookmark-rename list-bookmarks] 2 "\ Rename bookmark on current line. Prompts for a new name." nil]) (defalias 'Bookmark-menu-locate #[nil "À …Á ÃÄ\nÅ\"!)‡" [Bookmark-menu-check-position Bookmark-menu-bookmark bmrk message bookmark-locate t] 4 "\ Display location of this bookmark. Displays in the minibuffer." nil]) (defvar bookmark-menu-bar-length 70 "\ *Maximum length of a bookmark name displayed on a popup menu.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias bookmark-make-menu-bar-alist #[nil "À ˆÁ ˆ\nƒÃÄ\n\"‡ÅÆ!‡" [bookmark-try-default-file bookmark-maybe-sort-alist bookmark-alist mapcar #[(cell) "@‰G\nVƒ Ã\nO‚ )B‡" [cell str bookmark-menu-bar-length 0] 4] error "No bookmarks currently set."] 3] bookmark-make-menu-bar-with-function #[(func-sym menu-label menu-str event) "À  BD\"‰…ÇC\"*‡" [bookmark-make-menu-bar-alist menu x-popup-menu event menu-label menu-str str apply func-sym] 6]] 3) (defalias 'bookmark-menu-bar-insert #[(event) "ÀÁÂà $‡" [bookmark-make-menu-bar-with-function bookmark-insert "Bookmark Insert Menu" "--- Insert Contents ---" event] 5 "\ 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." "e"]) (defalias 'bookmark-menu-bar-jump #[(event) "ÀÁÂà $‡" [bookmark-make-menu-bar-with-function bookmark-jump "Bookmark Jump Menu" "--- Jump to Bookmark ---" event] 5 "\ 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." "e"]) (defalias 'bookmark-menu-bar-locate #[(event) "ÀÁÂà $‡" [bookmark-make-menu-bar-with-function bookmark-locate "Bookmark Locate Menu" "--- Insert Location ---" event] 5 "\ Insert the name of the file associated with BOOKMARK. (This is not the same as the contents of that file)." "e"]) (defalias 'bookmark-menu-bar-rename #[(event) "ÀÁÂà $‡" [bookmark-make-menu-bar-with-function bookmark-rename "Bookmark Rename Menu" "--- Rename Bookmark ---" event] 5 "\ 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, and C-v inserts the name of the file." "e"]) (defalias 'bookmark-menu-bar-delete #[(event) "ÀÁÂà $‡" [bookmark-make-menu-bar-with-function bookmark-delete "Bookmark Delete Menu" "--- Delete Bookmark ---" event] 5 "\ 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)." "e"]) (byte-code "ÀÁ!„\nÂÃ!ÀÄ!ƒ ƒÅ B‚ÆÇ ÈÉ#ˆÇ ÊË#ˆÇ ÌÍ#ˆÇ ÎÏ#ˆÇ ÐÑ#ˆÇ ÒÓ#ˆÇ ÔÕ#ˆÇ Ö×#ˆÇ ØÙ#ˆÇ ÚÛ#ˆÁ‰JMˆÜÅ!‡" [boundp menu-bar-bookmark-map make-sparse-keymap "Bookmark functions." menu-bar-final-items bookmark (bookmark) 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" . list-bookmarks) [delete] ("Delete bookmark" . bookmark-menu-bar-delete) [rename] ("Rename bookmark" . bookmark-menu-bar-rename) [locate] ("Insert location" . bookmark-menu-bar-locate) [insert] ("Insert contents" . bookmark-menu-bar-insert) [set] ("Set bookmark" . bookmark-set) [jump] ("Jump to bookmark" . bookmark-menu-bar-jump) provide] 4) emacs-19.22/lisp/buff-menu.elc100666 74777 1 20476 5425672314 14643 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Jul 29 02:57:16 1993 ;;; from file /home/fsf/rms/e19/lisp/buff-menu.el ;;; emacs version 19.17.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 "This file was compiled for Emacs 19")) (defvar Buffer-menu-mode-map nil "\ ") (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 put Buffer-menu-mode mode-class special] 4) (defalias 'Buffer-menu-mode #[nil "À ˆÁ\n!ˆÃÃÆÈ ÊË!‡" [kill-all-local-variables use-local-map Buffer-menu-mode-map t truncate-lines buffer-read-only Buffer-menu-mode major-mode "Buffer Menu" mode-name run-hooks buffer-menu-mode-hook] 2 "\ 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-mark] -- mark buffer to be displayed. \\[Buffer-menu-select] -- select buffer of line point is on. 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-this-window] -- select that buffer in place of the buffer menu buffer. \\[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] -- switch the other window to this buffer. \\[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."]) (byte-code "ÀÁ!„ÂÀÃ!„‡" [boundp Buffer-menu-buffer-column nil Buffer-menu-size-column] 2) (defalias 'Buffer-menu-buffer #[(error-if-non-existent-p) "„ŠebˆÁÂ!ˆÃÄ!ˆiÁÅ!ˆÃÄ!ˆi)ŠÇyˆuˆ`È \nËÌ!ˆÍÈxˆ\n`{ Î !†J…JÐÑ \"+‡" [Buffer-menu-buffer-column search-forward "Buffer" backward-word 1 "Size" Buffer-menu-size-column 0 nil string start re-search-forward " \\| " " " get-buffer error-if-non-existent-p error "No buffer named \"%s\""] 3 "\ Return buffer described by this line of buffer menu."]) (defalias 'buffer-menu #[(&optional arg) "À !ˆÂÃ!ˆÄyˆÅÆ!‡" [list-buffers arg pop-to-buffer "*Buffer List*" 2 message "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."] 2 "\ 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 and to restore previous window configuration." "P"]) (defalias 'Buffer-menu-quit #[nil "pÁ !ˆÃ!)‡" [buffer switch-to-buffer other-buffer bury-buffer] 2 "\ Quit the buffer menu." nil]) (defalias 'Buffer-menu-mark #[nil "ÀyˆÁÂ!ƒ à ‡ÄÆÇ!ˆÈcˆÇy)‡" [0 looking-at " [-M]" ding nil buffer-read-only delete-char 1 62] 2 "\ Mark buffer on this line for being displayed by \\\\[Buffer-menu-select] command." nil]) (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 "\ Cancel all requested operations on buffer on this line and move down. Optional ARG means move up." "P"]) (defalias 'Buffer-menu-backup-unmark #[nil "ÀyˆÁ ˆÀy‡" [-1 Buffer-menu-unmark] 1 "\ Move up and cancel all requested operations on buffer on line above." nil]) (defalias 'Buffer-menu-delete #[nil "ÀyˆÁÂ!ƒ à ‡ÄÆÇ!ˆÈcˆÇy)‡" [0 looking-at " [-M]" ding nil buffer-read-only delete-char 1 68] 2 "\ Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command." nil]) (defalias 'Buffer-menu-delete-backwards #[nil "À ˆÁyˆÂÃ!…Äy‡" [Buffer-menu-delete -2 looking-at " [-M]" 1] 2 "\ Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command and then move up one line" nil]) (defalias 'Buffer-menu-save #[nil "ÀyˆÁuˆÂÃ!ƒÄ ‡ÅÇÁ!ˆÈcˆÁy)‡" [0 1 looking-at " [-M]" ding nil buffer-read-only delete-char 83] 2 "\ Mark buffer on this line to be saved by \\\\[Buffer-menu-execute] command." nil]) (defalias 'Buffer-menu-not-modified #[nil "ŠÀÁ!qˆÂÃ!ˆ)ŠÄyˆÅuˆÆÇ!…\"ÃÉÅ!ˆÊc))‡" [Buffer-menu-buffer t set-buffer-modified-p nil 0 1 looking-at "\\*" buffer-read-only delete-char 32] 2 "\ Mark buffer on this line as unmodified (no changes to save)." nil]) (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 "\ Save and/or delete buffers marked with \\\\[Buffer-menu-save] or \\\\[Buffer-menu-delete] commands." nil]) (defalias 'Buffer-menu-select #[nil "ÀÁ!p‰ebˆÇÈÂÁ#ƒ9ÀÁ! ÊË!ˆÌcˆ) =„ >„ B‚ ŸÍ S GT¥Î ˆÏ!ˆ =„WÐ !ˆ GÑšƒeÏ!‚ ƒ~Ò \"ˆÓÔ!ˆÏ @!ˆ A‰„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 "\ Select this line's buffer; also display buffers marked with `>'. You can mark buffers with the \\\\[Buffer-menu-mark] command." nil]) (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 "\ Visit the tags table in the buffer on this line. See `visit-tags-table'." nil]) (defalias 'Buffer-menu-1-window #[nil "ÀÁÂ!!ˆÃÄ !ˆÅ ‡" [switch-to-buffer Buffer-menu-buffer t bury-buffer other-buffer delete-other-windows] 3 "\ Select this line's buffer, alone, in full frame." nil]) (defalias 'Buffer-menu-this-window #[nil "ÀÁÂ!!‡" [switch-to-buffer Buffer-menu-buffer t] 3 "\ Select this line's buffer in this window." nil]) (defalias 'Buffer-menu-other-window #[nil "ÀÁÂ!!‡" [switch-to-buffer-other-window Buffer-menu-buffer t] 3 "\ Select this line's buffer in other window, leaving buffer menu visible." nil]) (defalias 'Buffer-menu-switch-other-window #[nil "ÀÁÂ!!‡" [display-buffer Buffer-menu-buffer t] 3 "\ Make the other window select this line's buffer. The current window remains selected." nil]) (defalias 'Buffer-menu-2-window #[nil "ÀÁ!pÁÅ ˆÆÇ !ˆÈ !ˆÉ !+‡" [Buffer-menu-buffer t pop-up-windows menu buff delete-other-windows switch-to-buffer other-buffer pop-to-buffer bury-buffer] 3 "\ Select this line's buffer, with previous buffer in second window." nil]) (defalias 'Buffer-menu-toggle-read-only #[nil "ÀŠÂÃ!qˆÄ ˆ ƒÆ‚Ç)ŠÈyˆÉuˆg U?…-ÀÊË!ˆ c)*‡" [nil char Buffer-menu-buffer t toggle-read-only buffer-read-only 37 32 0 2 delete-char 1] 2 "\ Toggle read-only status of buffer on this line." nil]) emacs-19.22/lisp/byte-opt.elc100666 13437 1 53357 5450115510 14473 0ustar jimbdaemon;ELC ;;; compiled by bfox@albert.gnu.ai.mit.edu on Wed Sep 22 14:36:55 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/byte-opt.el ;;; emacs version 19.19.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆÇÈ#‡" [defalias byte-compile-log-lap-1 #[(format &rest args) "ÁHƒ\nÂÃ!ˆÄÅÆlj ÊË \"*#!‡" [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 >ƒ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] byte-compile-log-lap (macro . #[(format-string &rest args) "ÀÁ BBE‡" [and (memq byte-optimize-log (quote (t byte))) byte-compile-log-lap-1 format-string args] 5]) put inline byte-optimizer byte-optimize-inline-handler] 4) (defalias 'byte-optimize-inline-handler #[(form) "ÀÁ A\"B‡" [progn mapcar #[(sexp) "¢‰9ƒ7 \nžA„1à !ƒ7 ž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 "\ byte-optimize-handler for the `inline' special-form."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias byte-inline-lapcode #[(lap) "Ÿ ¤‰‡" [lap byte-compile-output] 2] byte-compile-inline-expand #[(form) "@‰\nžA†à !… K‰„ ÅÆ \"ˆ‚€ :ƒ2 @Ç=ƒ2È A@!ˆ :ƒF @Ç=ƒFÉÊ A@ #ˆ 9ƒTË AB!‚€Ì !ƒpÍ ÎHÏ ÐH ÑH ÒHFEAB‚€ @Í=„|ÉÓ \"ˆ AB*‡" [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 lambda 0 byte-code 1 2 3 "%s is not a lambda"] 8] byte-compile-unfold-lambda #[(form &optional name) "„Á\n@\nAÅ !ƒ#Ä ÆHÇ ÈH ÉH ÊHFE A@ AAˉ‰  @;ƒHAƒHA@:ƒ]@@Ñ=ƒ]Aƒñ@Ò=ƒ… ƒtÓÔ\"ˆA„ÓÕ\"ˆÖ‚è@×=ƒªA„˜ÓØ\"ˆAAƒ¤ÓÙ\"ˆÖ ‚è ƒÄ@ …¹Ú BD B Ë‚è„Ú „ÚÛÜ\"ˆËÝ‚è@ @D B AA‰„b ƒ Ý=„ÛÞ\"ˆ\n‚@ ƒß Ÿ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] byte-optimize-form-code-walker #[(form for-effect) "¢Á:„# … †9?†Æ=?…e‚e Ç=ƒEAAƒ6ÈÉÊ!\"ˆA@…e ?…e‚eË !„R ¢Ì=ƒXÍ!‚e Î>ƒp ÏÐA@\"ÑAA \"BB‚e Ò=ƒ€ ÏÓA\"B‚e Ô=ƒ«AAƒ¢ÑA \"‰AƒÔ\nB‚e\n@‚eÕA@ \"‚e Ö=ƒÒAAƒÉÖÕA@ \"ÑAAÆ\"BB‚eÕA@ \"‚e ×=ƒò×ÕA@Æ\"ÕØ8 \"ÑAAAÆ\"BBB‚e Ù>ƒ ÑA \"B‚e Ú=ƒ ÕA@Á\"ÑAA \"BB‚e Û=ƒ9 ÕA@Á\"ÕØ8 \"ÑÜ› \"BBB‚e Ý>ƒ£ ƒ™ÞA!‰ƒbÕ@ \" „bA‰„MAƒ‹„‹ ƒ‹!â>ƒ‹Æã‰$%&çèéÊ!\"!ˆ+…• ŸB)‚e ÏÕA\"B‚e ê=ƒ´ÈëÊ!\"ˆÁ‚e ì>ƒ¾‚e í=ƒÓ ÕA@ \"AABB‚e î=ƒè ÕA@Á\"AABB‚eï0\"‰=„ûÕ \"‚e 9„ñ ¢=„ÈòÊ !\"ˆ‚e ƒ^ ó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 \"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]] 3) (defalias 'byte-optimize-form #[(form &optional for-effect) "À \n\"É :ƒ_ @9ƒ_\nƒ! @ÆN‰„* @ÇN‰ƒ_ !‰=„_ƒV Ê>ƒVË̉ ÐÑÒÓ !Ó !#!ˆ+Ô \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 "\ The source-level pass of the optimizer."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÓÑÔÕ#ˆÀÖ×\"ˆÀØÙ\"ˆÀÚÛ\"ˆÀÜÝ\"ˆÀÞß\"ˆÓàÔÞ#ˆÓáÔË#ˆÓâÔÏ#ˆÓãÔÍ#ˆÓäÔÖ#ˆÓåÔÅ#ˆÓæÔÅ#ˆÓçÔÚ#ˆÓèÔÚ#ˆÓéÔÚ#ˆÓêÔÚ#ˆÓëÔÚ#ˆÓìÔÚ#ˆÓíÔÜ#ˆÓîÔÜ#ˆÓïÔÜ#ˆÓðÔÜ#ˆÓñÔÜ#ˆÓòÔÜ#ˆÓóÔÜ#ˆÓôÔÜ#ˆÓõÔÜ#ˆÓöÔÜ#ˆÓ÷ÔÜ#ˆÓøÔÜ#ˆÓùÔÜ#ˆÓúÔÜ#ˆÓûÔÜ#ˆÓüÔØ#ˆÓýÔØ#ˆÓþÔØ#ˆÓÿÔÜ#ˆÓ@ÔÜ#ˆÓAÔÜ#ˆÓBÔÜ#ˆÓCÔÜ#ˆÓDÔE#ˆÀEF\"ˆÀGH\"ˆÓIÔG#ˆÀJK\"ˆÀLM\"ˆÀNO\"ˆÀPQ\"ˆÀRS\"ˆÓTÔJ#ˆÓUÔL#ˆÓVÔN#ˆÓWÔP#ˆÓXÔR#ˆÓYÔZ#ˆÓ[ÔZ#ˆÓ\\ÔZ#ˆÀ]^\"ˆÀ_`\"ˆÓaÔ]#ˆÓbÔ_#ˆÓcÔd#ˆÓeÔd#ˆÀdf\"ˆÓgÔh#ˆÀhi\"ˆÓjÔk#ˆÀkl\"ˆmno‰pƒ[Óp@qr#ˆpA‰p„FoƒuÓo@qs#ˆoA‰o„`*Àtu\"ˆÓvwt#ˆxyÀ‡" [defalias byte-optimize-body #[(forms all-for-effect) "Á‰‰‰ƒ2† A @…Ç @ \"‰„' „+\n B A‰„ Ÿ,‡" [forms nil new fe result rest all-for-effect byte-optimize-form] 5] byte-compile-trueconstp (macro . #[(form) "ÀÁ\nDÃÄ\nDÅEDÆÇ\nDDCÃ\nÈECF‡" [cond consp form eq car (quote quote) not symbolp t] 6]) byte-optimize-associative-math #[(form) "À‰ A\nƒ%\n@§ƒ\n@ B‚\n@ B\nA‰„ AƒP ƒH @Å @ \" AƒB @ ŸB‚D @E‚QÅ @ \"‚Q +‡" [nil form rest constants args apply] 5] byte-optimize-nonassociative-math #[(form) "A@§ƒAA@§„‡A@AA @§ƒ-@\n @\" A‰‚ ƒ:@\n BB‚;\n*‡" [form rest constant] 4] byte-optimize-delay-constants-math #[(form start fun) "S ›\nA‰AƒH\n@§ƒÃÅ !S ›\nA‰ƒ7\n@§ƒ\n@ B\nàˆ‚Æà \"Ç Ÿ\"C¤)‚ )‡" [start form rest nil constants copy-sequence delq apply fun] 4] byte-optimize-plus #[(form) "À ÂÃ#Ä >ƒÅÄÆ !\" A„ÇÈɇ ‡" [byte-optimize-delay-constants-math form 1 + 0 delq copy-sequence nil (eval form) ((error form))] 4] 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] byte-optimize-multiply #[(form) "À ÂÃ#‰A„ Â‡Ä !@‰Æ=ƒÇ AD‚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] byte-compile-butlast #[(form) "À !AŸ‡" [reverse form] 2] put byte-optimizer byte-compile-inline-expand byte-optimize-divide #[(form) "À ÂÃ#Ä AA!@‰§ƒH GÆU„H ÇUƒ+ Ä !AŸ)‚H A@§ƒH @ A@ ¥ AAÄ !AŸ)BBÈ A@É=ƒZÊË AAÌ#‚z Í=ƒyÎÆ ›ƒr Ä !AŸ)‚u A@D‚z )‡" [byte-optimize-delay-constants-math form 2 * reverse last 3 1 nil 0 append (progn) (0) -1 -] 5] byte-optimize-logmumble #[(form) "À  @#ÃÄ >ƒ' @Å=ƒÆ AB‚\"ÇÄÈ !\"‰‚> ¢É=ƒ=Ê >ƒ=ÇÊÈ !\"‚> !‡" [byte-optimize-delay-constants-math form 1 byte-optimize-predicate 0 logand progn delq copy-sequence logior -1] 5] 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] 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] 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] identity + * - / max min = eq eql equal string= string-equal < > <= >= 1+ 1- not null memq consp listp symbolp stringp string< string-lessp logand logior logxor lognot car cdr car-safe cdr-safe quote byte-optimize-quote #[(form) "A@:„A@9ƒA@Á>„‡A@‡" [form (nil t)] 2] byte-optimize-zerop #[(form) "A@§ƒ Á!‡\nƒÃA@ÄE‡‡" [form eval byte-compile-delete-errors = 0] 3] zerop byte-optimize-and #[(form) "A?†5Á>ƒ(ÂÃÄ!‰‰A@ƒ A‰‚Á¡ˆ!ÁE‡AA„2A@‡Å!‡" [form nil progn byte-optimize-and copy-sequence byte-optimize-predicate] 6] byte-optimize-or #[(form) "À >ƒ ÂÀà !\"  A‰AƒA @:ƒ% @@Å=‚/ @9ƒ2 @Æ=ƒà ! @ >À¡‰‚ AAƒMÇ !‚P A@)‡" [nil form delq copy-sequence rest quote t byte-optimize-predicate] 5] 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] byte-optimize-if #[(form) "A@‰:ƒ @Â=‚ 9ƒ Ã=ƒ!Ä8‚} „9Å›ƒ3ÆÇ›B‚}Ç8‚}Ä8ƒTǛȚƒPÉ Ä8E‚}‚}Ç8„`Å›ƒyÉÊ DÅ›ƒrÆÇ›B‚uÇ8E‚}Æ ËE)‡" [form clause quote t 2 4 progn 3 (nil) if not nil] 6] byte-optimize-while #[(form) "A@…‡" [form] 1] and or cond if while /= byte-compile-negation-optimizer atom nlistp byte-optimize-funcall #[(form) "A@‰¢Â>ƒ A@AAB‚)‡" [form fn (quote function)] 3] 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] funcall apply let byte-optimize-letX let* #[(form) "A@„ ÁAAB‡Â8„Ûƒ‡@Ä=ƒ/ÅÆÇÈÇÉA@\"\"Ê#‡ËA@! ÍË A! @A@ÎF)‡" [form progn 2 3 let append (progn) mapcar car cdr (nil) reverse binds let* nil] 7] nth byte-optimize-nth #[(form) "A@Á>ƒÂA@ÃUƒÄ8‚ÅÄ8DD‡Æ!‡" [form (0 1) car 0 2 cdr byte-optimize-predicate] 4] nthcdr byte-optimize-nthcdr #[(form) "A@‰Â>„Ã!‚%Ä8Å S‰!ƒ$ÆD‚)‡" [form count (0 1 2) byte-optimize-predicate 2 natnump cdr] 4] (% * + - / /= 1+ 1- < <= = > >= append aref ash assoc assq boundp buffer-file-name buffer-local-variables buffer-modified-p buffer-substring capitalize car cdr concat coordinates-in-window-p copy-marker count-lines documentation downcase elt 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 format get get-buffer get-buffer-window getenv get-file-buffer length logand logior lognot logxor lsh marker-buffer max member memq min mod next-window nth nthcdr previous-window rassq regexp-quote reverse string< string= string-lessp string-equal substring user-variable-p window-buffer window-edges window-height window-hscroll window-width zerop) (arrayp atom bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp char-or-string-p commandp cons consp current-buffer dot dot-marker eobp eolp eq eql equal get-largest-window identity integerp integer-or-marker-p interactive-p keymapp list listp make-marker mark mark-marker markerp minibuffer-window natnump nlistp not null numberp one-window-p point point-marker processp selected-window sequencep stringp subrp symbolp syntax-table-p vector vectorp windowp) side-effect-and-error-free-fns side-effect-free-fns side-effect-free t error-free 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 byte-compile (byte-constant byte-constant2 byte-varref byte-varset byte-varbind) byte-constref-ops] 5) (defalias 'disassemble-offset #[nil " WƒGÂÃ\"ÂÅ\" Æ=ƒ#TH‚E Ã=ƒDTHTÉHÊ\"\\‚E )‡ YƒV Z ‡ Yƒ} Xƒ}THTÉHÊ\"\\‡Y…•X…•TH‡" [op byte-nth logand 7 tem 248 6 ptr bytes lsh 8 byte-constant byte-constant2 byte-goto-if-not-nil-else-pop byte-listN byte-insertN] 4 "\ Don't call this!"]) (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 "\ Turns BYTECODE into lapcode, referring to CONSTVEC."]) (byte-code "ÀÁÂ\"ˆÃ BÆÈ Ê Ì ¤ À‡" [defalias byte-decompile-bytecode-1 #[(bytes constvec &optional make-splicable) "GÁ‰‰‰‰‰‰‰Á \n     U„ö H  Î H‰>ƒ] ž†WÑ B B‰ @A‚ÜÒ=ƒjÓ‚r>ƒ´HÓ=ƒŸ ;ƒŒÖ \"‚ ž†¯ CB‰@‚¯ ž†¯ CB‰@‚܃ÜÚ=ƒÜ  SUƒÏÂ‚Ü †×Ñ ‰Û †æÁBBB T‰ ‚!‰ƒ+@@ ž‰ƒ\" ABAB¡ˆÝ  \" AA‰„þ) ƒ7Þß \"ˆ@A@„DA ƒP BBàáŸ\". ‡" [bytes 0 nil retcount endtag tmp lap offset op tags tag optr ptr length 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 make-splicable byte-return byte-goto rest delq error "optimizer error: missed tags %s" mapcar cdr] 12] TAG byte-goto-ops byte-tagref-ops (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 (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 "Byte-codes that can be moved past an unbind.") byte-after-unbind-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) byte-compile-side-effect-and-error-free-ops (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] 3) (defconst byte-boolean-vars (quote (abbrev-all-caps abbrevs-changed byte-metering-on check-protected-fields completion-auto-help completion-ignore-case cursor-in-echo-area debug-on-next-call debug-on-quit defining-kbd-macro delete-exited-processes enable-recursive-minibuffers indent-tabs-mode insert-default-directory inverse-video load-in-progress menu-prompting mode-line-inverse-video no-redraw-on-reenter noninteractive parse-sexp-ignore-comments pop-up-frames pop-up-windows print-escape-newlines print-escape-newlines truncate-partial-width-windows visible-bell vms-stmlf-recfm words-include-escapes x-save-under)) "\ 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.") (defalias 'byte-optimize-lapcode #[(lap &optional for-effect) "À‰‰‰‰‰ÁÂÀ‰‰‰ ƒ ‚  \n    ƒÔ  Á=„FÔ>ƒFÕÖ!ˆ\nÀ \nƒ/\n@\nA@Ø\n8@Ù=ƒï@>ƒïÚ @JH \nA\n ÜUƒ¨Ô>ƒ™ÕÝ\"ˆÞÞ\"\"‚Ë  ÂUƒÇÔ>ƒ¼Õß\"ˆÞ\"‚Ë  àUƒèÔ>ƒÛÕá\"ˆÙ ˆ¡ˆ‚Ë âã!ˆ‚Ë @$>ƒqA=ƒq@å=ƒÞ\"æ ‚8@'>ƒ0Ù‰  ˆ¡ˆ‚8âèØ8\"ˆé>ƒk*ƒkë>ƒkÚì‰-./ðñòA@A@ó !A@%!ˆ+Ú ‚Ë @ô=ƒ%AA=ƒ%@õ>ƒ%A@6>‰ ƒ @÷=ƒË Ú @ø>ƒý ƒ¹A@ù>ƒ¿A‚ÏÚ:ž†ÏÚC:B‰:@ Ô>ƒíÕû@ B&ˆ@ ˆ ¡ˆ‚Ë Ô>ƒÕü$ˆ@ ˆý ˆ¡ˆÜ ‚Ë @ý=ƒb@Ù=ƒb@þ>ƒbÔ>ƒKÕÿ‰#ˆÚ \nA\nÞÞ\"\"‚Ë @@=ƒÉ@A=„€@B=ƒÉÔ>ƒ¥ÕC‰@A=ƒœB‚ŸAAB#ˆ‰@A=ƒ¶B‚¹A ˆÞ\"Ú ‚Ë @A=„Ý@B=ƒ4@å=ƒ4A=ƒ4@A=ƒþB‚ADÔ>ƒÕEDAB&ˆÞ\"D ˆÚ )‚Ë @÷=ƒØ@F>ƒØ@A=„Y@G=ƒ`A@‚eA@?ƒÔ>ƒyÕH#ˆ\nA\nÞÞ\"\"‚Ò@'>ƒ·Ô>ƒ¬ÕIåAB$ˆÞ\"‚ÍÔ>ƒÍÕIåAB$ˆå ˆÚ ‚Ë @ô=ƒc\nA‰ @@ý=ƒö A‰ ‚æA @A=ƒc @@ô=ƒcJ>ƒMKL\nA =„5ALMPL‚Ô>ƒLÕNL‰L&ˆ)Ú  @ý ˆ @¡ˆ \n‚Ë @O=ƒ×@O=ƒ×P>ƒ¦*ƒ¦ë>ƒ¦Úì‰-./ðñQA@A@#!ˆ+R\"‰ƒÉ¡ˆ>A‚ªÞ\"Ú ‚Ë @O=ƒ%R\"„%S>ƒ*ƒë>ƒÚì‰-./ðñTA@\"!ˆ+Þ\"Ú ‚Ë @U>ƒ@V>„\n ÂW>À‰XLYZ A‰ ƒ @@O=„YƒN @XBXL[PLZTZ‚NYƒö @@O=ƒ›ñ\\ @A\"‚¤ @†¤K]Z^WƒÎ_Õ`LaQXŸ]]E¤$ˆ‚õÔ>ƒõÕbZ‰ÜUƒéK‚ìc]]&ˆ)\n ¡ˆ,Ú ‚Ë @d=ƒ=@e>ƒ=Ô>ƒ*Õf‰%ˆ\n ˆ\nA ˆÚ ‚Ë @d=ƒÔ@g>ƒÔÂAWƒÔ‰AS¡ÂUƒkÞ\n\"ˆ@h=ƒ\nÙÂB ˆ‚‡Þ\"Ô>ƒÎÕf@ATB@h=ƒ¬\n@‚°\nA@AÂU„É@h=ƒÉ\nA@‚ÌK%ˆÚ ‚Ë @$>ƒ9A>A@‰ @i>ƒ9 =„Ë @å=„ @å=ƒË Ô>ƒÕj@ ‰$ˆ @k=ƒ,k ˆ A¡ˆÚ ‚Ë @l>ƒßA>A‰ @@m>ƒß @=„ß @@nž@>ƒ›@ ˆA¡ˆÔ>ƒÙÕo@$ˆ‚ÙOÜ 8@=„³ p  AB¡ˆÔ>ƒÉÕq@A@$ˆA@ ˆ A@¡ˆÚ ‚Ë @÷=ƒ‘@å=ƒ‘A>A‰ @@r>ƒ‘ @=„‘ @‰@A@„s‚\"t>ƒRÔ>ƒ;Õu%ˆ@ ˆA¡ˆÀ\nB\n‚‹Ô>ƒcÕv#ˆOÜ 8@=„{ p  AB¡ˆ A@¡ˆÞ\"Ú ‚Ë @w=ƒ& @å=ƒ& A\n>„& A>A‰ @@ô=ƒ&  @AA=ƒ& A@6>„& p xÔ>ƒ ÕyAA@ @‰AA@ @xA@ýåxB& ˆ\nýÂB\nAB¡ˆ x¡ AB¡ˆ)Ü Ú ‚Ë @å=ƒË @O=ƒË A>A‰ @A=ƒË  @@z>ƒË p xÔ>ƒ‡ Õ{A@AA@ @ @@|žAxBxA@&ˆ x¡ AB¡ˆ @@G=ƒ¹ \n÷À:ž†² ÀC:B‰:@B\nAB¡ˆ @@}>A@ ˆ)Ú \nA‰\n‚OÀ:À~‰\nƒ% \n@\nA@@>ƒ#\nA÷=ƒ\nA~>„#\nA~B~‚#\nA:>„#\nA:B:@÷=ƒ}\nØ\n8@÷=ƒ}\nAØ\n8@=ƒ}\n@€>ƒ}\nÔ>ƒb\nÕ‰&ˆ\nAA@AB ˆ\nAýÂB ˆÜ ‚ @‚>ƒ×\n\n À A‰ @@ý=„Ž\nA @A=ƒ¾\n@ @@=ƒ¾\n ýÂB ˆÚ‚Ž\nƒ Ô>ƒ Õƒ‰‰$ˆ‚ @d=ƒ @d=ƒ Ô>ƒ ÕIdAA\\B$ˆÚ Þ\"‰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 --> %s dup..." byte-compile-maxdepth] 14 "\ Simple peephole optimizer. LAP is both modified and returned."]) (provide (quote byte-optimize)) emacs-19.22/lisp/byte-run.elc100666 13437 1 4666 5416160637 14470 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:21:15 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/byte-run.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁMˆÂÀÃÄ#‡" [inline progn put lisp-indent-hook 0] 4) (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 "\ Define an inline function. The syntax is just like that of `defun'."])) (defalias 'make-obsolete #[(fn new) "ÁN‰Ã=ƒÄN  ˆ‚!ÆÄ \nB#ˆÆÁÃ#ˆ)‡" [fn byte-compile handler byte-compile-obsolete byte-obsolete-info new put] 6 "\ 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." "aMake function obsolete: \nxObsoletion replacement: "]) (defalias 'make-obsolete-variable #[(var new) "À  #ˆ ‡" [put var byte-obsolete-variable new] 4 "\ 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." (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) (defalias 'dont-compile '(macro . #[(&rest body) "ÀÁ\nAƒ Ã\nB‚\n@DD‡" [eval quote body progn] 4 "\ Like `progn', but the body always runs interpreted (not compiled). If you think you need this, you're probably making a mistake somewhere."])) (put (quote eval-when-compile) (quote lisp-indent-hook) 0) (defalias 'eval-when-compile '(macro . #[(&rest body) "À B‡" [progn body] 2 "\ Like `progn', but evaluates the body at compile time. The result of the body appears to the compiler as a quoted constant."])) (put (quote eval-and-compile) (quote lisp-indent-hook) 0) (defalias 'eval-and-compile '(macro . #[(&rest body) "À B‡" [progn body] 2 "\ Like `progn', but evaluates the body at compile time and at load time."])) emacs-19.22/lisp/bytecomp.elc100666 12120 1 175051 5432647410 14443 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 13 04:21:27 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/bytecomp.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÂÃ!ˆÄÅ!„ÆÇ!ˆÈÉÊ\"ˆÈËÌ\"‡" ["FSF 2.10" byte-compile-version require backquote fboundp defsubst load-library "byte-run" defalias byte-compile-single-version (macro lambda nil) byte-compile-version-cond (macro lambda (cond) cond)] 3) (defvar emacs-lisp-file-regexp (byte-code "Á=ƒ‡Ç" [system-type vax-vms "\\.EL\\(;[0-9]+\\)?$" "\\.el$"] 2) "\ *Regexp which matches Emacs Lisp source files. You may want to redefine `byte-compile-dest-file' if you change this.") (byte-code "ÀÁ!„\nÁÂMˆÃÄÅ\"ˆÃÆÅ\"ˆÃÇÅ\"ˆÃÈÅ\"ˆÃÉÅ\"‡" [fboundp byte-compile-dest-file #[(filename) "À !\nÃ=ƒ ÄÅÆ \"OÇP‡Å \"ƒ$ ĉ”OÉP‡ ÇP‡" [file-name-sans-versions filename 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) (defvar byte-compile-verbose (byte-code "?… \nV‡" [noninteractive baud-rate search-slow-speed] 2) "\ *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-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-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'.") (byte-code "À‡" [(redefine callargs free-vars unresolved) byte-compile-warning-types nil] 1) (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. 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 (quote name) "\ *If non-nil, sort the call tree. The values `name', `callers', `calls', `calls+callers' specify different fields to sort on.") (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.") (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)))) "\ 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).") (byte-code "ÀÁ!„ÂÀ‡" [boundp byte-compile-tag-number 0] 2) (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.") (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias byte-defop (macro . #[(opcode stack-adjust opname &optional docstring) "ÀÁN†ÂÀÁÃÄÅ\"#ÆÁN†ÂÆÁÃÄÅ\"#‰ \nIˆ  Iˆ* ƒAÍ\n Î Ï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]) byte-extrude-byte-code-vectors (macro . #[nil "ÀÁ‰ÂNÉÂN¯ÄÁÂÅ#ˆÄÃÂÅ#ˆ‡" [setq byte-code-vector tmp-compile-time-value byte-stack+-info put nil] 6])] 3) (defconst byte-varref 8 "\ Byte code opcode for variable reference.") (defconst byte-varset 16 "\ Byte code opcode for setting a variable.") (defconst byte-varbind 24 "\ Byte code opcode for binding a variable.") (defconst byte-call 32 "\ Byte code opcode for calling a function.") (defconst byte-unbind 40 "\ Byte code opcode for unbinding special bindings.") (byte-code "ÀÂÄÆÈ Ê Ì ÎÐÒÔÖØÚÜÞà!â#ä%æ'è)ê+ì-î/ð1ò3ô5ö7ø9ú;ü=þ?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~€‚ƒ„…†‡ˆ‰Š‹ŒŽÀ‡" [56 byte-nth 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] 1) (defconst byte-constant2 129 "\ Byte code opcode for reference to a constant with vector index >= byte-constant-limit.") (defconst byte-goto 130 "\ Byte code opcode for unconditional jump.") (defconst byte-goto-if-nil 131 "\ Byte code opcode to pop value and jump if it's nil.") (defconst byte-goto-if-not-nil 132 "\ Byte code opcode to pop value and jump if it's not nil.") (defconst byte-goto-if-nil-else-pop 133 "\ 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-not-nil-else-pop 134 "\ Byte code opcode to examine top-of-stack, jump and don't pop it if it's non nil, otherwise pop it.") (defconst byte-return 135 "\ Byte code opcode to pop a value and return it from `byte-code'.") (defconst byte-discard 136 "\ Byte code opcode to discard one value from stack.") (defconst byte-dup 137 "\ Byte code opcode to duplicate the top of the stack.") (defconst byte-save-excursion 138 "\ Byte code opcode to make a binding to record the buffer, point and mark.") (defconst byte-save-window-excursion 139 "\ Byte code opcode to make a binding to record entire window configuration.") (defconst byte-save-restriction 140 "\ Byte code opcode to make a binding to record the current buffer clipping restrictions.") (defconst byte-catch 141 "\ Byte code opcode for catch. Takes, on stack, the tag and an expression for the body.") (defconst byte-unwind-protect 142 "\ Byte code opcode for unwind-protect. Takes, on stack, an expression for the unwind-action.") (byte-code "ÀÂÄÆÈ Ê Ì ÎÐÒÔÖØÚÜÞà!â#ä%æ'è)ê+ì-î/ð1ò3ô5ö7ø9À‡" [143 byte-condition-case 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] 1) (defconst byte-constant 192 "\ Byte code opcode for reference to a constant.") (defconst byte-constant-limit 64 "\ Exclusive maximum index usable in the `byte-constant' opcode.") (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)) "\ List of byte-codes whose offset is a pc.") (byte-code "ÀÂÄƇ" [(byte-goto-if-nil byte-goto-if-not-nil) byte-goto-always-pop-ops [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 nil] 1) (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 "\ Turns lapcode into bytecode. The lapcode is destroyed."]) (byte-code "ÀÀÃÄÅ\"ˆÀÃÇÈ\"ˆÃÉÊ\"ˆÃËÌ\"ˆÃÍÎ\"ˆÃÏÐ\"ˆÃÑÒ\"ˆÃÓÔ\"ˆÃÕÖ\"ˆÃ×Ø\"ˆÃÙÚ\"ˆÃÛÜ\"ˆÃÝÞ\"ˆÃßà\"ˆÃáâ\"‡" [nil byte-compile-current-form byte-compile-current-file 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-compile-last-warned-form 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 \n" current-time-string "\n" "While compiling " "%s" ":\n" " " fill string-match " " 78 fill-column fill-prefix fill-paragraph nil] 7] byte-compile-warn #[(format &rest args) "ÀÁ \n# ƒÄÅ \"‡ÆÇ PÈ\"‡" [apply format args byte-compile-error-on-warn error "%s" byte-compile-log-1 "** " t] 4] 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] byte-compile-obsolete #[(form) "@ÁNÃÄ@\n@;ƒ\n@‚ÅÆ\n@\"#ˆ\nA†!Ç!)‡" [form byte-obsolete-info new byte-compile-warn "%s is an obsolete function; %s" format "use %s instead." byte-compile-normal-call] 6] byte-compile-fdefinition #[(name macro-p) "ƒ ‚ \n žA‰†z ‰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] byte-compile-arglist-signature #[(arglist) "ÀÁ‰ ƒA @Æ=ƒ „:À‚: @Ç=ƒ- Aƒ:ÈÁ‚: ƒ7 T‚: T A‰„\n \n?…R ƒQ \\‚R +B‡" [0 nil restp opts args arglist &optional &rest t] 4] byte-compile-arglist-signatures-congruent-p #[(old new) "@ @V†! A„A†!A…! A…!A AW?‡" [new old] 2] byte-compile-arglist-signature-string #[(signature) "A„ ÁÂ@\"‡@AUƒÁÃ@\"‡ÁÄ@A#‡" [signature format "%d+" "%d" "%d-%d"] 4] byte-compile-callargs-warn #[(form) "À @Â\"† À @Ã\"‰…$Å ¢Æ=ƒ A@‚# ÇH! AG ƒp @W„HA…° AV…°ÊË @ ‰ÌUƒXÍ‚YÎ @WƒfÏ‚gÐÑ!&‚°Ò @!†° @=†° @ž AG‰ƒ¤A>†¯AB¡‚¯ @DB‰*+‡" [byte-compile-fdefinition form nil t def byte-compile-arglist-signature lambda 0 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] byte-compile-arglist-warn #[(form macrop) "À A@\n\"‰ƒZÄ ¢Å=ƒ A@‚ ÆH!ÄÇ 8! Ê \"†VËÌ @Í=ƒ<΂=Ï A@Ð ! ÑšƒOÒ‚PÓÐ!&*‚Í A@žÕ‰‰‰‰…ÌÄÇ 8!ÛÜA!Ý\"‰@Ÿ@@W„¥AƒÃAVƒÃËÞ A@Ð!ßšƒ¹à‚ºáÐB!%ˆâ\"‰-)‡" [byte-compile-fdefinition form macrop old byte-compile-arglist-signature lambda 0 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] byte-compile-warn-about-unresolved-functions #[nil "À >ƒ€Â AƒtÅÅGÈ ! Ê  ƒjÌ @@!  GÍ\\\\ A SWƒRÏ  …LÐR‚Ñ  …]ÐR GÒ\\‚ÓÔ\"ˆ,‚ ƒÓÕ @@\"ˆ)ʇ" [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] byte-compile-constp (macro . #[(form) "ÀÁ\nDÃÄ\nDÅEDÆÇ\nDDCÈ\nÉECF‡" [cond consp form eq car (quote quote) not symbolp memq (quote (nil t))] 6]) 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-warnings (if (eq byte-compile-warnings t) byte-compile-warning-types byte-compile-warnings))) body] 3]) displaying-byte-compile-warnings (macro . #[(&rest body) "ÀÁÂÃÄÅBÇFÈEE‡" [let ((byte-compile-warnings-point-max (if (boundp (quote byte-compile-warnings-point-max)) byte-compile-warnings-point-max (save-excursion (set-buffer (get-buffer-create "*Compile-Log*")) (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)))))] 7])] 3) (defalias 'byte-recompile-directory #[(directory &optional arg) "ƒÁ!\n„à ˆÄÅ !ˆÆ!CȉÉ\n   ÎÏ!ƒ/‚7ŠÐÑ!qˆd)ÒŽÓÔÕˆ*Ö× ‰ØUƒOÙ‚PÚ ØVƒ_ÛÜ \"‚`Ù$,‡" [arg prefix-numeric-value noninteractive save-some-buffers set-buffer-modified-p buffer-modified-p expand-file-name directory 0 nil last-dir dir-count file-count directories boundp byte-compile-warnings-point-max 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„ÃÄ \"ˆÅ !Ɖ‰ ƒÏÊ @ \" @Ë„UÌ!ƒU ƒL Î=„LÏÐÑ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 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 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 "\ 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." "DByte recompile directory: \nP"]) (defalias 'byte-compile-file #[(filename &optional load) "À !\n„,ÃÀ !!‰ƒ+Å !ƒ+ÆÇÈÉ !\"!ƒ+Š qˆÊ ˆ)) ƒ6ÌÍ \"ˆÎ !ω‰ŠÔÕ!‰qˆÖ ˆ× !ˆ Ù ˆ*ÏÛ!„ØÜ!ˆŠqˆdbˆÝcˆÞà !á!ƒ™Ï\"ãäd#ˆ)‚­åæçè!ƒ§é‚¨êE\"ˆ)Üp!ˆ)+ƒÎ+Þ=„ÈÆÇì \"!ƒÎŠí !ˆ).ƒØî!ˆ,Þ‡" [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..." file-name-nondirectory nil output-buffer input-buffer target-file byte-compile-current-file get-buffer-create " *Compiler Input*" erase-buffer insert-file-contents buffer-file-name set-auto-mode byte-compiler-error-flag byte-compile-from-buffer kill-buffer "\n" t vms-stmlf-recfm byte-compile-dest-file file-writable-p kanji-flag 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 "\ 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." (byte-code "Á‰‰ƒÅÆ žAÇ=ƒÈ !É !Ê ƒ&Ì‚'Í\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)]) (defalias 'compile-defun #[(&optional arg) "ŠÀ ˆÁ ˆÂÄÆÇÈ!ƒ‚ŠÉÊ!qˆd)ËŽÌÍÎ*!ƒ?ÑÒ!ˆÓp\"ˆÔc‚FÑÕÖ!\",‡" [end-of-defun beginning-of-defun nil byte-compile-current-file nothing byte-compile-last-warned-form eval boundp byte-compile-warnings-point-max 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 "\ Compile and evaluate the current top-level form. Print the result in the minibuffer. With argument, insert value in current buffer after the form." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÏÐÑÒ#ˆÀÒÓ\"ˆÏÔÑÕ#ˆÀÕÖ\"ˆÏ×ÑØ#ˆÏÙÑØ#ˆÀØÚ\"ˆÏÛÑÜ#ˆÀÜÝ\"ˆÏÞÑß#ˆÏàÑß#ˆÏáÑß#ˆÀßâ\"ˆÏãÑä#ˆÀäå\"ˆÏæÑç#ˆÀçè\"ˆÏéÑê#ˆÀêë\"ˆÀìí\"‡" [defalias byte-compile-from-buffer #[(inbuffer &optional eval) "ÀÀ‰‰‰‰Â‰‰À \n Ì !À‰‰‰Ñ=ƒ2‚4ŠØÙ!qÚ ˆÀ\nÛ)ÝÞ!ƒ_‚gŠØß!qˆd)àŽáâãˆ*Š qˆebˆ.$„ƒ ‚—Àå惒ä'!ˆ‚ƒè !ˆÀ)‡" [nil outbuffer 0 byte-compile-output byte-compile-maxdepth byte-compile-depth byte-compile-tag-number byte-compile-variables byte-compile-constants print-length case-fold-search float-output-format copy-alist byte-compile-initial-macro-environment byte-compile-verbose byte-optimize 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 overwrite-mode-binary overwrite-mode boundp byte-compile-warnings-point-max "*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„$ÆÇ!!ˆ‚È ˆ „/Ê ˆË ˆÃ )Ç" [inbuffer 1 " \n " nil looking-at ";" byte-compile-file-form read byte-compile-flush-pending eval byte-compile-insert-header byte-compile-warn-about-unresolved-functions byte-compile-unresolved-functions] 3) ((error (byte-compile-report-error error-info))) eval (byte-code "À !Ç" [read outbuffer form t] 2) ((end-of-file)) form kill-buffer] 9] byte-compile-insert-header #[nil "ŠqˆÁbˆÂ ƒÄ‚ÅƱˆÇÈ ÉÊ ËÌ Íϱ ˆÐÒ±ˆÓÕ×=ƒ;Ø‚PÙ=ƒFÚ‚PƒOÛ‚PÜ ƒXÝ‚YÒ±ˆ ?…hÞßàáâ±)‡" [outbuffer 1 ";ELC" byte-compile-compatibility 18 19 "\n" ";;; compiled by " 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\")))\n" " (error \"This file was compiled for Emacs 19\"))\n"] 9] byte-compile-output-file-form #[(form) "¢Á>ƒÂ8;ƒÃÄ\"‡Å‰Æ ÊË \"ˆÍ \"ˆ+Ƈ" [form (defun defmacro defvar defconst autoload) 3 byte-compile-output-docform ("\n(" 3 ")") t nil print-gensym print-readably print-escape-newlines princ "\n" outbuffer prin1] 3] byte-compile-output-docform #[(info form) "pqˆ @cˆ A@\n›Ã‰ÄÉ\n@\"ˆ\nA‰ƒNÊcˆ\n=ƒEÄ`TÉ\n@\"ˆbˆËcˆdbˆ)‚É\n@\"ˆ‚,Ì 8cˆqˆÄ‡" [outbuffer info form t nil print-gensym print-readably print-escape-newlines docl prin1 " " "\\\n" 2] 5] 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] byte-compile-flush-pending #[nil "…1ÁÂÃ\"‰¢Å=ƒÆÇ A\"ˆ‚! ƒ!Ç !ˆÈ È\nË Ë ȉ)‡" [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] 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 defsubst byte-hunk-handler 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] autoload 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] defvar byte-compile-file-form-defvar defconst #[(form) "À 8„\n !‡Ã >ƒ 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] require byte-compile-file-form-eval-boundary #[(form) "À !ˆÂ Ã\"‡" [eval form byte-compile-keep-pending byte-compile-normal-call] 3] progn byte-compile-file-form-progn prog1 prog2 #[(form) "ÀÁ\nA\"ˆÃ‡" [mapcar byte-compile-file-form form nil] 3] eval byte-compile-file-form-eval #[(form) "A@¢Á=ƒA@A@‡Â!‡" [form quote byte-compile-keep-pending] 2] defun byte-compile-file-form-defun #[(form) "À Â\"‡" [byte-compile-file-form-defmumble form nil] 3] defmacro byte-compile-file-form-defmacro #[(form) "À Â\"‡" [byte-compile-file-form-defmumble form t] 3] byte-compile-file-form-defmumble #[(form macrop) "A@\nƒ  Ä\nƒÄ‚à Jž JžÉ\nÉ  ƒ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;„§é*ƒvë‚wìè D\n„ƒ'‚¢'¢í=ƒ“îï'E‚¢è\nƒŸß%B‚¡%DE!‚ð ˆñ*ƒ´ò‚µó4\"ˆõ 4\"ˆö':„Ò\nƒÎ÷‚óø‚ó'@è=ƒê%'\nƒæù‚óú‚ó\nƒòû‚óüý'É\"\"ˆñþ4\"ˆÉ. ‡" [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-keep-pending byte-compile-compatibility fset defalias make-byte-code cons (quote macro) byte-compile-flush-pending princ "\n(fset '" "\n(defalias '" outbuffer prin1 byte-compile-output-docform (" '(macro . #[" 4 "])") (" #[" 4 "]") (" '(macro " 2 ")") (" '(" 2 ")") (" (cons 'macro (" 5 "))") (" (" 5 ")") append ")"] 7]] 4) (defalias 'byte-compile #[(form) "ÀÁ!ƒ\n ‚ŠÂÃ!qˆd)ÄŽÅÆÇ*‡" [boundp byte-compile-warnings-point-max 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   9ƒ5Î !…7 K‚7 ‰¢Ð=‰ƒHA¢Ñ=…uƒ^ÐÒ!B‚bÒ! 9ƒsÓ \"‚u.\n‡" [copy-alist byte-compile-initial-macro-environment nil byte-compile-verbose byte-optimize 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] 10) ((error (byte-compile-report-error error-info)))] 3 "\ 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-sexp #[(sexp) "ÀÁ!ƒ\n ‚ŠÂÃ!qˆd)ÄŽÅÆÇ*‡" [boundp byte-compile-warnings-point-max 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  Í!.‡" [copy-alist byte-compile-initial-macro-environment nil byte-compile-verbose byte-optimize 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] 9) ((error (byte-compile-report-error error-info)))] 3 "\ Compile and return SEXP."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆáâãä#ˆáåãæ#ˆáçãæ#ˆáèãæ#ˆáéãæ#ˆáêãæ#ˆáëãì#ˆáíãì#ˆáîãì#ˆáïãì#ˆáðãñ#ˆáòóô#ˆáòõö#ˆáöãò#ˆá÷óô#ˆá÷õø#ˆáøã÷#ˆáùóô#ˆáùõú#ˆáúãù#ˆáûóô#ˆáûõö#ˆáöãû#ˆáüóô#ˆáüõø#ˆáøãü#ˆáýóô#ˆáýõú#ˆáúãý#ˆáþóô#ˆáþõÿ#ˆáÿãþ#ˆá@óô#ˆá@õA#ˆáAã@#ˆáBóô#ˆáBõC#ˆáCãB#ˆáDóô#ˆáDõE#ˆáEãD#ˆá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#ˆáPQR#ˆáSóô#ˆáSõP#ˆáPãS#ˆáTQR#ˆáUóV#ˆáUõT#ˆáTãU#ˆáWQR#ˆáXóV#ˆáXõW#ˆáWãX#ˆáYQR#ˆáZóV#ˆáZõY#ˆáYãZ#ˆá[ó\\#ˆá[õ]#ˆá]ã[#ˆá^ó\\#ˆá^õ_#ˆá_ã^#ˆá`ó\\#ˆá`õa#ˆáaã`#ˆábó\\#ˆábõc#ˆácãb#ˆádó\\#ˆádõe#ˆáeãd#ˆáfó\\#ˆáfõe#ˆáeãf#ˆágó\\#ˆágõh#ˆáhãg#ˆáió\\#ˆáiõj#ˆájãi#ˆákó\\#ˆákõl#ˆálãk#ˆámó\\#ˆámõn#ˆánãm#ˆáoó\\#ˆáoõp#ˆápão#ˆáqó\\#ˆáqõr#ˆárãq#ˆásó\\#ˆásõt#ˆátãs#ˆáuó\\#ˆáuõv#ˆávãu#ˆáwó\\#ˆáwõx#ˆáxãw#ˆáyó\\#ˆáyõz#ˆázãy#ˆá{QR#ˆá|ó\\#ˆá|õ{#ˆá{ã|#ˆá}QR#ˆá~ó\\#ˆá~õ}#ˆá}ã~#ˆáQR#ˆá€ó\\#ˆá€õ#ˆáã€#ˆáQR#ˆá‚ó\\#ˆá‚õ#ˆáã‚#ˆáƒQR#ˆá„ó\\#ˆá„õƒ#ˆáƒã„#ˆá…QR#ˆá†ó\\#ˆá†õ…#ˆá…ã†#ˆá‡QR#ˆáˆó\\#ˆáˆõ‡#ˆá‡ãˆ#ˆá‰QR#ˆáŠó‹#ˆáŠõ‰#ˆá‰ãŠ#ˆáŒQR#ˆáó‹#ˆáõŒ#ˆáŒã#ˆáŽó#ˆáŽõ#ˆáãŽ#ˆá‘ó#ˆá‘õ#ˆáã‘#ˆá’ó#ˆá’õ“#ˆá“ã’#ˆá”ó#ˆá”õ•#ˆá•ã”#ˆá–ó#ˆá–õ—#ˆá—ã–#ˆá˜ó#ˆá˜õ™#ˆá™ã˜#ˆášó#ˆášõ›#ˆá›ãš#ˆáœó#ˆáœõ#ˆáãœ#ˆážó#ˆážõŸ#ˆáŸãž#ˆá ó#ˆá õ¡#ˆá¡ã #ˆá¢ó#ˆá¢õ£#ˆá£ã¢#ˆá¤ó#ˆá¤õ¥#ˆá¥ã¤#ˆá¦ó#ˆá¦õ§#ˆá§ã¦#ˆá¨ó©#ˆá¨õª#ˆáªã¨#ˆá«QR#ˆá¬ó©#ˆá¬õ«#ˆá«ã¬#ˆá«QR#ˆá­ó©#ˆá­õ«#ˆá«ã­#ˆá®QR#ˆá¯ó\\#ˆá¯õ®#ˆá®ã¯#ˆá°QR#ˆá±ó\\#ˆá±õ°#ˆá°ã±#ˆá²QR#ˆá³ó\\#ˆá³õ²#ˆá²ã³#ˆá´QR#ˆáµó\\#ˆáµõ´#ˆá´ãµ#ˆá¶QR#ˆá·ó#ˆá·õ¶#ˆá¶ã·#ˆá¸QR#ˆá¹ó#ˆá¹õ¸#ˆá¸ã¹#ˆá¶QR#ˆáºó#ˆáºõ¶#ˆá¶ãº#ˆá¸QR#ˆá»ó#ˆá»õ¸#ˆá¸ã»#ˆá¼QR#ˆá½ó#ˆá½õ¼#ˆá¼ã½#ˆá¾QR#ˆá¿ó#ˆá¿õ¾#ˆá¾ã¿#ˆáÀQR#ˆáÁó#ˆáÁõÀ#ˆáÀãÁ#ˆáÂQR#ˆáÃó#ˆáÃõÂ#ˆáÂãÃ#ˆáÄQR#ˆáÅó#ˆáÅõÄ#ˆáÄãÅ#ˆáÆQR#ˆáÇó#ˆáÇõÆ#ˆáÆãÇ#ˆáÈQR#ˆáÉó#ˆáÉõÈ#ˆáÈãÉ#ˆáÆQR#ˆáÊó#ˆáÊõÆ#ˆáÆãÊ#ˆáÈQR#ˆáËó#ˆáËõÈ#ˆáÈãË#ˆáÌQR#ˆáÍó#ˆáÍõÌ#ˆáÌãÍ#ˆáÎQR#ˆáÏó#ˆáÏõÎ#ˆáÎãÏ#ˆáÐQR#ˆáÑó#ˆáÑõÐ#ˆáÐãÑ#ˆáÒQR#ˆáÓó#ˆáÓõÒ#ˆáÒãÓ#ˆáÔóÕ#ˆáÔõÖ#ˆáÖãÔ#ˆá×óØ#ˆá×õÙ#ˆáÙã×#ˆáÚóØ#ˆáÚõÛ#ˆáÛãÚ#ˆáÜóØ#ˆáÜõÝ#ˆáÝãÜ#ˆáÞQR#ˆáßóØ#ˆáßõÞ#ˆáÞãß#ˆáàóá#ˆÀâã\"ˆÀôä\"ˆÀ\\å\"ˆÀæ\"ˆÀÕç\"ˆÀVè\"ˆÀ‹é\"ˆÀ©ê\"ˆÀáë\"ˆÀìí\"ˆÀØî\"ˆáæóï#ˆáæõð#ˆáðãæ#ˆáìóñ#ˆáìõò#ˆáòãì#ˆáóóô#ˆáóõõ#ˆáõãó#ˆáöó÷#ˆáöõø#ˆáøãö#ˆáùó÷#ˆáùõø#ˆáøãù#ˆáñóú#ˆáñõû#ˆáûãñ#ˆáüóý#ˆáþóÿ#ˆáQR#ˆáó#ˆáõ#ˆáã#ˆáQR#ˆáó#ˆáõ#ˆáã#ˆáó#ˆÀï\"ˆÀñ \"ˆÀÿ\n\"ˆÀ \"ˆÀ \"ˆÀô \"ˆÀ\"ˆÀý\"ˆÀ÷\"ˆÀú\"ˆÀ\"ˆáó#ˆáó#ˆáó#ˆáó#ˆÀ\"ˆÀ\"ˆÀ\"ˆÀ\"ˆÀ !\"ˆÀ\"#\"ˆá\"$%#ˆÀ&'\"ˆá&$%#ˆá(ó)#ˆá*ó)#ˆá+ó,#ˆá-ó.#ˆá/ó0#ˆá1ó2#ˆá3ó4#ˆá5ó6#ˆá7ó8#ˆáäó9#ˆá:ó#ˆá;ó#ˆá<ó#ˆá=ó#ˆá>ó?#ˆá@óA#ˆÀ)B\"ˆÀ,C\"ˆÀ.D\"ˆÀEF\"ˆÀ0G\"ˆÀ2H\"ˆÀ4I\"ˆÀ6J\"ˆÀ8K\"ˆÀ9L\"ˆÀ?M\"ˆÀAN\"ˆáOóP#ˆáQóP#ˆáRóP#ˆáOSš#ˆáQS^#ˆáRSb#ˆÀPT\"ˆÀUV\"ˆáWóX#ˆáYóZ#ˆá[ó\\#ˆá]ó^#ˆá_ó`#ˆáaób#ˆácód#ˆáeóf#ˆÀXg\"ˆÀZh\"ˆÀfi\"ˆÀ\\j\"ˆÀ^k\"ˆÀ`l\"ˆÀbm\"ˆÀdn\"ˆáoóp#ˆáqór#ˆásót#ˆáuót#ˆávów#ˆáxóy#ˆÀpz\"ˆÀr{\"ˆÀt|\"ˆÀw}\"ˆÀy~\"ˆÀ€\"ˆÀ‚\"ˆÀƒ„\"ˆÀ…†\"ˆÀ‡ˆ\"‡" [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] 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] byte-compile-lambda #[(fun) "A@ >…ÄÅÄÆÇ !\"\"¤AA‰ @;…+ @ A \nË ž‰ ƒ€  @=ƒE A  A:ƒr AAƒ[ÍÎÏ !\"ˆÐ 8¢Ñ=„€ËÒ A@!D ‚€ Aƒ€ÍÎÏ !\"ˆÒÓ BÔÕ#‰¢×=ƒº„ºÙÚÛ CA\n„¨ …«\nC …µ A@C$\"‚ÿ … C¢Ó=ƒÐA‚Ø…ØC¤Õ D\n„ê@;ƒü\n†ø …øÔCB‚þ¤.‡" [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 1 list byte-compile-top-level progn nil lambda compiled byte-code byte-compile-compatibility apply make-byte-code append] 8] byte-compile-constants-vector #[nil "À\nŸ ŸÆÆÉ\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] byte-compile-top-level #[(form &optional for-effect output-type) "À‰Á‰‰ÀÉ>ƒÊ  \"  ¢Í=ƒ6 AA„6 A@‰ ‚ ¢Î=ƒdÏ>„d A@;ƒdÐÑ 8!ƒdÒÓ 8!ƒd ‚qÔ  \"ˆÕ \".‡" [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] byte-compile-out-toplevel #[(&optional for-effect output-type) "ƒC @@Â=ƒ A‚CÃÄ ž?…AÆ !‰ƒ<@@9„<@@§„<A‰„#@@)!ˆÈÉÊ\"ˆ Ÿ Ì>ƒWÍ \"ÄÏ=?ĉÓ=ƒrÔ‚sÕ ›„qÖ ž„qÉ ž‰ƒqÆ !>AŸ‰@@×>ƒÙ@A@@@Ø=ƒÎ:„¼9ƒÎÙ>„΃^ÚDB‰‚RB‰‚Rƒ^Û›„^@@ÜN‰ƒ^AƒÝ>ƒ^AAƒ^A@@Â=ƒ^AÄŸÞ=ƒ8@¢Ú=ƒ8@A@AB‚=BCÓ=„UßÄàá@A\"\"?ƒ^A‰‚’„q@:ƒ‚Ï=ƒ‚â #äå !#&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] byte-compile-top-level-body #[(body &optional for-effect) "ÀÁ\nB Ä#‰¢Á=ƒ\nA‡\n…\nC‡" [byte-compile-top-level progn body for-effect t] 5] byte-compile-form #[(form &optional for-effect) "À \n\"‰:„2 9ƒ Ã>ƒÄ !ˆ‚£ ƒ*ƒ*Ç‚£ÈÉ \"ˆ‚£ @9ƒ| @‰\nËN \nÍ>ƒNÎÏ\n\"ˆ ƒiƒa\nÑNÒN„i !ˆ‚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] 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] byte-compile-variable-ref #[(base-op var) "9ƒ Á>ƒ) Ä=ƒÅ‚Æ9ƒ Ç‚!ÈÉ!#ˆ‚šÊNƒJÊN ÂÌ ;ƒB ‚GÍÎ \"#ˆ)Ï>ƒš Ä=ƒ`B‚šÒ!„š>„š Ó=ƒˆ>„šÂÕ\"ˆ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 ob "%s is an obsolete variable; %s" format "use %s instead." free-vars byte-compile-warnings 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] byte-compile-get-constant (macro . #[(const) "ÀÁ DÄ ÅEÆ ÅEFÇÈÅÉÊ DÅEEDE‡" [or if stringp const assoc byte-compile-constants assq car setq cons list] 8]) byte-compile-constant #[(const) "ƒÁ‰‡Âà ;ƒÅ \"‚ ž†' CB‰@\"‡" [for-effect nil byte-compile-out byte-constant const assoc byte-compile-constants] 5] byte-compile-push-constant #[(const) "À\n ƒÀ‰‚.ÃÄ\n;ƒÅ\n\"‚!\nž†-\nCB‰@\"*‡" [nil for-effect const byte-compile-out byte-constant assoc byte-compile-constants] 5] byte-defop-compiler (macro . #[(function &optional compile-handler) "À\n9ƒÃÄÅ\n!P!‚\nA@\n@ÆÇ\nDÈÇ ÊžA†3 †3ÃËÅ\n!P!DF ƒTÍ ÆÇ\nDÎÇ DFÆÇ DÏÇ\nDFF‚V *‡" [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]) 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]) byte-defop-compiler-1 (macro . #[(function &optional compile-handler) "À ÂD E‡" [byte-defop-compiler function nil compile-handler] 3]) 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 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] #[(form) "GÁU„ ÂÃ\"‡Ä@ÅNÆ\"‡" [form 1 byte-compile-subr-wrong-args "none" byte-compile-out byte-opcode 0] 3] #[(form) "GÁU„ ÂÃ\"‡ÄA@!ˆÅ@ÆNÇ\"‡" [form 2 byte-compile-subr-wrong-args 1 byte-compile-form byte-compile-out byte-opcode 0] 3] #[(form) "GÁU„ ÂÃ\"‡ÄA@!ˆÄÃ8!ˆÅ@ÆNÇ\"‡" [form 3 byte-compile-subr-wrong-args 2 byte-compile-form byte-compile-out byte-opcode 0] 3] #[(form) "GÁU„ ÂÃ\"‡ÄA@!ˆÄÅ8!ˆÄÃ8!ˆÆ@ÇNÈ\"‡" [form 4 byte-compile-subr-wrong-args 3 byte-compile-form 2 byte-compile-out byte-opcode 0] 3] #[(form) "G‰ÂUƒÃÄÅ\"!‚\" ÆUƒÃ!‚\"ÇÈ\")‡" [form len 1 byte-compile-one-arg append (nil) 2 byte-compile-subr-wrong-args "0-1"] 5] #[(form) "G‰ÂUƒÃÄÅ\"!‚\" ÆUƒÃ!‚\"ÇÈ\")‡" [form len 2 byte-compile-two-args append (nil) 3 byte-compile-subr-wrong-args "1-2"] 5] #[(form) "G‰ÂUƒÃÄÅ\"!‚\" ÆUƒÃ!‚\"ÇÈ\")‡" [form len 3 byte-compile-three-args append (nil) 4 byte-compile-subr-wrong-args "2-3"] 5] #[(form) "ÀÁ!‡" [byte-compile-constant nil] 2] byte-compile-discard #[nil "ÀÁÂ\"‡" [byte-compile-out byte-discard 0] 3] #[(form) "Aƒ#@ÁNÃÄA‰\"ˆA‰…!Å\nÆ\"ˆ‚)‡ÇÈ!!‡" [form byte-opcode opcode mapcar byte-compile-form byte-compile-out 0 byte-compile-constant eval] 4] byte-compile-list byte-list byte-compile-concat byte-concat fset byte-compile-fset byte-fset indent-to-column byte-compile-indent-to byte-indent-to indent-to byte-compile-insert byte-insert function byte-compile-function-form - byte-compile-minus byte-quo / byte-compile-quo byte-nconc nconc byte-compile-nconc beginning-of-line byte-compile-beginning-of-line #[(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] #[(form) "AG Wƒ! ÃWƒ!ÄÅA\"ˆÆÇ ÈZHÉ\"‚H ÉUƒ-ÅÊ!‚H ËWƒE „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] #[(form) "A‰„ ÁÂ!‡Ã@!ˆAƒ)A‰…-Ã@!ˆÄÅÂ\"ˆ‚ÄÆÂ\"‡" [form byte-compile-constant 0 byte-compile-form byte-compile-out byte-diff byte-negate] 3] #[(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] #[(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] #[(form) "À 8‰¢Å=ƒB A@‰¢Æ=ƒB AA‰@;ƒ% 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] byte-compile-funarg #[(form) "À A@‰¢Ã=ƒ#\nA@¢Ä=ƒ# @Å\nAB AABB‚$ )!‡" [byte-compile-normal-call form fn quote lambda function] 5] #[(form) "À A@9ƒ A@‚!\nƒÃÄ A@!!‚!Ä A@!!‡" [byte-compile-constant form byte-compile-compatibility byte-compile-byte-code-unmake byte-compile-lambda] 4] #[(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] #[(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] #[(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] setq byte-compile-setq setq-default byte-compile-setq-default quote byte-compile-quote quote-form byte-compile-quote-form #[(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] #[(form) "AÁ‰ƒÄÅ @D A@E\nB AA‰„ ÆÇ\nŸB!*‡" [form nil setters args set-default quote byte-compile-form progn] 4] #[(form) "À A@!‡" [byte-compile-constant form] 2] #[(form) "ÀÁ\nA@!!‡" [byte-compile-constant byte-compile-top-level form] 3] byte-compile-body #[(body &optional for-effect) "AƒÁ@Â\"ˆA‰‚Á@ \"‡" [body byte-compile-form t for-effect] 4] byte-compile-body-do-effect #[(body) "À \n\"ˆÃ‰‡" [byte-compile-body body for-effect nil] 3] byte-optimizer byte-compile-inline-expand byte-compile-form-do-effect #[(form) "À \n\"ˆÃ‰‡" [byte-compile-form form for-effect nil] 3] inline 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 byte-compile-funcall apply mapcar mapatoms mapconcat let byte-compile-let let* byte-compile-let* #[(form) "A \"ˆÄ‰)‡" [form body byte-compile-body for-effect nil] 3] #[(form) "A@Á\n\"ˆÃ)ÄAAÅ\"‡" [form byte-compile-form for-effect nil byte-compile-body t] 3] #[(form) "À A@Â\"ˆÃ 8À \"ˆÅ)Æ AAAÂ\"‡" [byte-compile-form form t 2 for-effect nil byte-compile-body] 3] byte-compile-goto-if (macro . #[(cond discard tag) "ÀÁ\nÁ ÄÅFÁ ÆÇFFE‡" [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] 8]) #[(form) "À A@!ˆÂ ›„-à ÅƒÇ‚È \"ˆÀÉ 8\"ˆÊ !ˆ)‚Zà à  ÅÇ \"ˆÀÉ 8\"ˆÅÌ \"ˆÊ !ˆÍ AAA\"ˆÊ !ˆ*Ή‡" [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] #[(clauses) "À Á‰ A‰ƒl @‰@Æ=„'\n@¢Ç=ƒ1\n@£¢ƒ1Æ\nBÁ‰‚ AƒÈ\n@!ˆ\nA„QÉ\nƒJË‚KÌ \"ˆ‚À ÉÍ \"ˆÎ\nA\n\"ˆÉÏ \"ˆÐ !ˆ‚\nAƒŽ\n@Æ=„ŽÈ\n@!ˆÉ\nƒ‡Í‚ˆÑ \"ˆ\nA\nÎ\n\"ˆÁ\n)Ð !+‡" [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] #[(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] #[(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] #[(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] #[(form) "ÀÁ\nA\"ˆÃÄ\nAAG\"‡" [mapcar byte-compile-form form byte-compile-out byte-call] 3] #[(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] #[(form) "Á\nA@! ƒ3 @:„ÄÅ!ˆ‚&Æ @A@!ˆ ‰@@ ˆÇÈ @\"ˆ A‰„ \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-compile-negated atom nlistp byte-compile-negated-op #[(form) "À ! \"ˆÄ‰)‡" [byte-compile-negation-optimizer form byte-compile-form for-effect nil] 3] 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] catch 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 #[(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] #[(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] #[(form) "ÀÁÂÃÄÅÆA@!DEDD!‡" [byte-compile-form funcall quote lambda nil track-mouse byte-compile-top-level form] 8] #[(form) "A@‰ƒ \nB‚\n 9„ÃÄ \"ˆÅ !ˆÅÆÇ8\"!ˆAAAÉ\n‰ ƒ„ @‰ @‰ 9„NÃÎÏ !\"ˆ‚k Ð=„k ÑN;ƒe ÒN:„kÃÓ \"ˆ Ô A\"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 "%s is not a symbol naming a condition (in condition-case)" prin1-to-string t error-message error-conditions "%s is not a known condition name (in condition-case)" byte-compile-top-level-body byte-compile-out byte-condition-case 0] 5] #[(form) "ÀÁÂ\"ˆ AÅ \"ˆÇ)ÀÈÉ\"‡" [byte-compile-out byte-save-excursion 0 form body byte-compile-body for-effect nil byte-unbind 1] 3] #[(form) "ÀÁÂ\"ˆ AÅ \"ˆÇ)ÀÈÉ\"‡" [byte-compile-out byte-save-restriction 0 form body byte-compile-body for-effect nil byte-unbind 1] 3] #[(form) "ÀÁ\nA \"!ˆÄÅÆ\"‡" [byte-compile-push-constant byte-compile-top-level-body form for-effect byte-compile-out byte-save-window-excursion 0] 4] #[(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] defun byte-compile-defun defmacro byte-compile-defmacro defvar byte-compile-defvar defconst autoload byte-compile-autoload lambda byte-compile-lambda-form #[(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] #[(form) "ÀÁ\nA@DÃÄÅ\nAAB!!‰¢Ç=ƒ ÈÉE‚(ÁÊË!BD)EÁ\nA@DD Í \"ˆÏ‰)‡" [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] #[(form) "A@Á8Â8Æ>ƒ BAA…8@É=ƒ-Ê E‚8ËÌÍ DDÊ EE …CÎÍ DÏ FÍ DEÑ\"ˆÓ‰,‡" [form 2 3 string value var free-vars byte-compile-warnings byte-compile-bound-variables defconst setq or boundp quote put (quote variable-documentation) body byte-compile-body for-effect nil] 5] #[(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] #[(form) "ÀÁ!‡" [error "`lambda' used as function name is invalid"] 2] byte-compile-make-tag #[nil "À T‰D‡" [TAG byte-compile-tag-number] 3] 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] byte-compile-goto #[(opcode tag) " B\nB A >ƒ S‚ ¡ˆÅ=?… S‰‡" [opcode tag byte-compile-output byte-goto-always-pop-ops byte-compile-depth byte-goto] 3] byte-compile-out #[(opcode offset) " B\nBÃ=ƒ Z‰‡Å=ƒƉ‡ JH†( S[\\‰]‰‡" [opcode offset byte-compile-output byte-call byte-compile-depth byte-return nil byte-stack+-info byte-compile-maxdepth] 4] byte-compile-annotate-call-tree #[(form) "À\n@ ž‰ƒ Å 8>„( A A@B ˆ‚(\n@ CÀE B ž‰ƒF\n@Æ 8>†P AA\n@Æ 8B ‚P À\n@CE B‰)‡" [nil entry form byte-compile-call-tree byte-compile-current-form 1 2] 4]] 4) (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 "\ 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." nil]) (defalias 'batch-byte-compile #[nil "„ÁÂ!ˆÃ ƒ†ÅÆ @!!ƒvÇ @!É ‰\nƒrË \n@\"ƒiÍ\n@!„iÆ\n@ @\"‰ ƒiÎ !‰ƒiÏ!ƒiÐ \"ƒiÑ !„iÒ\nA‰\n„'+‚Ñ @!„Ò A‰„ÓÔ!ˆÕ ƒ“Ö‚”×!)‡" [noninteractive error "`batch-byte-compile' is to be used only with -batch" nil command-line-args-left 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 "\ 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 (quote batch-byte-compile-file) #[(file) "ÀÁ‡" [err (byte-code "À !ˆÂ‡" [byte-compile-file file t] 2) ((error (byte-code "À Aƒ\n‚ à @ÅNÆ A!$ˆÇ‡" [message err ">>Error occurred processing %s: %s (%s)" ">>Error occurred processing %s: %s" file error-message prin1-to-string nil] 6)))] 3]) (defalias 'batch-byte-recompile-directory #[nil "„ÁÂ!ˆ „Ä ƒÅ @!ˆ A‰„ÆÇ!‡" [noninteractive error "batch-byte-recompile-directory is to be used only with -batch" command-line-args-left (".") byte-recompile-directory kill-emacs 0] 3 "\ 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 .'."]) (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; this is now a list of events." suspend-hooks suspend-hook comment-indent-hook comment-indent-function meta-flag "Use the set-input-mode function instead." provide byte-compile defalias byte-compile-report-ops #[nil "ÀÀqˆÁ‰‰‰ÇW…vÁHH  Wƒ7Ê Ë\"Ê Ì\"‚F  YƒF  Z  HÏÐ\"cˆÑ !cˆ ƒcÒÓ !Ô±ˆÕjˆÓ !Ö±ˆT‰‚,‘‡" ["*Meter*" 0 nil off op n i 256 byte-code-meter byte-nth logand 7 248 byte-constant byte-code-vector format "%-4d" symbol-name " [" int-to-string "]" 40 "\n"] 6]] 3) emacs-19.22/lisp/c-mode.elc100666 13437 1 51347 5474620065 14105 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:49:55 1993 ;;; from file /home/fsf/rms/e19/lisp/c-mode.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (defvar c-mode-abbrev-table nil "\ Abbrev table in use in C mode.") (define-abbrev-table (quote c-mode-abbrev-table) nil) (defvar c-mode-map nil "\ Keymap used in C mode.") (byte-code "„aÁ ÂÃÄ#ˆÂÅÄ#ˆÂÆÇ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÂÔÕ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÛ#ˆÂÜÝ#ˆÂÞß#ˆÁ‡" [c-mode-map make-sparse-keymap define-key "{" 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 "q" c-fill-paragraph "" c-forward-conditional "" c-backward-conditional "" c-up-conditional "" backward-delete-char-untabify " " c-indent-command] 4) (autoload (quote 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.") (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) (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.") (byte-code "À‡" [(("GNU" (c-indent-level . 2) (c-argdecl-indent . 5) (c-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 . -5) (c-label-offset . -5) (c-continued-statement-offset . 5)) ("BSD" (c-indent-level . 4) (c-argdecl-indent . 4) (c-brace-offset . -4) (c-label-offset . -4) (c-continued-statement-offset . 4)) ("C++" (c-indent-level . 4) (c-continued-statement-offset . 4) (c-brace-offset . -4) (c-argdecl-indent . 0) (c-label-offset . -4) (c-auto-newline . t)) ("Whitesmith" (c-indent-level . 4) (c-argdecl-indent . 4) (c-brace-offset . 0) (c-label-offset . -4) (c-continued-statement-offset . 4))) c-style-alist nil] 1) (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.") (byte-code "À‡" ["case[ '/(]\\|default\\(\\S_\\|'\\)" c-switch-label-regexp nil] 1) (defalias 'c-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍP ËÏ!ˆ ËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆÑË×!ˆØËÙ!ˆÚËÛ!ˆÜËÝ!ˆÞËß!ˆàËá!ˆÑ!âã!‡" [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 indent-line-function c-indent-line indent-region-function c-indent-region require-final-newline comment-start "/* " comment-end " */" comment-column 32 comment-start-skip "/\\*+ *" comment-indent-function c-comment-indent parse-sexp-ignore-comments run-hooks c-mode-hook] 2 "\ 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." nil]) (defalias (quote c-comment-indent) #[nil "ÀÁ!ƒ‡`ŠÂyˆÀÄ!ƒÅÆ!ˆiT‚HÀÇ!„)ÀÈ!ƒ-É‚H bˆÊËxˆ ÂUƒCnƒC‚HiT ]*‡" [looking-at "^/\\*" 0 opoint "[ ]*}[ ]*\\($\\|/\\*\\)" search-forward "}" "^#[ ]*endif[ ]*" "^#[ ]*else[ ]*" 7 " " nil comment-column] 2]) (defalias 'c-fill-paragraph #[(&optional arg) "ÀŠÂyˆÃÀwˆÄ !…`‰)‰„8Ç È=„8ŠÂyˆÉ ŠÀˆ`)È#`)‰ƒüŠÂyˆÄÊ!ƒMÉ !ˆËiÌ\"‚ƒUÍyˆÀˆiÂyˆ`ÏÐÈ!È\"ˆ`ÂyˆÒwˆ`){Ï!ˆ`Àˆ`|ˆ))ÔPÔPÂŒŠ ƒŸ bˆ‚£ØÙ!ˆi`ÛÌ\"ˆ*Š ƒ¼ Ü\\bˆÝÞÀß#ˆÍyˆ`)}ˆà!!ˆŠebˆÂVƒà``\\|ˆdbˆâyˆÝÞÀß#ˆÂyˆÄã!…÷ä .‚à!!*‡" [nil comment-start-place 0 " \n" looking-at comment-start-skip first-line calculate-c-indent t re-search-forward "[ ]*/\\*.*\\*/" make-string 32 1 line-width move-to-column calculate-c-indent-within-comment max-prefix-end " *" paragraph-start "\\|^[ ]*/\\*[ ]*$\\|^[ ]*\\*/[ ]*$\\|^[ /*]*$" paragraph-separate chars-to-delete fill-prefix search-backward "/*" column insert-char 2 search-forward "*/" move fill-paragraph arg -1 "[ ]*\\*/" delete-indentation] 6 "\ 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." "P"]) (defalias 'electric-c-brace #[(arg) "À\n„AlƒAŠÃÀxˆn)„ ƒAÅ ˆÆ ˆcˆÅ ˆ ƒ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 "\ Insert character and correct line's indentation." "P"]) (defalias 'electric-c-sharp-sign #[(arg) "ŠÀÁxˆn)ƒÁà !)‡ÅÆ !!‡" [" " nil c-auto-newline electric-c-terminator arg self-insert-command prefix-numeric-value] 3 "\ Insert character and correct line's indentation." "P"]) (defalias 'electric-c-semi #[(arg) "ƒÁ\n!‡ÃÄ\n!!‡" [c-auto-newline electric-c-terminator arg self-insert-command prefix-numeric-value] 3 "\ Insert character and correct line's indentation." "P"]) (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 "\ Insert character and correct line's indentation." "P"]) (defalias (quote c-inside-parens-p) #[nil "ÀÁ‡" [nil (byte-code "ŠŒ`À ˆ`}ˆdbˆÁ`ÂÃ#†efÄU*‡" [beginning-of-defun scan-lists -1 1 40] 4) ((error))] 3]) (defalias 'c-indent-command #[(&optional whole-exp) "ƒ=Á ‰ŠƒÇyˆŠÈyˆ`)` Wƒ.ÉÈ!ˆ`ÊÂwˆ‚) V…;Ë Ì$+‡„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 "\ 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." "P"]) (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ƒ\nd\nZbˆ‚\n `|ˆjˆd\nZ`Vƒ\nd\nZbˆ -‡" [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" backward-sexp "while\\b" c-backward-to-start-of-do 125 c-indent-level 123 c-brace-offset] 7 "\ Indent current line as C code. Return the amount the indentation changed by."]) (defalias 'calculate-c-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰ƒbˆ‚Ç ˆ` Wƒ1`È` À#‰A@‚É 8„=Ê 8ƒCÊ 8‚B\n„í bˆËÁwˆgÌUƒXÀ‚B͆_e!ˆŠÎÏÁÐ#ˆÁ‰Šm„ÓÔ!„Õyˆ‚oÁÖ׈ÀyˆÓØ!)ƒ“‚éÓÚ!ƒèÓÛ!ƒèÀ•Sbˆ`ÁÜ݈ÞÁwˆ` Wƒègß>„èbˆÀyˆ„Þàáâ#ƒÞàãâ#?‰ƒÈ„è‚éÀ+‚B\nfÌU„ü\nTbˆi‚B bˆÍ\n!ˆhä=„\"hå=ƒ9`æZfç=„\"`æZfzè>ƒ9hä=ƒ/éuˆê\n!ˆÀyˆÍ\n!ˆ‚`Á+,+„nŠÀˆhíU)ƒUÀˆ‚?ÀyˆgîUƒgÀˆ`,‚?â‰+ƒD,bˆ*hï>„©Š bˆËÁwˆgðU)„©ê\n!ˆ1iŠ bˆËÁwˆg)Ì=ƒ£2‚¤À\\\\‚B\nbˆŠÕuˆÀ3ôÁwˆÓõ!ƒêgîUƒÉÕyˆ‚³göUƒÛæuˆàãÁÐ#ˆ‚³ŠÁˆ`3)à÷!ˆ‚³` W… 3`Vƒÿø 9Z‚igÌUƒ :‚ ÀZ*†Bnƒ$;ÀUƒ$:1\\‚&;ËÁxˆnƒ2À‚4þé!ˆø \\\\-‡" [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 "^[^ \n#]" move lim comment looking-at " *[({}#/]" 1 (backward-sexp 1) ((error)) "DEFUN\\b" c-argdecl-indent "\\sw\\|\\s_" "[^\"\n=(]*(" (forward-sexp 1) ((error)) " " (44 59) search-forward "/*" t "*/" 44 58 2 39 (119 95) -1 c-backward-to-start-of-continued-exp stop found 92 35 (nil 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 c-indent-level c-brace-imaginary-offset 41 forward-sexp] 5 "\ 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-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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias c-backward-to-noncomment #[(lim) "À‰ ?…Ià xˆ`` Å\\Yƒ+ŠÆuˆÇÈ!)ƒ+ÉÊ Ë#ˆ‚` X†>ŠÌyˆÍÀwˆÇÎ!)?‰„Ìyˆ‚*‡" [nil stop opoint " \n " lim 2 -2 looking-at "\\*/" search-backward "/*" move 0 " " "#"] 5] c-backward-to-start-of-continued-exp #[(lim) "hÀ>ƒ\nÁÂ!ˆÃyˆ` Xƒ TbˆÅÆw‡" [(41 34) forward-sexp -1 0 lim " " nil] 2]] 3) (defalias 'c-backward-to-start-of-if #[(&optional limit) "„ ŠÁ ˆ`)ÂÃo?…E ÆU?…EÇÂ!ˆÈÉ!ƒ+ T‚ÈÊ!ƒ7 S‚`WƒÆbˆ‚*‡" [limit beginning-of-defun 1 nil case-fold-search if-level 0 backward-sexp looking-at "else\\b" "if\\b"] 2 "\ Move to the start of the last \"unbalanced\" `if'."]) (defalias 'c-backward-to-start-of-do #[(&optional limit) "„ ŠÁ ˆ`)Â`à „k`ÃÈɈ „gÊË!ƒ-Ì‚gŠÍÎ!ˆ„=hÏU†SÐуQhÏU„QÒ‚RÎ$)ƒ\\Ó‚gÃ`WƒgÓ)‚ Ì=ƒ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 "\ If point follows a `do' statement, move to beginning of it and return t. Otherwise return nil and don't move point."]) (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 "\ 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." "p"]) (defalias 'c-end-of-statement #[(count) "À [!‡" [c-beginning-of-statement count] 2 "\ 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." "p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] 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]] 3) (defalias 'mark-c-function #[nil "À`!ˆÁ ˆÀ`ÂÃ#ˆÄ ˆÅ ‡" [push-mark end-of-defun nil t beginning-of-defun backward-paragraph] 4 "\ Put mark at end of C function, point at beginning." nil]) (defalias 'indent-c-exp #[(&optional endpos) "ÀC` ƒ$ÀŠÅuˆÆ ˆ`) Œ `}ˆÀÇÈ*‚%`C À\nÀ À À ÀÀÀÀÀÀÀÀÀ׊ÙÅ!ˆ)Š`ÛŠÀˆ`)Ý#ƒšŠ×”bˆÞÀxˆn)„šß`À‰% á 8?…â 8?)ƒšã ˆ×yˆ*ŠÀ m?…3 ƒ®` W‚± ?…3À  „,mƒË݉ „,ß`Àˆ`À‰%‰@AA@ƒùAA@×YƒùAA@ä8„å8ƒ\næ ˆá8„ä8„å8ƒ%Åyˆ‚»Ý‰ ƒÀ ƒ]×Wƒ]ç ÀC\"ç ÀC\" TTè›è8T ˆ‚0 ?…f×X‰ „Ÿè8Vƒ‡ A A S‰‚nU„’ÀWƒ­À BÀ B T‰‚” @„Å A@†ÃŠÙé!ˆ`) ˆÅyˆÞÀwˆl„Ÿ ƒÚ` Y„Ÿ @ƒi @×Yƒi @fêU„ö @‚ŒŠ`ëì!gêUëí!î\n!ˆhï>„.ð @!ˆ1iƒ&2‚'×\\\\‚eƒ>ó\n!ˆô ‚eƒPõ\n!ƒPô ‚ehö=ƒabˆ÷ ‚e @)‚Œ÷ @ƒu @[‚v\n!‰8Ý=ƒƒù 8 8‰ ˆ)ë:!„¥ëû!ƒ®ŠÙÅ!ˆëü!)ƒ®Å=\\]gþUƒ»?ZgêUƒÔi×UƒÍׂÔ@\\lƒÛ×iU„õgAU„õ`×yˆ`|ˆjˆë!„Ÿ`ÛŠÀˆ`)Ý#ƒ/ß`À‰% á 8?…%â 8?)ƒ/ã ˆ×yˆ)‚Ÿ.‡" [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 123 looking-at "else\\W" "while\\b" 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 c-backward-to-start-of-do 44 calculate-c-indent val calculate-c-indent-within-comment c-switch-label-regexp "[A-Za-z]" ":" c-label-offset 125 c-indent-level c-brace-offset 35] 7 "\ Indent each line of the C grouping following point." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] c-indent-region #[(start end) "ŠbˆÁÂwˆÃyˆÄ !ÆnƒŽl„ŽÉ ‰‰\n   ŠŠÎyˆ` )Ãyˆ` WƒGÂÏЈÁÂwˆ‚4\nƒW\nbˆÑÎ!ˆ` )\nƒ|\n Vƒ|\nXƒ|  Wƒ|Ò ˆ\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 1 (byte-code "ÀÁ!ˆÂ À‡" [forward-sexp 1 point-marker sexpend] 2) ((error (byte-code "À\nb‡" [nil sexpend nextline] 1))) backward-sexp indent-c-exp] 4]] 3) (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 "\ 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." (list (completing-read "Use which C indentation style? " c-style-alist nil t) current-prefix-arg)]) (defvar c-backslash-column 48 "\ *Minimum column for end-of-line backslashes of macro definitions.") (defalias 'c-backslash-region #[(from to delete-flag) "Šbˆ   Æ“ˆ„4` Wƒ4ƈhÈUƒ)ÉuˆÊÆxˆ iT]Ëyˆ‚  ¦ÍVƒV  É\\\\ ¥ _‰Ï WƒU)bˆ` WƒilƒiËyˆ‚Y` WƒŠËyˆ` W)ƒ„†Ð !ˆ‚‰Ñ ˆË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 "\ 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." "r\nP"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias c-append-backslash #[(column) "ÀˆhÁUƒÂuˆÃ ˆ j‡ jˆÅc‡" [nil 92 -1 delete-horizontal-space column "\\"] 2] c-delete-backslash #[nil "ÀˆÁuˆÂÃ!…`TÄÀxˆ`|‡" [nil -1 looking-at "\\\\" " "] 3]] 3) (defalias 'c-up-conditional #[(count) "À [Â\"‡" [c-forward-conditional count t] 3 "\ 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." "p"]) (defalias 'c-backward-conditional #[(count &optional up-flag) "À [\n\"‡" [c-forward-conditional count up-flag] 3 "\ 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." "p"]) (defalias 'c-forward-conditional #[(count &optional up-flag) "ÁV‰ƒ  Ä\nƒÆ‚Ç` Ê ŠÁU„Ê ƒ/Á‚0ÃÊ Š „°ÏÊÐ#ƒ°ÁyˆÑÒ!ƒ6ÁyˆÑÔ!ƒc \\‚€ÑÕ!ƒz\nƒ€ÁUƒ€` ‚€ ZÁWƒ›Wƒ›Ö\nƒ˜×‚™Ø!ˆ\nƒ¢ÄyˆÁWƒ¬` )‚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 "\ 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." "p"]) emacs-19.22/lisp/cal-dst.elc100666 13437 1 20776 5471634100 14262 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 03:05:19 1993 ;;; from file /home/fsf/rms/e19/lisp/cal-dst.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (require (quote calendar)) (defvar calendar-current-time-zone-cache nil "\ Cache for result of calendar-current-time-zone.") (defvar calendar-system-time-basis (byte-code "ÀÂÂÅ SÇ_\\ ÉVƒC Ê_Ë\\Ì¥ZʦÍUƒCΦÍUƒ>ϦÍUƒCT, Ð_ Ê¥ Î¥[ Ï¥\\\\\\\\)‡" [1969 prior-years 1 month day 1970 year 31 day-of-year 2 4 23 10 0 100 400 365] 6) "\ Absolute date of starting date of system clock.") (defalias 'calendar-absolute-from-time #[(x utc-diff) "@A \n§ƒ\n‚\n@\\Å Æ\"Ç_È É\"\\\n È Æ\"Ç_È\nÆ\"\\\\Å\nÆ\"É_Å É\"\\,B‡" [x h xtail utc-diff l mod 675 512 floor 128 u calendar-system-time-basis] 5 "\ 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-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 "\ 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-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 "\ 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-time-zone-daylight-rules #[(abs-date utc-diff) "À ! æ\n@\nA@\nAA@ ÈUƒ;ɦÊUƒ;˦ÊUƒ7̦ÊUƒ;Í‚?Î SHÐÑ ÒFCÓW…XÔÕ Ò¯CÃZV…jÔÖ Ò¯C×ÈÙZ]SÓZ^T‰Yƒ˜ÔÕ Ò¯B‚v))$ÖZT×@‰ @Ô=ƒÇáâ AB!‚N @À=ƒØá A@!‚Ná !‰#AA@S$#@%#A@&#AA@&%Sç_\\(%ÈVƒ5(%É_é\\ê¥Z(ɦÊUƒ5˦ÊUƒ0̦ÊUƒ5(T((,$ë_$É¥$Ë¥[$Ì¥\\\\\\\\*ìí\n\"!ìí\nT\"!š„i BA‰*„±ƒ~Ÿ‚‚@CTA*„ª@. ‡" [calendar-gregorian-from-absolute abs-date date 7 weekday m d y 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last append list year 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 month day 31 day-of-year 23 10 365 current-time-zone calendar-time-from-absolute] 11 "\ 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-current-time-zone #[nil "†ÂÁ Ã\n!‰@ A@ „%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 "\ 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."]) (calendar-current-time-zone) (defvar calendar-time-zone (byte-code "@†Á‡" [calendar-current-time-zone-cache -300] 1) "\ *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 (byte-code "A@†Á‡" [calendar-current-time-zone-cache 60] 1) "\ *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 (byte-code "AA@†Á‡" [calendar-current-time-zone-cache "EST"] 1) "\ *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 (byte-code "À ›@†‡" [3 calendar-current-time-zone-cache "EDT"] 2) "\ *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-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) "\ *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-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) "\ *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 (byte-code "À ›@†‡" [6 calendar-current-time-zone-cache 120] 2) "\ *Number of minutes after midnight that daylight savings time starts.") (defvar calendar-daylight-savings-ends-time (byte-code "À ›@†\n‡" [7 calendar-current-time-zone-cache calendar-daylight-savings-starts-time] 2) "\ *Number of minutes after midnight that daylight savings time ends.") (provide (quote cal-dst)) emacs-19.22/lisp/cal-french.elc100666 13437 1 12471 5416161412 14726 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:27:22 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cal-french.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÄÆÀ‡" [require calendar ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"] french-calendar-month-name-array ["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 Recompense" "de la Revolution"] french-calendar-special-days-array] 2) (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 "\ 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-last-day-of-month #[(month year) "ÁWƒ‡à !ƒŇƇ" [month 13 30 french-calendar-leap-year-p year 6 5] 2 "\ 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 'calendar-absolute-from-french #[(date) "@A@AA@ SÄ_ ÅWƒ Æ¥‚1 SÆ¥ SÇ¥[ SÈ¥ SÉ¥[\\\\\\ SÊ_\nË\\\\\\\\+‡" [date year day month 365 20 4 100 400 4000 30 654414] 6 "\ 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-french-from-absolute #[(date) "ÁWƒ ‰‰E‡ÃZÄ¥‰‰ÂÈɉTE!Yƒ3É\\T‚*\\\nÉÂ È Ì \n\"\nE!Vƒ_É\\ T ‚?*T È É\nE!SZ \nE,‡" [date 654415 0 654414 366 approx sum y calendar-absolute-from-french 1 year m french-calendar-last-day-of-month month day] 7 "\ 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-print-french-date #[nil "ÀÁ † ÂÃ!AA@Á †ÂÃ!@Á †ÂÃ!A@Á †+ÂÃ!AA@ SÇ_\\ ÉVƒg Ê_Ë\\Ì¥Z ʦÍUƒg ΦÍUƒb ϦÍUƒgT, SÐ_ SÊ¥ SÎ¥[ SÏ¥\\\\\\\\)!‰AA@@A@ÕWƒ¡Ö×!‚ÒØUƒ¶ÖÙSH#‚ÒÖÛÜSÌ¥TÝ\"ȘHSH%,‡" [calendar-french-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" year month day 31 day-of-year 2 4 23 10 0 100 400 365 french-date y m d 1 message "Date is pre-French Revolution" 13 "Jour %s de l'Anne'e %d de la Revolution" french-calendar-special-days-array "Decade %s, %s de %s de l'Anne'e %d de la Revolution" make-string 73 french-calendar-day-name-array french-calendar-month-name-array] 8 "\ Show the French Revolutionary calendar equivalent of the selected date." nil]) (defalias 'calendar-goto-french-date #[(date &optional noecho) "ÀÁ !!!ˆ †Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-french date noecho calendar-print-french-date] 4 "\ Move cursor to French Revolutionary date DATE. Echo French Revolutionary date unless NOECHO is t." (byte-code "ÀÁÂÃÄÅ AA@Å @Å A@Å AA@SÉ_\\\nËVƒ\\\nÌ_Í\\Î¥Z\n̦ÏUƒ\\ЦÏUƒWѦÏUƒ\\\nT\n\n,SÒ_SÌ¥SÐ¥[SÑ¥\\\\\\\\)!AA@!#ÓÔÕ×!ƒ•ÓØ\"‚œÓÚ\"ŸA\"\"ÜÞßàáâÜ$!ãäå#\"A‰æVƒÁä‚ÅÀçè\")æVƒÕæZ‚ÙÀêë\"æVƒæì‚è)SÎ_\\E.C‡" [calendar-read "Anne'e de la Revolution (>0): " (lambda (x) (> x 0)) int-to-string calendar-french-from-absolute calendar-current-date year month day 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 #[(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] 12)]) (defalias 'diary-french-date #[nil "À AA@ @ A@ AA@ SÅ_\\ ÇVƒI È_É\\Ê¥Z\nȦËUƒI\n̦ËUƒD\nͦËUƒIT,\nSÎ_\nSÈ¥\nSÌ¥[\nSÍ¥\\\\\\\\)!‰AA@@A@ËV…®ÓUƒ’ÔÕSH#‚®Ô×ØSÊ¥TÙ\"SʦHSH%,‡" [calendar-french-from-absolute date year month day 31 day-of-year 2 4 23 10 0 100 400 365 french-date y m d 13 format "Jour %s de l'Anne'e %d de la Revolution" french-calendar-special-days-array "Decade %s, %s de %s de l'Anne'e %d de la Revolution" make-string 73 french-calendar-day-name-array french-calendar-month-name-array] 8 "\ French calendar equivalent of date diary entry."]) (provide (quote cal-french)) emacs-19.22/lisp/cal-mayan.elc100666 13437 1 27502 5431755735 14605 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Aug 10 13:33:17 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cal-mayan.el ;;; emacs version 19.18.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote calendar)) (defalias 'mayan-adjusted-mod #[(m n) "S ¦T‡" [m n] 2 "\ Non-negative remainder of M/N with N instead of 0."]) (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 the correlation used by Spinden.") (defconst calendar-mayan-haab-at-epoch (quote (8 . 18)) "\ Mayan haab date at the epoch.") (byte-code "À‡" [["Pop" "Uo" "Zip" "Zotz" "Tzec" "Xul" "Yaxkin" "Mol" "Chen" "Yax" "Zac" "Ceh" "Mac" "Kankin" "Muan" "Pax" "Kayab" "Cumku"] calendar-mayan-haab-month-name-array nil] 1) (defconst calendar-mayan-tzolkin-at-epoch (quote (4 . 20)) "\ Mayan tzolkin date at the epoch.") (byte-code "À‡" [["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 nil] 1) (defalias 'calendar-mayan-long-count-from-absolute #[(date) " \\‰Ã¥\næ‰Æ¥ Ʀ‰È¥ Ȧ‰Ê¥ ʦ    ¯. ‡" [date calendar-mayan-days-before-absolute-zero long-count 144000 baktun remainder 7200 katun 360 tun 20 uinal kin] 6 "\ Compute the Mayan long count corresponding to the absolute DATE."]) (defalias 'calendar-mayan-long-count-to-string #[(mayan-long-count) "ÀÁ B\"‡" [apply format "%s.%s.%s.%s.%s" mayan-long-count] 4 "\ Convert MAYAN-LONG-COUNT into traditional written form."]) (defalias 'calendar-string-to-mayan-long-count #[(str) "À GÂÆÇÈˆÉ !+‡" [nil str 0 cc c rlc condition (byte-code " Wƒ( \"‰@¨„ÅÆ @\"ˆ‚$ @B A)‚GÈU„5ÅÆÉ\"ˆÉ‡" [cc c read-from-string str datum signal invalid-read-syntax rlc 5 nil] 4) ((invalid-read-syntax)) reverse] 3 "\ Given STR, a string of format \"%d.%d.%d.%d.%d\", return list of nums."]) (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 "\ Convert absolute DATE into a Mayan haab date (a pair)."]) (defalias 'calendar-mayan-haab-difference #[(date1 date2) "A AZÂ_@ @Z\\æ‡" [date2 date1 20 365] 3 "\ Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2."]) (defalias 'calendar-mayan-haab-on-or-before #[(haab-date date) "‰ÁÂÃ! \"ZŦZ‡" [date calendar-mayan-haab-difference calendar-mayan-haab-from-absolute 0 haab-date 365] 5 "\ Absolute date of latest HAAB-DATE on or before absolute DATE."]) (defalias 'calendar-next-haab-date #[(haab-date &optional noecho) "ÀÁÂ Ä AA@Ä @Ä A@Ä AA@SÈ_\\ ÊVƒV Ë_Ì\\Í¥Z ˦ÎUƒV ϦÎUƒQ ЦÎUƒV T  , SÑ_ SË¥ SÏ¥[ SÐ¥\\\\\\\\)Ñ\\\"!!ˆ†|Ó ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-haab-on-or-before haab-date calendar-cursor-to-date year month day 31 day-of-year 2 4 23 10 0 100 400 365 noecho calendar-print-mayan-date] 10 "\ Move cursor to next instance of Mayan HAAB-DATE. Echo Mayan date if NOECHO is t." (list (calendar-read-mayan-haab-date))]) (defalias 'calendar-previous-haab-date #[(haab-date &optional noecho) "ÀÁÂ Ä AA@Ä @Ä A@Ä AA@SÈ_\\ ÊVƒV Ë_Ì\\Í¥Z ˦ÎUƒV ϦÎUƒQ ЦÎUƒV T  , SÑ_ SË¥ SÏ¥[ SÐ¥\\\\\\\\)S\"!!ˆ†{Ó ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-haab-on-or-before haab-date calendar-cursor-to-date year month day 31 day-of-year 2 4 23 10 0 100 400 365 noecho calendar-print-mayan-date] 10 "\ Move cursor to previous instance of Mayan HAAB-DATE. Echo Mayan date if NOECHO is t." (list (calendar-read-mayan-haab-date))]) (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 "\ Convert Mayan haab date (a pair) into its traditional written form."]) (defalias 'calendar-mayan-tzolkin-from-absolute #[(date) " \\Ã\n @\\Å\"Ã\n A\\Ç\"+B‡" [date calendar-mayan-days-before-absolute-zero long-count mayan-adjusted-mod calendar-mayan-tzolkin-at-epoch 13 day 20 name] 3 "\ Convert absolute DATE into a Mayan tzolkin date (a pair)."]) (defalias 'calendar-mayan-tzolkin-difference #[(date1 date2) "@ @ZA AZ‰‰\nZÄ_ŦÆ_\\Ǧ*‡" [date2 date1 name-difference number-difference 3 20 13 260] 4 "\ Number of days from Mayan tzolkin DATE1 to next occurrence of tzolkin DATE2."]) (defalias 'calendar-mayan-tzolkin-on-or-before #[(tzolkin-date date) "‰ÁÂÃ! \"ZŦZ‡" [date calendar-mayan-tzolkin-difference calendar-mayan-tzolkin-from-absolute 0 tzolkin-date 260] 5 "\ Absolute date of latest TZOLKIN-DATE on or before absolute DATE."]) (defalias 'calendar-next-tzolkin-date #[(tzolkin-date &optional noecho) "ÀÁÂ Ä AA@Ä @Ä A@Ä AA@SÈ_\\ ÊVƒV Ë_Ì\\Í¥Z ˦ÎUƒV ϦÎUƒQ ЦÎUƒV T  , SÑ_ SË¥ SÏ¥[ SÐ¥\\\\\\\\)Ò\\\"!!ˆ†|Ô ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-tzolkin-on-or-before tzolkin-date calendar-cursor-to-date year month day 31 day-of-year 2 4 23 10 0 100 400 365 260 noecho calendar-print-mayan-date] 10 "\ Move cursor to next instance of Mayan TZOLKIN-DATE. Echo Mayan date if NOECHO is t." (list (calendar-read-mayan-tzolkin-date))]) (defalias 'calendar-previous-tzolkin-date #[(tzolkin-date &optional noecho) "ÀÁÂ Ä AA@Ä @Ä A@Ä AA@SÈ_\\ ÊVƒV Ë_Ì\\Í¥Z ˦ÎUƒV ϦÎUƒQ ЦÎUƒV T  , SÑ_ SË¥ SÏ¥[ SÐ¥\\\\\\\\)S\"!!ˆ†{Ó ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-mayan-tzolkin-on-or-before tzolkin-date calendar-cursor-to-date year month day 31 day-of-year 2 4 23 10 0 100 400 365 noecho calendar-print-mayan-date] 10 "\ Move cursor to previous instance of Mayan TZOLKIN-DATE. Echo Mayan date if NOECHO is t." (list (calendar-read-mayan-tzolkin-date))]) (defalias 'calendar-mayan-tzolkin-to-string #[(tzolkin) "ÀÁ\n@ \nASH#‡" [format "%d %s" tzolkin calendar-mayan-tzolkin-names-array] 5 "\ Convert Mayan tzolkin date (a pair) into its traditional written form."]) (defalias 'calendar-mayan-tzolkin-haab-on-or-before #[(tzolkin-date haab-date date) "ÀÁÂ! \"ÅÆÂ!\"‰ Z‰ ʦÂU…* ‰  Ì_\\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 365 18980] 6 "\ 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-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 "\ Prompt for a Mayan haab 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 "\ Prompt for a Mayan tzolkin date"]) (defalias 'calendar-next-calendar-round-date #[(tzolkin-date haab-date &optional noecho) "À \nà AA@à @à A@à AA@ SÇ_\\ ÉVƒQ Ê_Ë\\Ì¥Z ʦÍUƒQ ΦÍUƒL ϦÍUƒQT, SÐ_ SÊ¥ SÎ¥[ SÏ¥\\\\\\\\)Ñ\\#‰„ÓÔÕ !Ö\n!#‚×Ø!!ˆ†Ú )‡" [calendar-mayan-tzolkin-haab-on-or-before tzolkin-date haab-date calendar-cursor-to-date year month day 31 day-of-year 2 4 23 10 0 100 400 365 18980 date 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] 10 "\ Move cursor to next instance of Mayan HAAB-DATE TZOKLIN-DATE combination. Echo Mayan date if NOECHO is t." (list (calendar-read-mayan-tzolkin-date) (calendar-read-mayan-haab-date))]) (defalias 'calendar-previous-calendar-round-date #[(tzolkin-date haab-date &optional noecho) "À \nà AA@à @à A@à AA@ SÇ_\\ ÉVƒQ Ê_Ë\\Ì¥Z ʦÍUƒQ ΦÍUƒL ϦÍUƒQT, SÐ_ SÊ¥ SÎ¥[ SÏ¥\\\\\\\\)S#‰„~ÒÓÔ !Õ\n!#‚ŒÖ×!!ˆ†ŒÙ )‡" [calendar-mayan-tzolkin-haab-on-or-before tzolkin-date haab-date calendar-cursor-to-date year month day 31 day-of-year 2 4 23 10 0 100 400 365 date 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] 10 "\ Move to previous instance of Mayan TZOKLIN-DATE HAAB-DATE combination. Echo Mayan date if NOECHO is t." (list (calendar-read-mayan-tzolkin-date) (calendar-read-mayan-haab-date))]) (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 "\ Compute the absolute date corresponding to the Mayan Long Count C. Long count is a list (baktun katun tun uinal kin)"]) (defalias 'calendar-print-mayan-date #[nil "À †ÁÂ!AA@À †ÁÂ!@À †ÁÂ!A@À †)ÁÂ!AA@ SÆ_\\ ÈVƒd É_Ê\\Ë¥Z ɦÌUƒd ͦÌUƒ_ ΦÌUƒdT, SÏ_ SÉ¥ SÍ¥[ SÎ¥\\\\\\\\)Ñ!Ó!Õ!×ØÙ!Ú!Û!$,‡" [calendar-cursor-to-date error "Cursor is not on a date!" year month day 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 message "Mayan date: Long count = %s; tzolkin = %s; haab = %s" calendar-mayan-long-count-to-string calendar-mayan-tzolkin-to-string calendar-mayan-haab-to-string] 6 "\ Show the Mayan long count, tzolkin, and haab equivalents of date." nil]) (defalias 'calendar-goto-mayan-long-count-date #[(date &optional noecho) "ÀÁ !!!ˆ †Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-mayan-long-count date noecho calendar-print-mayan-date] 4 "\ Move cursor to Mayan long count DATE. Echo Mayan date unless NOECHO is t." (byte-code "À „“ÂÃÄÅÆÇ AA@Ç @ Ç A@\nÇ AA@\n SË_\\  ÍVƒb  Î_Ï\\Ð¥Z ΦÑUƒbÒ¦ÑUƒ]Ó¦ÑUƒb T  ,SÔ_SÎ¥SÒ¥[SÓ¥\\\\\\\\)!!\"!Ö!ƒ)‚ )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 year month day 31 day-of-year 2 4 23 10 0 100 400 365 datum calendar-mayan-long-count-common-era] 11)]) (defalias 'calendar-mayan-long-count-common-era #[(lc) "ÀÁ!‰ƒ @\n@Uƒ A\nA‰„ ?†$ @\n@V)‡" [calendar-mayan-long-count-from-absolute 1 base lc] 3 "\ T if long count represents date in the Common Era."]) (defalias 'diary-mayan-date #[nil "AA@@A@AA@ \nSÄ_\\\nÆVƒC \nÇ_È\\É¥Z ǦÊUƒC ˦ÊUƒ@ ̦ÊUƒC T , SÍ_ SÇ¥ SË¥[ SÌ¥\\\\\\\\)Ï!Ñ!Ó!ÕÖ×!Ø!Ù!$,‡" [date year month day 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 "Mayan date: Long count = %s; tzolkin = %s; haab = %s" calendar-mayan-long-count-to-string calendar-mayan-tzolkin-to-string calendar-mayan-haab-to-string] 6 "\ Show the Mayan long count, haab, and tzolkin dates as a diary entry."]) (provide (quote cal-mayan)) emacs-19.22/lisp/calendar.elc100666 13437 1 301064 5471533300 14514 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 14 17:52:47 1993 ;;; from file /home/fsf/rms/e19/lisp/calendar.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (byte-code "À‡" ["Version 5.2, released October 20, 1993" calendar-version nil] 1) (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 view-diary-entries-initially nil "\ *If t, the diary entries for the current date will be displayed 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 will cause no diary entries to be displayed on Sunday, the current date's and the next day's diary entries to be displayed Monday through Thursday, Friday through Monday's entries to be displayed on Friday, and only Saturday's entries to be displayed 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 "\ *If t, dates with diary entries will be marked in the calendar window. The marking symbol is specified by the variable `diary-entry-marker'.") (defvar diary-entry-marker "+" "\ *The symbol used to mark dates that have diary entries.") (defvar view-calendar-holidays-initially nil "\ *If t, holidays for current three month period will be displayed on entry. The holidays are displayed in another window when the calendar is first displayed.") (defvar mark-holidays-in-calendar nil "\ *If t, dates of holidays will be marked in the calendar window. The marking symbol is specified by the variable `calendar-holiday-marker'.") (defvar calendar-holiday-marker "*" "\ *The symbol used to mark notable dates in the calendar.") (defvar all-hebrew-calendar-holidays nil "\ *If nil, show only major holidays from the Hebrew calendar. If nil, the only holidays from the Hebrew calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Hebrew calendar.") (defvar all-christian-calendar-holidays nil "\ *If nil, show only major holidays from the Christian calendar. If nil, the only holidays from the Christian calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Christian calendar.") (defvar all-islamic-calendar-holidays nil "\ *If nil, show only major holidays from the Islamic calendar. If nil, the only holidays from the Islamic calendar shown will be those days of such major interest as to appear on secular calendars. If t, the holidays shown in the calendar will include all special days that would be shown on a complete Islamic calendar.") (defvar calendar-load-hook nil "\ *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 could also be used to mark the current date with `='; 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 a 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 will not be displayed in the diary window; only the continuation lines will be 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-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 diary-date-forms (byte-code "ƒ ‡\n‡" [european-calendar-style european-date-diary-pattern american-date-diary-pattern] 1) "\ *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 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 calendar-date-display-form (byte-code "ƒ ‡\n‡" [european-calendar-style european-calendar-display-form american-calendar-display-form] 1) "\ *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'.") (defalias 'european-calendar #[nil "À\n Æ ‡" [t european-calendar-style european-calendar-display-form calendar-date-display-form european-date-diary-pattern diary-date-forms update-calendar-mode-line] 1 "\ Set the interpretation and display of dates to the European style." nil]) (defalias 'american-calendar #[nil "À\n Æ ‡" [nil european-calendar-style american-calendar-display-form calendar-date-display-form american-date-diary-pattern diary-date-forms update-calendar-mode-line] 1 "\ Set the interpretation and display of dates to the American style." nil]) (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 the 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' will be 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 the 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 "\ *If t, the holidays will be indicated in the diary display. The holidays will be given in the mode line of the diary buffer, or in the fancy diary buffer next to the date. This slows down the diary functions somewhat; setting it to nil will make the diary display faster.") (byte-code "ÀÁ!„‡" [boundp calendar-mark-ring nil] 2) (defvar general-holidays (quote ((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Ground Hog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fool's Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\ *General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details.") (defvar local-holidays nil "\ *Local holidays. See the documentation for `calendar-holidays' for details.") (defvar other-holidays nil "\ *User defined holidays. See the documentation for `calendar-holidays' for details.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ÆÀÇ!„!ÈÀ‡" [boundp 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)"))) 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)))] 2) (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.") (defvar christian-holidays (quote ((if all-christian-calendar-holidays (holiday-fixed 1 6 "Epiphany")) (holiday-easter-etc) (if all-christian-calendar-holidays (holiday-greek-orthodox-easter)) (if all-christian-calendar-holidays (holiday-fixed 8 15 "Assumption")) (if all-christian-calendar-holidays (holiday-advent)) (holiday-fixed 12 25 "Christmas") (if all-christian-calendar-holidays (holiday-julian 12 25 "Eastern Orthodox Christmas")))) "\ *Christian holidays. See the documentation for `calendar-holidays' for details.") (defvar islamic-holidays (quote ((holiday-islamic 1 1 (format "Islamic New Year %d" (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (extract-calendar-year (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))))) (if all-islamic-calendar-holidays (holiday-islamic 1 10 "Ashura")) (if all-islamic-calendar-holidays (holiday-islamic 3 12 "Mulad-al-Nabi")) (if all-islamic-calendar-holidays (holiday-islamic 7 26 "Shab-e-Mi'raj")) (if all-islamic-calendar-holidays (holiday-islamic 8 15 "Shab-e-Bara't")) (holiday-islamic 9 1 "Ramadan Begins") (if all-islamic-calendar-holidays (holiday-islamic 9 27 "Shab-e Qadr")) (if all-islamic-calendar-holidays (holiday-islamic 10 1 "Id-al-Fitr")) (if all-islamic-calendar-holidays (holiday-islamic 12 10 "Id-al-Adha")))) "\ *Islamic holidays. See the documentation for `calendar-holidays' for details.") (defvar solar-holidays (quote ((if (fboundp (quote atan)) (solar-equinoxes-solstices)) (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)) date (quote standard)) ""))))) (funcall (quote holiday-sexp) calendar-daylight-savings-ends (quote (format "Daylight Savings Time Ends %s" (if (fboundp (quote atan)) (solar-time-string (/ (- calendar-daylight-savings-ends-time calendar-daylight-time-offset) (float 60)) date (quote daylight)) "")))))) "\ *Sun-related holidays. See the documentation for `calendar-holidays' for details.") (defvar calendar-holidays (append general-holidays local-holidays other-holidays christian-holidays hebrew-holidays islamic-holidays solar-holidays) "\ *List of notable days for the command M-x holidays. Additional holidays are easy to add to the list, just put them in the list `other-holidays' in your .emacs file. Similarly, by setting any of `general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays', `islamic-holidays', or `solar-holidays' to nil in your .emacs file, you can eliminate unwanted categories of holidays. The intention is that (in the US) `local-holidays' be set in site-init.el and `other-holidays' be set by the user. 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.") (defalias 'increment-calendar-month '(macro . #[(mon yr n) "ÀÁÂà ÅEǯDCÉÊEÉ ËEF‡" [let macro-y + * yr 12 mon -1 n setq (1+ (% macro-y 12)) (/ macro-y 12)] 7 "\ 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 'calendar-for-loop '(macro . #[(var from init to final do &rest body) "À  DDCÄÅÆÈ É DEED\n\"E‡" [let var 1- init append while >= final setq 1+ body] 10 "\ Execute a for loop."])) (defalias 'calendar-sum '(macro . #[(index initial condition expression) "À \nDÃDÄ ÆÇÈÇ EEÆ Ê DEFÇF‡" [let index initial (sum 0) while condition setq sum + expression 1+] 9 "\ For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."])) (defalias 'extract-calendar-month '(macro . #[(date) "À D‡" [car date] 2 "\ Extract the month part of DATE which has the form (month day year)."])) (defalias 'extract-calendar-day '(macro . #[(date) "ÀÁ\nDD‡" [car cdr date] 3 "\ Extract the day part of DATE which has the form (month day year)."])) (defalias 'extract-calendar-year '(macro . #[(date) "ÀÁ‰\nDDD‡" [car cdr date] 4 "\ Extract the year part of DATE which has the form (month day year)."])) (defalias 'calendar-leap-year-p '(macro . #[(year) "ÀÁ ÄEDÅÆÁ ÇEDDÁ ÈEDEE‡" [and zerop % year 4 or not 100 400] 8 "\ Returns t if YEAR is a Gregorian leap year."])) (defalias 'calendar-last-day-of-month '(macro . #[(month year) "ÀÁ ÄEÅÆD!EÈÉÊË DEF‡" [if and = month 2 macroexpand calendar-leap-year-p year 29 aref [31 28 31 30 31 30 31 31 30 31 30 31] 1-] 7 "\ The last day in MONTH during YEAR."])) (defalias 'calendar-day-number '(macro . #[(date) "ÀÁÂà D!DÅÂÆ D!DÇÂÈ D!DÉFÊËÌÍÊÂÎ!ÏEEEÐF‡" [let* month macroexpand extract-calendar-month date day extract-calendar-day year extract-calendar-year (day-of-year (+ day (* 31 (1- month)))) if (> month 2) progn (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) (calendar-leap-year-p year) (setq day-of-year (1+ day-of-year)) day-of-year] 9 "\ 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-absolute-from-gregorian '(macro . #[(date) "ÀÁÂÃÄ D!DDCÆÇÃÈ D!CÉ#E‡" [let prior-years 1- macroexpand extract-calendar-year date append (+) calendar-day-number ((* 365 prior-years) (/ prior-years 4) (- (/ prior-years 100)) (/ prior-years 400))] 7 "\ 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 #[(&optional arg) "À !qˆÂ ˆÃ ÅÅÈ Ê   ƒ6ÍÎÏÐÑÒÓÕ\"\"ÕÅ$!Ö!\"A‚9 @ ƒNØÙÚÛ AA@!#‚S AA@Ý !ˆÞ\"ˆƒ‚à !ƒ‚áâ#!ƒ~#ä !H‚€#!ˆ.å&!‰'…’è'!‰)ƒœê‚È +ƒ§ì ˆ+íî!‡" [get-buffer-create calendar-buffer calendar-mode current-window-configuration calendar-window-configuration t completion-ignore-case pop-up-windows 1000 split-height-threshold calendar-current-date date arg assoc capitalize completing-read "Month name: " mapcar list append calendar-month-name-array nil calendar-make-alist month calendar-read "Year (>0): " (lambda (x) (> x 0)) int-to-string year pop-to-buffer 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] 10 "\ 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 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." "P"]) (autoload (quote view-diary-entries) "diary" "\ Prepare and display a buffer with diary entries. Searches the file diary-file for entries that match ARG days starting with the date indicated by the cursor position in the displayed three-month calendar." t) (autoload (quote calendar-sunrise-sunset) "solar" "\ Local time of sunrise and sunset for date under cursor." t) (autoload (quote calendar-phases-of-moon) "lunar" "\ Create a buffer of the phases of the moon for the current calendar window." t) (autoload (quote calendar-print-french-date) "cal-french" "\ Show the French Revolutionary calendar equivalent of the date under the cursor." t) (autoload (quote calendar-goto-french-date) "cal-french" "\ Move cursor to French Revolutionary date." t) (autoload (quote calendar-print-mayan-date) "cal-mayan" "\ Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor." t) (autoload (quote calendar-goto-mayan-long-count-date) "cal-mayan" "\ Move cursor to Mayan long count date." t) (autoload (quote calendar-next-haab-date) "cal-mayan" "\ Move cursor to next instance of Mayan Haab date." t) (autoload (quote calendar-previous-haab-date) "cal-mayan" "\ Move cursor to previous instance of Mayan Haab date." t) (autoload (quote calendar-next-tzolkin-date) "cal-mayan" "\ Move cursor to next instance of Mayan Tzolkin date." t) (autoload (quote calendar-previous-tzolkin-date) "cal-mayan" "\ Move cursor to previous instance of Mayan Tzolkin date." t) (autoload (quote calendar-next-calendar-round-date) "cal-mayan" "\ Move cursor to next instance of Mayan Haab/Tzoklin combination." t) (autoload (quote calendar-previous-calendar-round-date) "cal-mayan" "\ Move cursor to previous instance of Mayan Haab/Tzoklin combination." t) (autoload (quote show-all-diary-entries) "diary" "\ 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 (quote mark-diary-entries) "diary" "\ Mark days in the calendar window that have diary entries. Each entry in diary-file visible in the calendar window is marked." t) (autoload (quote insert-diary-entry) "diary-ins" "\ Insert a diary entry for the date indicated by point." t) (autoload (quote insert-weekly-diary-entry) "diary-ins" "\ Insert a weekly diary entry for the day of the week indicated by point." t) (autoload (quote insert-monthly-diary-entry) "diary-ins" "\ Insert a monthly diary entry for the day of the month indicated by point." t) (autoload (quote insert-yearly-diary-entry) "diary-ins" "\ Insert an annual diary entry for the day of the year indicated by point." t) (autoload (quote insert-anniversary-diary-entry) "diary-ins" "\ Insert an anniversary diary entry for the date indicated by point." t) (autoload (quote insert-block-diary-entry) "diary-ins" "\ Insert a block diary entry for the dates indicated by point and mark." t) (autoload (quote insert-cyclic-diary-entry) "diary-ins" "\ Insert a cyclic diary entry starting at the date indicated by point." t) (autoload (quote insert-hebrew-diary-entry) "diary-ins" "\ Insert a diary entry for the Hebrew date corresponding to the date indicated by point." t) (autoload (quote insert-monthly-hebrew-diary-entry) "diary-ins" "\ Insert a monthly diary entry for the day of the Hebrew month corresponding to the date indicated by point." t) (autoload (quote insert-yearly-hebrew-diary-entry) "diary-ins" "\ Insert an annual diary entry for the day of the Hebrew year corresponding to the date indicated by point." t) (autoload (quote insert-islamic-diary-entry) "diary-ins" "\ Insert a diary entry for the Islamic date corresponding to the date indicated by point." t) (autoload (quote insert-monthly-islamic-diary-entry) "diary-ins" "\ Insert a monthly diary entry for the day of the Islamic month corresponding to the date indicated by point." t) (autoload (quote insert-yearly-islamic-diary-entry) "diary-ins" "\ Insert an annual diary entry for the day of the Islamic year corresponding to the date indicated by point." t) (autoload (quote 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 (quote mark-calendar-holidays) "holidays" "\ Mark notable days in the calendar window." t) (autoload (quote calendar-cursor-holidays) "holidays" "\ Find holidays for the date specified by the cursor in the calendar window." t) (defalias 'generate-calendar-window #[(&optional mon yr) "À ‰@ A@ AA@?†.È $‰\nËX…-\nÌY) Î !Ð ˆƒGÑ \"ˆ‚MÑ \"ˆÒ ƒW ‚]ËE!ˆÕÀ!ˆÖ×!„xØ Ù UƒxÚÛ ÜZ!ˆÝÞ!ˆƒŠà ƒŠÝÞ!ˆáŽ\"…“ã .‡" [nil buffer-read-only calendar-current-date today 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 "ƒ ÁÂ!ˆ‚ÁÃ!ˆÁ‡" [today-visible run-hooks today-visible-calendar-hook today-invisible-calendar-hook] 2)) mark-diary-entries-in-calendar mark-diary-entries] 6 "\ Generate the calendar window for the current date. Or, for optional MON, YR."]) (defalias 'generate-calendar #[(month year) " SÂ_\\ÃWƒÄÅ!ˆ È ˆ Â_É\\\\‰\n¦T\nÂ¥)Ë Ã T‰ Y…ZÍ  Î_Ï\\#ˆ Â_\\‰\n¦T\nÂ¥)‚/)‡" [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] 6 "\ Generate a three-month Gregorian calendar centered around MONTH, YEAR."]) (defalias 'generate-calendar-month #[(month year indent) "ÀÁ\nà E! ZÆ\"\nÈUƒ/ ɦÊUƒ/ ˦ÊUƒ+ ̦ÊUƒ/Í‚3Î\nSHebˆÐÑÒÓÔÕ\n! #ÒEÖ×#Ù#ˆÐÒ\"ˆÚÜT‰YƒuÀ \\Æ\"HÊÈOcˆÞcˆ‚U)ÐÒÊÙ#ˆÐÒ\"ˆÊT‰Yƒ—ßcˆ‚…)ÊT‰Y…ÔÓà\"cˆÀ\\Æ\"ÊUƒ›U„›ÐÒÊÙ#ƒ›ÐÒ\"ˆ‚›+‡" [calendar-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 "] 7 "\ 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 'calendar-insert-indented #[(string indent &optional newline) "À !ˆi Wƒ jˆ\ncˆ ƒ$Ĉmƒ!à ˆ‚$ÅyˆÆ‡" [move-to-column indent string newline nil 1 t] 2 "\ 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 'redraw-calendar #[nil "À  \"ˆÅ !)‡" [calendar-cursor-to-date cursor-date generate-calendar-window displayed-month displayed-year calendar-cursor-to-visible-date] 3 "\ Redraw the calendar display." nil]) (defvar calendar-debug-sexp nil "\ *Turn debugging on when evaluating a sexp in the diary or holiday list.") (byte-code "ÀÁ!„ „à ÄÆ T‰Yƒ%Ç È !É#ˆ‚)ÊËÌÍÎÏÐÑÒÓÔÕÖ¯ @ƒcØ@!‰@ƒZÇ @Ú#ˆA‰‚EA)‚7)Ç ÛÜ#ˆÇ ÝÞ#ˆÇ ßà#ˆÇ áâ#ˆÇ ãä#ˆÇ åæ#ˆÇ çè#ˆÇ éê#ˆÇ ëì#ˆÇ íî#ˆÇ ïð#ˆÇ ñæ#ˆÇ òè#ˆÇ óî#ˆÇ ôð#ˆÇ õö#ˆÇ ÷ø#ˆÇ ùú#ˆÇ ûü#ˆÇ ýþ#ˆÇ ÿ@#ˆÇ AB#ˆÇ CD#ˆÇ EF#ˆÇ GF#ˆÇ HI#ˆÇ JK#ˆÇ LM#ˆÇ 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 make-sparse-keymap -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 kill-region copy-region-as-kill downcase-region upcase-region capitalize-region write-region l where-is-internal k calendar-not-implemented "-" negative-argument ">" scroll-calendar-right [prior] scroll-calendar-right-three-months "<" 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 [4194336] "" 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-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 " " redraw-calendar "." calendar-current-month "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 "s" show-all-diary-entries "pd" calendar-print-day-of-year "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 "?" describe-calendar-mode] 14) (defalias 'describe-calendar-mode #[nil "ÀÁÂÃÄÅ!ÄÆ!#!ˆÇ ‘‡" ["*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}" print-help-return-message] 7 "\ Create a help buffer with a brief description of the calendar-mode." nil]) (put (quote calendar-mode) (quote mode-class) (quote special)) (defvar calendar-mode-line-format (byte-code "ÀÁ!ÂÀÃ!ÄÀÅ!¯‡" [substitute-command-keys "\\\\[scroll-calendar-left]" "Calendar" "\\\\[describe-calendar-mode] help/\\[calendar-other-month] other/\\[calendar-current-month] current" (calendar-date-string (calendar-current-date) t) "\\\\[scroll-calendar-right]"] 6) "\ The mode line of the calendar buffer.") (defalias 'calendar-mode #[nil "À ˆÁÃÅ!ˆÇÉ\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-window-configuration calendar-mark-ring displayed-month displayed-year] 2 "\ A major mode for the calendar window. The commands for cursor movement are:\\ \\[calendar-forward-day] one day forward \\[calendar-backward-day] one day backward \\[calendar-forward-week] one week forward \\[calendar-backward-week] one week backward \\[calendar-forward-month] one month forward \\[calendar-backward-month] one month backward \\[calendar-forward-year] one year forward \\[calendar-backward-year] one year backward \\[calendar-beginning-of-week] beginning of week \\[calendar-end-of-week] end of week \\[calendar-beginning-of-month] beginning of month \\[calendar-end-of-month] end of month \\[calendar-beginning-of-year] beginning of year \\[calendar-end-of-year] end of year \\[calendar-goto-date] go to date \\[calendar-goto-julian-date] go to Julian date \\[calendar-goto-astro-day-number] go to astronomical (Julian) day number \\[calendar-goto-hebrew-date] go to Hebrew date \\[calendar-goto-islamic-date] go to Islamic date \\[calendar-goto-iso-date] go to ISO date \\[calendar-goto-french-date] go to French Revolutionary date \\[calendar-goto-mayan-long-count-date] go to Mayan Long Count date \\[calendar-next-haab-date] go to next occurrence of Mayan Haab date \\[calendar-previous-haab-date] go to previous occurrence of Mayan Haab date \\[calendar-next-tzolkin-date] go to next occurrence of Mayan Tzolkin date \\[calendar-previous-tzolkin-date] go to previous occurrence of Mayan Tzolkin date \\[calendar-next-calendar-round-date] go to next occurrence of Mayan Calendar Round date \\[calendar-previous-calendar-round-date] go to previous occurrence of Mayan Calendar Round date You can mark a date in the calendar and switch the point and mark: \\[calendar-set-mark] mark date \\[calendar-exchange-point-and-mark] exchange point and mark You can determine the number of days (inclusive) between the point and mark by \\[calendar-count-days-region] count days in the region The commands for calendar movement are: \\[scroll-calendar-right] scroll one month right \\[scroll-calendar-left] scroll one month left \\[scroll-calendar-right-three-months] scroll 3 months right \\[scroll-calendar-left-three-months] scroll 3 months left \\[calendar-current-month] display current month \\[calendar-other-month] display another month Whenever it makes sense, the above commands take prefix arguments that multiply their affect. For convenience, the digit keys and the minus sign are bound to digit-argument, so they need not be prefixed with ESC. If the calendar window somehow becomes corrupted, it can be regenerated with \\[redraw-calendar] redraw the calendar The following commands deal with holidays and other notable days: \\[calendar-cursor-holidays] give holidays for the date specified by the cursor \\[mark-calendar-holidays] mark notable days \\[calendar-unmark] unmark dates \\[list-calendar-holidays] display notable days The command M-x holidays causes the notable dates for the current month, and the preceding and succeeding months, to be displayed, independently of the calendar. The following commands control the diary: \\[mark-diary-entries] mark diary entries \\[calendar-unmark] unmark dates \\[view-diary-entries] display diary entries \\[show-all-diary-entries] show all diary entries \\[print-diary-entries] print diary entries Displaying the diary entries causes the diary entries from the diary-file (for the date indicated by the cursor in the calendar window) to be displayed in another window. This function takes an integer argument that specifies the number of days of calendar entries to be displayed, starting with the date indicated by the cursor. The command \\[print-diary-entries] prints the diary buffer (as it appears) on the line printer. The command M-x diary causes the diary entries for the current date to be displayed, independently of the calendar. The number of days of entries is governed by number-of-diary-entries. The format of the entries in the diary file is described in the documentation string for the variable diary-file. When diary entries are in view in the window, they can be edited. It is important to keep in mind that the buffer displayed contains the entire diary file, but with portions of it concealed from view. This means, for instance, that the forward-char command can put the cursor at what appears to be the end of the line, but what is in reality the middle of some concealed line. BE CAREFUL WHEN EDITING THE DIARY ENTRIES! (Inserting additional lines or adding/deleting characters in the middle of a visible line will not cause problems; watch out for end-of-line, however--it may put you at the end of a concealed line far from where the cursor appears to be!) BEFORE EDITING THE DIARY IT IS BEST TO DISPLAY THE ENTIRE FILE WITH show-all-diary-entries. BE SURE TO WRITE THE FILE BEFORE EXITING FROM THE CALENDAR. The following commands assist in making diary entries: \\[insert-diary-entry] insert a diary entry for the selected date \\[insert-weekly-diary-entry] insert a diary entry for the selected day of the week \\[insert-monthly-diary-entry] insert a diary entry for the selected day of the month \\[insert-yearly-diary-entry] insert a diary entry for the selected day of the year \\[insert-block-diary-entry] insert a diary entry for the block days between point and mark \\[insert-anniversary-diary-entry] insert an anniversary diary entry for the selected date \\[insert-cyclic-diary-entry] insert a cyclic diary entry There are corresponding commands to assist in making Hebrew- or Islamic-date diary entries: \\[insert-hebrew-diary-entry] insert a diary entry for the Hebrew date corresponding to the selected date \\[insert-monthly-hebrew-diary-entry] insert a diary entry for the day of the Hebrew month corresponding to the selected day \\[insert-yearly-hebrew-diary-entry] insert a diary entry for the day of the Hebrew year corresponding to the selected day \\[insert-islamic-diary-entry] insert a diary entry for the Islamic date corresponding to the selected date \\[insert-monthly-islamic-diary-entry] insert a diary entry for the day of the Islamic month corresponding to the selected day \\[insert-yearly-islamic-diary-entry] insert a diary entry for the day of the Islamic year corresponding to the selected day All of the diary entry commands make nonmarking entries when given a prefix argument; with no prefix argument, the diary entries are marking. The day number in the year and the number of days remaining in the year can be determined by \\[calendar-print-day-of-year] show day number and the number of days remaining in the year Equivalent dates on the ISO commercial, Julian, Hebrew, Islamic, French Revolutionary, and Mayan calendars can be determined by \\[calendar-print-iso-date] show equivalent date on the ISO commercial calendar \\[calendar-print-julian-date] show equivalent date on the Julian calendar \\[calendar-print-hebrew-date] show equivalent date on the Hebrew calendar \\[calendar-print-islamic-date] show equivalent date on the Islamic calendar \\[calendar-print-french-date] show equivalent date on the French Revolutionary calendar \\[calendar-print-mayan-date] show equivalent date on the Mayan calendar The astronomical (Julian) day number of a date is found with \\[calendar-print-astro-day-number] show equivalent astronomical (Julian) day number To find the times of sunrise and sunset and lunar phases use \\[calendar-sunrise-sunset] show times of sunrise and sunset \\[calendar-phases-of-moon] show times of quarters of the moon The times given will be for location `calendar-location-name' at latitude `calendar-latitude', longitude `calendar-longitude'; set these variables for your location. The following variables are also consulted, and you must set them if your system does not initialize them properly: `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-starts-time', `calendar-daylight-savings-ends-time'. To exit from the calendar use \\[exit-calendar] exit from calendar The variable `view-diary-entries-initially', whose default is nil, can be set to to t cause diary entries for the current date will be displayed in another window when the calendar is first displayed, if the current date is visible. The variable `number-of-diary-entries' controls number of days of diary entries that will be displayed initially or with the command M-x diary. 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, both the current day's and the next day's entries will be displayed. The value can also be a vector: If the value is [0 2 2 2 2 4 1] then no diary entries will be displayed on Sunday, the current date's and the next day's diary entries will be displayed Monday through Thursday, Friday through Monday's entries will be displayed on Friday, while on Saturday only that day's entries will be displayed. The variable `view-calendar-holidays-initially' can be set to t to cause the holidays for the current three month period will be displayed on entry to the calendar. The holidays are displayed in another window. The variable `mark-diary-entries-in-calendar' can be set to t to cause any dates visible with calendar entries to be marked with the symbol specified by the variable `diary-entry-marker', normally a plus sign. The variable `calendar-load-hook', whose default value is nil, is list of functions to be called when the calendar is first loaded. The variable `initial-calendar-window-hook', whose default value is nil, is 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. The variable `today-visible-calendar-hook', whose default value is nil, is the list of functions called after the calendar buffer has been prepared with the calendar when the current date is visible in the window. 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 could also be used to mark the current date with `*'; a function is also provided for this: (setq today-visible-calendar-hook 'calendar-mark-today) The variable `today-invisible-calendar-hook', whose default value is nil, is the list of functions called after the calendar buffer has been prepared with the calendar when the current date is not visible in the window. The variable `diary-display-hook' is the list of functions called after the diary buffer is prepared. The default value simply displays the diary file using selective-display to conceal irrelevant diary entries. An alternative function `fancy-diary-display' is provided that, when used as the `diary-display-hook', causes a noneditable buffer to be prepared with a neatly organized day-by-day listing of relevant diary entries, together with any known holidays. The inclusion of the holidays slows this fancy display of the diary; to speed it up, set the variable `holidays-in-diary-buffer' to nil. The variable `print-diary-entries-hook' is the list of functions called after a temporary buffer is prepared with the diary entries currently visible in the diary buffer. The default value of this hook adds a heading (composed from the diary buffer's mode line), does the printing with the command lpr-buffer, and kills the temporary buffer. Other uses might include, for example, rearranging the lines into order by day and time. The Gregorian calendar is assumed."]) (defalias 'calendar-string-spread #[(strings char length) "ÀÁ\n\" ÄÅ\n\"GZ\nGS\n@\nAÉ\n\nƒBËÉ\n\\¥] \"\n@Q\nT\n\nA‰„!É O.‡" [mapcar eval strings length apply concat n m s 0 i make-string char] 6 "\ Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH There must be at least 2 strings. 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 'update-calendar-mode-line #[nil "ÀÁ\n!!…Š\nqˆÃ ÅÆ #‰)‡" [bufferp get-buffer calendar-buffer calendar-string-spread calendar-mode-line-format 32 frame-width mode-line-format] 4 "\ Update the calendar mode line with the current date and date style."]) (defalias 'exit-calendar #[nil "À ! ! !‰„0È !ˆÊ !ˆƒ&Ê!ˆ …eÊ !‚eÌ!ƒ=ÍÎ!…eÈ !ˆÊ !ˆƒQÊ!ˆ ƒYÊ !ˆqˆÏÐ!ˆÊ!+‡" [get-file-buffer diary-file get-buffer fancy-diary-buffer holiday-buffer h-buffer d-buffer diary-buffer set-window-configuration calendar-window-configuration bury-buffer calendar-buffer buffer-modified-p yes-or-no-p "Diary modified; do you really want to exit the calendar? " set-buffer-modified-p nil] 5 "\ Get out of the calendar window and bury it and related buffers." nil]) (defalias 'calendar-current-month #[nil "À  !„à ‚Ä ˆÅ !)‡" [calendar-current-date today calendar-date-is-visible-p generate-calendar-window update-calendar-mode-line calendar-cursor-to-visible-date] 2 "\ Reposition the calendar window so the current date is visible." nil]) (defalias 'calendar-forward-month #[(arg) "À ˆÁ † ÂÃ!‰@ A@ AA@‰È_  Ê\\\\\\‰ ȦT È¥) ÌUƒWͦÎUƒWϦÎUƒSЦÎUƒWÑ‚[Ò SH‰Wƒh) EÕ!„~Ö \"ˆ×!-‡" [calendar-cursor-to-nearest-date calendar-cursor-to-date error "Cursor is not on a date!" cursor-date month day year 12 arg -1 macro-y 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last new-cursor-date calendar-date-is-visible-p calendar-other-month calendar-cursor-to-visible-date] 5 "\ Move the cursor forward ARG months. Movement is backward if ARG is negative." "p"]) (defalias 'calendar-forward-year #[(arg) "À Â_!‡" [calendar-forward-month arg 12] 3 "\ Move the cursor forward by ARG years. Movement is backward if ARG is negative." "p"]) (defalias 'calendar-backward-month #[(arg) "À [!‡" [calendar-forward-month arg] 2 "\ Move the cursor backward by ARG months. Movement is forward if ARG is negative." "p"]) (defalias 'calendar-backward-year #[(arg) "À Â_!‡" [calendar-forward-month arg -12] 3 "\ Move the cursor backward ARG years. Movement is forward is ARG is negative." "p"]) (defalias 'scroll-calendar-left #[(arg) "À ˆÁ   ÆU?…MÈ_ Ê\\\\\\‰ ȦT  È¥)Ì \"ˆÍÎ !ƒ< ‚LÎ !ƒF ‚L ÏE!*‡" [calendar-cursor-to-nearest-date calendar-cursor-to-date calendar-current-date today old-date arg 0 displayed-year 12 displayed-month -1 macro-y generate-calendar-window calendar-cursor-to-visible-date calendar-date-is-visible-p 1] 5 "\ 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." "p"]) (defalias 'scroll-calendar-right #[(arg) "À [!‡" [scroll-calendar-left arg] 2 "\ 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." "p"]) (defalias 'scroll-calendar-left-three-months #[(arg) "À Â_!‡" [scroll-calendar-left arg 3] 3 "\ 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." "p"]) (defalias 'scroll-calendar-right-three-months #[(arg) "À Â_!‡" [scroll-calendar-left arg -3] 3 "\ 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." "p"]) (defalias 'calendar-current-date #[nil "À Âà \"ŠƔƕOÇÉÊ#\"A Ì Í”Í•O!Ì Ï”Ï•O! E-‡" [current-time-string date string-match "^\\([A-Z][a-z]*\\) *\\([A-Z][a-z]*\\) *\\([0-9]*\\) .* \\([0-9]*\\)$" garbage assoc 2 calendar-make-alist calendar-month-name-array 1 (lambda (x) (substring x 0 3)) month string-to-int 3 day 4 year] 6 "\ Returns the current date in a list (month day year). If in the calendar buffer, also sets the current date local variables."]) (defalias 'calendar-cursor-to-date #[nil "ÀÁ!…ÂÃe`\"W…ŠÄÅ!ˆÆuˆÇ``È\\{!‰ ÊUƒ+ ‚-  iÌ¥  Ï\\\\Ц‰ÊUƒIЂK‰ÐUƒ` ÊUƒ`S‚vÆUƒt ÂUƒtT‚v E.‡" [looking-at "[*0-9]" 2 count-lines re-search-backward "[^0-9]" 1 string-to-int 3 day 0 starred-day 25 segment displayed-month -1 12 month displayed-year year] 5 "\ Returns a list of the month, day, and year of current cursor position. Returns nil if the cursor is not on a specific day."]) (defalias 'calendar-cursor-to-nearest-date #[nil "À i‰ƒ \n‚]ÃÄe`\"VƒÅÃ!ˆÆ !ˆÇÈ!„[ÇÉ!„U ÊW„H ËVƒ< ÌW„H ÍVƒU ÎWƒUÏÈÐÑ#ˆÒÓ!ˆ‚[ÔÈÐÑ#ˆÀ *‡" [calendar-cursor-to-date column date 3 count-lines goto-line move-to-column looking-at "[0-9]" " *$" 25 27 50 52 75 re-search-forward nil t backward-char 1 re-search-backward] 5 "\ 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."]) (defalias 'calendar-forward-day #[(arg) "ÁU?…¯Â ‰ƒ ‚ÁVƒSÄ Å AA@S @ A@ AA@ SÊ_\\ ÌVƒs Í_Î\\Ï¥Z  ͦÁUƒs ЦÁUƒn ѦÁUƒs T  ,Ò_ͥХ[Ñ¥\\\\\\\\)\\!‰@AA@Ö!„ª×\"ˆØ!-‡" [arg 0 calendar-cursor-to-date cursor-date calendar-cursor-to-nearest-date calendar-gregorian-from-absolute prior-years month day year 31 day-of-year 2 4 23 10 100 400 365 new-cursor-date new-display-month new-display-year calendar-date-is-visible-p calendar-other-month calendar-cursor-to-visible-date] 8 "\ Move the cursor forward ARG days. Moves backward if ARG is negative." "p"]) (defalias 'calendar-backward-day #[(arg) "À [!‡" [calendar-forward-day arg] 2 "\ Move the cursor back ARG days. Moves forward if ARG is negative." "p"]) (defalias 'calendar-forward-week #[(arg) "À Â_!‡" [calendar-forward-day arg 7] 3 "\ Move the cursor forward ARG weeks. Moves backward if ARG is negative." "p"]) (defalias 'calendar-backward-week #[(arg) "À Â_!‡" [calendar-forward-day arg -7] 3 "\ Move the cursor back ARG weeks. Moves forward if ARG is negative." "p"]) (defalias 'calendar-beginning-of-week #[(arg) "À ˆÁ !Ä UƒÇ_‚\"È ZÇ\"SÇ_\\!)‡" [calendar-cursor-to-nearest-date calendar-day-of-week calendar-cursor-to-date day calendar-backward-day calendar-week-start-day arg 7 calendar-mod] 4 "\ Move the cursor back ARG calendar-week-start-day's." "p"]) (defalias 'calendar-end-of-week #[(arg) "À ˆÁ !Ä ÅSÇ\"UƒÇ_‚*ÉÅ ZÇ\"ZSÇ_\\!)‡" [calendar-cursor-to-nearest-date calendar-day-of-week calendar-cursor-to-date day calendar-forward-day calendar-mod calendar-week-start-day 7 arg 6] 5 "\ Move the cursor forward ARG calendar-week-start-day+6's." "p"]) (defalias 'calendar-beginning-of-month #[(arg) "À ˆÁ ‰@\nA@\nAA@ ÆUƒÇ!‚+É Æ E!ˆÇS!,‡" [calendar-cursor-to-nearest-date calendar-cursor-to-date date month day year 1 calendar-backward-month arg calendar-cursor-to-visible-date] 5 "\ Move the cursor backward ARG month beginnings." "p"]) (defalias 'calendar-end-of-month #[(arg) "À ˆÁ ‰@\nA@\nAA@ ÆUƒ4 ǦÈUƒ4 ɦÈUƒ0 ʦÈUƒ4Ë‚8Ì SH  U„NÎ  E!ˆS Ð_ Ñ\\\\\\‰ЦTÐ¥) ‰ÆUƒˆ ǦÈUƒˆ ɦÈUƒ„ ʦÈUƒˆË‚ŒÌ SH E Ó !„žÔ \"‚¢Î !.‡" [calendar-cursor-to-nearest-date calendar-cursor-to-date date month day year 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] last-day calendar-cursor-to-visible-date arg 12 -1 macro-y calendar-date-is-visible-p calendar-other-month] 5 "\ Move the cursor forward ARG month ends." "p"]) (defalias 'calendar-beginning-of-year #[(arg) "À ˆÁ ‰@\nA@\nAA@Ɖ E ÆUƒ- ÆUƒ-È Ê_!‚J ÆUƒBË!ƒBÌ!‚JÍÆ  SZ\"-‡" [calendar-cursor-to-nearest-date calendar-cursor-to-date date month day year 1 jan-first calendar-backward-month arg 12 calendar-date-is-visible-p calendar-cursor-to-visible-date calendar-other-month] 5 "\ Move the cursor backward ARG year beginnings." "p"]) (defalias 'calendar-end-of-year #[(arg) "À ˆÁ ‰@\nA@\nAA@ÆÇ E ÇUƒ- ÆUƒ-É\nÆ_!‚R\nËUƒBÌ!ƒBÍ!‚RÎÆ \nSZ\"ˆÍÆÇE!-‡" [calendar-cursor-to-nearest-date calendar-cursor-to-date date month day year 12 31 dec-31 calendar-forward-month arg 1 calendar-date-is-visible-p calendar-cursor-to-visible-date calendar-other-month displayed-year] 5 "\ Move the cursor forward ARG year beginnings." "p"]) (defalias 'calendar-gregorian-from-absolute #[(date) "S‰Â¥ ¦‰Å¥ Ŧ‰È¥ Ȧ‰\nË¥ \n˦T Î_Ï_ Ð_ \\\\\\ÐU„L ÐUƒTÒÓE‚­TÔÖUƒ‚Ц×Uƒ‚Ϧ×Uƒ~Φ×Uƒ‚Ø‚‡ÙSH‰ W…˜ Z‰ )ƒ¥T‰‚^ 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] 5 "\ 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-mod #[(x y) "À \n\"Ä Vƒ \n\\‚ )‡" [mod x y v 0] 3 "\ Returns X % Y; value is *always* non-negative."]) (defalias 'calendar-cursor-to-visible-date #[(date) "@A@AA@Ä Å E!Ç\nÈÄ Å E! ZÊ\"Ë\\\\Ê¥Ì\\!ˆÍÎ $TÑ_ÈÄ! ZÊ\"Ì_Ò\\\\!,‡" [date month day year calendar-day-of-week 1 first-of-month-weekday goto-line calendar-mod calendar-week-start-day 7 -1 3 move-to-column calendar-interval displayed-month displayed-year 25 6] 7 "\ Move the cursor to DATE that is on the screen."]) (defalias 'calendar-other-month #[(month year) " U… \n U?…9Ä Å È\n\"ˆÉÊ!ƒ'‚7Ê!ƒ3‚7Ë\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] 4 "\ Display a three-month calendar centered around MONTH and YEAR." (byte-code "ÀÂÃÄÅÆÇÈ Ê\"\"ÊÀ$!Ë !\"A ÍÎÏÐÑ AA@!# +D‡" [t completion-ignore-case assoc capitalize completing-read "Month name: " mapcar list append calendar-month-name-array nil calendar-make-alist month calendar-read "Year (>0): " (lambda (x) (> x 0)) int-to-string calendar-current-date year] 9)]) (defalias 'calendar-set-mark #[(arg) "À †ÁÂ! „' B‰GTVƒ! ›Ç¡ˆÈÉ!‚= „1ÁÊ!‚=Ë @!ˆ C¤A‰)‡" [calendar-cursor-to-date error "Cursor is not on a date!" date arg calendar-mark-ring mark-ring-max nil message "Mark set" "No mark set in this buffer" calendar-goto-date] 3 "\ 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." "P"]) (defalias 'calendar-exchange-point-and-mark #[nil "@Á †\nÂÃ!‰„ÂÆ!‚ ABÇ !*‡" [calendar-mark-ring calendar-cursor-to-date error "Cursor is not on a date!" date mark "No mark set in this buffer" calendar-goto-date] 4 "\ Exchange the current cursor position with the marked date." nil]) (defalias 'calendar-count-days-region #[nil "À †ÁÂ!AA@SÀ †ÁÂ!@À †ÁÂ!A@À †*ÁÂ!AA@ SÇ_\\ ÉVƒi Ê_Ë\\Ì¥ZʦÍUƒiΦÍUƒdϦÍUƒiT, Ð_ Ê¥ Î¥[ Ï¥\\\\\\\\)@†‡ÁÒ!AA@S@†•ÁÒ!@@† ÁÒ!A@@†¬ÁÒ!AA@ SÇ_\\ ÉVƒë Ê_Ë\\Ì¥ZʦÍUƒëΦÍUƒæϦÍUƒëT, Ð_ Ê¥ Î¥[ Ï¥\\\\\\\\)Z‰ÍVƒ‚[TÔÕ‰ÖVƒ\"ׂ#Ø#*‡" [calendar-cursor-to-date error "Cursor is not on a date!" prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 calendar-mark-ring "No mark set in this buffer" days message "Region has %d day%s (inclusive)" 1 "s" ""] 8 "\ Count the number of days (inclusive) between point and the mark." nil]) (defalias 'calendar-not-implemented #[nil "ÀÁÂà !\"‡" [error "%s not available in the calendar" global-key-binding this-command-keys] 4 "\ Not implemented." nil]) (defalias 'calendar-read #[(prompt acceptable &optional initial-contents) "À \n\" !„À \n\"‚ )‡" [read-minibuffer prompt initial-contents value acceptable] 3 "\ 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-date #[nil "ÀÁÂÃÄ AA@!#È ÊËÌÍÎÏÐÑ\"\"ÑÈ$!ÒÓË#\"A‰ÕUƒO Ö¦×UƒO ئ×UƒK Ù¦×UƒOÚ‚TÛSHÀÝÞ\"ß\"  E.‡" [calendar-read "Year (>0): " (lambda (x) (> x 0)) int-to-string calendar-current-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 format "Day (1-%d): " (lambda (x) (and (< 0 x) (<= x last))) day] 10 "\ Prompt for Gregorian date. Returns a list (month day year)."]) (defalias 'calendar-goto-date #[(date) "@AA@Ã!„#Ä\nÅUƒ ÅUƒÆ‚ \n \"ˆ*Ç!‡" [date year month calendar-date-is-visible-p calendar-other-month 1 2 calendar-cursor-to-visible-date] 3 "\ Move cursor to DATE." (list (calendar-read-date))]) (defalias 'calendar-goto-julian-date #[(date &optional noecho) "ÀÁ !!!ˆ †Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-julian date noecho calendar-print-julian-date] 4 "\ Move cursor to Julian DATE; echo Julian date unless NOECHO is t." (byte-code "À ÂÃÄÅÆ AA@S @ A@ AA@\n SË_\\ ÍVƒ\\ Î_Ï\\Ð¥Z \nΦÑUƒ\\\nÒ¦ÑUƒW\nÓ¦ÑUƒ\\ T  ,Ô_Î¥Ò¥[Ó¥\\\\\\\\)!AA@!#\n×ÙÚÛÜÝÞßà\"\"à×$!áâÚ#\"A\nΦÑUƒ²ÍUƒ²ã‚·äSH%Âæç\nâUƒÎâUƒÎè‚Ïâ%#é\"  \nE.C‡" [calendar-current-date today calendar-read "Julian calendar year (>0): " (lambda (x) (> x 0)) int-to-string calendar-julian-from-absolute prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 calendar-month-name-array month-array t completion-ignore-case assoc capitalize completing-read "Julian calendar month name: " mapcar list append nil calendar-make-alist 1 29 [31 28 31 30 31 30 31 31 30 31 30 31] last format "Julian calendar day (%d-%d): " 3 (lambda (x) (and (< (if (and (= year 1) (= month 1)) 2 0) x) (<= x last)))] 11)]) (defalias 'calendar-goto-hebrew-date #[(date &optional noecho) "ÀÁ !!!ˆ †Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-hebrew date noecho calendar-print-hebrew-date] 4 "\ Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is t." (byte-code "À ÂÃÄÅÆ AA@S @ A@ AA@\n SË_\\ ÍVƒ\\ Î_Ï\\Ð¥Z \nΦÑUƒ\\\nÒ¦ÑUƒW\nÓ¦ÑUƒ\\ T  ,Ô_Î¥Ò¥[Ó¥\\\\\\\\)!AA@!#\nÕ\n!ƒ‰‚‹ÙÛÜÝÞßàáâ\"\"\nãU…¤äÙ$!åæÜ#\"Aç\n\"(\nãUƒËÐUƒËé‚Ìæ*Âëì*(#í\"  \nE.C‡" [calendar-current-date today calendar-read "Hebrew calendar year (>3760): " (lambda (x) (> x 3760)) int-to-string calendar-hebrew-from-absolute prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 hebrew-calendar-leap-year-p calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year month-array t completion-ignore-case assoc capitalize completing-read "Hebrew calendar month name: " mapcar list append nil 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))))) calendar-make-alist 1 hebrew-calendar-last-day-of-month last 18 first format "Hebrew calendar day (%d-%d): " (lambda (x) (and (<= first x) (<= x last)))] 11)]) (defalias 'calendar-goto-islamic-date #[(date &optional noecho) "ÀÁ !!!ˆ †Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-islamic date noecho calendar-print-islamic-date] 4 "\ Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t." (byte-code "À ÂÃÄÅÆ AA@S @ A@ AA@\n SË_\\ ÍVƒ\\ Î_Ï\\Ð¥Z \nΦÑUƒ\\\nÒ¦ÑUƒW\nÓ¦ÑUƒ\\ T  ,Ô_Î¥Ò¥[Ó¥\\\\\\\\)!AA@!#\n×ÙÚÛÜÝÞßà\"\"à×$!áâÚ#\"Aã\n\"$Âåæ$\"ç\"  \nE.C‡" [calendar-current-date today calendar-read "Islamic calendar year (>0): " (lambda (x) (> x 0)) int-to-string calendar-islamic-from-absolute prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 calendar-islamic-month-name-array month-array t completion-ignore-case assoc capitalize completing-read "Islamic calendar month name: " mapcar list append nil calendar-make-alist 1 islamic-calendar-last-day-of-month last format "Islamic calendar day (1-%d): " (lambda (x) (and (< 0 x) (<= x last)))] 11)]) (defalias 'calendar-goto-iso-date #[(date &optional noecho) "ÀÁ !!!ˆ †Å ‡" [calendar-goto-date calendar-gregorian-from-absolute calendar-absolute-from-iso date noecho calendar-print-iso-date] 4 "\ Move cursor to ISO DATE; echo ISO date unless NOECHO is t." (byte-code "À ÂÃÄÅ AA@!#ÇÈɉÊTEAA@S ÉÊTE@ ÉÊTEA@ ÉÊTEAA@  SÎ_\\ ÐVƒz Ê_Ñ\\Ò¥ZʦÓUƒzÔ¦ÓUƒuÕ¦ÓUƒzT, Ö_ Ê¥ Ô¥[ Õ¥\\\\\\\\)\"S!@ÂØÙ\"Ú\"ÂÜÝ\"  E-C‡" [calendar-current-date today calendar-read "ISO calendar year (>0): " (lambda (x) (> x 0)) int-to-string year calendar-iso-from-absolute calendar-dayname-on-or-before 1 4 prior-years month day 31 day-of-year 2 23 10 0 100 400 365 no-weeks format "ISO calendar week (1-%d): " (lambda (x) (and (> x 0) (<= x no-weeks))) week "ISO day (1-7): " (lambda (x) (and (<= 1 x) (<= x 7)))] 9)]) (defalias 'calendar-interval #[(mon1 yr1 mon2 yr2) " ZÂ_ Z\\‡" [yr2 yr1 12 mon2 mon1] 3 "\ The number of months difference between MON1, YR1 and MON2, YR2."]) (defalias 'calendar-day-name #[(date) "Á\n!H‡" [calendar-day-name-array calendar-day-of-week date] 3 "\ Returns a string with the name of the day of the week of DATE."]) (byte-code "ÀÁ!„ÂÀÃ!„ÄÀ‡" [boundp calendar-day-name-array ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] calendar-month-name-array ["January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"]] 2) (defalias 'calendar-make-alist #[(sequence &optional start-index filter) "ƒ S‚\nÁÃÄÅÇ\"\")‡" [start-index 0 index mapcar #[(x) "T ƒ \n!‚\nB‡" [index filter x] 2] append sequence nil] 5 "\ 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-month-name #[(month) " SH‡" [calendar-month-name-array month] 2 "\ The name of MONTH."]) (defalias 'calendar-day-of-week #[(date) "AA@S@A@AA@ \nSÅ_\\\nÇVƒI\nÈ_É\\Ê¥Z ȦËUƒI ̦ËUƒD ͦËUƒIT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)Ϧ‡" [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 7] 6 "\ Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."]) (defalias 'calendar-unmark #[nil "ÀÀŠÃÄ!ˆÅyˆÀ`ÆÇÀÈ#` \n  \nƒZÍ  ÎZÏ!ÑÈ%ˆÍ  ÎZÏ!ÑÈ%ˆÍ dÏ!ÑÈ%ˆÍ dÏ!ÑÈ%ˆ‚rÍ dÏ!ÑÈ%ˆÍ dÏ!ÑÈ%ˆÓÀ!-‡" [nil mark-diary-entries-in-calendar mark-holidays-in-calendar goto-line 3 0 search-forward "**" t star-point star-date start buffer-read-only subst-char-in-region 2 string-to-char diary-entry-marker 32 calendar-holiday-marker set-buffer-modified-p] 6 "\ Delete the diary and holiday marks from the calendar." nil]) (defalias 'calendar-date-is-visible-p #[(date) "À \n @ AA@$Å !…Æ V…Ç W)‡" [calendar-interval displayed-month displayed-year date gap calendar-date-is-legal-p 2 -2] 5 "\ Returns t if DATE is legal and is visible in the calendar window."]) (defalias 'calendar-date-is-legal-p #[(date) "@A@AA@Ä X…L ÅX…LÄ\nX…L\n ÆUƒA ǦÈUƒA ɦÈUƒ= ʦÈUƒAË‚EÌ SHX…LÄ 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]] 3 "\ Returns t if DATE is a legal date."]) (defalias 'calendar-date-equal #[(date1 date2) "@ @U…A@ A@U…AA@ AA@U‡" [date1 date2] 2 "\ Returns t if the DATE1 and DATE2 are the same."]) (defalias 'mark-visible-calendar-date #[(date &optional mark) "À !….Š\nqˆÃ !ˆÄuˆÅÇÄ!ˆƒ\"‚$ cˆÊuˆ)ËÅ!)‡" [calendar-date-is-legal-p date calendar-buffer calendar-cursor-to-visible-date 1 nil buffer-read-only delete-char mark diary-entry-marker -2 set-buffer-modified-p] 2 "\ Leave mark DATE with MARK. MARK defaults to diary-entry-marker."]) (defalias 'calendar-star-date #[nil "ÀÂÃ!ˆÄuˆÅ``ÆZ{!ÇÈ!ˆÉcˆÊÄ!ˆËÀ!)‡" [nil buffer-read-only make-variable-buffer-local starred-day 1 string-to-int 2 delete-char -2 "**" backward-char set-buffer-modified-p] 4 "\ 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-mark-today #[nil "ÀÂuˆÃÂ!ˆÄcˆÅÆ!ˆÇÀ!)‡" [nil buffer-read-only 1 delete-char "=" backward-char 2 set-buffer-modified-p] 2 "\ Mark the date under the cursor in the calendar window with an equal sign. This function can be used with the today-visible-calendar-hook run after the calendar window has been prepared."]) (defalias 'calendar-date-compare #[(date1 date2) "@AA@S@@@A@@AA@ \nSÅ_\\\nÇVƒM\nÈ_É\\Ê¥Z ȦËUƒM ̦ËUƒH ͦËUƒMT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)@AA@S@@@A@@AA@ \nSÅ_\\\nÇVƒ³\nÈ_É\\Ê¥Z ȦËUƒ³ ̦ËUƒ® ͦËUƒ³T, Î_ È¥ Ì¥[ Í¥\\\\\\\\)W‡" [date1 prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 date2] 7 "\ Returns t if DATE1 is before DATE2, nil otherwise. The actual dates are in the car of DATE1 and DATE2."]) (defalias 'calendar-date-string #[(date &optional abbreviate nodayname) "?… ƒ !ÄÅO‚ ! @ ƒ)È!ÄÅO‚-È! Ê A@! Ê!Ê AA@! ÍÎÐ#.‡" [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 ""] 4 "\ 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-dayname-on-or-before #[(dayname date) "‰ Z¦Z‡" [date dayname 7] 3 "\ 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-nth-named-absday #[(n dayname month year &optional day) "ÁVƒžSÂ_à †ÇEAA@S †#ÇE@‰†/ÇEA@ †=ÇEAA@ SÊ_\\ ÌVƒ€ Í_Î\\Ï¥Z ͦÁUƒ€ЦÁUƒ{ѦÁUƒ€ T  , Ò_ Í¥ Ð¥[ Ñ¥\\\\\\\\)Ó\\\"\\‡TÂ_à †Ó ÌUƒÏͦÁUƒÏЦÁUƒËѦÁUƒÏÔ‚ÓÕ SHEAA@S †  ÌUƒͦÁUƒЦÁUƒѦÁUƒÔ‚ Õ SHE@‰†? ÌUƒ;ͦÁUƒ;ЦÁUƒ7ѦÁUƒ;Ô‚?Õ SHEA@ †u ÌUƒqͦÁUƒqЦÁUƒmѦÁUƒqÔ‚uÕ SHEAA@ SÊ_\\ ÌVƒ¸ Í_Î\\Ï¥Z ͦÁUƒ¸ЦÁUƒ³ѦÁUƒ¸ T  , Ò_ Í¥ Ð¥[ Ñ¥\\\\\\\\)\"\\‡" [n 0 7 calendar-dayname-on-or-before dayname month day 1 year 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]] 10 "\ 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-day #[(n dayname month year &optional day) "ÀÁ\n %!‡" [calendar-gregorian-from-absolute calendar-nth-named-absday n dayname month year day] 7 "\ 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-print-day-of-year #[nil "À †ÁÂ!‰AA@ @ A@ AA@ SÇ_\\ ÉVƒS Ê_Ë\\Ì¥Z ʦÍUƒS ΦÍUƒN ϦÍUƒST,ÐÇ E@ÐÇ EA@ÐÇ EAA@ SÇ_\\ ÉVƒ¦ Ê_Ë\\Ì¥Z ʦÍUƒ¦ ΦÍUƒ¡ ϦÍUƒ¦T,ZÒÓ ‰ÔUƒ¿Õ‚ÀÖ%,‡" [calendar-cursor-to-date error "Cursor is not on a date!" date year month day 31 day-of-year 2 4 23 10 0 100 400 12 days-remaining message "Day %d of %d; %d day%s remaining in the year" 1 "" "s"] 8 "\ Show the day number in the year and the number of days remaining in the year for the date under the cursor." nil]) (defalias 'calendar-absolute-from-iso #[(date) "@A@AA@Äʼn‰ EAA@Sʼn E@ʼn EA@ʼn EAA@\nSÈ_\\ ÊVƒh Ë_Ì\\Í¥Z ˦ÎUƒh ϦÎUƒc ЦÎUƒh T  ,Ñ_˥ϥ[Ð¥\\\\\\\\)Ò\\\" SÓ_\nÎUƒ’Ô‚”\nS\\\\+‡" [date week day year calendar-dayname-on-or-before 1 prior-years month 31 day-of-year 2 4 23 10 0 100 400 365 3 7 6] 8 "\ 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."]) (defalias 'calendar-iso-from-absolute #[(date) "À ÂZ!AA@‰‰Ä ÇȉTE!Yƒ( È\\T‚ *\\ Çȉ E!ZÊ¥T ʦ E*‡" [calendar-gregorian-from-absolute date 3 approx 0 sum y calendar-absolute-from-iso 1 year 7] 7 "\ 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."]) (defalias 'calendar-print-iso-date #[nil "À †ÁÂ!‰AA@S @ A@ AA@ SÈ_\\ ÊVƒX Ë_Ì\\Í¥Z ˦ÎUƒXϦÎUƒSЦÎUƒX T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)Ò¦Ó AA@S @ A@ AA@ SÈ_\\ ÊVƒÁ Ë_Ì\\Í¥Z ˦ÎUƒÁϦÎUƒ¼ЦÎUƒÁ T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)!ÕÖÎUƒæÒ‚è@AA@$+‡" [calendar-cursor-to-date error "Cursor is not on a date!" greg-date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 7 calendar-iso-from-absolute iso-date message "ISO date: Day %s of week %d of %d."] 8 "\ Show equivalent ISO date for the date under the cursor." nil]) (defalias 'calendar-julian-from-absolute #[(date) "Á\\Â¥‰‰ÄÇȉTE!Yƒ% È\\T‚ *\\ ÈÄ\nÇ\n‰ÁUƒF ˦ÄUƒFÌ‚KÍ\nSH E!Vƒ_ È\\\nT\n‚/ *TÇÈ E!SZ E,‡" [date 2 366 approx 0 sum y calendar-absolute-from-julian 1 year m 4 29 [31 28 31 30 31 30 31 31 30 31 30 31] month day] 7 "\ 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."]) (defalias 'calendar-absolute-from-julian #[(date) "@A@AA@@A@AA@\n SÄ_\\ ÆVƒJ Ç_È\\É¥Z ǦÊUƒJ ˦ÊUƒG ̦ÊUƒJ T , ˦ÊUƒf ̦ÊU„f ÆVƒfÍ‚gÊ SÎ_ SÇ¥Ï\\\\\\\\+‡" [date year day month 31 day-of-year 2 4 23 10 0 100 400 1 365 -2] 5 "\ 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-print-julian-date #[nil "ÀÁÂÃÄ † ÅÆ!AA@SÄ †ÅÆ!@Ä †%ÅÆ!A@ Ä †1ÅÆ!AA@\n SË_\\ ÍVƒt Î_Ï\\Ð¥Z \nΦÑUƒt\nÒ¦ÑUƒo\nÓ¦ÑUƒt T  ,Ô_Î¥Ò¥[Ó¥\\\\\\\\)!ÕÖ#\"‡" [message "Julian date: %s" calendar-date-string calendar-julian-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 nil t] 10 "\ Show the Julian calendar equivalent of the date under the cursor." nil]) (defalias 'islamic-calendar-leap-year-p #[(year) "Á¦ÂÃÄÅÆÇÈÉÊË̯ >‡" [year 30 2 5 7 10 13 16 18 21 24 26 29] 12 "\ Returns t if YEAR is a leap year on the Islamic calendar."]) (defalias 'islamic-calendar-last-day-of-month #[(month year) "ÁÂÃÄÅƯ>ƒLJÈÉÊË̯>ƒ͇Î!ƒ&LJ͇" [month 1 3 5 7 9 11 30 2 4 6 8 10 29 islamic-calendar-leap-year-p year] 7 "\ The last day in MONTH during YEAR on the Islamic calendar."]) (defalias 'islamic-calendar-day-number #[(date) "@A@ Ã¥Ä_ SÃ¥Å_\n\\\\*‡" [date month day 2 30 29] 3 "\ Return the day number within the year of the Islamic date DATE."]) (defalias 'calendar-absolute-from-islamic #[(date) "@A@AA@‰Ħ‰ÆWƒÇ‚u ÈWƒ$É‚u ÊWƒ.Ë‚u ÌWƒ8Æ‚u ÍWƒB΂u ÏWƒLЂu ÑWƒVÈ‚u ÒWƒ`Ó‚u ÔWƒjÊ‚u ÕWƒtÖ‚u×Ù! SÚ_ Ä¥Ì_Û\\\\\\\\-‡" [date month day year 30 y 3 0 6 1 8 2 11 14 4 17 5 19 22 7 25 27 9 10 leap-years-in-cycle islamic-calendar-day-number 354 227014] 6 "\ Absolute date of Islamic DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC."]) (defalias 'calendar-islamic-from-absolute #[(date) "ÁWƒ ‰‰E‡ÃZÄ¥‰‰ÂÈɉTE!Yƒ3É\\T‚*\\\nÉÂ È Ì \n\"\nE!Vƒ_É\\ T ‚?*T È É\nE!SZ \nE,‡" [date 227015 0 227014 355 approx sum y calendar-absolute-from-islamic 1 year m islamic-calendar-last-day-of-month month day] 7 "\ 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."]) (byte-code "ÀÁ!„ÂÀ‡" [boundp 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"]] 2) (defalias 'calendar-print-islamic-date #[nil "Á †\nÃÄ!AA@S †ÃÄ!@ †\"ÃÄ!A@ †.ÃÄ!AA@SÉ_\\\nËVƒq\nÌ_Í\\Î¥Z\n̦ÏUƒqЦÏUƒlѦÏUƒq\nT\n\n, Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\)!AA@ÕWƒ›Ö×!‚¤ÖØÙÚÛ#\"*‡" [calendar-islamic-month-name-array calendar-islamic-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 islamic-date calendar-month-name-array 1 message "Date is pre-Islamic" "Islamic date (until sunset): %s" calendar-date-string nil t] 8 "\ Show the Islamic calendar equivalent of the date under the cursor." nil]) (defalias 'calendar-hebrew-from-absolute #[(date) "À !Ã\n@SHÅ\nAA@Ç\\ ÉÊËTE!Yƒ*T‚Ì! É Î \"E!VƒI  ¦T‚0) É ËE!ZT E,‡" [calendar-gregorian-from-absolute date greg-date [9 10 11 12 1 2 3 4 7 7 7 8] month nil day 3760 year calendar-absolute-from-hebrew 7 1 hebrew-calendar-last-month-of-year length hebrew-calendar-last-day-of-month] 6 "\ 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."]) (defalias 'hebrew-calendar-leap-year-p #[(year) "Á_T¦ÁW‡" [year 7 19] 2 "\ t if YEAR is a Hebrew calendar leap year."]) (defalias 'hebrew-calendar-last-month-of-year #[(year) "À !ƒ‡Ç" [hebrew-calendar-leap-year-p year 13 12] 2 "\ The last month of the Hebrew calendar YEAR."]) (defalias 'hebrew-calendar-last-day-of-month #[(month year) "ÁÂÃÄů>„3ÆUƒÇ!ƒ3ÉUƒ&Ê!ƒ3ËUƒ5Ì!ƒ5͇·" [month 2 4 6 10 13 12 hebrew-calendar-leap-year-p year 8 hebrew-calendar-long-heshvan-p 9 hebrew-calendar-short-kislev-p 29 30] 6 "\ The last day of MONTH in YEAR."]) (defalias 'hebrew-calendar-elapsed-days #[(year) "SÁ¥Â_SÁ¦Ã_SÁ¦Ä_TÁ¥\\\\‰ƦÇ_È\\ Ã_ Æ¥Ç_ Æ¥Ê\\\\\\‰ ̦Æ_ Ʀ\\ Î_ Ì¥Ï\\\\ ÑY„ĦÒUƒh ÓYƒhÔ!ƒĦÏUƒ… ÕYƒ…ÔS!ƒ…T‚‡‰Ħ×ØÊE>ƒšT‚œ.‡" [year 19 235 12 7 months-elapsed 1080 793 204 parts-elapsed 5 hours-elapsed 24 parts 29 1 day 19440 2 9924 hebrew-calendar-leap-year-p 16789 alternative-day 0 3] 5 "\ Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."]) (defalias 'hebrew-calendar-days-in-year #[(year) "À T!À !Z‡" [hebrew-calendar-elapsed-days year] 3 "\ Number of days in Hebrew YEAR."]) (defalias 'hebrew-calendar-long-heshvan-p #[(year) "À !¦ÃU‡" [hebrew-calendar-days-in-year year 10 5] 2 "\ t if Heshvan is long in Hebrew YEAR."]) (defalias 'hebrew-calendar-short-kislev-p #[(year) "À !¦ÃU‡" [hebrew-calendar-days-in-year year 10 3] 2 "\ t if Kislev is short in Hebrew YEAR."]) (defalias 'calendar-absolute-from-hebrew #[(date) "@A@AA@\n ÄWƒ]ÄÅ‰È !Xƒ4É \"\\T‰‚*Êʼn WƒVÉ \"\\T‰‚>*\\‚Äʼn Wƒ|É \"\\T‰‚d*Ë !Ì\\\\\\+‡" [date month day year 7 0 sum m hebrew-calendar-last-month-of-year hebrew-calendar-last-day-of-month 1 hebrew-calendar-elapsed-days -1373429] 7 "\ Absolute date of Hebrew DATE. The absolute date is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC."]) (byte-code "ÀÁ!„ÂÀÃ!„ÄÀ‡" [boundp calendar-hebrew-month-name-array-common-year ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"] calendar-hebrew-month-name-array-leap-year ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]] 2) (defalias 'calendar-print-hebrew-date #[nil "ÀÁ † ÂÃ!AA@SÁ †ÂÃ!@Á † ÂÃ!A@Á †,ÂÃ!AA@ SÈ_\\ ÊVƒl Ë_Ì\\Í¥Z ˦ÎUƒlϦÎUƒgЦÎUƒl T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)!ÓAA@!ƒ“‚•×ØÙÚÛ#\"*‡" [calendar-hebrew-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 hebrew-date hebrew-calendar-leap-year-p calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year calendar-month-name-array message "Hebrew date (until sunset): %s" calendar-date-string nil t] 7 "\ Show the Hebrew calendar equivalent of the date under the cursor." nil]) (defalias 'hebrew-calendar-yahrzeit #[(death-date year) "A@@AA@\nÄUƒ* ÅUƒ*Æ T!„*ÇÈÉ\nE!S‚\nÈUƒH ÅUƒHË T!ƒHÇÌÉ\nE!S‚\nÍUƒ[ÇÎ\n! \nE!‚ ÅUƒx\nÏUƒxÐ\n!„xÇÑÅ\nE!‚Ç\n \nE!+‡" [death-date death-day death-month death-year 8 30 hebrew-calendar-long-heshvan-p calendar-absolute-from-hebrew 9 1 year hebrew-calendar-short-kislev-p 10 13 hebrew-calendar-last-month-of-year 12 hebrew-calendar-leap-year-p 11] 4 "\ Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."]) (defalias 'calendar-set-mode-line #[(str) "ÀÁ\nÁEÃÄ #‰‡" [calendar-string-spread "" str 45 frame-width mode-line-format] 4 "\ Set mode line to STR, centered, surrounded by dashes."]) (defalias 'list-yahrzeit-dates #[(death-date start-year end-year) "ÀÁ!ˆÂÄ AA@S @ A@ AA@ SÊ_\\ ÌVƒ[ Í_Î\\Ï¥Z  ͦÐUƒ[ ѦÐUƒV Ò¦ÐUƒ[ T  ,Ó_ͥѥ[Ò¥\\\\\\\\)!‰@A@AA@Ø !qˆÙÛÜÝÞ !ß!ƒ¢ ‚¤!\"ÞÙã#)#!ˆä ˆebˆ%S&'&T‰&YƒXÞèéÄê‰&EAA@Sê‰&E@ê‰&EA@ê‰&EAA@ SÊ_\\ ÌVƒ1 Í_Î\\Ï¥Z  ͦÐUƒ1 ѦÐUƒ, Ò¦ÐUƒ1 T  ,Ó_ͥѥ[Ò¥\\\\\\\\)!AA@\"!!뱈‚»)ebˆìÙ!ˆãí !ˆÀî!-‡" [message "Computing yahrzeits..." "*Yahrzeits*" yahrzeit-buffer calendar-hebrew-from-absolute death-date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 h-date h-month h-day h-year get-buffer-create nil buffer-read-only calendar-set-mode-line format "Yahrzeit dates for %s = %s" calendar-date-string hebrew-calendar-leap-year-p calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year calendar-month-name-array t erase-buffer start-year i end-year calendar-gregorian-from-absolute hebrew-calendar-yahrzeit 1 "\n" set-buffer-modified-p display-buffer "Computing yahrzeits...done"] 12 "\ 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." (byte-code "pÀ !šƒ  ‚|à ÅÆÇÈ AA@!# \n Ì ÎÏÐÑÒÓÔ Õ\"\"ÕÌ$!Ö ×Ï#\"A‰ÙUƒb Ú¦ÛUƒb ܦÛUƒ^ ݦÛUƒbÞ‚gßSH Åáâ \"ã\"$$ E.‰%AA@&Åáç&\"èÈ&T!#)Åáê)\"ë\",%),E,‡" [get-buffer calendar-buffer calendar-cursor-to-date calendar-current-date today calendar-read "Year of death (>0): " (lambda (x) (> x 0)) int-to-string year calendar-month-name-array month-array t completion-ignore-case assoc capitalize completing-read "Month of death (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 format "Day of death (1-%d): " (lambda (x) (and (< 0 x) (<= x last))) day death-date death-year "Starting year of Yahrzeit table (>%d): " (lambda (x) (> x death-year)) start-year "Ending year of Yahrzeit table (>=%d): " (lambda (x) (>= x start-year)) end-year] 10)]) (defalias 'calendar-print-astro-day-number #[nil "ÀÁ †\nÃÄ!AA@S †ÃÄ!@ †\"ÃÄ!A@ †.ÃÄ!AA@SÉ_\\\nËVƒq\nÌ_Í\\Î¥Z\n̦ÏUƒqЦÏUƒlѦÏUƒq\nT\n\n, Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\)Ó\\\"‡" [message "Astronomical (Julian) day number after noon UTC: %d" calendar-cursor-to-date error "Cursor is not on a date!" prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 1721425] 8 "\ Show astronomical (Julian) day number of afternoon on date shown by cursor." nil]) (defalias 'calendar-goto-astro-day-number #[(daynumber &optional noecho) "ÀÁ\nÃZ!!ˆ †Å ‡" [calendar-goto-date calendar-gregorian-from-absolute daynumber 1721425 noecho calendar-print-astro-day-number] 4 "\ Move cursor to astronomical (Julian) DAYNUMBER. Echo astronomical (Julian) day number unless NOECHO is t." (list (calendar-read "Astronomical (Julian) day number (>1721425): " (quote (lambda (x) (> x 1721425)))))]) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks calendar-load-hook provide calendar] 2) emacs-19.22/lisp/case-table.elc100666 74777 1 4447 5416161755 14741 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:31:08 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/case-table.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'describe-buffer-case-table #[nil "ÀÁÂ\"à Ä ÁWƒ? ‰‰—U„%ÈÉ —!P‚6 ‰–U„5ÊÉ –!P‚6ËIˆ T‰‚ ŠÌ qˆÎ!‘,‡" [make-vector 256 nil current-case-table 0 ch case-table vector "uppercase, matches " text-char-description "lowercase, matches " "case-invariant" "*Help*" standard-output describe-vector] 6 "\ Describe the case table of the current buffer." nil]) (defalias 'set-case-syntax-delims #[(l r table) " ‰Iˆ\n‰IˆÃ ÄÅ\n!ÆQÇ #ˆÃ ÄÅ\n!ÆQ#ˆÃ\nÉÅ !ÆQÇ #ˆÃ\nÉÅ !ÆQ#‡" [table l r modify-syntax-entry "(" char-to-string " " standard-syntax-table text-mode-syntax-table ")"] 5 "\ 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', and `text-mode-syntax-table' to indicate left and right delimiters."]) (defalias 'set-case-syntax-pair #[(uc lc table) " \nIˆ\n‰IˆÃ\nÄÅ #ˆÃ\nÄ#ˆÃ ÄÅ #ˆÃ Ä#‡" [table uc lc modify-syntax-entry "w " standard-syntax-table text-mode-syntax-table] 4 "\ 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' and `text-mode-syntax-table' to indicate an (uppercase, lowercase) pair of letters."]) (defalias 'set-case-syntax #[(c syntax table) " ‰IˆÂ Ä #ˆÂ #‡" [table c modify-syntax-entry syntax standard-syntax-table text-mode-syntax-table] 4 "\ 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' and `text-mode-syntax-table'. SYNTAX should be \" \", \"w\", \".\" or \"_\"."]) (provide (quote case-table)) emacs-19.22/lisp/chistory.elc100666 74777 1 11254 5416161764 14617 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:31:16 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/chistory.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'repeat-matching-complex-command #[(&optional pattern) "ƒÁÂ\"†GÃO‰ÄšƒÃ Ƀ`„`@ƒ@ÁÉ@!\"ƒWÊËÌÍ!‰\"!ƒW@‚\"A‰„'„kÎÏ!‚{ @@Ð=ƒv AÑÒ\"+‡" [pattern string-match "[ ]*[^ ]" nil "" command-history what temp history symbol-name y-or-n-p format "Redo %s? " prin1-to-string error "Command history exhausted" repeat-matching-complex-command edit-and-eval-command "Redo: "] 6 "\ 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." "sRedo Command (regexp): "]) (defvar default-command-history-filter-garbage (quote (command-history-mode list-command-history electric-command-history)) "\ *A list of symbols. If `default-list-command-history-filter' 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 (quote default-command-history-filter) "\ 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.") (defalias 'default-command-history-filter #[(frob) ":?†\n@ >‡" [frob default-command-history-filter-garbage] 2 "\ Filter commands matching `default-command-history-filter-garbage' list from the command history."]) (defvar list-command-history-max 32 "\ *If non-nil, should be a positive number which specifies the maximum length of the Command History listing produced by `list-command-history'.") (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 "\ 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." nil]) (defalias (quote Command-history-setup) #[(&optional majormode modename keymap) "ÀqˆÁ\n† !ˆÄÅ!ˆÆ!ˆÈ Á\n† !ˆ\n†%Ë  †-Ή‡" ["*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]) (defvar command-history-hook nil "\ If non-nil, its value is called on entry to `command-history-mode'.") (byte-code "ÀÁ!„ „-à ¤Å !ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÊ#ˆÆ ÌÍ#ˆÂ‡" [boundp command-history-map nil make-sparse-keymap shared-lisp-mode-map suppress-keymap define-key "x" command-history-repeat "\n" next-line " " "" previous-line] 4) (defalias 'command-history-repeat #[nil "ŠÀŠÁyˆÂp!)à A@qˆ!)‡" [eval 0 read buffer-list] 3 "\ Repeat the command shown on the current line. The buffer for that command is the previous current buffer." nil]) (defalias 'command-history-mode #[nil "À ˆÁÂ!ˆÃÄ!‡" [list-command-history pop-to-buffer "*Command History*" run-hooks command-history-hook] 2 "\ 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." nil]) (provide (quote chistory)) emacs-19.22/lisp/cl-compat.elc100666 12120 1 6665 5426301147 14441 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Jul 30 16:19:51 1993 ;;; from file /home/fsf/rms/e19/lisp/cl-compat.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„\nÂÁ!ˆÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"ˆÊËÌÍ#ˆÊÎÌÍ#ˆÊÏÌÐ#ˆÊÑÌÐ#ˆÒÓ!„:ÔÃÕÖ\"ˆÃ×Ø\"ˆÃÙÚ\"ˆÃÏÛ\"ˆÃËÜ\"ˆÃÎÝ\"ˆÃÑÞ\"ˆÃßà\"ˆÃáâ\"ˆÃãä\"ˆÃåæ\"ˆÃçè\"ˆÃéê\"ˆÃëì\"ˆÃíî\"ˆÃïð\"ˆÃñò\"ˆÃóô\"ˆÃõö\"ˆÃ÷ø\"ˆÃùú\"ˆÃûü\"ˆÃýþ\"ˆÃÿ@\"ˆAB!‡" [featurep cl require defalias defkeyword (macro . #[(x &optional doc) "ÀÁ\nÃ\nD … C$‡" [list* defconst x quote doc] 5]) keywordp #[(sym) "9…Á!ÂHÃ=…‰L‡" [sym symbol-name 0 58] 2] keyword-of #[(sym) "À !†ÀÂÃÄ \"!!‡" [keywordp sym intern format ":%s"] 5] put Multiple-value-bind lisp-indent-function 2 Multiple-value-setq Multiple-value-call 1 Multiple-value-prog1 boundp *mvalues-values* nil Values #[(&rest val-forms) "@‡" [val-forms *mvalues-values*] 1] Values-list #[(val-forms) "ÀÁ\n\"‡" [apply values val-forms] 3] 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]) (macro . #[(function &rest args) "À ÂÃÄ \"BE‡" [apply function append mapcar #[(x) "À D‡" [Multiple-value-list x] 2] args] 6]) (macro . #[(vars form &rest body) "ÀÁ\nà D $‡" [list* multiple-value-bind vars Multiple-value-list form body] 5]) (macro . #[(vars form) "À  DE‡" [multiple-value-setq vars Multiple-value-list form] 4]) (macro . #[(form &rest body) "À ÂÃÄ #E‡" [prog1 form list* let ((*mvalues-values* nil)) body] 6]) build-klist #[(arglist keys &optional allow-others) "ÀÁÂÃÅÅ @=ƒ †C*ÃÇ!‰ @=ƒ* †-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] extract-from-klist #[(klist key &optional def) " ž‰ƒ \nA‚ )‡" [key klist res def] 3] keyword-argument-supplied-p #[(klist key) " ž‡" [key klist] 2] elt-satisfies-test-p #[(item elt klist) "À žA žAà žA ƒ !ƒ*\"?‚4 †/É\"+‡" [:test-not klist :test :key key test test-not elt item eql] 4] cl-floor #[(a &optional b) "ÀÁ\n \"!‡" [Values-list floor* a b] 4] cl-ceiling #[(a &optional b) "ÀÁ\n \"!‡" [Values-list ceiling* a b] 4] cl-round #[(a &optional b) "ÀÁ\n \"!‡" [Values-list round* a b] 4] cl-truncate #[(a &optional b) "ÀÁ\n \"!‡" [Values-list truncate* a b] 4] safe-idiv #[(a b) "À !À\n!¥Ä !Ä\n!_Æ \n__Z #*‡" [abs a b q signum s Values] 6] pair-with-newsyms #[(oldforms) "ÀÁ\n\"ÄÅÆ \n# \")‡" [mapcar #[(x) "À ‡" [gensym] 1] oldforms newsyms Values mapcar* list] 5] zip-lists #[(evens odds) "ÀÁ\n #‡" [mapcan list evens odds] 4] unzip-lists #[(list) "À‰ ƒ @\nBÄ ! BÅ !‰„Æ\nŸ Ÿ\"*‡" [nil o e list cadr cddr Values] 4] reassemble-argslists #[(list) "ÀÁÂà \"\"ÅS‰ÈYƒ#ÂÉ \"B‚ *‡" [apply min mapcar length list nil res n 0 #[(x) " œ‡" [x n] 2]] 5] duplicate-symbols-p #[(list) "À\nƒ\n@\nA>ƒ\n@ B\nA‰„ )‡" [nil res list] 3] setnth #[(n list x) " ›\n ‡" [n list x] 2] setnthcdr #[(n list x) "S ›\n¡‡" [n list x] 2] setelt #[(seq n x) ":ƒ ›\n ‡ \nI‡" [seq n x] 3] provide cl-compat] 4) emacs-19.22/lisp/cl-extra.elc100666 12120 1 46432 5431756145 14325 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Aug 10 13:35:33 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cl-extra.el ;;; emacs version 19.18.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "À >„\nÂÃ!ˆÄÅÆ\"ˆÄÇÈ\"‡" [cl-19 features error "Tried to load `cl-extra' before `cl'!" defalias cl-push (macro . #[(x place) "À  EE‡" [setq place cons x] 5]) cl-pop (macro . #[(place) "ÀÁ\nÃ\nÄ\nDEED‡" [car prog1 place setq cdr] 7])] 3) (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 "\ Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier."]) (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 "\ 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 (quote cl-mapcar-many) #[(cl-func cl-seqs) "AAƒzÁÃÄÅÆ\"\"È Ê! Á Á Ê! Wƒu    ƒc  @:ƒN @@ ‰@A ˆ‚T @ H ˆ A  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]) (defalias 'map #[(cl-type cl-func cl-seq &rest cl-rest) "ÀÁ\n $…Ç \")‡" [apply mapcar* cl-func cl-seq cl-rest cl-res cl-type coerce] 5 "\ 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 'maplist #[(cl-func cl-list &rest cl-rest) "ƒ6Á\nÃ!BÁÁ >„1Ç \"B  ƒ ‰‰A@A ˆ‚!Ÿ+‡Á\nƒM\n!B\nA‰„=Ÿ)‡" [cl-rest nil cl-list copy-sequence cl-p cl-args cl-res apply cl-func] 5 "\ 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 'mapc #[(cl-func cl-seq &rest cl-rest) "ƒÁÂà %ˆ‚Æ \"ˆ ‡" [cl-rest apply map nil cl-func cl-seq mapcar] 6 "\ Like `mapcar', but does not accumulate values returned by the function."]) (defalias 'mapl #[(cl-func cl-list &rest cl-rest) "ƒÁ $ˆ‚ ‰ƒ !ˆ A‰„) ‡" [cl-rest apply maplist cl-func cl-list cl-p] 6 "\ Like `maplist', but does not accumulate values returned by the function."]) (defalias 'mapcan #[(cl-func cl-seq &rest cl-rest) "ÀÁÀ $\"‡" [apply nconc mapcar* cl-func cl-seq cl-rest] 7 "\ Like `mapcar', but nconc's together the values returned by the function."]) (defalias 'mapcon #[(cl-func cl-list &rest cl-rest) "ÀÁÀ $\"‡" [apply nconc maplist cl-func cl-list cl-rest] 7 "\ Like `maplist', but nconc's together the values returned by the function."]) (defalias 'some #[(cl-pred cl-seq &rest cl-rest) "„ <„ ÂÇÄ ƒ  ‰A@!‰ƒ )‡" [cl-rest cl-seq cl-some (byte-code "ÀÁÂà %ˆÂ‡" [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 "\ 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 'every #[(cl-pred cl-seq &rest cl-rest) "„ <„ ÂÇ ƒ @!ƒ A‰„ ?‡" [cl-rest cl-seq cl-every (byte-code "ÀÁÂà %ˆÆ‡" [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 "\ Return true if PREDICATE is true of every element of SEQ or SEQs."]) (defalias 'notany #[(cl-pred cl-seq &rest cl-rest) "ÀÁ\n $?‡" [apply some cl-pred cl-seq cl-rest] 5 "\ Return true if PREDICATE is false of every element of SEQ or SEQs."]) (defalias 'notevery #[(cl-pred cl-seq &rest cl-rest) "ÀÁ\n $?‡" [apply every cl-pred cl-seq cl-rest] 5 "\ Return true if PREDICATE is false of some element of SEQ or SEQs."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias cl-map-keymap #[(cl-func cl-map) "9ƒ K‰‚ Â=ƒà \"‡<ƒW A‰:…U @:ƒ8 @@ @A\"ˆ‚Æ @!ƒHÇ @\"ˆ‚ @È=ƒɉ‚)‡Ê  T‰ GW…y HƒZ   H\"ˆ‚Z)‡" [cl-map cl-emacs-type lucid map-keymap cl-func cl-p vectorp cl-map-keymap keymap nil -1 cl-i] 5] 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] cl-map-intervals #[(cl-func &optional cl-what cl-prop cl-start cl-end) "„pÁ!ƒ—‰ÃŠqˆÈ †!e!\n…-È\n!) ƒ…ƒAWƒ…ËÌ!…[ ƒVÎ #‚[Ì\"‰†fŠqˆd)Ð! “ˆƒ ^‚€ \"ˆ‚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] cl-map-overlays #[(cl-func &optional cl-buffer cl-start cl-end cl-arg) "„pÁÂ!ƒ|ÊqˆÂ  ƒÆ !ƒ(Æ!) @ A¤‰ƒgÈ @!ƒ`ƒIÈ @!Y„` ƒVÉ @! X„`\n @ \"„g A‰„3 ƒp É“ˆ…zÉ“)‡ŠqˆÆ ††e!)…–ŠqˆÆ!)É  ŠÏ!‰ …Æ  †²dW…ÆqˆÐ !Ñ !Ó)ƒô ƒŸÈ @! Uƒê\n @ \"ƒêÉ“„Ÿ A‰„΂ŸÉ“ˆ … É“,‡" [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] cl-set-frame-visible-p #[(frame val) "„ Á\n!ˆ‚Ã=ƒÄ\n!ˆ‚Å\n!ˆ‡" [val make-frame-invisible frame icon iconify-frame make-frame-visible] 2] cl-progv-before #[(syms values) "…7Á@!ƒ@@JB‚@\nB ƒ,‰A@ ‰A@Lˆ‚ĉA@!ˆ‚‡" [syms boundp cl-progv-save values makunbound] 3] cl-progv-after #[nil "…\"@:ƒ@@@ALˆ‚Á@!ˆ‰Aˆ‚‡" [cl-progv-save makunbound] 2]] 3) (defalias 'gcd #[(&rest args) "À ‰A@†\nÂ! ƒ,À ‰A@!‰ÂVƒ( ‰¦‰‚)‚ )‡" [abs args 0 a b] 4 "\ Return the greatest common divisor of the arguments."]) (defalias 'lcm #[(&rest args) "À >ƒÀ‡Â ‰A@†Ã! ƒ- ‰A@! Æ \"¥ _)‚ )‡" [0 args abs 1 a b gcd] 4 "\ Return the least common multiple of the arguments."]) (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 "\ Return the integer square root of the argument."]) (defalias 'cl-expt #[(x y) "ÁXƒÁUƒ‡ Ä>ƒ ‡Á‡ŦÁUƒ$‚% Æ ‰_Å¥\"_‡" [y 0 1 x (-1 1) 2 cl-expt] 5 "\ Return X raised to the power of Y. Works only for integer arguments."]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÀ‡" [fboundp expt subrp defalias cl-expt] 3) (defalias 'floor* #[(x &optional y) "À \n\"‰ \nƒ\n _‚ Z)D‡" [floor x y q] 5 "\ 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 'ceiling* #[(x &optional y) "À \n\"‰A@ÄUƒ ‚ @T A@\n†ÅZD)‡" [floor* x y res 0 1] 4 "\ 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 'truncate* #[(x &optional y) "ÁY\n?† \nÁY=ƒÃ\n\"‡Ä\n\"‡" [x 0 y floor* ceiling*] 3 "\ 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 '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 "\ Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient."]) (defalias 'mod* #[(x y) "À \n\"A@‡" [floor* x y] 3 "\ The remainder of X divided by Y, with the same sign as Y."]) (defalias 'rem* #[(x y) "À \n\"A@‡" [truncate* x y] 3 "\ The remainder of X divided by Y, with the same sign as X."]) (defalias 'signum #[(a) "ÁVƒ‡ÁWƒÇÁ‡" [a 0 1 -1] 2 "\ Return 1 if A is positive, -1 if negative, 0 if zero."]) (defalias 'random* #[(lim &optional state) "„ ÂH‰¨ƒgÄÅÆ !ǦZÈÉ\n   ÂÎÏÉ\"‰Iˆ Ä Iˆ Ð\\Ϧ‰ ÄVƒS     Z ‰ Iˆ‚1 T‰ ÑWƒfÒÓ\"ˆ‚S,ÈÈHTϦI ÓÓHTϦI Ô   H  HZIÕ\"¨ƒêØ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 8.38860800000000000000e+006] 7 "\ Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object."]) (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 "\ 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 'random-state-p #[(object) "À !… GÂU… ÃHÄ=‡" [vectorp object 4 0 cl-random-state-tag] 2 "\ Return t if OBJECT is a random-state object."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias cl-finite-do #[(func a b) "ÀÁ‡" [err (byte-code " \n\"‰§… ‰Ä¥U?… )‡" [func a b res 2] 4) ((arith-error))] 3] cl-float-limits #[nil "„üÁ§ƒüÂÉÇȉ#ƒ\"‰_‚Çȉɥ#ƒ8‰É¥_‚\"Çʉ#ƒJ‰\\‚8É¥ÇÊ #ƒr \\U„r \\ É¥‚R[  ¥Ì ¥ _ÍÎσžÉ¥ É¥‚Š  [Ò ¥‰ÍÓÔƒ¼É¥‚¬[××Ø\\ÙU„ÚÉ¥‰‚ɉ\\ÛÜZÝU„õÉ¥‚ã‰\\+Ç" [most-positive-float 2.00000000000000000000e+001 2.00000000000000000000e+000 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.00000000000000000000e+000 1.00000000000000000000e+000 1.00000000000000000000e+000 float-epsilon 1.00000000000000000000e+000 1.00000000000000000000e+000 1.00000000000000000000e+000 float-negative-epsilon] 6]] 3) (defalias 'subseq #[(seq start &optional end) ";ƒ\n \nO‡Ã\nƒ\nÅWƒ\nG‰\\ ÅWƒ. †,G‰\\<ƒg ÅVƒ= ›\nƒaÃ\nS‰ YƒZ‰A@B‚DŸ)‚Ç!‚\n„r †qGÈ\n ZÅ]Ã\"Å  \nWƒš  HIˆ T T‰‚€*)‡" [seq start end nil len 0 res copy-sequence make-vector i] 5 "\ 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 'concatenate #[(type &rest seqs) "Á=ƒ Âà \"‡Å=ƒÂÆ \"‡Ç=ƒ$Âȉ É\"\"‡ÊË\"‡" [type vector apply vconcat seqs string concat list append (nil) error "Not a sequence type name: %s"] 5 "\ Concatenate, into a sequence of type TYPE, the argument SEQUENCES."]) (defalias 'revappend #[(x y) "À !\n¤‡" [reverse x y] 2 "\ Equivalent to (append (reverse X) Y)."]) (defalias 'nreconc #[(x y) "Ÿ ¤‡" [x y] 2 "\ Equivalent to (nconc (nreverse X) Y)."]) (defalias 'list-length #[(x) "À ‰ Aƒ% \n=ƒ ÀV„% Å\\ AA\nA‚ ƒ4 A?…5 T‚5 +‡" [0 x slow fast n 2] 3 "\ Return the length of a list. Return nil if list is circular."]) (defalias 'tailp #[(sublist list) ":ƒ =„A‰‚ §ƒ š‡ =‡" [list sublist] 3 "\ Return true if SUBLIST is a tail of LIST."]) (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 "\ 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."]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÀ‡" [fboundp copy-tree subrp defalias cl-copy-tree] 3) (defalias 'get* #[(sym tag &optional def) " N†-\n…-Ã!‰ƒ! @ =„! AA‰„ ƒ+ A@‚,\n)‡" [sym tag def symbol-plist plist] 3 "\ Return the value of SYMBOL's PROPNAME property, or DEFAULT if none."]) (defalias 'getf #[(plist tag &optional def) "ÀÁ\n\"ˆÁ N† …ÅÁ #‡" [setplist --cl-getf-symbol-- plist tag def get*] 4 "\ Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias cl-set-getf #[(plist tag val) "‰ƒ @\n=„ AA‰„ ƒ\" A  ˆ‚'Ä\n #)‡" [plist p tag val list*] 5] cl-do-remf #[(plist tag) "A‰Aƒ A@\n=„ AA‰‚ A…% ‰AAA¡ˆÃ)‡" [plist p tag t] 3]] 3) (defalias 'cl-remprop #[(sym tag) "À !‰ƒ \n@=ƒÄ \nAA\"ˆÅ‚Æ\n \")‡" [symbol-plist sym plist tag setplist t cl-do-remf] 4 "\ Remove from SYMBOL's plist the property PROP and its value."]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÀ‡" [fboundp remprop subrp defalias cl-remprop] 3) (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 "\ 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."]) (byte-code "ÀÁ!„ ÂÃ!ƒÄÃÅ!!ƒÃÅ!ÆH‚ÇÈ!À‡" [boundp cl-lucid-hash-tag fboundp make-hashtable vectorp 1 0 make-symbol "--cl-hash-tag--"] 3) (defalias 'hash-table-p #[(x) "¢Á=†%Â!ƒGÃUƒÄH =†%ÆÇ!…%Ç!‡" [x cl-hash-table-tag vectorp 4 0 cl-lucid-hash-tag fboundp hashtablep] 2 "\ Return t if OBJECT is a hash table."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„%ÇÈ!ƒ\"ÉÈK!ƒ\"ÈK‚#ÁÅÊ!„@ÇË!ƒ=ÉËK!ƒ=ËK‚>Á\nÅÌ!„[ÇÍ!ƒXÉÍK!ƒXÍK‚YÁ ÅÎ!„vÇÏ!ƒsÉÏK!ƒsÏK‚tÁÀ‡" [defalias cl-not-hash-table #[(x &optional y &rest z) "ÀÁ † D\"‡" [signal wrong-type-argument hash-table-p y x] 4] cl-hash-lookup #[(key table) "¢Á=„ Â!ˆÃ8A@È 9ƒ)È J ‚¢:„>Ê!ƒHGËVƒHËœ‰‚+;ƒ\\ Ì=ƒš—‚š9ƒkÍ!‚š§ƒ—ÎVƒ—ÏWƒ—¨„‹Ð!ÑÒÓ\"H‚šÔÕ \"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] boundp cl-builtin-gethash fboundp gethash subrp cl-builtin-remhash remhash cl-builtin-clrhash clrhash cl-builtin-maphash maphash] 3) (defalias 'cl-gethash #[(key table &optional def) ":ƒÁ\n\"‰@ƒ @A‚ )‡ \n #‡" [table cl-hash-lookup key found def cl-builtin-gethash] 5 "\ Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias gethash cl-gethash cl-puthash #[(key val table) ":ƒoÁ\n\"‰@ƒ @ ¡ˆ‚kÅ 8ƒUÆ8Å8GÆ_VƒAÇÆ8È\" ÊËÅ8\"ˆAA  ˆ)ÌÅ 8Å8\"\n B A@BLˆ‚aÅ8\n B A@BLˆAAAÆ8T ˆ)‚uÍ\n #ˆ ‡" [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]] 3) (defalias 'cl-remhash #[(key table) ":ƒ?Á\n\"‰@…=Ä @ A@\"AAAÆ8S ˆÇ 8ƒ5ÈÇ 8Ç8\" Lˆ‚;Ç8 Lˆ)É)‡\n\nË#Ë=? \n\"ˆ‡" [table cl-hash-lookup key found delq del 3 2 intern t cl-builtin-gethash --cl-- cl-builtin-remhash] 5 "\ Remove KEY from HASH-TABLE."]) (defalias (quote remhash) (quote cl-remhash)) (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 "\ Clear HASH-TABLE."]) (defalias (quote clrhash) (quote cl-clrhash)) (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 "\ Call FUNCTION on keys and values from HASH-TABLE."]) (defalias (quote maphash) (quote cl-maphash)) (defalias 'hash-table-count #[(table) "À !„\n !ˆ :ƒà 8‡Ä !‡" [hash-table-p table cl-not-hash-table 3 hashtable-fullness] 2 "\ Return the number of entries in HASH-TABLE."]) (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 "\ Insert a pretty-printed rendition of a Lisp FORM in current buffer."]) (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅÃÆ!„ÅŇ" [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] boundp cl-macroexpand-cmacs nil cl-closure-vars] 3) (defalias 'cl-macroexpand-all #[(form &optional env) "Á\n\"‰=ƒ ƒÄ!‰=ƒ:„ ‡@Å>ƒ·A@„6ÆÇÈ!B\n\"‡É‰Ê!    ƒ” @:ƒlÆÎ !\n\"‰9„^Ð ÑÒ !\n\")B‚†Æ @\n\"‰9ƒ~‚…Ð ÉD) B  A‰ „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 "\ Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!‡" [defalias cl-macroexpand-body #[(body &optional env) "ÀÁ\n\"‡" [mapcar #[(x) "À \n\"‡" [cl-macroexpand-all x env] 3] body] 3] 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 cl-extra-load-hook] 3) emacs-19.22/lisp/cl-indent.elc100666 74777 1 13413 5416162013 14613 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:31:37 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cl-indent.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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'.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÍÏ@@Á@A9ƒ8@AÁN‚=@A@#ˆA‰„!)À‡" [defalias common-lisp-indent-function #[(indent-point state) "iÁ‰ Ŝ \n bˆi „«  Wƒ«` Å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 % ‚”ë\n & + 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] lisp-indent-report-bad-format #[(m) "ÀÁ\nà $‡" [error "%s has a badly-formed %s property: %s" function common-lisp-indent-function m] 5] 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ƒŠÊ !ˆ ƒœ :„œÎÏ\"ˆ‚, Ë=ƒ¿ÎÏÑUƒ¸„¸\\‚º\"ˆ‚, Ì=ƒÕÑVÑ A ‚,ÑVƒöS A ÑWƒ,ÎÏ\"ˆ‚, Ã=ƒÎÏD\"ˆ‚, ¨ƒ%ÎÏ„ \\D‚ \"ˆ‚, 9ƒ;ÎÏ  %\"ˆ‚,ƒL AA É‚. A@ÎÏ ƒ[‚‚ Ã=ƒ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] 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] 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] lisp-indent-function-lambda-hack #[(path state indent-point sexp-column normal-indent) "A„ @Á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] ((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] 6) emacs-19.22/lisp/cl-macs.elc100666 12120 1 216400 5426665055 14142 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 1 03:01:00 1993 ;;; from file /home/fsf/rms/e19/lisp/cl-macs.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (byte-code "À >„\nÂÃ!ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"ˆËÅÌÍ#ˆËÇÌÍ#ˆËÉÌÍ#ˆÎÏÄ!„6ÄÐMˆÏÑ!„AÄÑÒ\"ˆ †IÓC‰@!ˆÔÕ!„UÖÄ×Ø\"‡" [cl-19 features error "Tried to load `cl-macs' before `cl'!" defalias cl-push (macro . #[(x place) "À  EE‡" [setq place cons x] 5]) cl-pop (macro . #[(place) "ÀÁ\nÃ\nÄ\nDEED‡" [car prog1 place setq cdr] 7]) cl-pop2 (macro . #[(place) "ÀÁ DDÄ Â‰ DDEE‡" [prog1 car cdr place setq] 7]) put edebug-form-spec edebug-sexps require fboundp fset cl-transform-function-property #[(n p f) "ÀÁ\nDÁ DÄÅBDF‡" [put quote n p function lambda f] 6] cl-kludge boundp cl-old-bc-file-form nil 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]] 4) (defalias 'gensym #[(&optional arg) ";ƒ ‚\nÁ¨ƒ‚\n‰TÅÆÇ #!*‡" [arg "G" *gensym-counter* num prefix make-symbol format "%s%d"] 5 "\ Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\"."]) (defalias 'gentemp #[(&optional arg) ";ƒ ‚\nÁÂÅÆÇ #‰!ƒ\"T‚ É !*‡" [arg "G" nil name prefix intern-soft format "%s%d" *gensym-counter* intern] 5 "\ Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\"."]) (defalias 'defun* '(macro . #[(name args &rest body) "À \nB \"Å ABB @ƒÇ @E‚*‡" [cl-transform-lambda args body name res defun form progn] 3 "\ (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 'defmacro* '(macro . #[(name args &rest body) "À \nB \"Å ABB @ƒÇ @E‚*‡" [cl-transform-lambda args body name res defmacro form progn] 3 "\ (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 'function* '(macro . #[(func) "¢Á=ƒ'ÂAÃ\"ÅÁ ABD @ƒ#Ç @E‚%*‡ÅD‡" [func lambda cl-transform-lambda cl-none res function form progn] 3 "\ (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."])) (byte-code "ÀÁÂ\"ˆÃÅÆ!„ÇÀÈÉ\"ˆÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"ˆÅÐ!„-ÇLJ" [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] (&optional &rest &key &allow-other-keys &aux &whole &body &environment) lambda-list-keywords boundp cl-macro-environment nil cl-transform-lambda #[(form bind-block) "@AÃÃÃÃÃà Ã\n\n@;„'\n@¢Ë=ƒ4\n‰A@ B ‚ <ƒ?Ì !‚BÍ DÎ !‰AƒVÍAD¡ˆ)Ð >A@‰ƒmÑÐÑ \"\" A@Ò >‰ƒzÑÒ \"Ó >ƒ„ÔÕ!ˆÖ >‰A@ƒ¥Ñ@Ñ \"\"ØÙDD¤* ƒÖ @9ƒÖ @Ú>„Ö @Û=ƒÉ „Ö A@:„Ö ‰A@\nB\n‚¦Ý=„åÞ\nBBC „÷Ã\nŸ Ÿ\n¤BB‚GÛ\n>ƒÛ Bß Ã\nGÛ\n>ƒà‚áZ#ˆŸ…(âãŸBB\nŸÍ‰A@@D¤ ŸäDŸ¤\n¤C¤BB. ‡" [form args body nil bind-defs bind-enquote bind-inits bind-lets bind-forms header simple-args interactive copy-list &rest last p &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 block cl-do-arglist 1 0 eval-when (compile load eval) let*] 7] cl-do-arglist #[(args expr &optional num) "<„ >„9„ÂÃ\"‡ D B‰‡Æ!Ç!‰Aƒ4ÉAD¡ˆ)Ê>‰ƒCÉ ˆ)Ë>ƒNÂÌ!ˆÉ>Í ƒ\\‚]ÏЉ‰‰„wÙA@<ƒ‡ÚÛ!‚A@ D B@Ü=ƒ¨A@AAD BƒÒ@ >„Ò=„ÉÝDA‰„´@Þ>ƒïßàDá\"GE=?)ƒO@ >„OA„„ â‚\nãD$å‰A@„!ÙUƒ&$‚Aæ$çèé*ë=?…:ì*DàDEEF\"ˆ)Tí‚ð@î=ƒà‰A@ƒàƒO@ >„O‰A@‰/:„z/C//AAƒåð/8ñíE\"ˆ/Aƒš/A@‚¨2@†¨/@2žA@âD$‰3ƒ¿4ƒ¿ì3D3å/@3ƒÓæ$3F‚Õ$\"ˆT+‚^@É=ƒA@AA‰/:ƒüå/\"ˆ)‚5@õ=„5ÙU„5„5æçöé*ë=?…%ì*D÷àDEEEE8B8@õ=ƒc‰A@ƒcƒ5@ >„5‰A@‰/:„`/C//@:ƒn/@@‚vùúû/@\"!</@:ƒ‡/@A@‚Š/@=/Aƒ™/A@‚¦2@†¦=2žA@3þì„ï@:ƒ?4ƒ/@A@ƒ/å@@ì‰A@A@D\"ˆ‚å@@‰A@A@\"ˆ‚å‰A@Ð\"ˆ‚…VÂV\".‡" [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 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 2 and bind-defs def bind-enquote &key (quote wrong-number-of-arguments) + bind-forms intern format ":%s" karg 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] cl-arglist-args #[(args) "<„C‡Á‰‰:ƒ[‰A@‰ >ƒ$\n‚\nÆ=ƒ2‰Aˆ‚\n:ƒ> ƒ>\n@\n:ƒR\nAƒR Ç=ƒR\nA@ È\n!¤‚ …bC¤+‡" [args nil arg kind res lambda-list-keywords &cl-defs &key cl-arglist-args] 4] 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]) cl-not-toplevel] 3) (defalias 'eval-when '(macro . #[(when &rest body) "ÀÁ!ƒ[Á ƒ[\n„[ÃÄ!„[Å>† Ç>È Ê>„2Ë>ƒL ƒAÌÍÎ\"B‚YÐщBBB‚Y ƒXÒÌB!ˆÑ*‡Ò>„iÓ>…mÌ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 if nil eval :execute] 4 "\ (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."])) (byte-code "ÀÁÂ\"ˆÃÄ!ƒÄK¢Å=ƒÆÇ!ˆÀ‡" [defalias cl-compile-time-too #[(form) "¢9ƒ ¢ÁN„Âà B\"¢Å=ƒ#ÅÆÇA\"B‡¢È=ƒMA@ Ê >„=Ë >ƒJÈÌ BAABB‚K)‡Ê!ˆ‡" [form byte-hunk-handler macroexpand (eval-when) byte-compile-macro-environment progn mapcar cl-compile-time-too eval-when when eval :execute compile] 4] 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))))] 3) (defalias 'load-time-value '(macro . #[(form &optional read-only) "À ƒGÁÂ!ÄÅ DEÇÈ!ƒ:ÉÊ!ƒ:ÉË!ƒ:ÌÍÎÏÐÅÌKDEÌÅ DDѯMˆ‚@Ò Ó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 "\ Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant."])) (defalias 'case '(macro . #[(expr &rest clauses) "À Â\"ƒ ‚ à ÅÇÈÉ\n\"B =ƒ% ‚-Ì 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 "\ (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 'ecase '(macro . #[(expr &rest clauses) "À  Ä\"BB‡" [case expr append clauses ((ecase-error-flag))] 5 "\ (ecase EXPR CLAUSES...): like `case', but error if no case fits. `otherwise'-clauses are not allowed."])) (defalias 'typecase '(macro . #[(expr &rest clauses) "À Â\"ƒ ‚ à ÅÇÈÉ\n\"B =ƒ% ‚-Ì 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 "\ (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 'etypecase '(macro . #[(expr &rest clauses) "À  Ä\"BB‡" [typecase expr append clauses ((ecase-error-flag))] 5 "\ (etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. `otherwise'-clauses are not allowed."])) (defalias 'block '(macro . #[(name &rest body) "ÀÁ\nB!ƒ Á\nB‡ÃÄÅÆÇÈ \"!D\nBBD‡" [cl-safe-expr-p progn body cl-block-wrapper catch quote intern format "--cl-block-%s--" name] 7 "\ (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."])) (byte-code "ÀÁ!„ÂÃÄÅÆ#ˆÇÆÈ\"ˆÃÉÅÊ#ˆÇÊË\"‡" [boundp cl-active-block-names nil put cl-block-wrapper byte-compile cl-byte-compile-block defalias #[(cl-form) "ÀÁ!ƒ8\nA@A@A@ÃB‰ BÆÇ\nA@AAB! Aƒ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 cl-body byte-compile-form catch] 5] cl-block-throw 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]] 4) (defalias 'return '(macro . #[(&optional res) "ÀÁ\nE‡" [return-from nil res] 3 "\ (return [RESULT]): return from the block named nil. This is equivalent to `(return-from nil RESULT)'."])) (defalias 'return-from '(macro . #[(name &optional res) "ÀÁ \"!ÅÆ DE)‡" [intern format "--cl-block-%s--" name name2 cl-block-throw quote res] 4 "\ (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 'loop '(macro . #[(&rest args) "ÀÁÂÃÄÃÀÅ!\"\"\">„ÇÄÈÀBBE‡Ä‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰ \n   ÙÚ\"@Û=„aÜ ˆ‚SƒpÀDCB ƒ‰ ÀDCBÝ ÄEB Ÿ†“C¤ßŸ!‰ A@Ÿ¤!ÙŸ ƒÑÇâã @À=ƒÀ!‚Éä @åE!Bæ #E‚ÙÈ @!BBCƒú皃ìC‚üèéBFC‚ü#*ƒ CBƒW@Aƒ*ë‰A@*À#C*‚ Ä,ƒI@A„I‰A@@,B,‚-ë,*Ä#C*)‚  ƒfí *BBC*Ç*.BB‡" [t mapcar symbolp delq nil copy-list args block 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 while-body --cl-finish-- subst or (return-from --cl-finish-- nil) --cl-map (nil) if progn body cl-loop-let lets symbol-macrolet] 17 "\ (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."])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [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‰@ä>ƒÆå!ˆ@æ=†AA@ç>(@é>†,AA@ê>+@ì>…<A@AA-@î>…LA@AA/@ð=…\\A@AA1ò/!?…hÜ 3ò1!?…tÜ 41ƒŽ1§ƒŽ1õXƒŽÆö1\"ˆ-†–õDB3ƒ«3/DB4ƒº41DB/ƒê(ƒÑ+ƒÍ÷‚Ûø‚Û+ƒÚù‚Ûú3†ä/E;B;(ƒõü‚öý4†1†þEDB.‚„ ÿ>ƒÑ @=‰@ƒ+9ƒ+‚-Ü ‰A‰A@DBBAD;B; C=ƒ_DADDEBE‚ˆA=„ˆ×DB@ƒ|A‚‚DADDBA@ð=ƒÁA@AA‰1¢F>ƒµ1A@9ƒµ1A@AD‚½G1AE)‚ÇHADDB*‚„ I=ƒ`‰A@-@J=ƒóA@AA‚õ-J×DB„@K=ƒ5LM†Ü ‰M-FDBJDB‚\\-J=ƒD-‚VLM†QÜ ‰M-JFDB*‚„ N>ƒØÜ Ü O‰P‰A@DBOQDBùROSODETPDE;B; U=ƒ»VPOEDEBE‚Ô×DBVPOEDB*‚„ W>ƒà@X>†ø@Y>?…øÆZ!A@AAÜ @[=ƒ4A@G\\Uƒ,A@@]=ƒ,A@AAA@‚6Æ^!‚6Ü O_`a_`DBOõDBaƒ†Ü ‰bT_DDBc_OEDEBEùObE;B;)‚Î×DBK_dB_DùOT_DEEE;B;LB_De_DV_OEFDBOSODDB,‚„ >ƒi@f>„õÆZ!ˆA@AAg@[=ƒ8A@G\\Uƒ0A@@ >ƒ0A@@ =„0A@AAA@‚:Æ^!‚:Ü h i>ƒLhhjklhDmBBDgEn*‚„ o>ƒž@p>…A@AAqrklCmBBDqEn)‚„ s>ƒ׉‰tuv@w>ƒî@u=ƒÍA@AAu‚¯@t=ƒâA@AAt‚¯A@AAv‚¯xklÜ Dy×FDvut¯n+‚„ z>ƒÕ׉‰‰Ü Ü {|tu}v@~>ƒ€@u=ƒJA@AAu‚,@t=ƒ_A@AAt‚,@=ƒtA@AA}‚,A@AAv‚,:ƒ¡@9ƒ¡A9ƒ¡@|A{‚±€|{EDBkl|{D‚EDv}ut¯n.‚„ >ƒl@ƒ>„êÆZ!ˆA@AA‰@[=ƒ+A@G\\Uƒ#A@@ >ƒ#A@@ =„#A@AAA@‚-Æ^!‚-Ü h„ …>ƒAhh †>ƒO‡‚RˆklhDmBBD„En*‚„ ‰>ƒßÜ AŠ‹=ƒ‰Œ‚ŒDBA×DBŽAEDdARAEEE;B;Š‹=ƒÏ‘‚Ò’DDB)‚„ “>ƒc@”>…÷A@AAÜ A••ƒŠ‹=ƒ–‚—•D‚˜DBA×DBŽAEDdARAEEE;B;™DDB*‚„ 9…m šN‰›ƒ|›!ˆ‚ƒÆœ \"ˆ)@)K=ƒ›‰Aˆ‚Ń°ƒ°ŸžBž‚¾Ÿ \"ž¤žƒÛ¡¢ŸR#E;B;ƒþƒë£‚îR¤¥Ÿ\"B¦B¦,‚¯ §=ƒ3 Ü ‰A‰A@DCžBžøRA¨ADEõE;B;)‚¯ ©=ƒ ‰A@ª×«\"¬­=ƒk ¡®¬EE;B;‚‰ ¡R¯ ¬DEEE;B;*‚¯ °>ƒö ‰A@ª×«\"¬¡R‰­=ƒÒ ¯ ±>ƒÆ «‚É ²¬DE‚è ³>ƒà ¯‚ã ¥¬EEE;B;*‚¯ ´>ƒ)\n‰A@ªµ!¬¡¶·¬FE;B;*‚¯ ¸>ƒ\\\n‰A@ª¹!¬¡¶º¬FE;B;*‚¯ »>ƒŠ\n‰A@ªõ!¬¡¼¬EE;B;*‚¯ ½>ƒ¼\n‰A@ªõ!¬¡L¬¼DEE;B;*‚¯ ¾>ƒ4 ‰A@¬¿¬!ƒÙ\n¬‚Û\nÜ Aª×!ÀÁ !õÂO!ÃRLÃAEAFEÄ¡A¬=ƒ Ä‚' ÅA¬DCÄEE;B;-‚¯ Æ=ƒw ×ljA@@I=…T A@AADÇBÇ@K=ƒk ‰Aˆ‚? ÇŸžBž)‚¯ È=ƒŒ ‰A@;B;‚¯ É=ƒ¥ ‰A@D;B;‚¯ Ê=ƒÎ Ë„¶ Ü ËRˉA@E;B;Ì‚¯ Í=ƒû Ë„ß Ü ËRˉA@DE;B;Ì‚¯ Î=ƒ2 Ë„ Ü ËÏ„ Ü ÏRËRωA@EDE;B;‚¯ Ð>ƒ& ‰A@Ñ×;Ò ˆÓ;Ÿ!)J×;@Ô=ƒg AÒ ˆÓ;Ÿ!)ÔJ@=…‚ Ô@=Õ@ï=ƒŽ A Ö=ƒž ÔJÔJÕƒ® ¡JA@B‚´ \\J8ÕƒÀ ÔA@‚Ç \\Ô8CB×Ø×Ù\"ƒÿ Ü ‰ACžBžLRAÑEÚAÙ×#BB×)‚\n LÑ×BB×Õƒ ¡×E‚ ×;B;-‚¯ Û>ƒd ×Ü@:„= ÆÝ!ˆ@:ƒP ‰A@ÜBÜ‚= ¡ÜBŸB;B;)‚¯ Ï=ƒ“ Ë„s Ü ËÏ„| Ü ÏRωA@Ëׯ;B;‚¯ 9… ÞN‰›„ª Æß \"ˆ› ˆ)@K=…¿ 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" (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 (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 2 index "Bad `using' clause" temp-seq seq ref temp-len elt or pop (in of) table other (hash-value hash-values) maphash function 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] cl-loop-let #[(specs body par) "Á‰‰ƒ @¢9„ @A@„ A‰„\n ƒT ƒTÁ‰ƒTÆ @A@!„MÇ ‰ @A@D B @A ˆ) A‰„/ƒÙ@:ƒÎ@@<ƒÎ@@ Á\n‰A@A@   ž†’ Í Î\"†ŠÇ B B‰ @A‰ D\nB :ƒÄ ‰A @ …» ƒ·Ï‚¸ÐDD\nB\n‚œ\nŸ¤,‚T‰A@\nB‚TÒ=ƒ ƒèÓ‚éÒÔÕ\nŸ\"B ƒþ× ŸE‚)‚ ƒ Ø‚ × Ÿ\nŸ¤BB+‡" [specs nil new temps p par cl-const-expr-p gensym temp spec nspecs expr loop-destr-temps last 0 pop car body setq psetq apply nconc set let* let] 5] cl-loop-handle-accum #[(def &optional func) "@Á=ƒ#A@AA‰ >„ \n DC B\n B\n)‡†FÇ ‰ DC Bƒ@D‚B ‡" [args into var loop-accum-vars def loop-bindings loop-accum-var gensym func loop-result] 3] cl-loop-build-ands #[(clauses) "À‰ ƒX @¢Ä=ƒMÅ @!@Æ=ƒM AƒAÇ @! A@¢Ä=ƒ3 A@A‚7 A@C¤ AAB‰‚Ç ‰A@!A‚ ‰A@\nB‚\nŸ†_ÆC‰AƒkÈ\nB‚m\n@ ‰ƒÉ\nÄÉ Ê\"BC\"‚€\n‰ AƒŽÈ B‚‘ @)E*‡" [nil body ands clauses progn last t butlast and append (t) full] 9]] 3) (defalias 'do '(macro . #[(steps endtest &rest body) "À \n Ä$‡" [cl-expand-do-loop steps endtest body nil] 5 "\ 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 "\ The Common Lisp `do*' loop. Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"])) (defalias (quote cl-expand-do-loop) #[(steps endtest body star) "ÀÁ\nƒ\n ÄÅÆ\"ÈÉ\n@DË ÅÍ\"ÏÁ\"‰…A\n„5A„9Ђ:ÑÒË\"BC)\"BB\nA†LÓBBBE‡" [block nil star let* let mapcar #[(c) ":ƒ @A@D‡‡" [c] 2] steps while not endtest append body #[(c) ":…AA…@Á8D‡" [c 2] 3] sets delq setq psetq apply (nil)] 13]) (defalias 'dolist '(macro . #[(spec &rest body) "ÀÁ!ÃÄÅ\nA@D@DÇ\nÈ@É\nDEÊ È\nÌ\nDEC\"BBBAAƒ>È@ÄEAAB‚?ÍBBBE)‡" [gensym "--dolist-temp--" temp block nil let spec while setq car append body cdr (nil)] 13 "\ (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 'dotimes '(macro . #[(spec &rest body) "ÀÁ!ÃÄÅ\nA@D@ÇDDÈÉ@\nEÊ Ì@DC\"BBAA†.ÍBBBE)‡" [gensym "--dotimes-temp--" temp block nil let spec 0 while < append body incf (nil)] 10 "\ (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 'do-symbols '(macro . #[(spec &rest body) "ÀÁ @CÄÅÆ @CBBD A@… A@CBB AA@FE‡" [block nil let spec mapatoms function lambda body] 9 "\ (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 (quote do-all-symbols) (quote (macro . #[(spec &rest body) "À @ A@E BB‡" [do-symbols spec nil body] 4]))) (defalias 'psetq '(macro . #[(&rest args) "À B‡" [psetf args] 2 "\ (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 'progv '(macro . #[(symbols values &rest body) "ÀÁÂÃÄ EBBÈEE‡" [let ((cl-progv-save nil)) unwind-protect progn cl-progv-before symbols values body (cl-progv-after)] 7 "\ (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 'flet '(macro . #[(bindings &rest body) "ÀÁ \" BB‡" [letf* mapcar #[(x) "ÀÁ\nA@Ã\n@\nAABBEDÅ ƒ&ÆÇ!ƒ&\n@È !BBÉÊ\n@DD )D‡" [function* lambda x block func cl-compiling-file boundp byte-compile-function-environment eval symbol-function quote] 6] bindings body] 4 "\ (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 (quote labels) (quote (macro . #[(&rest args) "À B‡" [flet args] 2]))) (defalias 'macrolet '(macro . #[(bindings &rest body) "AƒÁ@CÁA\nBBE‡„Ã\nB‡@@Å@A \"Ç@!ˆÈÃ\nB ÉABB\nB\"*‡" [bindings macrolet body progn name cl-transform-lambda res eval cl-macroexpand-all lambda cl-macro-environment] 5 "\ (macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. This is like `flet', but for macros instead of functions."])) (defalias 'symbol-macrolet '(macro . #[(bindings &rest body) "AƒÁ@CÁA\nBBE‡„Ã\nB‡ÄÃ\nBÅ@@!@A@DB\"‡" [bindings symbol-macrolet body progn cl-macroexpand-all symbol-name cl-macro-environment] 5 "\ (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 ...)."])) (byte-code "ÀÁ!„‡" [boundp cl-closure-vars nil] 2) (defalias 'lexical-let '(macro . #[(bindings &rest body) "Á \"ÅÆBÁÈ \"ÉC¤\n¤\" Ì!@ÍN„3ÎÁÏ \"ÐÁÑ \" \"E‚CÎÁÒ \"ÓÔÕÁÖ \"# F+‡" [cl-closure-vars mapcar #[(x) ":„CÁÂÃ@\"! B@A@ @E‡" [x gensym format "--%s--" cl-closure-vars] 4] bindings vars cl-macroexpand-all progn body #[(x) "À @! AA@DÃE‡" [symbol-name x symbol-value t] 3] (defun . cl-defun-expander) cl-macro-environment ebody last used let #[(x) "AA@A@D‡" [x] 2] sublis #[(x) "AA@ÁAA@DB‡" [x quote] 3] #[(x) "AA@ÁÂÃ@\"DD‡" [x make-symbol format "--%s--"] 5] apply append (setf) #[(x) "À AA@D A@D‡" [symbol-value x] 2]] 8 "\ (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‡Ã!ƒÄ‰A@C\nBBC‚ \n@‡" [bindings progn body reverse lexical-let] 3 "\ (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 (quote cl-defun-expander) #[(func &rest rest) "ÀÁ DÄÅBDE DE‡" [progn defalias quote func function lambda rest] 6]) (defalias 'multiple-value-bind '(macro . #[(vars form &rest body) "À ÁÄ DÆÇ\"B *BB‡" [gensym -1 n temp let* form mapcar #[(v) "Á\nT‰ ED‡" [v nth n temp] 4] vars body] 5 "\ (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-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 "\ (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)."])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„ÇÅÈ!„ÇÀÉÊ\"ˆË !  ƒ:É ‰A @Ç\"ˆ‚'Î )ÀÏÐ\"‡" [defalias locally (macro . #[(&rest body) "À B‡" [progn body] 2]) the (macro lambda (type form) form) boundp cl-proclaim-history t cl-declare-stack 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@A@Ý=ƒãÞ\n@@\"‚Áß\n@@\"ƒò‚ø\n@@B‚Áχ" [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 0 delq member*] 5] reverse cl-proclaims-deferred p nil declare (macro . #[(&rest specs) "À ƒ ƒ\n<ƒ @\nBà ‰A@Ä\"ˆ‚ć" [cl-compiling-file specs cl-declare-stack cl-do-proclaim nil] 3])] 3) (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 "\ (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 'defsetf '(macro . #[(func arg1 &rest args) "<ƒxÁÁÁÁÁÁ@A@ ÊËÌ \"! ÁÁÁ@;ƒD@Aƒ”@Ò=„”@Ó=ƒeA‰@‚‹@Ô>„‹@:ƒ{@@‚~@\nBÊËÌ\n@\"! BA‰„I\nŸ Ÿƒ¹Õ\nC\"ÊËÌ\"!Õ C\"‚½\n \n ƒò@ØËÙ@\"DDB@@DBAA‚Ã*ƒDBÕÚE…CÜ ØËÙ \"DDƒ0ÕÝÞEDC\"‚2BŸßƒ>à‚?ß BƒJà‚Kß Bß DÜ  DBŸBBƒhà‚ißáD BB¯EC#. ‡âãäåá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 "\ (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))."])) (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É B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store aset append aref] 7] car #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store setcar append car] 7] cdr #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store setcdr append cdr] 7] elt #[(seq n) "ÀÁ!ÀÃ!ÀÅ!\n DDC\n  ÊËDÌÍE EÎ FF+Ï\n E¯+‡" [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É B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store put append get] 7] get* #[(x y &optional d) "ÀÁ!ÀÃ!ÀÅ!ÀÇ!\n E \n EC\n \n  Í \n F,Î\n F¯,‡" [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 E \n EC\n \n  Í  \nF,Î\n F¯,‡" [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 DDC\n  ÊËE E+Ì\n E¯+‡" [gensym "--n--" --n--temp-- "--x--" --x--temp-- "--store--" --store--temp-- n x store setcar nthcdr nth] 7] subseq #[(seq start &optional end) "ÀÁ!ÀÃ!ÀÅ!ÀÇ!\n E \n EC\n \n  ÍÎ  Ï\nÐ ¯ E,Ñ\n F¯,‡" [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É B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store fset append symbol-function] 7] symbol-plist #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store setplist append symbol-plist] 7] symbol-value #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set append symbol-value] 7] first #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store setcar append first] 7] second #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈ DE*É\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cdr second] 6] third #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈ DE*É\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cddr third] 6] fourth #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈ DE*É\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar cdddr fourth] 6] fifth #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 4 fifth] 7] sixth #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 5 sixth] 7] seventh #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 6 seventh] 7] eighth #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 7 eighth] 7] ninth #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 8 ninth] 7] tenth #[(x) "ÀÁ!ÀÃ!\nC C C\n ÇÈÉ EE*Ê\nD¯*‡" [gensym "--x--" --x--temp-- "--store--" --store--temp-- x store setcar nthcdr 9 tenth] 7] rest #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store setcdr append rest] 7] buffer-file-name #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-visited-file-name append buffer-file-name] 8] buffer-modified-p #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-buffer-modified-p append buffer-modified-p] 8] buffer-name #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn rename-buffer append buffer-name] 8] buffer-string #[nil "ÀÁ!É\nC\nÅÆÇ DE)ÈC¯)‡" [gensym "--store--" --store--temp-- nil store progn (erase-buffer) insert buffer-string] 7] buffer-substring #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store cl-set-buffer-substring append buffer-substring] 7] current-buffer #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-buffer append current-buffer] 7] current-case-table #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-case-table append current-case-table] 7] current-column #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn move-to-column append current-column] 8] current-global-map #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn use-global-map append current-global-map] 8] current-input-mode #[nil "ÀÁ!É\nC\nÅÆÇ E E)È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*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn use-local-map append current-local-map] 8] current-window-configuration #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-window-configuration append current-window-configuration] 8] default-file-modes #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-default-file-modes append default-file-modes] 8] default-value #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-default append default-value] 7] documentation-property #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store put append documentation-property] 7] extent-data #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-extent-data append extent-data] 7] extent-face #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-extent-face append extent-face] 7] extent-priority #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-extent-priority append extent-priority] 7] extent-end-position #[(ext) "ÀÁ!ÀÃ!\nC C C\n ÇÈÉ 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 C\n ÇÈÉ 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 DDC\n  Ê F+Ë\n E¯+‡" [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 DDC\n  Ê F+Ë\n E¯+‡" [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 DDC\n  Ê F+Ë\n E¯+‡" [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 DDC\n  Ê F+Ë\n E¯+‡" [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 DDC\n  Ê F+Ë\n E¯+‡" [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*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-file-modes append file-modes] 8] frame-height #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-screen-height append frame-height] 8] frame-parameters #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn modify-frame-parameters append frame-parameters] 8] frame-visible-p #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store cl-set-frame-visible-p append frame-visible-p] 7] frame-width #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-screen-width append frame-width] 8] getenv #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn setenv append getenv] 8] get-register #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-register append get-register] 7] global-key-binding #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store global-set-key append global-key-binding] 7] keymap-parent #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-keymap-parent append keymap-parent] 7] local-key-binding #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store local-set-key append local-key-binding] 7] mark #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-mark append mark] 8] mark-marker #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-mark append mark-marker] 8] marker-position #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-marker append marker-position] 8] match-data #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn store-match-data append match-data] 8] mouse-position #[(scr) "ÀÁ!ÀÃ!\nC C C\n Ç È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É B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store overlay-put append overlay-get] 7] overlay-start #[(ov) "ÀÁ!ÀÃ!\nC C C\n ÇÈ É DFE*Ê\nD¯*‡" [gensym "--ov--" --ov--temp-- "--store--" --store--temp-- ov store progn move-overlay overlay-end overlay-start] 9] overlay-end #[(ov) "ÀÁ!ÀÃ!\nC C C\n ÇÈ É 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É B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store goto-char append point] 7] point-marker #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn goto-char append point-marker] 8] point-max #[nil "ÀÁ!É\nC\nÅÆÇ E E)ÈC¯)‡" [gensym "--store--" --store--temp-- nil store progn narrow-to-region (point-min) point-max] 7] point-min #[nil "ÀÁ!É\nC\nÅÆ ÇE E)È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É B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-process-buffer append process-buffer] 7] process-filter #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-process-filter append process-filter] 7] process-sentinel #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-process-sentinel append process-sentinel] 7] read-mouse-position #[(scr) "ÀÁ!ÀÃ!\nC C C\n Ç È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*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-screen-height append screen-height] 8] screen-width #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-screen-width append screen-width] 8] selected-window #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store select-window append selected-window] 7] selected-screen #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store select-screen append selected-screen] 7] selected-frame #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store select-frame append selected-frame] 7] standard-case-table #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-standard-case-table append standard-case-table] 7] syntax-table #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-syntax-table append syntax-table] 7] visited-file-modtime #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-visited-file-modtime append visited-file-modtime] 8] window-buffer #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-window-buffer append window-buffer] 8] window-display-table #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-window-display-table append window-display-table] 8] window-dedicated-p #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn set-window-dedicated-p append window-dedicated-p] 8] window-height #[nil "ÀÁ!É\nC\nÅÆÇ ÈED E)ÉC¯)‡" [gensym "--store--" --store--temp-- nil store progn enlarge-window - (window-height) window-height] 8] window-hscroll #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-window-hscroll append window-hscroll] 7] window-point #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-window-point append window-point] 7] window-start #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈ\nC\"*BÉ B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store set-window-start append window-start] 7] window-width #[nil "ÀÁ!É\nC\nÅÆÇ ÈEÉE E)Ê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*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn x-store-cutbuffer append x-get-cutbuffer] 8] x-get-cut-buffer #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn x-store-cut-buffer append x-get-cut-buffer] 8] x-get-secondary-selection #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn x-own-secondary-selection append x-get-secondary-selection] 8] x-get-selection #[(&rest args) "ÀÁ\n\"ÁÄ! \n C  ÇÈÉ\nC\"BE*Ê B¯*‡" [mapcar gensym args --args--temp-- "--store--" --store--temp-- store progn x-own-selection append x-get-selection] 8] apply #[(func arg1 &rest rest) "¢Á>ƒ£¢9„ÂÃ\"ˆA@ BBÇ\"‰ @ A@Ê 8ËÌ 8A@ @#ËÍ 8A@ @#¯*‡" [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 4] 9] defalias cl-setf-make-apply #[(form func temps) "@Á=ƒÁÂA@ #AABB‡Å!Å !š„$ÆÇ \"ˆÈÉ@DABB‡" [form progn cl-setf-make-apply func temps last error "%s is not suitable for use with setf-of-apply" apply quote] 5] nthcdr #[(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@  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@  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) (defalias 'get-setf-method #[(place &optional env) "9ƒÁÂ!ĉ CÅ E¯)‡@9ƒ„@Ç!ÉN\nÄ \nƒ`  Î\nA\"‰\n)ƒ`\n:ƒX\nGÏUƒX\n‚]ÐÑ\"†€ÒÓ\"ƒpÔÕ!!†€Ö=…€ÔGS8 \",†º× \"‰=ƒµ@9ƒ¯Ø@!ƒ¯@K9ƒ¯Ô@KAB \"‡ÐÙ@\"‡Ô \"‡" [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" string-match "\\`c[ad][ad][ad]?[ad]?r\\'" get-setf-method compiler-macroexpand edebug-after macroexpand fboundp "No setf-method known for %s"] 6 "\ 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'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias cl-setf-do-modify #[(place opt-expr) "À \n\"‰@ A@ÆÆ Ê=?…1 Ë=„(Ì !†1ÍÎ 8@Ï 8\"‰…@ :…@Ñ A! ƒx„RÓ @!ƒe ‰A@ ‰A@BB‚B ‰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] cl-setf-do-store #[(spec val) "@Aà !„\"Å !ƒÆ \n\"Ç=„\"È\n \"ƒ*É \n #‚1Ê\n DC 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] cl-setf-simple-store-p #[(sym form) ":…,Á\n\"Ã=…,GS8\n=…,@9…,Ä@!…,@K¢Å=?‡" [form cl-expr-contains sym 1 fboundp macro] 3]] 3) (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 "\ (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 'psetf '(macro . #[(&rest args) "Á ƒ@ @9ƒÆ A@ \"ƒÂ @ >ƒ(ÇÈ @\"ˆ ‰A@ B „8ÇÉ!ˆ ‰Aˆ‚ ƒMÊËBÂE‚xÌ!ËA@@E AA‰ƒrËA@Î@ 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 expr prog1] 5 "\ (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 (quote 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]) (defalias 'remf '(macro . #[(place tag) "À Â\"Ä !?…ÆÇ!É !?…ÆÊ! †#   †-Í 8ÏÐ @ …? Í 8DC…I DC#ÑÒ ÓDEÔÕ A@ÖD\"ÂE× EFE-‡" [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 "\ (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 'shiftf '(macro . #[(place &rest args) "ÀÁÂà B!\">„0Æ À ƒ)È @EB ‰A@‚Ÿ)BB‡É B!‰\n‰A\n@ \nƒiÌ\n‰A\n@Í\"Ï@ÆÐ8ÑA@ \"EE )‚? *‡" [nil mapcar symbolp butlast place args prog1 sets setq reverse places form cl-setf-do-modify unsafe method let* 2 cl-setf-do-store] 8 "\ (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 'rotatef '(macro . #[(&rest args) "ÀÁ \">„1 A…ŠÀ @ Aƒ& ‰A@ @D¤‚ÆC ¤ @ D¤*‡Ç !ÉÊ!‰  Aƒi͉A@Î\"Ð@ÑÒ8ÓA@ \"EE )‚>Í@Î\"ÐÔ@ Ò8DC\"ÓA@ \"À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 "\ (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 'letf '(macro . #[(bindings &rest body) "A„@Aƒ@@9ƒÁ\nBB‡Ã‰‰Ä! ƒ @@9ƒ:ÉÊ @@DD‚= @@ @A@ Í Î\"ÐÑ! @Ó>…\\ÐÔ!Ö !?…nA…nÐ×!@ƒž @É=ƒ†Ù‚‡ÚÛ8A@DDÜÛ8EDD‚¦Û8DC¤…² DC¤¤ÝÞ @AƒÒßA@†Ì \"\nB‚Ó\nBƒüàßA@\" @É=ƒðá‚ñâÛ8A@DF‚ßA@\"EC A.‚%ã\n,BB‡" [bindings let body nil reverse rev unsets sets lets symbol-value quote place 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 "\ (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‡Ã!ƒÄ‰A@C\nBBC‚ \n@‡" [bindings progn body reverse letf] 3 "\ (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 'callf '(macro . #[(func place &rest args) "À  B\"Å 8 BÇ @È A@ 9ƒ# B‚,ÊË DBB\"E*‡" [cl-setf-do-modify place list args method 2 rargs let* cl-setf-do-store func funcall function] 7 "\ (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 'callf2 '(macro . #[(func arg1 place &rest args) "À !ƒ !ƒ 9ƒÅ BBBE‡Ç ÈB\" Ê !?…0ËÌ!‰ †7 Î 8BBÐÑ …M DC @\"Ò A@ 9ƒb B‚jÓÔ DBB\"E+‡" [cl-safe-expr-p arg1 cl-simple-expr-p place func setf 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 "\ (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 'define-modify-macro '(macro . #[(name arglist func &optional doc) "À >ƒ\nÂÃ!ˆÄÅ!Ç B Ê >ƒ\"Ë‚#ÌÍÎDÐ !BBBB¯)‡" [&key arglist error "&key not allowed in define-modify-macro" gensym "--place--" place defmacro* name doc &rest list* list (quote callf) quote func cl-arglist-args] 10 "\ (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 'defstruct '(macro . #[(struct &rest descs) ":ƒ\n@‚ £ÃÃÆ !ÇPÉÊË \"! à ÉÊÎ \"!ÉÊÐ \"!ÃÃÔ ƒE‚FÖÃÉÊÙ \"!ÉÊÛ \"!ÃÃÃà Ã!Ã\"Ã#Ã$%@;ƒŒæç Dè%‰A%@F\"B\"éêë%\"B%\nƒ†\n@:ƒ¥\n@@‚§\n@\n‰A@£,‰-î=ƒÐ,ƒ‚,@ƒÊÆ,@!‚Ëï‚‚-ð=ƒô,Aƒç, B ‚‚,ƒ‚,@ ‚‚-ñ=ƒ,ƒ‚,@‚‚-ò=ƒ,ƒ‚,@‚‚-ó=ƒ<,@êô,A\"ÉÊÛ\"!‚‚-õ=ƒK,@‚‚-ö=ƒZ,@ ‚‚-÷=ƒgø!‚‚-ù=ƒ|ú,@û\"%¤%‚‚üý-\"ˆ*‚•ƒ¥þÿ@DABC¯øE‚Ü „܃¸DNƒÜø„Å ƒË?…ÚþEÊF \"BEDƒ|GNHNI‰J„ýüK\"ˆ ƒJ@ =„üL \"ˆƒ;@@Iž†,üM@@#I>‰A@ ˆ‚NIOP%ž%\"\"%J@ P%ž!JA@ƒi ø!QçDE\"B\"*‚§ ƒ R>„’üS \"ˆ!ƒ§ ‚§T U!!„ºOP%ž%\"%VD\"B\"!…2%GP%ž%>GZW T=ƒXYZ[%GE\\]AWEEF‚1W^Uƒ\\_E‚1X`\\aWAEEE)‰#…d^V…d#A@@b=ƒbcUƒbX#AAAB‚d#$^%dWdƒžd‰Ad@‰e@‰fg>ƒ à BfP=…šçD B‚•fdžƒ±ühf #ˆÉÊif#!jf BeA@ BkjlN$…îm$üÊnj #AEEC T=ƒ]AWE‚W^Uƒo‚aWAEC\"BBB\"B\"jøBBpjqreAA>A@ƒOüÊsj\"D‚itAç DçjD$…eç$DW¯F\"B\"ƒ”EÊuf\"BEvjADBED¤ˆ)*WTW‚o* Ÿ Ÿƒå#ƒåkw#@X=ƒÍN#x\"‚ÔX#øEF\"B\"yBBƒz{|F\"B\"øBB ƒ }OÃ~ !\"BD B  ƒ @@ ‰A @A@,,!€‚ #ƒk „çÃ%BD,BB ƒBF\"B\"…þê†%\"B!ƒ{ øBB,‚ƒ‡øD¤ˆƒ±ˆ@‰ŠX#EED‹E\"B\"ŒçDDE\"B\"Žæç Dç%DFæç D‘ç !ø=DDFæç D’Fê“\"BBBBB\"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] 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 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 vectorp 1 descp desc slot (cl-tag-slot cl-skip-slot) "Duplicate slots named %s in %s" "%s%s" accessor defsubst* (cl-x) or "%s accessing a non-%s" (car cl-x) define-setf-method (cl-x) :read-only "%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]] 12 "\ (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 (quote cl-struct-setf-expander) #[(x name accessor pred-form pos) "ÀÁ!ÀÃ!\nC C CÆÇ…(ÉÊ\nË#ÌÍÎ#\nEECÑN@Ò=ƒ;Ó\n F‚gÕÖXƒ`\nS‰ØYƒZÙD‚F)‚eÚ\nE EC#\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]) (defalias 'deftype '(macro . #[(name args &rest body) "ÀÁ ÄÅÆBBB#E‡" [eval-when (compile load eval) cl-transform-function-property name cl-deftype-handler &cl-defs (quote ((quote *))) args body] 8 "\ (deftype NAME ARGLIST BODY...): define NAME as a new data type. The type name can then be used in `typecase', `check-type', etc."])) (defalias (quote 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\"\"‡¢Ö>ƒß×ØÙÄ @\"A@Ú>ƒžØ‚µA@:ƒ¯Û A@@E‚µÜ A@EAA@Ý>ƒÂØ‚ÜAA@:ƒÕÞ AA@@E‚Üß AA@EF\"‡¢à>ƒï@áâA\"B‡¢ã>ƒÙä åADEØE‡¢æ=ƒA@ 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 (* nil) > >= (* nil) < <= (and or not) mapcar #[(x) "À \n\"‡" [cl-make-type-test val x] 3] (member member*) member* quote satisfies error "Bad type spec: %s"] 8]) (defalias 'typep #[(val type) "ÀÁ \"!‡" [eval cl-make-type-test val type] 4 "\ Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier."]) (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 "\ Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type."])) (defalias 'assert '(macro . #[(form &optional show-args string &rest args) "À ƒ ÂW„ ÂU…G …ÅÆÇÈ A\"\"\nËÌ  ƒ7Î Ï\n\"BB‚CÑÒÓÔ D\nBBEEÆ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 error append args signal (quote cl-assertion-failed) list quote] 8 "\ 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 'ignore-errors '(macro . #[(&rest body) "À  à BÅF)‡" [gensym err condition-case progn body (error nil)] 4 "\ Execute FORMS; if an error occurs, return nil. Otherwise, return result of last FORM."])) (byte-code "ÀÂÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"ˆÄËÌ\"ˆÄÍÎ\"ˆÄÏÐ\"ˆÄÑÒ\"ˆÄÓÔ\"ˆÄÕÖ\"ˆÄ×Ø\"‡" [(car cdr nth aref elt if and or + - 1+ 1- min max car-safe cdr-safe progn prog1 prog2) cl-simple-funcs (* / % length memq list vector vectorp < > <= >= = error) cl-safe-funcs defalias cl-simple-expr-p #[(x &optional size) "„Á\n:ƒG\n@Ã>„G\n@9…O\n@ >„&\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] cl-simple-exprs-p #[(xs) "ƒÁ@!ƒA‰„?‡" [xs cl-simple-expr-p] 3] 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] cl-const-expr-p #[(x) ":ƒ%@Á=†3@Â>…$A@9†$A@¢Ã=…$ć9ƒ2Å>…3ƇƇ" [x quote (function function*) lambda func (nil t) t] 2] cl-const-exprs-p #[(xs) "ƒÁ@!ƒA‰„?‡" [xs cl-const-expr-p] 3] cl-const-expr-val #[(x) "À !Â=… :ƒ A@‡ ‡" [cl-const-expr-p x t] 2] cl-expr-access-order #[(x v) "À !ƒ\n‡ :ƒ A‰ƒà @\n\"‚ \n‡ \n@=ƒ)\nA‡Ä‡" [cl-const-expr-p x v cl-expr-access-order (t)] 3] cl-expr-contains #[(x y) " šƒ‡ :ƒ5 ¢Ã>„5Ä ƒ, Æ ‰A@\"†'Ä\\‚ ÄV…3 )‡Ç‡" [y x 1 (quote function function*) 0 sum cl-expr-contains nil] 4] cl-expr-contains-any #[(x y) "ƒÁ\n@\"„‰Aˆ‚‡" [y cl-expr-contains x] 3] cl-expr-depends-p #[(x y) "À !?… !?†à \"‡" [cl-const-expr-p x cl-safe-expr-p cl-expr-contains-any y] 3]] 3) (defalias 'define-compiler-macro '(macro . #[(func args &rest body) "<ƒ ‚ ÁD :ƒ ‰A@ B‚ Ÿ …*Á D¡ˆ*ÅÆÇÉÊ>ƒ@ËÊ\"‚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 "\ (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."])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] cl-byte-compile-compiler-macro #[(form) "Á!‰=ƒÂ!‡Ã!‡" [form compiler-macroexpand byte-compile-normal-call byte-compile-form] 3]] 3) (defalias 'defsubst* '(macro . #[(name args &rest body) "À !‰Ä BÇ!? ƒ(É @\"Ê=ƒ( ‰Aˆ‚Ä ?…`Ë ÍÎÏ BBBÐÑ\nDÑÒ BBD†NÓ\n\"?Ô >…VÎ\nBBBBBBFÕ BBBE,‡" [cl-arglist-args args argns p progn body pbody cl-safe-expr-p unsafe cl-expr-contains 1 define-compiler-macro name &whole cl-whole &cl-quote cl-defsubst-expand quote block cl-expr-access-order &key defun*] 12 "\ (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 ...)."])) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#ˆÃÄÇÈ#ˆÄÅN„ÃÄÅÉ#ˆÃÊÇË#ˆÊÅN„/ÃÊÅÉ#ˆÃÌÇÍ#ˆÌÅN„AÃÌÅÉ#ˆÃÎÇÏ#ˆÎÅN„SÃÎÅÉ#ˆÃÐÇÑ#ˆÐÅN„eÃÐÅÉ#ˆÃÒÇÓ#ˆÒÅN„wÃÒÅÉ#ˆÃÔÇÕ#ˆÔÅN„‰ÃÔÅÉ#ˆÖ×Ø\"ˆÙÚ!ˆÖÛÜ\"ˆÖÝÞ\"ˆßà!‡" [defalias cl-defsubst-expand #[(argns body simple whole unsafe &rest argvs) "ƒÁ B!„‡Ä !ƒÅÇÈÉÊ #\"‰ ƒ/Í E‚1)‡" [whole cl-safe-expr-p progn argvs cl-simple-exprs-p t simple delq nil mapcar* #[(argn argv) "„\nÁ\n!ƒÃ\n #… \nD‡ \nD‡" [simple cl-const-expr-p argv subst argn body unsafe] 4] argns lets let body] 7] put eql byte-compile nil cl-compiler-macro #[(form a b) "À !Â=ƒ%à !‰§ƒ ¨„Å E‚#Ç E)‡À!Â=ƒLÃ!‰§ƒE ¨„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‚ð É=ƒ2ÊE‚ðƒ< Ë=ƒîÌ!Í=ƒeÃ!‰§…T¨?)ƒ\\Ê‚]Æ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 x nil mq mb p quote form] 5] assoc* #[(form a list &rest keys) "GÁU…@Â=…ÃA@!‰Å=ƒ#ÆE‚l É=ƒ2ÊE‚lË!Ì=ƒjƒE Í=ƒjÃ!‰§…T¨?)ƒaÊE‚lÆE‚l)‡" [keys 2 :test cl-const-expr-val test eq assq a list equal assoc cl-const-expr-p t eql x form] 4] adjoin #[(form a list &rest keys) "À !ƒ!À\n!ƒ!à >„!ÅÆ \n BBB\nÇ \nEF‡‡" [cl-simple-expr-p a list :key keys if member* cons form] 6] list* #[(--cl-whole-arg-- arg &rest others) "À \nB!‰@ A‰ƒÅ @ E‚ *‡" [reverse arg others args form cons] 4] get* #[(--cl-whole-arg-- sym prop &optional def) "ƒ Á D F‡Å E‡" [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) "À @ÂÃ#ˆÀ @ÄÅ#ˆÀ @ÆÇÈ A@9ƒ.ÉÊ A@DÉÊ AA@DËEE‚2É ABE#‡" [put y side-effect-free t byte-compile cl-byte-compile-compiler-macro cl-compiler-macro lambda (w x) list quote x] 10] ((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.22/lisp/cl-seq.elc100666 12120 1 100530 5426665206 14001 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 1 03:02:30 1993 ;;; from file /home/fsf/rms/e19/lisp/cl-seq.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (byte-code "À >„\nÂÃ!ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"ˆËÉÌÍ#ˆËÉÎÏ#ˆÄÐÑ\"ˆÄÒÓ\"ˆÄÔÕ\"ˆÄÖ×\"ˆËÐÎØ#ˆËÔÎØ#ˆËÒÎØ#ˆËÖÎØ#‡" [cl-19 features error "Tried to load `cl-seq' before `cl'!" defalias cl-push (macro . #[(x place) "À  EE‡" [setq place cons x] 5]) cl-pop (macro . #[(place) "ÀÁ\nÃ\nÄ\nDEED‡" [car prog1 place setq cdr] 7]) 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]) put lisp-indent-function 2 edebug-form-spec (sexp sexp &rest form) cl-check-key (macro . #[(x) "ÀÁÂÁ E F‡" [if cl-key funcall x] 5]) 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]) cl-check-test (macro . #[(item x) "À  DE‡" [cl-check-test-nokey item cl-check-key x] 4]) 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]) edebug-forms] 4) (defalias 'reduce #[(cl-func cl-seq &rest cl-keys) "À >A@à >A@†ÄÆ >A@È >A@ Ê >A@ ‰ ƒM @Í>„CÎ >A@„CÏÐ @\"ˆ AA‰ „,)<„[ÒÓ\"Ô #\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 "\ Reduce two-argument FUNCTION across SEQUENCE. Keywords supported: :start :end :from-end :initial-value :key"]) (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 "\ Fill the elements of SEQ with ITEM. Keywords supported: :start :end"]) (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ƒ¶ \\\\œ‰<ƒª› ‚±Iˆ+‚{*‚´<ƒW › ƒÎ Z‚ÏÖ<ƒ › ƒí Z‚îÖ^ƒƒS‰ÂYƒ@ ˆAA‚ó*‚S †(G\\^ ƒS WƒSH ˆAT‚0*‚´ †^G  †gGZ\\^<ƒ˜› Wƒ” @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 val n seq 4000000 cl-n1 cl-p1 cl-p2] 6 "\ Replace the elements of SEQ1 with the elements of SEQ2. SEQ1 is destructively modified, then returned. Keywords supported: :start1 :end1 :start2 :end2"]) (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 "\ 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-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply remove* nil cl-list :if cl-pred cl-keys] 7 "\ 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-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply remove* nil cl-list :if-not cl-pred cl-keys] 7 "\ 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 '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 "\ 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-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply delete* nil cl-list :if cl-pred cl-keys] 7 "\ 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-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply delete* nil cl-list :if-not cl-pred cl-keys] 7 "\ 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"]) (byte-code "ÀÁ!ƒ ÂÁK!„ÃÁÄ\"ˆÃÅÆ\"ˆÃÇÈ\"‡" [fboundp delete subrp defalias #[(x y) "À \nÃÄ$‡" [delete* x y :test equal] 5] remove #[(x y) "À \nÃÄ$‡" [remove* x y :test equal] 5] remq #[(x y) " >ƒ Âà !\"‡ ‡" [x y delq copy-list] 4]] 3) (defalias 'remove-duplicates #[(cl-seq &rest cl-keys) "À \nÃ#‡" [cl-delete-duplicates cl-seq cl-keys t] 4 "\ Return a copy of SEQ with all duplicate elements removed. 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 "\ Remove all duplicate elements from SEQ (destructively). Keywords supported: :test :test-not :key :start :end :from-end"]) (defalias (quote 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]) (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ƒ¥‚ß$‰ „º‚á!„ô \"#‰$<ƒá#$›\" ‚è$#\"Iˆ+ 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 val n seq apply nsubstitute] 11 "\ 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-if #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nà Å&‡" [apply substitute cl-new nil cl-list :if cl-pred cl-keys] 8 "\ 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-not #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nà Å&‡" [apply substitute cl-new nil cl-list :if-not cl-pred cl-keys] 8 "\ 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 '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ƒ6WƒÞ ÏVƒÞS\nƒ©\nƒœ!‚¢œ\"? =‚ ƒÍ ƒÀœ!‚Åœ!? =‚§ƒîƒåœ!‚ꜚ‚ƒœ!‚œ=ƒr !‰\"<ƒ%!\"›  ‚,\"! Iˆ+ S ‚rWƒÞ ÏVƒÞ\nƒh\nƒ\\H!‚aH\"? =‚Å ƒŒ ƒH!‚„H!? =‚ŧƒ­ƒ¤H!‚©Hš‚Ń¿H!‚ÄH=ƒÕIˆ S T‰‚8. ‡" [: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 val n seq] 6 "\ 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-if #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nà Å&‡" [apply nsubstitute cl-new nil cl-list :if cl-pred cl-keys] 8 "\ 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-not #[(cl-new cl-pred cl-list &rest cl-keys) "ÀÁ\nà Å&‡" [apply nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys] 8 "\ 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 'find #[(cl-item cl-seq &rest cl-keys) "ÀÁ\n $‰… œ)‡" [apply position cl-item cl-seq cl-keys cl-pos] 6 "\ 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-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply find nil cl-list :if cl-pred cl-keys] 7 "\ 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-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply find nil cl-list :if-not cl-pred cl-keys] 7 "\ 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 '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 "\ 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 (quote cl-position) #[(cl-item cl-seq cl-start &optional cl-end cl-from-end) "<ƒ¤ › „ÄÅ\nƒ  Wƒ ƒ&ƒ ƒF \nƒ<\n\n@!‚>\n@\"? =‚‘ ƒd \nƒZ\n\n@!‚\\\n@!? =‚‘ §ƒ \nƒy\n\n@!‚{\n@š‚‘ \nƒŽ\n\n@!‚\n@=ƒ— \nA T‚*‡ „«Gƒ7 S‰ Yƒ/ƒÛ \nƒÐ\n H!‚Ó H\"? =‚, ƒû \nƒð\n H!‚ó H!? =‚, §ƒ \nƒ\n H!‚ Hš‚, \nƒ(\n H!‚+ H=ƒ° Y…Á ‡ Wƒºƒ_ \nƒT\n H!‚W H\"? =‚° ƒ \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]) (defalias 'position-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply position nil cl-list :if cl-pred cl-keys] 7 "\ 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-not #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply position nil cl-list :if-not cl-pred cl-keys] 7 "\ 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 '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 "\ Count the number of occurrences of ITEM in LIST. Keywords supported: :test :test-not :key :start :end"]) (defalias 'count-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply count nil cl-list :if cl-pred cl-keys] 7 "\ Count the number of items 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 "\ Count the number of items not satisfying PREDICATE in LIST. Keywords supported: :key :start :end"]) (defalias 'mismatch #[(cl-seq1 cl-seq2 &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@†1Ë Í >A@Ï >A@†CËÑ >A@ ‰ƒt@Ô>„jÕ >A@„jÖ×@\"ˆAA‰„S)„G„‰G ƒz WƒdWƒd\nƒØ\nƒ´Sœ!‚ºSœƒËSœ!‚ÑSœ\"? =‚TƒéSœ!‚ïSœ§ƒ%ƒSœ!‚\nSœƒSœ!‚!Sœš‚Tƒ6Sœ!‚<SœƒMSœ!‚SSœ=ƒdSS‚Ž W„tW…S‚<…… ›<…› WƒWƒ\nƒ\nƒÄƒ»@‚À H!‚ÔƒÏ@‚Ô Hƒïƒæ@‚ëH!‚ÿƒú@‚ÿH\"? =‚æƒ!ƒ@‚ H!‚1ƒ,@‚1 H§ƒƒPƒG@‚L H!‚`ƒ[@‚` Hƒ{ƒr@‚wH!‚‹ƒ†@‚‹Hš‚惪ƒ¡@‚¦ H!‚ºƒµ@‚º HƒÕƒÌ@‚ÑH!‚åƒà@‚åH=ƒAA T T‚” W„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-p2 cl-p1] 6 "\ 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 'search #[(cl-seq1 cl-seq2 &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@†1Ë Í >A@Ï >A@†CËÑ >A@ ‰ƒt@Ô>„jÕ >A@„jÖ×@\"ˆAA‰„S)„G„‰G Yƒ  ƒ›‚%‚% Zƒ· œ!‚¼ œÜÜSZWƒß %‰ƒàáÊ TÍÏ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 "\ 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 '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 "\ Sort the argument SEQUENCE 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 $‡" [apply sort* cl-seq cl-pred cl-keys] 5 "\ 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 'merge #[(cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) "<„\nÁÂ\" <„Á Â\"Ä >A@ ‰ƒC@È>„9É >A@„9ÊË@\"ˆAA‰„\") ƒ ƒ ƒ^ @!‚` @ƒm@!‚o@\"ƒ€ ‰A@ B ‚G‰A@ B ‚GÎ Ÿ¤ ¤\"*‡" [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 "\ 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 'member* #[(cl-item cl-list &rest cl-keys) "ƒðÁ>A@Ã>A@…Ã>A@‰…ÄÆ>A@È>A@ Ê>A@…@Ê>A@‰ …@Ä ‰ ƒj @Í>„`Î>A@„`ÏÐ @\"ˆ AA‰ „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 "\ 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-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply member* nil cl-list :if cl-pred cl-keys] 7 "\ Find the first item 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 "\ Find the first item not satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. Keywords supported: :key"]) (defalias (quote 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]) (defalias 'assoc* #[(cl-item cl-alist &rest cl-keys) "ƒÁ>A@Ã>A@…Ã>A@‰…ÄÆ>A@È>A@ Ê>A@…@Ê>A@‰ …@Ä ‰ ƒj @Í>„`Î>A@„`ÏÐ @\"ˆ AA‰ „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 "\ Find the first item whose car matches ITEM in LIST. Keywords supported: :test :test-not :key"]) (defalias 'assoc-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply assoc* nil cl-list :if cl-pred cl-keys] 7 "\ Find the first item whose car satisfies 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 "\ Find the first item whose car does not satisfy PREDICATE in LIST. Keywords supported: :key"]) (defalias 'rassoc* #[(cl-item cl-alist &rest cl-keys) "„ §ƒÂ>A@Ä>A@…\"Ä>A@‰…\"ÅÇ>A@É>A@\nË>A@…FË>A@‰\n…FÅ ‰ ƒp @Î>„fÏ>A@„fÐÑ @\"ˆ AA‰ „O)ƒþ@:ƒõ ƒž ƒ’@A!‚–@A\"?=‚ò\nƒÀ\nƒ´@A!‚¸@A!? =‚ò §ƒÝ ƒÕ@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 "\ Find the first item whose cdr matches ITEM in LIST. Keywords supported: :test :test-not :key"]) (defalias (quote rassoc) #[(item alist) "À \nÃÄ$‡" [rassoc* item alist :test equal] 5]) (defalias 'rassoc-if #[(cl-pred cl-list &rest cl-keys) "ÀÁÂ Ä &‡" [apply rassoc* nil cl-list :if cl-pred cl-keys] 7 "\ Find the first item whose cdr satisfies 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 "\ Find the first item whose cdr does not satisfy PREDICATE in LIST. Keywords supported: :key"]) (defalias 'union #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „ ‡ šƒ‡G GY„  ƒM\n„. @§ƒ9ÃÄ @\n$‚E @>„E @B ‰Aˆ‚ ‡" [cl-list1 cl-list2 cl-keys apply adjoin] 5 "\ 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 'nunion #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „ ‡Âà $‡" [cl-list1 cl-list2 apply union cl-keys] 5 "\ 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 'intersection #[(cl-list1 cl-list2 &rest cl-keys) "…… …… šƒ‡Â >A@ ‰ƒ9 @Æ>„1Ç >A@„1ÈÉ @\"ˆ AA‰„)Ê G GY„I  ƒ‚ „W @§ƒlÌÍ ƒd @!‚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 "\ 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 'nintersection #[(cl-list1 cl-list2 &rest cl-keys) "… …Âà $‡" [cl-list1 cl-list2 apply intersection cl-keys] 5 "\ 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 'set-difference #[(cl-list1 cl-list2 &rest cl-keys) "ƒ „\n‡Â >A@ ‰ƒ3 @Æ>„+Ç >A@„+ÈÉ @\"ˆ AA‰„)Ê ƒp „E@§ƒZÌÍ ƒR @!‚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 "\ 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 'nset-difference #[(cl-list1 cl-list2 &rest cl-keys) "ƒ „\n‡Âà $‡" [cl-list1 cl-list2 apply set-difference cl-keys] 5 "\ 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 'set-exclusive-or #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „ ‡ šƒ‡ÃÄÅ $ÄÅ $\"‡" [cl-list1 cl-list2 nil append apply set-difference cl-keys] 7 "\ 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 'nset-exclusive-or #[(cl-list1 cl-list2 &rest cl-keys) "„ ‡ „ ‡ šƒ‡ÃÄ $ÃÄ  $¤‡" [cl-list1 cl-list2 nil apply nset-difference cl-keys] 6 "\ 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 'subsetp #[(cl-list1 cl-list2 &rest cl-keys) "„Á‡\n„ Ç\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 "\ 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 'subst-if #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC Å&‡" [apply sublis nil cl-new cl-tree :if cl-pred cl-keys] 7 "\ 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-not #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC Å&‡" [apply sublis nil cl-new cl-tree :if-not cl-pred cl-keys] 7 "\ 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 'nsubst #[(cl-new cl-old cl-tree &rest cl-keys) "ÀÁ\n BC $‡" [apply nsublis cl-old cl-new cl-tree cl-keys] 5 "\ 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-if #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC Å&‡" [apply nsublis nil cl-new cl-tree :if cl-pred cl-keys] 7 "\ 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-not #[(cl-new cl-pred cl-tree &rest cl-keys) "ÀÁ BC Å&‡" [apply nsublis nil cl-new cl-tree :if-not cl-pred cl-keys] 7 "\ 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 'sublis #[(cl-alist cl-tree &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä ‰ ƒf @Í>„\\Î >A@„\\ÏÐ @\"ˆ AA‰ „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 "\ 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 (quote cl-sublis-rec) #[(cl-tree) "ƒ\n !‚ \n ƒQ ƒ# @@ \"?=‚Gƒ3 !?=‚G @@§ƒB @@ š‚G @@ =„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]) (defalias 'nsublis #[(cl-alist cl-tree &rest cl-keys) "À >A@à >A@…à >A@‰…ÄÆ >A@È >A@ Ê >A@…<Ê >A@‰ …<Ä ‰ ƒf @Í>„\\Î >A@„\\ÏÐ @\"ˆ AA‰ „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 "\ 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 (quote cl-nsublis-rec) #[(cl-tree) ":…Ù ƒ @!‚@\n ƒX ƒ* @@ \"?=‚Nƒ: !?=‚N @@§ƒI @@ š‚N @@ =„X A‰„ ƒe @A ˆ‚p@:ƒpÉ@!ˆ ƒ{ A!‚}A\n‰ƒÃ ƒ• @@ \"?=‚¹ƒ¥ !?=‚¹ @@§ƒ´ @@ š‚¹ @@ =„à 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]) (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 "\ 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"]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias cl-tree-equal-rec #[(cl-x cl-y) ":ƒ :ƒÂ@ @\"ƒA A‚:?…† :?…† ƒH ƒ7 !‚8 ƒB !‚C \"? =‡ ƒR !‚S§ƒo ƒa !‚b ƒl !‚m š‡ ƒy !‚z ƒ„ !‚… =‡" [cl-x cl-y cl-tree-equal-rec cl-test cl-key cl-test-not] 4] run-hooks cl-seq-load-hook] 3) emacs-19.22/lisp/cl.elc100666 13437 1 41152 5426661402 13325 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 1 02:30:26 1993 ;;; from file /home/fsf/rms/e19/lisp/cl.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„(ÂÃ!ƒÃJ„ Å™ƒÆ‚'ÇÈ \"ƒ&É‚'ÊÂË!„2ËÌMˆÀÍ!„;Î ÀÏ!„DÎÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßÀ‡" [boundp cl-emacs-type fboundp epoch::version emacs-version "19" 18 string-match "Lucid" lucid 19 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) (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.") (defalias 'eql #[(a b) "§ƒ  š‡ =‡" [a b] 2 "\ 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 'incf '(macro . #[(place &optional x) "9ƒÁ\nƒÃ\nE‚ÄDE‡ÅÃ\n†ÆF‡" [place setq x + 1+ callf 1] 5 "\ (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 'decf '(macro . #[(place &optional x) "9ƒÁ\nƒÃ\nE‚ÄDE‡ÅÃ\n†ÆF‡" [place setq x - 1- callf 1] 5 "\ (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 'pop '(macro . #[(place) "9ƒÁÂÃÄDEED‡Å!‡" [place car prog1 setq cdr cl-do-pop] 7 "\ (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 'push '(macro . #[(x place) "9ƒ Á EE‡Ä F‡" [place setq cons x callf2] 5 "\ (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 'pushnew '(macro . #[(x place &rest keys) "9ƒÁÂà  $E‡ÂÆà  %‡" [place setq list* adjoin x keys callf2] 7 "\ (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"])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias cl-set-elt #[(seq n val) "<ƒ ›\n ‡ \nI‡" [seq n val] 3] cl-set-nthcdr #[(n list x) "ÁXƒ\n‡S ›\n¡ˆ ‡" [n 0 x list] 2] cl-set-buffer-substring #[(start end val) "Š |ˆbˆ\ncˆ\n)‡" [start end val] 2] cl-set-substring #[(str start end val) "ƒÁWƒ\nG\\‚\nG ÁWƒ \n\\ ÁV…)\nÁ O \nGW…5\nÅOQ‡" [end 0 str start val nil] 5]] 3) (defalias 'when '(macro . #[(cond &rest body) "À  BE‡" [if cond progn body] 4 "\ (when COND BODY...): if COND yields non-nil, do BODY, else return nil."])) (defalias 'unless '(macro . #[(cond &rest body) "À  BBB‡" [if cond nil body] 4 "\ (unless COND BODY...): if COND yields nil, do BODY, else return nil."])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÄ\"ˆÀÊÄ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÏÐ!„1ÑÏÒ!„@ÓKÀÓÔ\"ˆÀÔÕ\"ˆÏÖ!„NÑÀÖ×\"ˆÏØ!„\\ÑÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÏß!„zàÝ á\"â_ч" [defalias cl-map-extents #[(&rest cl-args) "ÀÁ!ƒ Âà \"‡ÀÅ!…ÂÅ \"‡" [fboundp next-overlay-at apply cl-map-overlays cl-args map-extents] 3] 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 cl-old-macroexpand macroexpand cl-macroexpand #[(cl-macro &optional cl-env) "\n \"‰9ƒ Ä !žAƒ ÅÄ !ž!‚ )‡" [cl-env cl-macro-environment cl-old-macroexpand cl-macro symbol-name cadr] 4] cl-compiling-file #[nil "†ÁÂ!…ÃÂJ!…ÄÂJ!Åš‡" [cl-compiling-file boundp outbuffer bufferp buffer-name " *Compiler Output*"] 2] cl-proclaims-deferred proclaim #[(spec) "ÀÁ!ƒÁ\nÃ\"ˆ‚\n BŇ" [fboundp cl-do-proclaim spec t cl-proclaims-deferred nil] 3] 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]) cl-random-time #[nil "ÀÁ !‰GÄ S‰ÄYƒ Æ_\n H\\‚\n +‡" [copy-sequence current-time-string time i 0 v 3] 4] *gensym-counter* logand 1023 100] 4) (defalias 'floatp-safe #[(x) "§…¨?‡" [x] 1 "\ T if OBJECT is a floating point number. On Emacs versions that lack floating-point support, this function always returns nil."]) (defalias 'plusp #[(x) "ÁV‡" [x 0] 2 "\ T if NUMBER is positive."]) (defalias 'minusp #[(x) "ÁW‡" [x 0] 2 "\ T if NUMBER is negative."]) (defalias 'oddp #[(x) "À Â\"Â=‡" [logand x 1] 3 "\ T if INTEGER is odd."]) (defalias 'evenp #[(x) "À Â\"Ã=‡" [logand x 1 0] 3 "\ T if INTEGER is even."]) (defalias 'cl-abs #[(x) "ÁYƒ‡[‡" [x 0] 2 "\ Return the absolute value of ARG."]) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÄÅ!„ÆÇÈÉÊ $ËÌ! ËÎ!ÐÐÐÐÐÐÐÐÂÙÚ\"‡" [fboundp abs defalias cl-abs boundp *random-state* vector cl-random-state-tag -1 30 cl-random-time 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) (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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias first car rest cdr endp null] 3) (defalias 'second #[(x) "A@‡" [x] 1 "\ Return the second element of the list LIST."]) (defalias 'third #[(x) "AA@‡" [x] 1 "\ Return the third element of the list LIST."]) (defalias 'fourth #[(x) "À 8‡" [3 x] 2 "\ Return the fourth element of the list LIST."]) (defalias 'fifth #[(x) "À 8‡" [4 x] 2 "\ Return the fifth element of the list LIST."]) (defalias 'sixth #[(x) "À 8‡" [5 x] 2 "\ Return the sixth element of the list LIST."]) (defalias 'seventh #[(x) "À 8‡" [6 x] 2 "\ Return the seventh element of the list LIST."]) (defalias 'eighth #[(x) "À 8‡" [7 x] 2 "\ Return the eighth element of the list LIST."]) (defalias 'ninth #[(x) "À 8‡" [8 x] 2 "\ Return the ninth element of the list LIST."]) (defalias 'tenth #[(x) "À 8‡" [9 x] 2 "\ Return the tenth element of the list LIST."]) (defalias 'caar #[(x) "@@‡" [x] 1 "\ Return the `car' of the `car' of X."]) (defalias 'cadr #[(x) "A@‡" [x] 1 "\ Return the `car' of the `cdr' of X."]) (defalias 'cdar #[(x) "@A‡" [x] 1 "\ Return the `cdr' of the `car' of X."]) (defalias 'cddr #[(x) "AA‡" [x] 1 "\ Return the `cdr' of the `cdr' of X."]) (defalias 'caaar #[(x) "@@@‡" [x] 1 "\ Return the `car' of the `car' of the `car' of X."]) (defalias 'caadr #[(x) "A@@‡" [x] 1 "\ Return the `car' of the `car' of the `cdr' of X."]) (defalias 'cadar #[(x) "@A@‡" [x] 1 "\ Return the `car' of the `cdr' of the `car' of X."]) (defalias 'caddr #[(x) "AA@‡" [x] 1 "\ Return the `car' of the `cdr' of the `cdr' of X."]) (defalias 'cdaar #[(x) "@@A‡" [x] 1 "\ Return the `cdr' of the `car' of the `car' of X."]) (defalias 'cdadr #[(x) "A@A‡" [x] 1 "\ Return the `cdr' of the `car' of the `cdr' of X."]) (defalias 'cddar #[(x) "@AA‡" [x] 1 "\ Return the `cdr' of the `cdr' of the `car' of X."]) (defalias 'cdddr #[(x) "AAA‡" [x] 1 "\ Return the `cdr' of the `cdr' of the `cdr' of X."]) (defalias 'caaaar #[(x) "@@@@‡" [x] 1 "\ Return the `car' of the `car' of the `car' of the `car' of X."]) (defalias 'caaadr #[(x) "A@@@‡" [x] 1 "\ Return the `car' of the `car' of the `car' of the `cdr' of X."]) (defalias 'caadar #[(x) "@A@@‡" [x] 1 "\ Return the `car' of the `car' of the `cdr' of the `car' of X."]) (defalias 'caaddr #[(x) "AA@@‡" [x] 1 "\ Return the `car' of the `car' of the `cdr' of the `cdr' of X."]) (defalias 'cadaar #[(x) "@@A@‡" [x] 1 "\ Return the `car' of the `cdr' of the `car' of the `car' of X."]) (defalias 'cadadr #[(x) "A@A@‡" [x] 1 "\ Return the `car' of the `cdr' of the `car' of the `cdr' of X."]) (defalias 'caddar #[(x) "@AA@‡" [x] 1 "\ Return the `car' of the `cdr' of the `cdr' of the `car' of X."]) (defalias 'cadddr #[(x) "AAA@‡" [x] 1 "\ Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."]) (defalias 'cdaaar #[(x) "@@@A‡" [x] 1 "\ Return the `cdr' of the `car' of the `car' of the `car' of X."]) (defalias 'cdaadr #[(x) "A@@A‡" [x] 1 "\ Return the `cdr' of the `car' of the `car' of the `cdr' of X."]) (defalias 'cdadar #[(x) "@A@A‡" [x] 1 "\ Return the `cdr' of the `car' of the `cdr' of the `car' of X."]) (defalias 'cdaddr #[(x) "AA@A‡" [x] 1 "\ Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."]) (defalias 'cddaar #[(x) "@@AA‡" [x] 1 "\ Return the `cdr' of the `cdr' of the `car' of the `car' of X."]) (defalias 'cddadr #[(x) "A@AA‡" [x] 1 "\ Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."]) (defalias 'cdddar #[(x) "@AAA‡" [x] 1 "\ Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."]) (defalias 'cddddr #[(x) "AAAA‡" [x] 1 "\ Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."]) (defalias 'last #[(x &optional n) "ƒ3Á\n :ƒ T ‰Aˆ‚ÁXƒ\" ‚1 Wƒ0 Z\n›‚1\n*‡\nA:ƒA\n‰Aˆ‚3\n‡" [n 0 x p m] 2 "\ Returns the last link in the list LIST. With optional argument N, returns Nth-to-last link (default 1)."]) (defalias 'butlast #[(x &optional n) "ƒ ÁXƒ \n‡ÃÄ\n!\"‡" [n 0 x nbutlast copy-sequence] 3 "\ Returns a copy of LIST with the last N elements removed."]) (defalias 'nbutlast #[(x &optional n) "G\n„ Ã\n W…\nÄVƒ S\nZ›Å¡ˆ)‡" [x m n 1 0 nil] 2 "\ Modifies LIST to remove the last N elements."]) (defalias 'list* #[(arg &rest rest) "„ ‡A„ @B‡GÃ!\nÅZ ›‰‰A@¡ˆ +B‡" [rest arg n copy-sequence copy 2 last] 3 "\ 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 'ldiff #[(list sublist) "À\n:ƒ\n =„\n‰A@ B‚ Ÿ)‡" [nil res list sublist] 2 "\ Return a copy of LIST with the tail SUBLIST removed."]) (defalias 'copy-list #[(list) ":ƒÁ:ƒ‰A@\nB‚\nŸ\n¡ˆ)‡@‡" [list nil res] 3 "\ 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."]) (byte-code "ÀÁÂ\"ˆÃÄ!ƒÅÄK!„ÀÄÁ\"ˆÀÆÇ\"ˆÀÈÉ\"ˆÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"ˆÀÐÑ\"‡" [defalias cl-maclisp-member #[(item list) "ƒ @š„A‰„‡" [list item] 3] fboundp member subrp cl-member memq cl-floor floor* cl-ceiling ceiling* cl-truncate truncate* cl-round round* cl-mod mod*] 3) (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 "\ 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 'subst #[(cl-new cl-old cl-tree &rest cl-keys) "„ §ƒ ¨„Âà BC $‡Æ #‡" [cl-keys cl-old apply sublis cl-new cl-tree cl-do-subst] 5 "\ 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"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÈÉÊ#ˆÇÈËÌ#‡" [defalias cl-do-subst #[(cl-new cl-old cl-tree) " =ƒ\n‡:ƒ2Ã\n @#Ã\n A#‰@=ƒ- A=ƒ-‚0 B*‡‡" [cl-tree cl-old cl-new cl-do-subst d a] 6] acons #[(a b c) " B\nB‡" [a b c] 2] pairlis #[(a b &optional c) "ÀÁ\n # ¤‡" [mapcar* cons a b c] 4] put cl-assertion-failed error-conditions (error) error-message "Assertion failed"] 4) (defalias 'cl-add-hook #[(hook func &optional append) "À !… J‰<ƒ\n@Ã=„\nC \n?…/ ƒ+\n C¤‚. \nBL)‡" [boundp hook old lambda func append] 4 "\ Add to hook variable HOOK the function FUNC. FUNC is not added if it already appears on the list stored in HOOK."]) (byte-code "ÀÁ!„ ÂÁÃ\"ˆÄÅÆ\"ˆÄÇÈ\"ˆÉÊ!ˆËÌ!„\"Í ÂÎÏ\"ˆÎ ˆÁÐÎ\"ˆÉÑ!ˆÉÒ!ˆÓÔ!‡" [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 cl-hack-byte-compiler #[nil "?…ÁÂ!…à ˆÄ‰‡" [cl-hacked-flag fboundp byte-compile-file-form cl-compile-time-init t] 2] emacs-lisp-mode-hook cl mini-cl run-hooks cl-load-hook] 3) emacs-19.22/lisp/cmacexp.elc100666 74777 1 12404 5416162071 14361 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:32:25 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cmacexp.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar c-macro-shrink-window-p nil "\ *Non-nil means shrink the *Macroexpansion* window to fit its contents.") (defvar c-macro-always-prompt-p nil "\ *Non-nil means always 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-default-cppflags "" "\ Default cpp flags used by c-macro-expand.") (byte-code "À‡" ["*Macroexpansion*" c-macro-buffer-name nil] 1) (defalias 'c-macro-expand #[(start end &optional flag) "…Áš?p\nƒÄ !‚Æ !È \n„(Ëšƒ/ÌÍ\"\nƒSƒS =„SÐÑ!ˆÒÓ!ˆÔ„SÆ !tƒ\\ÐÕ !ˆÖÚQ# ÐÕ ÛP!ˆ\nƒ`U|ˆ cˆ…ŒÝ )‚ÀqˆÔÞ!ˆß ˆ cˆàÔ!ˆ ȘƒµÐá!ˆ‚¹â !ˆãä!,‡" [flag (16) subst inbuf get-buffer c-macro-buffer-name get-buffer-create displaybuf "" expansion c-macro-always-prompt-p (16) read-string "Preprocessor arguments: " c-macro-default-cppflags buffer-read-only message "Buffer is read only: displaying expansion in alternate window" sit-for 2 nil c-macro-default-message c-macro-expansion start end c-macro-preprocessor " " "done" exchange exchange-point-and-mark buffer-flush-undo erase-buffer set-buffer-modified-p "Null expansion" c-macro-display-buffer t bury-buffer] 6 "\ Expand all C macros occurring in the region using c-macro-preprocessor. Normally display output in temp buffer. Prefix arg means replace the region with it. Prompt for a string of arguments to the preprocessor, (e.g. -DDEBUG -I ./include) when prefixed with two C-u's. It is intended for interactive use only. For non interactive use, see the c-macro-expansion function." "r\nP"]) (defalias (quote c-macro-display-buffer) #[(retbuf) "ebˆÀ ˆÁÂ!ˆÃ Äp!ÅÆÇ! \n \n„-ÌpÍ\"ˆ à U? ƒ6ÎÏ!ˆ…ƒ\n„E …ƒÑ Ò‰ŠÖÄp!!ˆ\nƒ`à ‚bØ Ù¥ÚÛÜ!Ù\\]^à Z!ˆebˆÖ!,,‡" [c-mode require view window-height get-buffer-window nil boundp view-kill-when-finished niceview popped alreadythere oldwinheight display-buffer t view-mode 1 c-macro-shrink-window-p selected-window 0 maxheight minheight oldwin select-window window-min-height screen-height 2 enlarge-window vertical-motion 1000000] 5]) (defalias 'c-macro-expansion #[(start end cppcommand) "pÀÁ!\nƒÃÄ !\n\"ƒ\nÆ•ÇO‚È ÆÇ \n   ÎŽŠŒ~ˆ qˆÇÐ ˆÑ!ˆÓ Ô#ˆ)Öcˆ×ØÚ#ƒ„ÛÜÔ`\"›ÝšƒHÆ•bˆÞÔ`\"\nßà\n # B‰ @cˆáÇxˆâcˆÆ”bˆ‚HÞÔ`\"nƒÔ‚‘Æ\\\nÜÔ\"#Û#8$å#8&ç#8‰(…²Ö$ƒ»é‚Á&…Áêßà\n #$ƒÑé‚×&…×ë(…Ýì°, B‰ @cˆáÇxˆâcˆíÔdîï‰Çð1òP&ˆó ! ô @Çï#ƒõö!ˆ A‰ „``dÔZ]{.‡" [get-buffer-create " *C Macro Expansion*" buffer-file-name string-match regexp-quote default-directory 0 nil buffer-name linelist linenum filename outbuf inbuf ((kill-buffer outbuf)) buffer-read-only erase-buffer set-syntax-table c-mode-syntax-table insert-buffer-substring 1 end " " re-search-backward "\n#\\(endif\\|else\\)\\>" start move 3 parse-partial-sexp (nil nil nil 0) count-lines format "\n# %d \"%s\"\n" "^#" "line" startstat startinstring 4 startincomment 5 startafterquote "\"" "*/" "/*" "\\" call-process-region "sh" t "-c" cppcommand " 2>/dev/null" reverse search-backward replace-match ""] 11 "\ Expands 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. Returns the output as a string."]) (defalias 'c-macro-eval #[(start end &optional flag) "ÀÁ!„\nÂÃ!ˆ „ ÆšƒÇÈ \" tƒ$ÊË !ˆÌ Ð Q#ÑÒ!ÕŽŠqˆÖØ ˆcˆtƒPÊÙ!ˆÚÁÜ ÝÞE!)Ø ˆ ƒÂÁÝÞßà¯!áâÁÝÞã#[ßà¯!äâÁÝÞåæßà¯!籈ŠâÁÝÞåæßà¯!±ˆ)èéÖÚ#ƒÆê”ê•{똃»ìí!ˆ‚¢ìî!ˆ‚¢cˆtƒÖïêd\"ˆÊÜ !‚ØÜ ,‡" [fboundp calc-eval require calc c-macro-always-prompt-p flag (16) read-string "Preprocessor arguments: " c-macro-default-cppflags message c-macro-default-message c-macro-expansion start end c-macro-preprocessor " " get-buffer-create " *Macro Evaluation*" evalbuf evaluation ((kill-buffer evalbuf)) nil buffer-read-only erase-buffer "Invoking calc..." t calc-eval-error buffer-string calc-language c calc-simplify-mode binary "(u)" " == " calc-word-size "(d)" calc-number-radix 16 "(x)" re-search-forward "0x\\([^,]+\\)\\(, \\|\\'\\)" 1 "0" replace-match "FALSE\\2" "TRUE\\2" copy-region-as-kill] 14 "\ Expand region using cpp and evaluate it using calc. Interactively print value in minibuffer and push it on the kill ring. With a C-u argument shows the evaluation in a variety of formats. With two C-u's prompts the user for a string of flags to the preprocessor. Non interactively returns value of region between START and END as a string. Several formats are used if optional FLAG is non-nil." "r\nP"]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias c-macro-default-message #[nil "ÀÁ\n Ęƒ Ä‚Å $‡" [format "Invoking %s%s%s on region..." c-macro-preprocessor c-macro-default-cppflags "" " "] 5] provide cmacexp] 3) emacs-19.22/lisp/cmuscheme.elc100666 74777 1 25174 5416162104 14717 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:32:36 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cmuscheme.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require scheme comint] 2) (defvar inferior-scheme-mode-hook nil "\ *Hook for customising inferior-scheme mode.") (byte-code "ÀÁ!„ „,à !Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÎ !ˆÅÆÇ#ˆÅÈÉ#ˆÅÐÇ#ˆÅÑÒ#ˆÅÓÔ#ˆÅÕÖ#ˆÅ×Ø#ˆÅÙÚ#ˆÅÛÜ#ˆÅÊË#ˆÅÌÍ#‡" [boundp inferior-scheme-mode-map nil full-copy-sparse-keymap comint-mode-map define-key "˜" scheme-send-definition "" scheme-send-last-sexp " " 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] 4) (defalias 'inferior-scheme-mode #[nil "À ˆÁà ˆÄÆÈ Ê !ˆÌ ÎÐÒÓ!‡" [comint-mode "^[^>]*>+ *" 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 ignore comint-input-sentinel scheme-get-old-input comint-get-old-input run-hooks inferior-scheme-mode-hook] 2 "\ 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." nil]) (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.") (defalias 'scheme-input-filter #[(str) "À \n\"?‡" [string-match inferior-scheme-filter-regexp str] 3 "\ Don't save anything matching inferior-scheme-filter-regexp"]) (defalias 'scheme-get-old-input #[nil "Š`Á ˆ`{*‡" [end backward-sexp] 2 "\ Snarf the sexp ending at point"]) (defalias (quote scheme-args-to-list) #[(string) "ÀÁ\n\"‰„\nC‚: ÄU„%\nÄ OÅ\n Æ\\\nGO!B‚:ÀÇ\n\"‰??…9Å\n\nGO!))‡" [string-match "[ ]" string where 0 scheme-args-to-list 1 "[^ ]" pos] 6]) (defvar scheme-program-name "scheme" "\ *Program invoked by the run-scheme command") (defalias 'scheme #[(&rest foo) "ÀÁ!ˆÂ ‡" [message "Use run-scheme" ding] 2 "\ Use run-scheme" nil]) (defalias 'run-scheme #[(cmd) "ÀÁ!„ !ÅÆÇ @È A%qˆÉ ˆ)Á\nËÁ!‡" [comint-check-proc "*scheme*" scheme-args-to-list cmd cmdlist apply make-comint "scheme" nil inferior-scheme-mode scheme-buffer switch-to-buffer] 6 "\ Run an inferior Scheme process, input and output via buffer *scheme*. If there is a process already running in *scheme*, just switch to that buffer. With argument, allows you to edit the command line (default is value of scheme-program-name). Runs the hooks from inferior-scheme-mode-hook (after the comint-mode-hook is run). (Type \\[describe-mode] in the process buffer for a list of commands.)" (list (if current-prefix-arg (read-string "Run Scheme: " scheme-program-name) scheme-program-name))]) (defalias 'scheme-send-region #[(start end) "ÀÁ \n #ˆÄÁ Å\"‡" [comint-send-region scheme-proc start end comint-send-string "\n"] 4 "\ Send the current region to the inferior Scheme process." "r"]) (defalias 'scheme-send-definition #[nil "ŠÀ ˆ` ˆÃ` \"*‡" [end-of-defun end beginning-of-defun scheme-send-region] 3 "\ Send the current definition to the inferior Scheme process." nil]) (defalias 'scheme-send-last-sexp #[nil "ÀŠÁ ˆ`)`\"‡" [scheme-send-region backward-sexp] 3 "\ Send the previous sexp to the inferior Scheme process." nil]) (defvar scheme-compile-exp-command "(compile '%s)" "\ *Template for issuing commands to compile arbitrary Scheme expressions.") (defalias 'scheme-compile-region #[(start end) "ÀÁ  ÂÄ {\"\"\"ˆÀÁ Ç\"‡" [comint-send-string scheme-proc format scheme-compile-exp-command "(begin %s)" start end "\n"] 8 "\ Compile the current region in the inferior Scheme process. (A BEGIN is wrapped around the region: (BEGIN ))" "r"]) (defalias 'scheme-compile-definition #[nil "ŠÀ ˆ` ˆÃ` \"*‡" [end-of-defun end beginning-of-defun scheme-compile-region] 3 "\ Compile the current definition in the inferior Scheme process." nil]) (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 "\ Switch to the scheme process buffer. With argument, positions cursor at end of buffer." "P"]) (defalias 'scheme-send-region-and-go #[(start end) "À \n\"ˆÃÄ!‡" [scheme-send-region start end switch-to-scheme t] 3 "\ Send the current region to the inferior Scheme process. Then switch to the process buffer." "r"]) (defalias 'scheme-send-definition-and-go #[nil "À ˆÁÂ!‡" [scheme-send-definition switch-to-scheme t] 2 "\ Send the current definition to the inferior Scheme. Then switch to the process buffer." nil]) (defalias 'scheme-compile-definition-and-go #[nil "À ˆÁÂ!‡" [scheme-compile-definition switch-to-scheme t] 2 "\ Compile the current definition in the inferior Scheme. Then switch to the process buffer." nil]) (defalias 'scheme-compile-region-and-go #[(start end) "À \n\"ˆÃÄ!‡" [scheme-compile-region start end switch-to-scheme t] 3 "\ Compile the current region in the inferior Scheme. Then switch to the process buffer." "r"]) (defvar scheme-source-modes (quote (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.") (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 "\ Load a Scheme file into the inferior Scheme process." (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file scheme-source-modes t)]) (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 "\ Compile a Scheme file in the inferior Scheme process." (comint-get-source "Compile Scheme file: " scheme-prev-l/c-dir/file scheme-source-modes nil)]) (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.") (defalias 'scheme-proc #[nil "À Â=ƒ p‚ !‰†ÅÆ!)‡" [get-buffer-process major-mode inferior-scheme-mode scheme-buffer proc error "No current process. See variable scheme-buffer"] 4 "\ Returns the current scheme process. See variable scheme-buffer."]) (defvar cmuscheme-load-hook nil "\ This hook is run when cmuscheme is loaded in. This is a good place to put keybindings.") (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks cmuscheme-load-hook provide cmuscheme] 2) emacs-19.22/lisp/comint.elc100666 12062 1 137633 5475264477 14103 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:26:06 1993 ;;; from file /home/fsf/rms/e19/lisp/comint.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote ring)) (defvar comint-prompt-regexp "^" "\ Regexp to recognise prompts in the inferior process. Defaults to \"^\", the null string at BOL. Good choices: Canonical Lisp: \"^[^> ]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp) Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" kcl: \"^>+ *\" shell: \"^[^#$%>]*[#$%>] *\" T: \"^>+ *\" This is a good thing to set in mode hooks.") (defvar comint-delimiter-argument-list nil "\ 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. Good choices: shell: (\"|\" \"&\" \"<\" \">\" \"(\" \")\" \";\") This is a good thing to set in mode hooks.") (defvar comint-input-autoexpand (quote 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 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-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-get-old-input (quote 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-after-partial-filename-command (quote comint-after-partial-filename) "\ Function that returns non-nil if point is after a file name. By default this is `comint-after-partial-filename'. This is a good thing to set in mode hooks.") (defvar comint-dynamic-complete-filename-command (quote comint-dynamic-complete-filename) "\ Function that dynamically completes the file name at point. By default this is `comint-dynamic-complete-filename', though an alternative is `comint-replace-by-expanded-filename'. This is a good thing to set in mode hooks.") (defvar comint-dynamic-complete-command-command (quote comint-dynamic-complete-filename) "\ Function that dynamically completes the command at point. By default this is `comint-dynamic-complete-filename'. This is a good thing to set in mode hooks.") (defvar comint-get-current-command (quote comint-get-old-input-default) "\ Function that returns the current command including arguments. By default this is `comint-get-old-input-default', meaning the whole line. This is a good thing to set in mode hooks.") (defvar comint-input-sentinel (quote ignore) "\ Called on each input submitted to comint mode process by `comint-send-input'. Thus it can, for instance, track cd/pushd/popd commands issued to a shell.") (defvar comint-input-filter #[(str) "ÀÁ\n\"?‡" [string-match "\\`\\s *\\'" str] 3] "\ 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-output-filter-functions (quote (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 (quote 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 nil "\ Called upon entry into comint-mode This is run before the process is cranked up.") (defvar comint-exec-hook nil "\ 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.") (byte-code "ÀÁ!„‡" [boundp comint-mode-map nil] 2) (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.") (byte-code "ÀÁ!„‡" [boundp comint-input-ring nil] 2) (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.") (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÀÉÂÃ#ˆÀÊÂÃ#‡" [put comint-input-ring permanent-local t comint-input-ring-index comint-input-autoexpand comint-output-filter-functions comint-scroll-to-bottom-on-input comint-scroll-to-bottom-on-output comint-scroll-show-maximum-output comint-ptyp] 4) (defalias 'comint-mode #[nil "À ˆÁÃÅÇ!ˆÉÊ!ˆË \nÉÌ!ˆË  ÉÍ!ˆË  ÉÎ!ˆÉÏ!ˆÉÐ!ˆÉÑ!ˆÒÐ!ƒB„HÓ!ÉÔ!ˆÒÔ!ƒW„ZÕÉÖ!ˆÉ×!ˆÉØ!ˆÉÙ!ˆÉÚ!ˆÉÛ!ˆÉÜ!ˆÉÝ!ˆÉÞ!ˆÉß!ˆÉà!ˆÉá!ˆÉâ!ˆÉã!ˆÉä!ˆÉå!ˆÉæ!ˆçæè\"ˆÉé!ˆÉê!ˆÉë!ˆÉì!ˆíî!‡" [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 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 nil comint-matching-input-from-input-string comint-input-autoexpand comint-input-ignoredups comint-delimiter-argument-list comint-after-partial-filename-command comint-dynamic-complete-filename-command comint-dynamic-complete-command-command comint-get-current-command comint-get-old-input comint-input-sentinel 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 run-hooks comint-mode-hook] 3 "\ 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-sentinel', `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-list-dynamic-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'." nil]) (byte-code "„ÂÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáâ#ˆÂãä#ˆÂåæ#ˆÂçè#ˆÂéê#ˆÂëì#ˆÂíî#ˆÂïðÁð!B#ˆÂñò#ˆÂóô#ˆÂõö#ˆÂ÷ø#ˆÂùú#ˆÂûü#ˆÂýþÁþ!B#ˆÂÿ@#ˆÂAB#ˆÂCD#ˆÂEF#ˆÂGH#ˆÂIJ#ˆÂKL#ˆÂMN#ˆÂOP#ˆÂQR#ˆÂST#ˆÂUV#ˆÂWX#ˆÂYZ#ˆÂ[\\#ˆÂ]^#ˆÂ_`#ˆÂabÁb!B#ˆÂcd#ˆÂef#ˆÂgh#ˆÂij#ˆÂkl#ˆÂmn#ˆopq\"qÁ‡" [comint-mode-map make-sparse-keymap define-key "p" comint-previous-input "n" comint-next-input "r" comint-previous-matching-input "s" comint-next-matching-input [-8126350] comint-previous-matching-input-from-input [-8126349] comint-next-matching-input-from-input " " 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-output "" comint-show-maximum-output "" 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-variable] ("Complete Variable Name" . comint-dynamic-complete-variable) [menu-bar completion complete-command] ("Complete Command Name" lambda nil (interactive) (funcall comint-dynamic-complete-command-command)) [menu-bar completion complete-file] ("Complete File Name" . comint-dynamic-complete-filename) [menu-bar completion complete] ("Complete Before Point" . comint-dynamic-complete) [menu-bar input] "In/Out" [menu-bar input kill-output] ("Kill Current Output Group" . comint-kill-output) [menu-bar input next-prompt] ("Forward Output Group" . comint-next-prompt) [menu-bar input previous-prompt] ("Backward Output Group" . comint-previous-prompt) [menu-bar input show-maximum-output] ("Show Maximum Output" . comint-show-maximum-output) [menu-bar input show-output] ("Show Current Output Group" . comint-show-output) [menu-bar input kill-input] ("Kill Current Input" . comint-kill-input) [menu-bar input copy-input] ("Copy Old Input" . comint-copy-old-input) [menu-bar input forward-matching-history] ("Forward Matching Input..." . comint-forward-matching-input) [menu-bar input backward-matching-history] ("Backward Matching Input..." . comint-backward-matching-input) [menu-bar input next-matching-history] ("Next Matching Input..." . comint-next-matching-input) [menu-bar input previous-matching-history] ("Previous Matching Input..." . comint-previous-matching-input) [menu-bar input next-matching-history-from-input] ("Next Matching Current Input" . comint-next-matching-input-from-input) [menu-bar input previous-matching-history-from-input] ("Previous Matching Current Input" . comint-previous-matching-input-from-input) [menu-bar input next-history] ("Next Input" . comint-next-input) [menu-bar input previous-history] ("Previous Input" . comint-previous-input) [menu-bar input list-history] ("List Input History" . comint-dynamic-list-input-ring) [menu-bar input 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 input output signals) menu-bar-final-items] 6) (defalias 'full-copy-sparse-keymap #[(km) ":ƒÁ@!ÁA!B‡‡" [km full-copy-sparse-keymap] 3 "\ Recursively copy the sparse keymap KM."]) (defalias 'comint-check-proc #[(buffer) "À !‰… Ã\n!Ä>)‡" [get-buffer-process buffer proc process-status (run stop)] 3 "\ Return t if there is a living process associated w/buffer BUFFER. Living means the status is `run' or `stop'. BUFFER can be either a buffer or the name of one."]) (defalias 'make-comint #[(name program &optional startfile &rest switches) "ÀÁ\nÁQ!Ä !„ Š qˆÅ ˆ)Æ \n %ˆ )‡" [get-buffer-create "*" name buffer comint-check-proc comint-mode comint-exec program startfile switches] 6 "\ Make a comint 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 'comint-exec #[(buffer name command startfile switches) "ŠqˆÁ!‰ƒÃ\n!ˆ)Ä $È\nÉ\"ˆÊË!ˆ  dbˆÍ\n!`ΓˆƒQÐÑ!ˆdbˆÒ!ˆ`d{`d|ˆÓ\n\"ˆÔÕ!ˆ*‡" [buffer get-buffer-process proc delete-process comint-exec-1 name command 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 "\ 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 (quote comint-exec-1) #[(name buffer command switches) "ÁÂÃÄÅ \"\"ˆÁÆÇ\"ˆÁÈÉ\"ˆÊË  %)‡" [process-environment setenv "TERMCAP" format "emacs:co#%d:tc=unknown" frame-width "TERM" "emacs" "EMACS" "t" apply start-process name buffer command switches] 6]) (defalias 'comint-read-input-ring #[nil "ƒ\nÁšƒ ‡Ã!„ÄÅ\"‡Æ!Ç! \nŠ\n†+Ë!qˆŠŒ~ˆebˆÌÍÂÎ#ƒeϔϕ{ƒZÒ !„ZÓ Ô\"˜„aÕ \"ˆ)‚4)\n„oÖÂ!ˆ* ‰*‡" [comint-input-ring-file-name "" nil file-readable-p message "Cannot read history file %s" get-file-buffer make-ring comint-input-ring-size ring history-buf find-file-noselect re-search-forward "^\\s *\\([^#].*\\)\\s *$" t 1 history comint-input-ignoredups ring-empty-p ring-ref 0 ring-insert kill-buffer comint-input-ring comint-input-ring-index] 4 "\ 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. Useful within mode or mode hooks. The structure of the history file should be one input command per line, and most recent command last. See also `comint-input-ignoredups' and `comint-write-input-ring'."]) (defalias 'comint-write-input-ring #[nil "ƒÁš„\nƒÃ\n!ƒćÅ!„!ÆÇ\"‡ÈÉ!\n\n  Í !Š\nqˆÏ ˆÐVƒSSÑ \"Ò±ˆ‚:ÓÔ Ä ÄÕ%ˆÖÄ!-‡" [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 "\ 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-dynamic-list-input-ring #[nil "À !ƒ  !ƒÃÄ!‡ÅÆÇ !SÈ  \n  \nÍYƒ:Î \n\" B \nS‰\n‚\" Ï !ˆ 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 "\ List in help buffer the buffer's input history." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias comint-regexp-arg #[(prompt) "À\nà À‰‰Å%‰ǘƒ ‰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] 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] comint-search-start #[(arg) "ƒÁ\nÃVƒÄ‚Å\\Æ!\"‡\nÃYƒ ÇÆ!S‡" [comint-input-ring-index mod arg 0 1 -1 ring-length comint-input-ring] 4]] 3) (defalias 'comint-previous-input-string #[(arg) "À \nƒà \n\\Å !\"‚ \"‡" [ring-ref comint-input-ring comint-input-ring-index mod arg ring-length] 6 "\ Return the string ARG places along the input ring. Moves relative to `comint-input-ring-index'."]) (defalias 'comint-previous-input #[(arg) "ÀÁ\n\"‡" [comint-previous-matching-input "." arg] 3 "\ Cycle backwards through input history." "*p"]) (defalias 'comint-next-input #[(arg) "À [!‡" [comint-previous-input arg] 2 "\ Cycle forwards through input history." "*p"]) (defalias 'comint-previous-matching-input-string #[(regexp arg) "À \n\"‰… Ä \")‡" [comint-previous-matching-input-string-position regexp arg pos ring-ref comint-input-ring] 4 "\ Return the string matching REGEXP ARG places along the input ring. Moves relative to `comint-input-ring-index'."]) (defalias 'comint-previous-matching-input-string-position #[(regexp arg &optional start) "À !ƒ  !ƒÃÄ!ˆÅ !È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 "\ 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 #[(regexp arg) "À ! \"‰„ÅÆ!‚* ÈÉ T\"ˆÊËp!!`|ˆÌ \"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 "\ 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." (comint-regexp-arg "Previous input matching (regexp): ")]) (defalias 'comint-next-matching-input #[(regexp arg) "À \n[\"‡" [comint-previous-matching-input regexp arg] 3 "\ 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." (comint-regexp-arg "Next input matching (regexp): ")]) (defalias 'comint-previous-matching-input-from-input #[(arg) "Á>„ÂÃp!!`{ÅÇÈÉ !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 "\ 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, find the next or Nth next match." "p"]) (defalias 'comint-next-matching-input-from-input #[(arg) "À [!‡" [comint-previous-matching-input-from-input arg] 2 "\ Search forwards 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, find the next or Nth next match." "p"]) (defalias 'comint-replace-by-expanded-history #[nil "ŠŠÀˆ`)`ZÁÀ!ˆ`ÄÅŠÀˆ` Z)Æ#…wÀÈ”bˆhÉU„3Ê\n`\"ƒ:È•bˆ‚ËÌ!ƒKÈ•bˆÍÎ!ˆ‚ËÏ!ƒÐєѕ{!S‰Ó!XƒÕÖ×!ؔؕ#Ɖ#ˆÍÙT\"ˆ‚‰È•bˆÍÚ!ˆ)‚ËÛ!„™ËÜ!ƒªÕÖ×È!єѕ#Ɖ#ˆ‚ËÝ!ƒ+єѕؔ Ø•! †Ç!†Î{\"ã $åŽËæ!*ƒâç‚ãè)ã *ëŽì)í\"!PÑ\"*‰.„\nÍï!ˆÈ•bˆð ˆ‚&.ÍÙ.T\"ˆÕÖñ.\"ò”ò•#Ɖ#ˆ.‚Ëó!ƒpєѕ{ؔؕ{À.45Õ×È!Ɖ#ˆ`.È”bˆö5.Æ#ƒeÕ4Ɖ#ˆ‚lÍï!ˆð ˆ+‚È•bˆ‚+‡" [nil comint-bol start toend re-search-forward "[!^]" t comint-input-ring-index 0 92 comint-within-quotes looking-at "![0-9]+\\($\\|[^-]\\)" 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 "History item: %d" "Relative reference exceeds input history size" "!!?:?\\([0-9^$*-]+\\)" "!!" "!\\??\\({\\(.+\\)}\\|\\(\\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 "Not found" ding ring-ref 4 "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?" new old search-forward] 6 "\ Expand input command history references before point. 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. See also `comint-magic-space'." nil]) (defalias 'comint-magic-space #[(arg) "À ˆÁ\n!‡" [comint-replace-by-expanded-history self-insert-command arg] 2 "\ Expand input history references before point and insert ARG spaces. A useful command to bind to SPC. See `comint-replace-by-expanded-history'." "p"]) (defalias 'comint-within-quotes #[(beg end) "ÀÁ\n #ÀÄ\n #ÇÈ\"ÉU†Ç È\"ÉU*‡" [comint-how-many-region "\\(^\\|[^\\\\]\\)'" beg end "\\(^\\|[^\\\\]\\)\"" countdq countsq mod 2 1] 5 "\ Return t if the number of quotes between BEG and END is odd. Quotes are single and double."]) (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 "\ Return number of matches for REGEXP from BEG to END."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] comint-delim-arg #[(arg) "ƒ Á \"ƒ C‡ÄÅÆÇÈ#\"ÉÆÊÉ#ËRÆÌÉ#ÍÎÁ #=„GÁ #=ƒYΕ ΔOB‚-,‡" [comint-delimiter-argument-list string-match "[\"'`]" arg format "\\([^%s]" mapconcat #[(d) "À !‡" [regexp-quote d] 2] "" "\\|" #[(d) "ÀÁ\n!P‡" ["\\\\" regexp-quote d] 3] "\\)+" #[(d) "À !ÂP‡" [regexp-quote d "+"] 2] nil 0 pos args delim-str not-delim] 6]] 3) (defalias 'comint-arguments #[(string nth mth) "ÀÁÂÁÇ #ƒ&•” OÉ ! ¤‚ \n†. GS ƒ< G ZS‚=  ÎÏ  ›Ÿ›Ð#.‡" ["\\(\\S \\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)\\)+" nil 0 str pos args arg string-match string comint-delim-arg nth mth m n mapconcat (lambda (a) a) " "] 5 "\ 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. Arguments are assumed to be delimited by whitespace. Strings comprising characters in the variable `comint-delimiter-argument-list' are treated as delimiters and arguments. Argument 0 is the command name."]) (defalias 'comint-send-input #[nil "Àp!‰„ÂÃ!‚òÄ !`Æ !Yƒ(ƒ\"Ȉ `{‚7 \n bˆ\ncˆ\n)  Í=„E ‚KÎ ˆ `{  Ï=„Y ‚lÎ ˆ `{\n `|ˆ cˆ\n)ƒz `|ˆ‚}Ñcˆ!ƒªƒ£Ô!ƒ£Ö!„£×Ø\"˜„ªÙ\"ˆ !ˆ  \"ˆÈ È“ˆ`È“ˆÄ !`È“ˆß !à=…ñ!‰\"…ð\"@ ãP!ˆ\"A‰\"„ÝÈ),)‡" [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 history comint-process-echoes 10 comint-input-filter comint-input-ignoredups ring-p comint-input-ring ring-empty-p ring-ref 0 ring-insert comint-input-sentinel comint-input-sender comint-input-ring-index comint-last-input-start comint-last-input-end process-filter comint-output-filter comint-output-filter-functions functions "\n"] 4 "\ 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 value of variable `comint-input-sentinel' 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. `comint-get-old-input', `comint-input-sentinel', 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-sentinel 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-sentinel 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." nil]) (defalias (quote comint-output-filter) #[(process string) "À !‰…ÌÃ\n!…Ìpĉ‰\nqˆ`edÄ GÄ\n  ~ˆÍ !bˆ`\n`XƒG \\`WƒU \\` Xƒ`  \\Î !ˆÏÐ !`UƒxÑÐ ` GZ\"ˆƒ”Ó!ƒ”`Uƒ”‰ ZÄ“ˆ\nÄ“ˆÍ !`Ä“ˆÕ ˆ+ }ˆbˆ‰ƒÇ@ !ˆA‰„·)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 comint-output-filter-functions functions] 5]) (defalias 'comint-preinput-scroll-to-bottom #[nil "…C Â>…Cà pÆ !…B`É!W…B…BÊ !?…BË=ƒ=db‚BÌÍÎÏ#,‡" [comint-scroll-to-bottom-on-input this-command (self-insert-command comint-magic-space yank mouse-yank-at-click hilit-yank) selected-window selected current get-buffer-process process scroll process-mark window-minibuffer-p this walk-windows #[(window) "À !\n=…, Ä=„! Å=„! Æ=…, =…,È !ˆdbˆÈ!‡" [window-buffer window current scroll t all this selected select-window] 2] not-minibuf t] 4 "\ 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', `mouse-yank-at-click', and `hilit-yank'. Depends on the value of `comint-scroll-to-bottom-on-input'. This function should be a pre-command hook."]) (defalias 'comint-postoutput-scroll-to-bottom #[(string) "À pÃ\n!  …ÇÈÉÊ#,‡" [selected-window selected current get-buffer-process process comint-scroll-to-bottom-on-output scroll walk-windows #[(window) "À !\n=…ià !ˆ`Ä !WƒOÇ=„JÈ=„JÉ=ƒ0\n =„JË=ƒ>\n =ƒJ`Ä ! GZYƒ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 "\ 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-show-maximum-output #[nil "dbˆÀÁ!‡" [recenter -1] 2 "\ Put the end of the buffer at the bottom of the window." nil]) (defalias 'comint-get-old-input-default #[nil "ŠÀyˆÁ ˆ`È\n`{*‡" [0 comint-skip-prompt beg nil] 2 "\ Default for `comint-get-old-input'. Take the current line, and discard any initial text matching `comint-prompt-regexp'."]) (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 "\ Insert after prompt old input at point as new input to be edited. Calls `comint-get-old-input' to get old input." nil]) (defalias 'comint-skip-prompt #[nil "ŠÀˆ`) !…Ä• X…Ä•b)‡" [nil eol looking-at comint-prompt-regexp 0] 2 "\ 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-after-pmark-p #[nil "ÀÁp!!Ã\n!`X)‡" [process-mark get-buffer-process pmark marker-position] 3 "\ Return t if point is after the process output marker."]) (defalias 'comint-simple-send #[(proc string) "À \n\"ˆÀ Ã\"‡" [comint-send-string proc string "\n"] 3 "\ 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-bol #[(arg) "Àyˆ ?…\n ‡" [0 arg comint-skip-prompt] 1 "\ 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. If you don't like this command, bind C-a to `beginning-of-line' in your hook, `comint-mode-hook'." "P"]) (defalias 'comint-read-noecho #[(prompt &optional stars) "ÀÁ‰Âà „‘ ƒ%ÊË ÍGÎ\"#ˆ‚*Ê !ˆÏ ‰Ð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 "\ 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 '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 "\ 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]." "P"]) (defvar comint-input-chunk-size 512 "\ *Long inputs are sent to comint processes in chunks of this size. If your process is choking on big inputs, try lowering the value.") (defalias 'comint-send-string #[(proc str) "G‰\n^Ä Æ O\"ˆ W…3 \n\\È ˆÉÆ!ˆÄ  ^O\"ˆ)‚*‡" [str len comint-input-chunk-size i process-send-string proc 0 next-i accept-process-output sit-for] 7 "\ 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 `comint-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 'comint-send-region #[(proc start end) "À \n {\"‡" [comint-send-string proc start end] 4 "\ 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 `comint-send-string'."]) (defalias 'comint-kill-output #[nil "ÀÁp!!bˆÂyˆÃ Å \"ˆÇcˆÈ ˆ `É“)‡" [process-mark get-buffer-process 0 point-marker pmark kill-region comint-last-input-end "*** output flushed ***\n" comint-skip-prompt nil] 3 "\ Kill all output from interpreter since last input. Does not delete the prompt." nil]) (defalias 'comint-show-output #[nil "` bˆÂyˆÃÄ `\"ˆÅ!ƒb‚Æ )‡" [pos comint-last-input-end -1 set-window-start selected-window pos-visible-in-window-p comint-skip-prompt] 3 "\ Display start of this batch of interpreter output at top of window. Also put cursor there if the current position is not visible." nil]) (defalias 'comint-interrupt-subjob #[nil "ÀÁ\n\"‡" [interrupt-process nil comint-ptyp] 3 "\ Interrupt the current subjob." nil]) (defalias 'comint-kill-subjob #[nil "ÀÁ\n\"‡" [kill-process nil comint-ptyp] 3 "\ Send kill signal to the current subjob." nil]) (defalias 'comint-quit-subjob #[nil "ÀÁ\n\"‡" [quit-process nil comint-ptyp] 3 "\ Send quit signal to the current subjob." nil]) (defalias 'comint-stop-subjob #[nil "ÀÁ\n\"‡" [stop-process nil comint-ptyp] 3 "\ 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.)" nil]) (defalias 'comint-continue-subjob #[nil "ÀÁ\n\"‡" [continue-process nil comint-ptyp] 3 "\ Send CONT signal to process buffer's process group. Useful if you accidentally suspend the top-level process." nil]) (defalias 'comint-kill-input #[nil "ÀÁp!!`Ã\n!V…Ä\n`\")‡" [process-mark get-buffer-process pmark marker-position kill-region] 3 "\ Kill all text from last stuff output by interpreter to point." nil]) (defalias 'comint-delchar-or-maybe-eof #[(arg) "mƒÀ ‡Á\n!‡" [process-send-eof delete-char arg] 2 "\ Delete ARG characters forward, or (if at eob) send an EOF to subprocess." "p"]) (defalias 'comint-send-eof #[nil "À ‡" [process-send-eof] 1 "\ Send an EOF to the current buffer's process." nil]) (defalias 'comint-backward-matching-input #[(regexp arg) "Á\nQŠ ÅVƒÅ‚ÆˆÇ ÈÉ $…`)‰\n„-ËÌ!ˆÍ ‚4\nbˆÎÈ!*‡" [comint-prompt-regexp ".*" regexp re arg 0 1 re-search-backward nil t pos message "Not found" ding comint-bol] 6 "\ 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." (comint-regexp-arg "Backward input matching (regexp): ")]) (defalias 'comint-forward-matching-input #[(regexp arg) "À \n[\"‡" [comint-backward-matching-input regexp arg] 3 "\ 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." (comint-regexp-arg "Forward input matching (regexp): ")]) (defalias 'comint-next-prompt #[(n) "\nÃVƒ Ä‚ ÈÅ\n!ˆÆ )‡" [comint-prompt-regexp paragraph-start n 0 1 forward-paragraph comint-skip-prompt] 2 "\ Move to end of Nth next prompt in the buffer. See `comint-prompt-regexp'." "p"]) (defalias 'comint-previous-prompt #[(n) "À [!‡" [comint-next-prompt n] 2 "\ Move to end of Nth previous prompt in the buffer. See `comint-prompt-regexp'." "p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] 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]] 3) (defalias 'comint-extract-string #[nil "Š`Áyˆ`È`bˆÅÆ\nÇ#…`TbˆÉÆ Ç#…)`S\n…:\n…:\n{.‡" [point 0 bol nil eol search-backward "\"" t start search-forward end] 4 "\ Return string around POINT that starts the current line, or nil."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias comint-get-source #[(prompt prev-dir/file source-modes mustmatch-p) "À \n\"Ä ‰…ÆÇÈ…É !?‰\nƒ#Ë !‚% @ \nƒ2Í !‚4 AσFÐÑ#‚H ‰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] comint-proc-query #[(proc str) "À !à !Å\n!ˆ\nqˆÆ\n!Ç ! Ê  \"ˆÌ !ˆÍ \"?…TÎ !Ð \"ˆÑÒ!ˆÍ \"„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]] 3) (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. 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-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.") (defalias (quote comint-directory) #[(directory) "ÀÁ\n!ƒ \nP‚\n!‡" [expand-file-name file-name-absolute-p directory comint-file-name-prefix] 3]) (defalias 'comint-match-partial-filename #[nil "ŠÀÁÂÃ#ƒ ÄuˆÅÆ!„ÇÈ!ˆÉÊ!ˆË̔̕{!)‡" [re-search-backward "[^~/A-Za-z0-9+@:_.$#,={}-]" nil move 1 looking-at "[~/A-Za-z0-9+@:_.$#,={}-]" error "" re-search-forward "[~/A-Za-z0-9+@:_.$#,={}-]+" substitute-in-file-name 0] 4 "\ Return the filename at point, or signal an error. Environment variables are substituted."]) (defalias 'comint-match-partial-variable #[nil "ŠÀÁÂÃ#ƒ ÄuˆÅÆ!„ÇÈ!ˆÉÊ!ˆË”Ë•{)‡" [re-search-backward "[^A-Za-z0-9_${}]" nil move 1 looking-at "\\$" error "" re-search-forward "\\${?[A-Za-z0-9_]+}?" 0] 4 "\ Return the variable at point, or signal an error."]) (defalias 'comint-after-partial-filename #[nil "À  ÄŽÅÆ \"*†Ç”ŠÈÉ!ˆ`)=?)‡" [comint-match-partial-filename filename match-data match-data ((store-match-data match-data)) string-match "/" 0 comint-bol nil] 3 "\ Returns t if point is after a file name. File names are assumed to contain `/'s or not be the first item in the input. See also `comint-bol'."]) (defalias 'comint-dynamic-complete #[nil "À \nƒÃÄ \"ƒÆ ˆ À U…( ƒ% ‚( )‡" [buffer-modified-tick previous-modified-tick comint-input-autoexpand string-match "[!^]" comint-get-current-command comint-replace-by-expanded-history comint-after-partial-filename-command comint-dynamic-complete-filename-command comint-dynamic-complete-command-command] 3 "\ Dynamically complete/expand the command/filename/history at point. If the text contains (a non-absolute line reference) `!' or `^' and `comint-input-autoexpand' is non-nil, then an attempt is made to complete the history. The value of the variable `comint-after-partial-filename-command' is used to match file names. Otherwise, an attempt is made to complete the command. See also the variables `comint-after-partial-filename-command', `comint-dynamic-complete-filename-command', and `comint-dynamic-complete-command-command', and functions `comint-replace-by-expanded-history' and `comint-magic-space'." nil]) (defalias 'comint-dynamic-complete-filename #[nil "À Ä !Æ ! ƒÈ !‚ \nË\n\"‰ „2ÍÎ \"ˆÏ ‚Ñ Ð=ƒGƒAÒcˆÍÓ!‚Ñ Ô˜ƒSÕ ‚ÑÖ\n! PØ•bˆÙ !GÀOcˆË \n\"9ƒŽƒˆÚ!ƒ…Û‚†ÒcˆÍÜ!‚Ѓ»ƒ» ˜ƒ»Þ!ƒ»Ú!ƒ²Û‚³ÒcˆÍß!‚Ð „È ˜ƒÍÕ ‚ÐÍá!).‡" [nil completion-ignore-case 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" ding t comint-completion-addsuffix " " "Sole completion" "" comint-dynamic-list-filename-completions file-name-as-directory file 0 directory-file-name file-directory-p "/" "Completed" comint-completion-recexact file-exists-p "Completed shortest" comint-completion-autolist "Partially completed"] 4 "\ Dynamically complete the filename at point. 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' and `comint-completion-recexact', and the timing of completions listing is dependent on the value of `comint-completion-autolist'." nil]) (defalias 'comint-replace-by-expanded-filename #[nil "ÀÁ !É#ˆÄ ‡" [replace-match expand-file-name comint-match-partial-filename t comint-dynamic-complete-filename] 4 "\ 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'." nil]) (defalias 'comint-dynamic-complete-variable #[nil "À ‰ÄÅ \"ÀOÄÇ \"ƒÈ‚%ÄÉ \"ƒ$Ê‚%Ë ÍÎ\"ÑÓ\"‰„HÕÖ\"ˆ× ‚êGØUƒ@‰˜ƒcÕÚ!ˆ‚rÛ!GÀOcˆÕÜ!ˆ cˆ…‰!ƒ‡Þ‚ˆßc)‚êà\"Û!GÀOcˆ!ƒÒƒÒ˜ƒÒƒÒ !ƒÈÞ‚Éß±ˆÕâ!‚é#„ߘƒæä!‚éÕå!).‡" [nil completion-ignore-case comint-match-partial-variable variable string-match "[^$({]" varname "{" "}" "(" ")" "" protection mapcar #[(x) "ÁÂÃ\"OC‡" [x 0 string-match "="] 5] process-environment variables #[(var) "ÀÁÂà P!!!‡" [file-directory-p comint-directory substitute-in-file-name "$" var] 5] var-directory-p all-completions completions message "No completions of %s" ding 1 completion "Sole completion" directory-file-name "Completed" comint-completion-addsuffix "/" " " try-completion comint-completion-recexact "Completed shortest" comint-completion-autolist comint-dynamic-list-completions "Partially completed"] 5 "\ Dynamically complete the environment variable at point. 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 `comint-dynamic-complete-process-environment-variable'. See also `comint-dynamic-complete-filename'." nil]) (defalias 'comint-dynamic-simple-complete #[(stub candidates) "ÀÂà \"Å \"‰„ÈÉ\"ˆÊ ‚šGËUƒP@‰ ˜ƒ8ÈÍ!ˆ‚E GÀOcˆÈÎ!ˆ…LÐc)‚šÑ \"‰ GÀOcˆƒ‚ƒ‚ ˜ƒ‚ ƒ‚ÐcˆÈÓ!‚™„ ˜ƒ–Õ!‚™ÈÖ!)+‡" [nil completion-ignore-case mapcar #[(x) "C‡" [x] 1] candidates all-completions stub completions message "No completions of %s" ding 1 completion "Sole completion" "Completed" comint-completion-addsuffix " " try-completion comint-completion-recexact "Completed shortest" comint-completion-autolist comint-dynamic-list-completions "Partially completed"] 4 "\ 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. See also `comint-dynamic-complete-filename'."]) (defalias 'comint-dynamic-list-filename-completions #[nil "À Ä !Æ ! ƒÈ !‚ \nË\n\"‰ ƒ/Í !‚6ÎÏ \"ˆÐ .‡" [nil completion-ignore-case comint-match-partial-filename filename file-name-directory pathdir file-name-nondirectory pathnondir comint-directory default-directory directory file-name-all-completions completions comint-dynamic-list-completions message "No completions of %s" ding] 4 "\ List in help buffer possible completions of the filename at point." nil]) (defalias 'comint-dynamic-list-completions #[(completions) "À ÂÃÄ Æ\"!‘ˆÇÈ!ˆÉÊ!ˆË ‰ Í=ƒ%Î !‚+ C‰*‡" [current-window-configuration conf " *Completions*" display-completion-list sort completions string-lessp sit-for 0 message "Hit space to flush" read-event ch 32 set-window-configuration unread-command-events] 6 "\ List in help buffer sorted COMPLETIONS. Typing SPC flushes the help buffer."]) (provide (quote comint)) emacs-19.22/lisp/edt.elc100666 13437 1 23017 5424635202 13500 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sun Jul 25 21:59:29 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/edt.el ;;; emacs version 19.17.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 "This file was compiled for Emacs 19")) (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.") (defalias 'delete-current-line #[(num) "` yˆhÂ=„Ãcˆ`{`|)‡" [beg num 10 "\n" edt-last-deleted-lines] 2 "\ 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 EDT `undelete-lines' command." "p"]) (defalias 'delete-to-eol #[(num) "`Áuˆ\nˆ`{`|)‡" [beg 1 num edt-last-deleted-lines] 2 "\ Delete text up to end of line. With argument, delete up to to Nth line-end past point. They are saved for the EDT `undelete-lines' command." "p"]) (defalias 'delete-current-word #[(num) "` vˆ`{`|)‡" [beg num edt-last-deleted-words] 2 "\ Delete one or specified number of words after point. They are saved for the EDT `undelete-words' command." "p"]) (defalias 'edt-delete-previous-word #[(num) "` [vˆ`{`|)‡" [beg num edt-last-deleted-words] 2 "\ Delete one or specified number of words before point. They are saved for the EDT `undelete-words' command." "p"]) (defalias 'delete-current-char #[(num) "`d`\\^{`d`\\^|‡" [num edt-last-deleted-chars] 4 "\ Delete one or specified number of characters after point. They are saved for the EDT `undelete-chars' command." "p"]) (defalias 'delete-previous-char #[(num) "e`Z]`{e`Z]`|‡" [num edt-last-deleted-chars] 3 "\ Delete one or specified number of characters before point. They are saved for the EDT `undelete-chars' command." "p"]) (defalias 'undelete-lines #[nil "c‡" [edt-last-deleted-lines] 1 "\ Yank lines deleted by last EDT `line-delete' command." nil]) (defalias 'undelete-words #[nil "c‡" [edt-last-deleted-words] 1 "\ Yank words deleted by last EDT `word-delete' command." nil]) (defalias 'undelete-chars #[nil "c‡" [edt-last-deleted-chars] 1 "\ Yank characters deleted by last EDT `character-delete' command." nil]) (defalias 'next-end-of-line #[(num) "Àuˆ ‡" [nil num] 1 "\ 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." "p"]) (defalias 'previous-end-of-line #[(num) "À Z‡" [1 num] 2 "\ Move EOL upward. Accepts a prefix argument for the number of lines to move." "p"]) (defalias 'forward-to-word #[(num) "TvˆÁv‡" [num -1] 1 "\ Move to next word-beginning, or to Nth following word-beginning." "p"]) (defalias 'backward-to-word #[(num) "T[vˆÁv‡" [num 1] 1 "\ Move back to word-end, or to Nth word-end seen." "p"]) (defalias 'backward-line #[(num) "[y‡" [num] 1 "\ Move point to start of previous line. Prefix argument serves as repeat-count." "p"]) (defalias 'scroll-window-down #[(num) "ÀÁ \n_ÃZ!‡" [scroll-down window-height num 2] 3 "\ Scroll the display down a window-full. Accepts a prefix argument for the number of window-fulls to scroll." "p"]) (defalias 'scroll-window-up #[(num) "ÀÁ \n_ÃZ!‡" [scroll-up window-height num 2] 3 "\ Scroll the display up a window-full. Accepts a prefix argument for the number of window-fulls to scroll." "p"]) (defalias 'next-paragraph #[(num) "ÁV… ÂÃ!ˆÄ ˆÅÃ!ˆlƒÂÃ!ˆS‰‚‡" [num 0 next-line 1 forward-paragraph previous-line] 3 "\ Move to beginning of the next indented paragraph. Accepts a prefix argument for the number of paragraphs." "p"]) (defalias 'previous-paragraph #[(num) "ÁV… ˆÃÄ!ˆlƒÅÄ!ˆS‰‚‡" [num 0 backward-paragraph previous-line 1 next-line] 3 "\ Move to beginning of previous indented paragraph. Accepts a prefix argument for the number of paragraphs." "p"]) (defalias 'move-to-beginning #[nil "eb‡" [] 1 "\ Move cursor to the beginning of buffer, but don't set the mark." nil]) (defalias 'move-to-end #[nil "db‡" [] 1 "\ Move cursor to the end of buffer, but don't set the mark." nil]) (defalias 'goto-percent #[(perc) "ÁV„ ÂWƒÃÄ\"‡d_Á¥b‡" [perc 100 0 error "Percentage %d out of range 0 < percent < 100"] 3 "\ Move point to ARG percentage of the buffer." "NGoto-percentage: "]) (defalias 'update-mode-line #[nil "ÀÁ !ˆÂÃ!‡" [set-buffer-modified-p buffer-modified-p sit-for 0] 2 "\ Ensure mode-line reflects all changes."]) (defalias 'advance-direction #[nil "ÀÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"ˆÂÉÊ\"ˆÂËÌ\"ˆÂÍÎ\"ˆÂÏÐ\"ˆÑ ‡" [" ADVANCE" edt-direction-string global-set-key [kp-f3] isearch-forward [kp-8] scroll-window-up [kp-7] next-paragraph [kp-1] forward-to-word [kp-2] next-end-of-line [kp-3] forward-char [kp-0] forward-line update-mode-line] 3 "\ Set EDT Advance mode so keypad commands move forward." nil]) (defalias 'backup-direction #[nil "ÀÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"ˆÂÉÊ\"ˆÂËÌ\"ˆÂÍÎ\"ˆÂÏÐ\"ˆÑ ‡" [" BACKUP" edt-direction-string global-set-key [kp-f3] isearch-backward [kp-8] scroll-window-down [kp-7] previous-paragraph [kp-1] backward-to-word [kp-2] previous-end-of-line [kp-3] backward-char [kp-9] backward-line update-mode-line] 3 "\ Set EDT Backup mode so keypad commands move backward." nil]) (defalias 'edt-beginning-of-window #[nil "ÀÁ!‡" [move-to-window-line 0] 2 "\ Home cursor to top of window." nil]) (defalias 'edt-line-to-bottom-of-window #[nil "ÀÁ!‡" [recenter -1] 2 "\ Move the current line to the top of the window." nil]) (defalias 'edt-line-to-top-of-window #[nil "ÀÁ!‡" [recenter 0] 2 "\ Move the current line to the top of the window." nil]) (defalias 'case-flip-character #[(num) "ÁV… ÂgXƒÂÄ``T\"ˆÅuˆS‰‚‡" [num 0 97 upcase-region downcase-region 1] 4 "\ Change the case of the character under the cursor. Accepts a prefix argument of the number of characters to invert." "p"]) (defalias 'indent-or-fill-region #[nil "Á˜ƒ Â`à Ä#‡Å`à \"‡" [paragraph-start "^$\\|^ " indent-region mark nil fill-region] 4 "\ Fill region in text modes, indent region in programming language modes." nil]) (defalias 'mark-section-wisely #[nil "Á=ƒ  ‡Ã=ƒ ‡Ä=ƒÅ ‡Æ ‡" [major-mode emacs-lisp-mode mark-defun lisp-mode c-mode mark-c-function mark-paragraph] 2 "\ Mark the section in a manner consistent with the major-mode. Uses mark-defun for emacs-lisp, lisp, mark-c-function for C, and mark-paragraph for other modes." nil]) (defalias 'edt-emulation-on #[nil "À ˆÁ ˆÂ Ä\"ÆÄÇ\"ˆÂ È\" ÆÈÊ\"ˆÂ È\" Í ÈÊ#ˆÍÈÊ#ˆÂ Ï\"ÆÏÑ\"ˆÍÓÔ#‡" [advance-direction edt-bind-gold-keypad lookup-key global-map "" edt-mode-old-c-\\ global-set-key quoted-insert "" edt-mode-old-delete delete-previous-char emacs-lisp-mode-map edt-mode-old-lisp-delete define-key lisp-mode-map "\n" edt-mode-old-linefeed edt-delete-previous-word esc-map "?" apropos] 4 "\ Emulate DEC's EDT editor. Note that many keys are rebound; including nearly all keypad keys. Use \\[edt-emulation-off] to undo all rebindings except the keypad keys." nil]) (defalias 'edt-emulation-off #[nil "ÀÂà \"ˆÂÅ\"ˆÇÅ #ˆÇ\nÅ #ˆÂË \"‡" [nil edt-direction-string global-set-key "" edt-mode-old-c-\\ "" edt-mode-old-delete define-key emacs-lisp-mode-map edt-mode-old-lisp-delete lisp-mode-map "\n" edt-mode-old-linefeed] 4 "\ Return from EDT emulation to normal Emacs key bindings. The keys redefined by \\[edt-emulation-on] are given their old definitions." nil]) (defvar GOLD-map (make-keymap) "\ `GOLD-map' maps the function keys on the VT100 keyboard preceded by the PF1 key. GOLD is the ASCII the 7-bit escape sequence OP.") (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@ÿ#ˆÛ\nAB#ˆÛ\nCB#ˆÛ\nDE#ˆÛ\nDE#ˆÛ\nFG#ˆÛ\nHG#ˆÛ\nIJ#ˆÛ\nKJ#ˆÛ\nLM#ˆÛ\nLM#ˆÀNO\"ˆPQž„KRQBQÀ‡" [defalias GOLD-prefix GOLD-map global-set-key [home] edt-beginning-of-window [kp-f2] describe-key [kp-f4] delete-current-line [kp-9] append-to-buffer [kp-subtract] delete-current-word [kp-4] advance-direction [kp-5] backup-direction [kp-6] kill-region [kp-separator] delete-current-char [kp-decimal] set-mark-command [kp-enter] other-window [kp-f1] define-key "" keyboard-quit "" delete-window "" delete-other-windows " " newline-and-indent " " undo "%" goto-percent "=" goto-line "`" what-line "" split-window-vertically "b" buffer-menu "B" "d" "D" "e" compile "E" "i" insert-file "I" "l" "L" "m" save-some-buffers "M" "n" next-error "N" "o" switch-to-buffer-other-window "O" "r" revert-file "s" save-buffer "S" "v" find-file-other-window "V" "w" write-file edt-bind-gold-keypad #[nil "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àá#ˆÀ âã#ˆÀ äå#ˆÀ æç#ˆÀ èé#ˆÀ êë#ˆÀ ìí#‡" [define-key GOLD-map [up] edt-line-to-top-of-window [down] edt-line-to-bottom-of-window [left] backward-sentence [right] forward-sentence [kp-f1] mark-section-wisely [kp-f2] describe-function [kp-f3] occur [kp-f4] undelete-lines [kp-0] open-line [kp-1] case-flip-character [kp-2] delete-to-eol [kp-3] copy-region-as-kill [kp-4] move-to-end [kp-5] move-to-beginning [kp-6] yank [kp-7] execute-extended-command [kp-8] indent-or-fill-region [kp-9] replace-regexp [kp-subtract] undelete-words [kp-separator] undelete-chars [kp-decimal] redraw-display [kp-enter] shell-command] 4] edt-direction-string minor-mode-alist (edt-direction-string edt-direction-string)] 4) emacs-19.22/lisp/compare-w.elc100666 74777 1 5076 5471634253 14631 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 03:07:06 1993 ;;; from file /home/fsf/rms/e19/lisp/compare-w.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defvar compare-windows-whitespace "[ \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.") (defalias 'compare-windows #[(ignore-whitespace) "ÀÀÀÀÀÀÀÀÀ `\nÀ  …# `pÏÐ !‰Ð =ƒ:ÑÒ!ˆÓ!Ô!\n dŠqˆd)Õƒ-À bˆÖ\n\"ˆƒÍŠÀ‰‰‰‰‰;ƒ‹Ü\n!‚\n!`qˆ\nbˆ;ƒ©Ü !‚® !`ƒËƒË=ƒË.ÝÀ ‰ áVƒ)Õ  ƒ Z \nZ^^‰ áV… â\n \n\\  \\&áU‰ ƒà  \\\n \\Õ‚à 㥉 ‚Ø+‚U bˆÖ\n\"ˆ`\nU…?ä . ‡" [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 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 "\ 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. 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." "P"]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias compare-windows-skip-whitespace #[(start) "```à !ƒ\nÅ•XƒÅ•`V„*`U„0`Uƒ0Çuˆ‚`\nbˆ U?†@\nU?+‡" [opoint beg end looking-at compare-windows-whitespace 0 start -1] 3] provide compare-w] 3) emacs-19.22/lisp/compile.elc100666 12062 1 52122 5451134723 14167 0ustar bobdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:36:19 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/compile.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (defvar compilation-mode-hook nil "\ *List of hook functions run by `compilation-mode' (see `run-hooks').") (defconst 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, that cons's car is a cons (DIRECTORY . FILE), specifying the file the message is about, and its cdr is the number of the line the message is about. Or its cdr may be nil if that error is not interesting. The value may be t instead of a list; this means that the buffer of 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 (quote 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 erros. 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-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-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.") (byte-code "À ž„\n BÀ‡" [compilation-in-progress minor-mode-alist (compilation-in-progress " Compiling")] 2) (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-error-regexp-alist (quote (("\n\\([^:( \n]+\\)[:(][ ]*\\([0-9]+\\)[:) ]" 1 2) ("[ :]\\([^:( \n]+\\)[:(](+[ ]*\\([0-9]+\\))[:) ]*$" 1 2) ("([ ]*\\([^:( \n]+\\)[:(][ ]*\\([0-9]+\\))" 1 2) ("\n\\(Error on \\)?[Ll]ine[ ]+\\([0-9]+\\)[ ]+of[ ]+\"?\\([^\"\n]+\\)\"?:" 3 2) ("\"\\([^,\" \n ]+\\)\", lines? \\([0-9]+\\)[:.,-]" 1 2) ("rror: \\([^,\" \n ]+\\), line \\([0-9]+\\):" 1 2) ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1))) "\ Alist that specifies how to match errors in compiler output. Each element has the form (REGEXP FILE-IDX LINE-IDX). If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th subexpression gives the line number.") (defvar grep-regexp-alist (quote (("^\\([^:( \n]+\\)[:( ]+\\([0-9]+\\)[:) ]" 1 2))) "\ Regexp used to match grep hits. See `compilation-error-regexp-alist'.") (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.") (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))))))") (defconst 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.") (defconst 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.") (byte-code "ÀÁ!„ÂÀÃ!„‡" [boundp compile-history nil grep-history] 2) (defalias 'compile #[(command) "ÂÉ\"ˆÄ Å\"‡" [command compile-command save-some-buffers nil compile-internal "No more errors"] 3 "\ 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. 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." (list (read-from-minibuffer "Compile command: " compile-command nil nil (quote (compile-history . 1))))]) (defalias 'grep #[(command-args) "À ÂPÃÄÅ%‡" [compile-internal command-args " /dev/null" "No more grep hits" "grep" nil grep-regexp-alist] 6 "\ 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." (list (read-from-minibuffer "Run grep (like this): " "grep -n " nil nil (quote grep-history)))]) (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=ƒˆdbˆâ !Š qˆã ˆäp!ˆåØ!Lˆåæ!'LˆåÖ!Lˆ‰C(ée\"ˆ\n*ë =„Ììe\"ˆ-ƒïî!ï Uƒïë 0ñŽò!ˆó-ô Z!ˆ*õ*—  #6÷6ø\"ˆù6ú\"ˆû6!` “ˆ6To 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)." nil]) (defalias (quote 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]) (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.") (byte-code "ÀÁ!ˆÁ\nž„Ã\nBÁ ž„Á B BÀ‡" [make-variable-buffer-local compilation-minor-mode minor-mode-alist (compilation-minor-mode " Compilation") minor-mode-map-alist compilation-minor-mode-map] 2) (defalias 'compilation-minor-mode #[(&optional arg) "„ ?‚Â!ÃV‰…Ä ‡" [arg compilation-minor-mode prefix-numeric-value 0 compilation-setup] 2 "\ Toggle compilation minor mode. With arg, turn compilation mode on if and only if arg is positive. See `compilation-mode'." "P"]) (defalias 'compilation-sentinel #[(proc msg) "À !à !Ä>…†Å\n!„Æ Ç\"ˆ‚~plj \nËŽ\nqˆÇ d ` bˆÍϱˆÑuˆÒÓ ÔÕO±ˆÖuˆ×Øà !!PÚ !ˆÛÜ !ˆ)ƒq Wƒqbˆƒ}\n\"ˆ,Þ \"‰)‡" [process-buffer proc buffer process-status (signal exit) buffer-name set-process-buffer nil opoint omax obuf ((set-buffer obuf)) buffer-read-only 10 mode-name " " msg -1 " at " current-time-string 0 19 1 ": " symbol-name mode-line-process delete-process set-buffer-modified-p buffer-modified-p compilation-finish-function delq compilation-in-progress] 4 "\ Sentinel for compilation buffers."]) (defalias 'compilation-filter #[(proc string) "ŠÀ !qˆÂŠÄ !bˆÅ!ˆÄ !`“+‡" [process-buffer proc nil buffer-read-only process-mark insert-before-markers string] 3 "\ Process filter for compilation buffers. Just inserts the text, but uses `insert-before-markers'."]) (defalias (quote compile-error-at-point) #[nil "ÀÁ`\"ˆ\n‰ƒ` @@Vƒ A‰„ )‡" [compile-reinitialize-errors nil compilation-old-error-list errors] 4]) (defalias 'compilation-next-error #[(n) "Àp!„\nÁÂ!ˆpÄ ÇWƒMÇ \n =„2\nT\n A‰ ‚[\nVƒAÁË!‚I\n\\8*‚j A ÍΉ#ˆ ƒfS 8‚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 "\ Move point to the next error in the compilation buffer. Does NOT find the source line like \\[next-error]." "p"]) (defalias 'compilation-previous-error #[(n) "À [!‡" [compilation-next-error n] 2 "\ Move point to the previous error in the compilation buffer. Does NOT find the source line like \\[next-error]." "p"]) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#ˆÀÆÇ\"ˆÃÆÄÅ#‡" [defalias compilation-error-filedata #[(data) "AÁ!ƒ Â!‡@‡" [data markerp marker-buffer] 2] put byte-optimizer byte-compile-inline-expand compilation-error-filedata-file-name #[(filedata) "À !ƒ\n !‡ @‡" [bufferp filedata buffer-file-name] 2]] 4) (defalias 'compilation-next-file #[(n) "Àp!„\nÁÂ!ˆp ÅWƉ‰ „(Ê †#ÁË!‚MÌÆ`\"ˆÍ! [ƒM`@@WƒMA‰„; ÅVƒï@‰AÐ!ƒjÑ!‚m@)†Ã ƒ˜ÁÒÓ!ƒÔ!‚“@)\"‚§ÆÌƉÖ#ˆ‰)†ÃÁ×Ó!ƒ¾Ô!‚Á@)\"@‰AÐ!ƒØÑ!‚Û@)šƒèA‚p S‰‚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 "\ Move point to the next error for a different file than the current one." "p"]) (defalias 'compilation-previous-file #[(n) "À [!‡" [compilation-next-file n] 2 "\ Move point to the previous error for a different file than the current one." "p"]) (defalias 'kill-compilation #[nil "À  !ƒà!!‚ÄÅ!)‡" [compilation-find-buffer buffer get-buffer-process interrupt-process error "The compilation process is not running."] 3 "\ Kill the process made by the \\[compile] command." nil]) (defalias (quote compile-reinitialize-errors) #[(argp &optional limit-search find-at-least) "Šqˆ Â=„ :ƒÄ ˆÅ …1ƒ&V…1?†1 GY?…fÉ!ˆÊË!ˆdW…fÅU  \"ˆ ƒ^ ‰‚e ¤‰))‡" [compilation-last-buffer compilation-error-list t argp compilation-forget-errors 1 compilation-parsing-end limit-search find-at-least switch-to-buffer set-buffer-modified-p nil at-start compilation-parse-errors-function compilation-old-error-list] 3]) (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 next-error 1] 4 "\ Visit the source for the error message point is on. Use this command in a compilation log buffer. \\[universal-argument] as a prefix arg means to reparse the buffer's error messages first; other kinds of prefix arguments are ignored." "P"]) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#ˆÀÆÇ\"‡" [defalias compilation-buffer-p #[(buffer) "ÀÁ\n!ž‡" [compilation-error-list buffer-local-variables buffer] 3] put byte-optimizer byte-compile-inline-expand compilation-find-buffer #[(&optional other-buffer) "„pÂà !ž)ƒp‡ ƒ'Å !ƒ'ƒ% p=„' ‡Æ ‰ƒQ@Âà !ž)ƒHƒQ@p=ƒQA‰„/ƒ\\@‚zƒwpÂà !ž)ƒwƒsÈÉ!ˆp†zÊË!)‡" [other-buffer buffer compilation-error-list buffer-local-variables compilation-last-buffer buffer-name buffer-list buffers message "This is the only compilation buffer." error "No compilation started!"] 4]] 4) (defalias 'next-error #[(&optional argp) "À Â Ä :?…Å !ÆWƒÇ‚Å !S#ˆ :ƒ%Äĉ Š qˆÅ !ÇVƒAÅ !S\n›‚|Å !SÇ    \n=„d T  A‰ ‚P[ VƒsÏÐ!‚{ \\ ›+‰ @‰„¹ ƒÅ !ÇVƒ™ÏÑ!ˆ‚ÏÐ!ˆÒ ˆÏÔp!…´ÕÔp!!Ö=…´×P!‚¤ A\nAƒ§ØA!„žA@ÚA@@#‰„ ‰ ƒ @A:ƒ  @A@šƒ  @@ĉ“ˆ @Ä¡ˆ A‰ ‚è AAqˆŠŒ~ˆÞ!ˆÇyˆß ¡ˆƒœ@A:ƒ“@A@šƒ“@AA@AAZ !\"ã=ƒƒ ÇWƒxäåÄæ [$ˆ‚‡çåÄæ $ˆ‚‡ yˆ!@ß ¡ˆ*A‰„:,*ØA!?ƒ³\n‰ @‰‚ƒ)\nƒÍ\n@AAšƒÍ\nA‰\n„¹èéA!!ˆAbˆ`êA!U„ë~ˆAbˆã+ìé@!!-î-@\"ˆï-@\",‡" [compilation-find-buffer compilation-last-buffer compile-reinitialize-errors argp nil prefix-numeric-value 1 0 next-error next-errors compilation-error-list compilation-old-error-list e i n error "Moved back past first error" "Moved past last error" compilation-forget-errors compilation-error-message get-buffer-process process-status run " yet" markerp fileinfo compilation-find-file buffer last-line errors goto-line point-marker lines this selective-display t re-search-backward "[\n ]" end re-search-forward switch-to-buffer marker-buffer marker-position pop-up-windows display-buffer w set-window-point set-window-start] 6 "\ 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." "P"]) (byte-code "À ÂÃ#ˆÄÅÆ\"ˆÄÇÈ\"‡" [define-key ctl-x-map "`" next-error defalias compilation-find-file #[(filename dir marker) "Á‰‰ƒ+ „+Å @†\"È\n!…#É\n! A‰„\n †nÊ ÌÍ!!Ð\"ˆÑ\"ˆ*ÅÒÓÔ\"Ê$!Õ\n!ƒeÖ\n!PÈ\n!…nÉ\n!+‡" [compilation-search-path nil name result dirs expand-file-name filename dir 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 format "Find this error in: (default %s) " file-directory-p file-name-as-directory] 7] compilation-forget-errors #[nil "ƒ\"@‰@‰“ˆÃ A!ƒ A‰“ˆ)A‰„‰‡" [compilation-old-error-list next-error nil markerp compilation-error-list compilation-directory-stack] 4]] 4) (defalias 'count-regexp-groupings #[(regexp) "À GÀ WƒS H T ÇUƒ2 Wƒ\n HÈU„\n T‰‚ ÉUƒ\n Wƒ\n H T ÊUƒ\nT‚\n,‡" [0 regexp nil c i len groupings 91 93 92 41] 5 "\ Return the number of \\( ... \\) groupings in REGEXP (a string)."]) (defalias 'compilation-parse-errors #[(limit-search find-at-least) "ÀÂÃ!ˆÀ‰‰‰‰‰‰‰‰‰‰‰Ä \n   bˆoƒ:ÓyˆÔuˆÕ×Õ×ÕÙÚÜ#Ý°  Þ Þß!Þ\\\\‰ ß!Þ\\\\\n†màá! \nT ƒ¦‰ @A@\\Ó @8\\EBß @@!Þ\\\\ A‰ „y\"ã!äå\"„&æ Àç#ƒ& ”ƒýèä Þ\\” Þ\\•{!!)ê)$‰)+B+ì)!ƒù)\")‚  ”ƒY Þ\\”+-‰.ƒDèä. Þ\\•{!!)ê)$)-ƒC-@)˜„C-A‰-„1)-A‰+@‰-ƒU-\"*‚ \n”ƒ‰ ƒx @@”„x A‰ „g ƒ… @ ‚‰àï!ˆÄ”\" A@” A@•{BŒÓ 8”Ó 8•}ˆebˆðñ!…²òp!)345ŠÄyˆö 43BB‰7A @Aš„Ø7 B T*8ƒ 8Yƒ Aƒ @A@ A@A@š„ A5bˆç+‚ àù!ˆÂú `û_d¥#ˆ<ƒ·`??)‡" [this-command-keys 1 0 key 128 meta event-modifiers] 4] boundp PC-ignored-extensions empty-cache PC-delims PC-ignored-regexp nil PC-word-failed-flag PC-delim-regex PC-ndelims-regex PC-delims-list PC-do-completion #[(&optional mode beg end) "„e „ d\n  Æ>È  {\n…'ËÌ\n\" ÈÈÈÈÈÈÈØ=ƒVÙ\n #ƒVÚ‚}ƒz\nÛ\n!‰š„z |ˆcˆ\n\nG\\š„›ÞßQ áâQ#äÈ\"%ƒ=Ëæ\n\"ƒ=\nÈ'(Ëé(\"TË (#‰ƒÞ(êOë(ÈOQ(ì\\‚·í(ëP!‰'ƒ5î'@!'/A‰ƒ /î@!š„õƒÈÈÈð‚1 |ˆ/ñ\n!P‰\ncˆ\nG\\*‚<ÈÈÈ*ƒi ƒZ\n ÈO\nê O ‚mñ\n!î\n! ‚m\nò!‰GêVƒ˜êHó=„˜4ð=„”4ƒ˜ƒ˜õ‚™ê‰Ë #‰ƒHö=ƒÙêO# TÈOR#G G\\\\‚žH÷>ƒçø‚èê9ê9\\O#9\\ÈOQ#Gõ\\\\)‚žêƒ9Ëú#‰ƒ9êOûì\\ÈOQ‚üPË ƒKý‚LþP\n G\\#‰„gÿ\n #‚–ÿ\nêO #‰@‰ƒ•Ë@\"ƒŒ@BA‰„z)„èA=ƒ½B„½ðBCõ!ˆDA!)‚}E ˆFƒÐG‚âH=ƒßI‚âJ!ˆÈ‚}‰A„úK>ƒJƒWH=„WLMNš„*OPòM‰NQ#RQSÈLƒMËSL@\"„DL@BLA‰L„2ƒV)H=?…c‰ƒ{@š„{A‰„iƒ‘„FT!ˆð‚}ȉ‰üUVWXH=„ÝYþZ[\"\"‰WƒÝðÈ\\]A=ƒÓ^W\"W G\\bˆê\\êWGWƒ^` WƒûW\\Hg=ƒûõuˆ‚U` Wƒ._`!ƒW\\H%>„\"W\\H—g—=ƒ.aõ!ˆ S‚IƒF_b!ƒFaõ!ˆ SðXW\\‰TOcˆ T\\T‰\\‚ÞV„l`š„l`V_ !ƒÇUòW!#QUYþZc\"\"‰WƒÇ\\êV„£WGêVƒÇA=ƒÚ]ƒÇWGêVƒÇÈ]WêõO‰W„ÚA=ƒÔ ‚ÚV†Úbˆ*A=ƒB„X…FÙõ S{ #…F S |‚FXƒØ=…FÙd #‚Fe„'H=ƒ=fghi\"!‘ˆ‚EFj!ˆÈ,‚}@šƒc„|Fk!ˆ‚| |ˆƒwÛ @P!‚z@cˆð.‡" [beg end minibuffer-completion-table table minibuffer-completion-predicate pred (read-file-name-internal read-directory-name-internal) filename nil dirname str string-match "<\\([^\"<>]*\\)>?$" incname ambig basestr regex p offset poss helpposs completion-ignore-case case-fold-search mode exit PC-is-complete-p complete substitute-in-file-name PC-word-delimiters PC-delims "[" "]" PC-delim-regex "[^" "]*" PC-ndelims-regex append PC-delims-list "\\*.*/" files pat "/[^/]*\\'" 0 "*" 2 PC-expand-many-files file-name-directory 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)" skip pt prefix improved try-completion mapcar list i first PC-chop-word looking-at " " delete-char "\\*" #[(x) "À \n\"… \nÕÄOC‡" [string-match skip x 0 nil] 3] buffer-string completion-auto-help " *Completions*" display-completion-list sort string-lessp " (Next char not unique)" " (Sole completion)"] 7] PC-is-complete-p #[(str table pred) "<ƒ Á\n\"‚%Ã!ƒ\nÄš†%Å\n\"‚%\nÇ#‰…EƒC<„;Ã!ƒC!…E)‡" [table assoc str vectorp "nil" intern-soft pred lambda res] 5] PC-chop-word #[(new old) "À‰à \nT#‰ƒà  T#‰„ ƒ9ƒ0à  T#‰ƒ9È TO‚;*‡" [-1 j i string-match PC-delim-regex old new PC-word-failed-flag 0] 4] PC-not-minibuffer] 3) (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 "\ A Lisp version of `temp_minibuffer_message' from minibuf.c."]) (defalias 'PC-lisp-complete-symbol #[nil "`Á ÃŽŠ ƒÅ !ˆÆÇ!ˆ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 "\ 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." nil]) (byte-code "ÀÁ!„ÂÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"ˆ\n„)Ä >„)Ä B ÃÌÍ\"ˆÃÎÏ\"‡" [boundp PC-many-files-list nil 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] 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] 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] PC-disable-wildcards find-file-not-found-hooks 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] PC-include-file-path #[nil "†4ÁÂ!ɉ„ÇÈ!ˆÉÊ\"‰ƒ2 TÃO BË O‚ +‡" [PC-include-file-path getenv "INCPATH" nil pos path env error "No include file path specified" string-match ":[^:]+$" 0] 4]] 3) (defalias 'PC-include-file-all-completions #[(file search-path &optional full) "ÀÁ\n\"à !ƒÅ !ÆÇ !È !\"‡È !Ç !É\n ‰ ƒ0ÀÍ\n\"É\nƒb\n@ƒB‚D  Ð!ƒ[ÀÑÆ \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 "\ 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."]) (byte-code "ÀÁ!„ÂÃÄÅ\"ˆ„Ç>„ÇB„/ „/ÉKÉÄMˆÊË!‡" [boundp PC-old-read-file-name-internal nil defalias PC-read-include-file-name-internal #[(string dir action) "ÀÁ\n\"ƒ[\nÔÕO\nÅ”ÆOÈÉÊ Ë \"\"‰ „'Æ‚Y Æ=ƒ8Î Æ#‚Y Ï=ƒIÐ Æ#‚Y Ñ=…YÎ Æ#Ï=+‡\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] PC-disable-includes PC-look-for-include-file find-file-not-found-hooks read-file-name-internal provide complete] 3) emacs-19.22/lisp/completion.elc100666 13437 1 104136 5427520702 15120 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Aug 3 13:34:57 1993 ;;; from file /home/fsf/rms/e19/lisp/completion.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (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 (quote (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.") (defconst completion-min-length nil "\ *The minimum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (defconst completion-max-length nil "\ *The maximum length of a stored completion. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (defconst completion-prefix-min-length nil "\ The minimum length of a completion search string. DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÃ ˆÅÆ!‡" [defalias eval-when-compile-load-eval (macro . #[(&rest body) "ÀÁ\n\"ˆÃ\nB‡" [mapcar eval body progn] 3]) completion-eval-when #[nil "ÀÂĉ‡" [6 completion-min-length 200 completion-max-length 3 completion-prefix-min-length] 2] require cl] 3) (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.") (defalias 'minibuffer-window-selected-p #[nil "ÀÁ !‡" [window-minibuffer-p selected-window] 2 "\ True iff the current window is the minibuffer."]) (defalias (quote cmpl-read-time-eval) (quote (macro lambda (form) form))) (defalias 'cmpl-string-case-type #[(string) "ÀÂà \"ƒ+ÂÅ \"ƒ' GÆVƒ#ÂÅ Æ#„#Ç‚7È‚7É‚7ÂÅ \"ƒ6Ê‚7Ë)‡" [nil case-fold-search string-match "[a-z]" string "[A-Z]" 1 :capitalized :mixed :down :up :neither] 4 "\ Returns :capitalized, :up, :down, :mixed, or :neither."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÇ  ÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"ˆÊ Ì Î À‡" [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] 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] cmpl-hours-since-origin #[nil "À  @Ã¥ÄÅÆ\"_Ç 8È¥\\!)‡" [current-time time truncate 3.60000000000000000000e+003 lsh 1 16 2 3.60000000000000000000e+003] 5] cmpl-make-standard-completion-syntax-table #[nil "ÀÁÂ\"Ä Wƒ(Ç È\\É #ˆÇ Ê\\É #ˆ T‰‚ *Ë  WƒDÇ Í\\É #ˆ T‰‚/*Îω҉ƒj@ÇÉ #ˆA‰„U*Ò‰ƒ‹@ÇÖ #ˆA‰„v, )‡" [make-vector 256 0 table 26 i --dotimes-temp--0 modify-syntax-entry 97 "_" 65 10 --dotimes-temp--1 48 (64 47 92 42 43 126 36 60 62 37) (95 45 58 46) symbol-chars-ignore symbol-chars nil char --dolist-temp--2 --dolist-temp--3 "w"] 6] cmpl-standard-syntax-table cmpl-make-lisp-completion-syntax-table #[nil "À ! ʼnƒ%@ÈÉ #ˆA‰„* *‡" [copy-syntax-table cmpl-standard-syntax-table (33 38 63 61 94) symbol-chars table nil char --dolist-temp--4 modify-syntax-entry "_"] 5] cmpl-make-c-completion-syntax-table #[nil "À ! ʼnƒ%@ÈÉ #ˆA‰„* *‡" [copy-syntax-table cmpl-standard-syntax-table (43 42 47 58 37) separator-chars table nil char --dolist-temp--5 modify-syntax-entry " "] 5] cmpl-make-fortran-completion-syntax-table #[nil "À ! ʼnƒ%@ÈÉ #ˆA‰„* *‡" [copy-syntax-table cmpl-standard-syntax-table (43 45 42 47 58) separator-chars table nil char --dolist-temp--6 modify-syntax-entry " "] 5] cmpl-lisp-syntax-table cmpl-c-syntax-table cmpl-fortran-syntax-table] 3) (defvar cmpl-syntax-table cmpl-standard-syntax-table "\ This variable holds the current completion syntax table.") (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) (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.") (byte-code "ÀÁ!„ÂÀÃ!„‡" [boundp cmpl-saved-syntax nil cmpl-saved-point] 2) (defalias 'symbol-under-point #[nil "À  !ˆgzÄ>ƒj`Æ TÇ\"Æ É\"\nfzËUƒ3bˆÉvˆ` bˆ\nSfzËUƒJ\nbˆÇvˆ`\n bˆÂ !ˆ \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 "\ Returns the symbol that the point is currently on. But only if it is longer than `completion-min-length'."]) (defalias 'symbol-before-point #[nil "À  !ˆhz‰ÅUƒF`ÇTÈ\"‰ fzÊUƒ1 bˆËvˆ` bˆÂ !ˆ  \\Y…™ {‡ ÊUƒ”` Ç TÈ\" Èvˆ` fzÊUƒp bˆËvˆ`  bˆÂ !ˆ  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 "\ Returns a string of the symbol immediately before point. Returns nil if there isn't one longer than `completion-min-length'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÉ\nË ÍÏÑÓÕ×Ø!„1×Ù!„:Ú×Û!„CÇ×Ü!„LÚ×Ý!„UÚ×Þ!„^ß×à!„gÇ Ú‡" [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] symbol-before-point-for-complete #[nil "À  !ˆhz‰Å>ƒQ`ÇTÈ\"‰ fzÊUƒ1 bˆËvˆ` bˆÂ !ˆ  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] cmpl-statistics-block (macro lambda (&rest body)) 0 cmpl-source-unknown 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] 3) (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 "\ Resets the cdabbrev search to search for abbrev-string. INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore during the search."]) (defalias (quote set-cdabbrev-buffer) #[nil "Á=ƒ  ‚Ã!q‡" [cdabbrev-current-window t other-buffer window-buffer] 2]) (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 "\ Resets the cdabbrev search to search for abbrev-string."]) (defalias 'next-cdabbrev #[nil "…ÀÁ‰‰‰‰‰‰ŠÉŽÊ ˆ`Ë Ì !ˆbˆÏÒ#ƒ„hz‰ÓU„S ÔU…€`ÕvˆhzÓU\nbˆ…€Ö ‰…€— ƒt @˜„t A‰„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 "\ 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'."]) (byte-code "ÀÀ‡" [511 cmpl-obarray-length] 1) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias completion-string (macro . #[(completion-entry) "À D‡" [car completion-entry] 2]) completion-num-uses (macro . #[(completion-entry) "ÀÁ\nDD‡" [car cdr completion-entry] 3]) completion-last-use-time (macro . #[(completion-entry) "ÀÁ\nE‡" [nth 2 completion-entry] 3]) completion-source (macro . #[(completion-entry) "ÀÁ\nE‡" [nth 3 completion-entry] 3]) set-completion-string (macro . #[(completion-entry string) "À \nE‡" [setcar completion-entry string] 3]) set-completion-num-uses (macro . #[(completion-entry num-uses) "ÀÁ\nD E‡" [setcar cdr completion-entry num-uses] 3]) set-completion-last-use-time (macro . #[(completion-entry last-use-time) "ÀÁ‰\nDD E‡" [setcar cdr completion-entry last-use-time] 4])] 3) (defalias 'make-completion #[(string) "Á FC‡" [string 0 nil current-completion-source] 4 "\ Returns a list of a completion entry."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias cmpl-prefix-entry-head (macro . #[(prefix-entry) "À D‡" [car prefix-entry] 2]) cmpl-prefix-entry-tail (macro . #[(prefix-entry) "À D‡" [cdr prefix-entry] 2]) set-cmpl-prefix-entry-head (macro . #[(prefix-entry new-head) "À \nE‡" [setcar prefix-entry new-head] 3]) set-cmpl-prefix-entry-tail (macro . #[(prefix-entry new-tail) "À \nE‡" [setcdr prefix-entry new-tail] 3])] 3) (defalias 'make-cmpl-prefix-entry #[(completion-entry-list) "‰B‡" [completion-entry-list] 2 "\ Makes a new prefix entry containing only completion-entry."]) (defalias 'clear-all-completions #[nil "À Â\"À Â\"Ň" [make-vector cmpl-obarray-length 0 cmpl-prefix-obarray cmpl-obarray nil] 3 "\ Initializes the completion storage. All existing completions are lost." nil]) (defalias 'list-all-completions #[nil "ÀÂà \"ˆ )‡" [nil return-completions mapatoms list-all-completions-1 cmpl-prefix-obarray] 3 "\ Returns a list of all the known completion entries."]) (defalias (quote list-all-completions-1) #[(prefix-symbol) "À !… J@ \"‰‡" [boundp prefix-symbol append return-completions] 3]) (defalias 'list-all-completions-by-hash-bucket #[nil "ÀÂà \"ˆ )‡" [nil return-completions mapatoms list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray] 3 "\ Return list of lists of known completion entries, organized by hash bucket."]) (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅÃÆ!„ÅÃÇ!„ÅÃÈ!„(ÅÃÉ!„1Å Ň" [defalias list-all-completions-by-hash-bucket-1 #[(prefix-symbol) "À !… J@\nB‰‡" [boundp prefix-symbol return-completions] 2] boundp completion-to-accept nil cmpl-db-downcase-string cmpl-db-symbol cmpl-db-prefix-symbol cmpl-db-entry] 3) (defvar cmpl-db-debug-p nil "\ Set to T if you want to debug the database.") (defalias 'find-exact-completion #[(string) "ÀÁ\n—‰ \"‰!… J‡" [boundp intern string cmpl-db-downcase-string cmpl-obarray cmpl-db-symbol] 4 "\ Returns the completion entry for string or nil. Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'."]) (defalias 'find-cmpl-prefix-entry #[(prefix-string) "ÀÁ\n \"‰!… J‡" [boundp intern prefix-string cmpl-prefix-obarray cmpl-db-prefix-symbol] 4 "\ 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'."]) (byte-code "ÀÁ!„‡" [boundp inside-locate-completion-entry nil] 2) (defalias 'locate-completion-entry #[(completion-entry prefix-entry) "@Á‰@ =?…C ƒ! A‰@=„!\n‰„ †C ƒ1ÆÇ\"‚C ƒ;Ê ‚C ÁLˆÌ !*‡" [prefix-entry nil next-prefix-list prefix-list completion-entry cmpl-db-debug-p error "Completion entry exists but not on prefix list - %s" string inside-locate-completion-entry locate-completion-db-error cmpl-db-symbol locate-completion-entry-retry] 4 "\ 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'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] locate-completion-db-error #[nil "ÀÁ!‡" [error "Completion database corrupted. Try M-x clear-all-completions. Send bug report."] 2]] 3) (defalias 'add-completion-to-tail-if-new #[(string) "À !†8 !à Å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 "\ 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-head #[(string) "ƒÁ ˆÂ !‰ƒLÅÇO! Ê  \"‰ A  ˆ ƒI  A¡„<  ¡ˆ  @¡ˆ   ˆ +‡Í !ÅÇO!  ƒp @¡ˆ  ˆ‚xÐ!Lˆ@L*‡" [completion-to-accept accept-completion find-exact-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 "\ If STRING is not in the database, add it to prefix list. STRING is added to the head of the appropriate prefix list. Otherwise it is moved to the head of the list. 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 'delete-completion #[(string) "ƒÁ ˆÂ !‰ƒMÅÇO! Ê  \"  ÍLˆ ƒ< ‰AA¡„J  ¡ˆ‚J ‰@A „JÍLˆ*͇ÏÐ \"‡" [completion-to-accept accept-completion find-exact-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. Couldn't delete it."] 4 "\ Deletes the completion from the database. String must be longer than `completion-prefix-min-length'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias interactive-completion-string-reader #[(prompt) "À ‰ƒÂà #‚ÂÅ \"Ç\"‰ GÊUƒ+ †)Ë  +C‡" [symbol-under-or-before-point default format "%s: (default: %s) " prompt "%s: " new-prompt completing-read cmpl-obarray read 0 ""] 5] check-completion-length #[(string) "G Wƒ ÂÃ\"‡C‡" [string completion-min-length error "The string \"%s\" is too short to be saved as a completion."] 3]] 3) (defalias 'add-completion #[(string &optional num-uses last-use-time) "À !ˆtƒ \n‚ Ä !ƒ A ˆ…( AA *‡" [check-completion-length string cmpl-source-interactive current-completion-source add-completion-to-head entry num-uses last-use-time] 2 "\ 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-completion-string-reader "Completion to add")]) (defalias 'add-permanent-completion #[(string) "tƒ‚  ÄÅ#)‡" [cmpl-source-interactive current-completion-source add-completion string nil t] 4 "\ Add STRING if it isn't already listed, and mark it permanent." (interactive-completion-string-reader "Completion to add permanently")]) (defalias (quote kill-completion) #[(string) "À !ˆÂ !‡" [check-completion-length string delete-completion] 2 nil (interactive-completion-string-reader "Completion to kill")]) (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 "\ Accepts the pending completion in `completion-to-accept'. This bumps num-uses. Called by `add-completion-to-head' and `completion-search-reset'."]) (defalias 'use-completion-under-point #[nil "…Á \n‰…Å !*‡" [enable-completion symbol-under-point cmpl-source-cursor-moves current-completion-source string add-completion-to-head] 3 "\ Add the completion symbol underneath the point into the completion buffer."]) (defalias 'use-completion-before-point #[nil "…Á \n‰…Å !*‡" [enable-completion symbol-before-point cmpl-source-cursor-moves current-completion-source string add-completion-to-head] 3 "\ Add the completion symbol before point into the completion buffer."]) (defalias 'use-completion-under-or-before-point #[nil "…Á \n‰…Å !*‡" [enable-completion symbol-under-or-before-point cmpl-source-cursor-moves current-completion-source string add-completion-to-head] 3 "\ Add the completion symbol before point into the completion buffer."]) (defalias 'use-completion-before-separator #[nil "…Á \nÉ…+Ç!…+ A@ÉU…+ AÊ ˆË‰ +‡" [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 "\ 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."]) (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÅÀÆ!„!ÇÀÈ!„*ÇÀÉ!„3Ç ÀÊ!„<Ç\nÀË!„EÇ LJ" [boundp cmpl-test-string "" 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) (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 "\ Set up the for completion searching for STRING. STRING must be longer than `completion-prefix-min-length'."]) (defalias (quote 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]) (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 "\ 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-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 "\ 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-mode #[nil "?Áƒ ÂÄ\"‡" [enable-completion message "Completion mode is now %s." "ON" "OFF"] 3 "\ Toggles whether or not to add new words to the completion database." nil]) (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ÆÀÇ!„!Äć" [boundp cmpl-current-index 0 cmpl-original-string nil cmpl-last-insert-location -1 cmpl-leave-point-at-start] 2) (defalias 'complete #[(&optional arg) " =ƒ\n`|ˆ †Å\\‚T„Ç ˆ:ƒ+ÉÊ ‚.Ì Í ‰„>ÏÐÑ\"ˆƒG ‚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, the 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 "\ 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.}" "*p"]) (byte-code "ÀÁÂ\"ˆÀÃÂ\"ˆÄ ÆÇ#‡" [global-set-key "" complete [4194317] define-key function-key-map [C-return] [4194317]] 4) (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 "\ Parse possible completions from a file and add them to data base." "fFile: "]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÃ >ƒ ‚à BÀ‡" [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 "Do not know how to parse completions in %s buffers."] 3 nil nil] cmpl-find-file-hook #[nil "…! Â>ƒà >ƒÅ ‡ Æ>…!Ç >…!Å ‡" [enable-completion major-mode (emacs-lisp-mode lisp-mode) lisp completions-merging-modes add-completions-from-buffer (c-mode) c] 2] find-file-hooks] 3) (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 "\ Add completions from the current tags table." nil]) (defconst *lisp-def-regexp* "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" "\ A regexp that searches for lisp definition form.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÃ À‡" [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] cmpl-make-c-def-completion-syntax-table #[nil "ÀÁÂ\"ÃÄÁ  Wƒ*ÊË#ˆT‰‚*Ì ‰ƒL@ Ê Ï#ˆA‰„6* Ì ‰ƒm@ Ê Ñ#ˆA‰„W*ÊÒÓ#ˆÊÔÕ#ˆÊÖ×#ˆÊØÙ#ˆ+‡" [make-vector 256 0 (32 10 9 12 11 13) (44 42 61 40 59) separator-chars whitespace-chars table i --dotimes-temp--7 modify-syntax-entry "w" nil char --dolist-temp--8 "_" --dolist-temp--9 " " 91 "(]" 123 "(}" 93 ")[" 125 "){"] 5] cmpl-c-def-syntax-table] 3) (defconst *c-def-regexp* "\n[_a-zA-Z#]" "\ A regexp that searches for a definition form.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÇÀÉÊ\"‡" [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ƒ/``Ã\\{‰Ř„ ƘƒÇvƒÈ ‰ƒÉ !ˆ‚`\n\nƒË\nÌ\"‰\nƒ\nbˆg‰ ÎUƒ[Ë`Ì\"‰\nbˆ‚FÏvˆÐ ‰ƒlÉ !ˆ‚€ÑÒ!ƒ€ÏvˆÐ ‰ƒ€É !ˆ\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 bug report." throw finish-add-completions t] 3)))] 3)] 4] 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] "11" completion-version ";;; 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 completion-backup-filename #[(filename) "ÁP‡" [filename ".BAK"] 2]] 3) (defalias 'save-completions-to-file #[(&optional filename) "À †\n!à !…Ü „Å ˆÆÇ \"ˆÈ Ê   ÎÐ ÊÊÊÕ !Š×Ø!ˆØ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 trim-versions-without-asking 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--10 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 "ÀÁ!ˆÂà \"‡" [set-buffer-modified-p nil message "Couldn't save completion file %s." filename] 3))) cmpl-completions-accepted-p] 4 "\ Save completions in init file FILENAME. If file name is not specified, use `save-completions-file-name'." nil]) (defalias 'load-completions-from-file #[(&optional filename no-message-p) "À †\n!à !Å !‰ƒ Å !…€„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ÉÊ !‰ 8 È=„e ÍVƒ È=„ ƒe  Vƒ 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 "\ Loads a completion init file FILENAME. If file is not specified, then use `save-completions-file-name'." nil]) (defalias 'initialize-completions #[nil "„Á ˆÂ‰‡" [cmpl-initialized-p load-completions-from-file t] 2 "\ Load the default completions file. Also sets up so that exiting emacs will automatically save the file." nil]) (add-hook (quote kill-emacs-hook) (quote (lambda nil (kill-emacs-save-completions) (cmpl-statistics-block (record-cmpl-kill-emacs))))) (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 "\ 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." "r"]) (byte-code "ÀÁÂ\"ˆÃÄÅ\"ˆÃÆÇ\"‡" [global-set-key "" completion-kill-region defalias completion-separator-self-insert-command #[(arg) "À ˆÁ\n!‡" [use-completion-before-separator self-insert-command arg] 2 nil "p"] completion-separator-self-insert-autofilling #[(arg) "À ˆÁ\n!ˆi V… … ‡" [use-completion-before-separator self-insert-command arg fill-column auto-fill-function] 2 nil "p"]] 3) (defalias 'def-completion-wrapper '(macro . #[(function-name type &optional new-name) "Á=ƒÂà DÅÆF‡Ç=ƒÂà DÈÉF‡Ê=ƒ*Âà DËÌF‡Í=ƒ8Âà DÎÏF‡Ð=ƒFÂà DÑÒF‡Ó=ƒTÂà DÔÕF‡Ö=…aÂà D×Ø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 "\ 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."])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊÇ\"ˆËÌÍ\"ˆËÎÏ\"ˆËÐÏ\"ˆËÑÏ\"ˆËÒÏ\"ˆËÓÏ\"ˆËÔÏ\"ˆËÕÏ\"ˆËÖÏ\"ˆË×Ï\"ˆËØÏ\"ˆËÙÏ\"ˆËÚÏ\"ˆËÛÏ\"ˆËÜÏ\"ˆËÝÏ\"ˆËÞÏ\"ˆËßÏ\"ˆËàÏ\"ˆËáÏ\"ˆËâÏ\"ˆËãÏ\"ˆä%Îæ#ˆä%Òæ#ˆä%Ðæ#ˆä%áæ#ˆä%Õæ#ˆä%Ñæ#ˆçèéê#ˆä+ìÏ#ˆä+íÏ#ˆä+îÏ#ˆÀïð\"ˆçñéê#ˆçòéê#ˆçóéê#ˆçôéÁ#ˆçõéê#ˆçöéê#ˆç÷éø#ˆçùéø#ˆçúéø#ˆçûéø#ˆçüéø#ˆçýéø#ˆçþéø#ˆçÿéø#ˆç@éø#ˆçAéÃ#ˆçBéÃ#ˆçCéÃ#ˆçDéÅ#ˆçEéÅ#‡" [defalias use-completion-minibuffer-separator #[nil " )‡" [cmpl-standard-syntax-table cmpl-syntax-table use-completion-before-separator] 1] use-completion-backward-under #[nil "À ˆÁ‡" [use-completion-under-point nil] 1] use-completion-backward (lambda nil) completion-before-command #[nil "ÁN† ‡" [this-command completion-function use-completion-under-or-before-point] 2] add-hook before-command-hook global-set-key " " completion-separator-self-insert-autofilling "!" completion-separator-self-insert-command "%" "^" "&" "(" ")" "=" "`" "|" "{" "}" "[" "]" ";" "\"" "'" "#" "," "?" "." ":" define-key lisp-mode-map self-insert-command put electric-c-semi completion-function use-completion-before-separator c-mode-map "+" "*" "/" completion-setup-fortran-mode #[nil "À ÂÃ#ˆÀ ÄÃ#ˆÀ ÅÃ#ˆÀ ÆÃ#‡" [define-key fortran-mode-map "+" completion-separator-self-insert-command "-" "*" "/"] 4] newline newline-and-indent comint-send-input exit-minibuffer 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 backward-word backward-sexp delete-backward-char delete-backward-char-untabify] 4) emacs-19.22/lisp/cookie1.elc100666 12120 1 5600 5451134727 14106 0ustar rmsdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:36:23 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/cookie1.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (random t) (defconst cookie-delimiter "\n%%\n\\|" "\ Delimiter used to separate cookie file entries.") (defvar cookie-cache (make-vector 511 0) "\ Cache of cookie files that have already been snarfed.") (defalias 'cookie #[(phrase-file startmsg endmsg) "À \n #Å !ˆ ÆH)‡" [cookie-snarf phrase-file startmsg endmsg cookie-vector shuffle-vector 1] 4 "\ 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-insert #[(phrase-file &optional count startmsg endmsg) "À \n #Å !ˆ`ÇcˆÈ GÉZ\n†É^ \"ˆÇcˆË`Ì#*‡" [cookie-snarf phrase-file startmsg endmsg cookie-vector shuffle-vector start 10 cookie1 1 count fill-region-as-paragraph nil] 4 "\ 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 'cookie1 #[(arg cookie-vec) "ÁUƒ‡ HcˆÄcˆÅS \"‡" [arg 0 t cookie-vec " " cookie1] 3 "\ Inserts a cookie phrase ARG times."]) (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 " beg kill-buffer endmsg apply vector] 5 "\ 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 'read-cookie #[(prompt phrase-file startmsg endmsg &optional require-match) "À \n\"„ à #ˆÆÈ \n\"‰ ÊN†KË à #‰ GS‰ÏVƒC HC B ‚*Ð Ê #+)Ëˉ&‡" [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 "\ 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 'shuffle-vector #[(vector) "ÀÁ‰\nG‰ Wƒ5Ç Z!\\\nH\n\n HIˆ\n IˆT‰‚ ,\n‡" [0 nil vector len temp j i random] 5 "\ Randomly permute the elements of VECTOR (all permutations equally likely)"]) (provide (quote cookie1)) emacs-19.22/lisp/cplus-md.elc100666 12062 1 27662 5426661562 14306 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 1 02:32:18 1993 ;;; from file /home/fsf/rms/e19/lisp/cplus-md.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (defvar c++-mode-abbrev-table nil "\ Abbrev table used in C++ mode.") (define-abbrev-table (quote c++-mode-abbrev-table) nil) (defvar c++-mode-map nil "\ Keymap used in C++ mode.") (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) (defvar c++-mode-syntax-table nil "\ Syntax table used in C++ mode.") (byte-code "„Á\n!ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÁ‡" [c++-mode-syntax-table copy-syntax-table c-mode-syntax-table modify-syntax-entry 42 ". 23b" 47 ". 124" 10 ">"] 4) (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 class 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.") (defalias 'c++-mode #[nil "À ˆÁ\n!ˆÃ !ˆÅÇÉ\n  ÍÎ!ÏLˆÍÐ!ÑLˆÍÒ!ÓLˆÍÔ!ÕLˆÍÖ!×LˆÍØ!ÙPLˆÍÛ!LˆÍÜ!ÝLˆÍÞ!ÝLˆÍß!àLˆáâ!ˆ#…fä\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 nil run-hooks c++-mode-hook c++-electric-colon define-key ":" electric-c++-terminator] 4 "\ 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 class 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." nil]) (defalias (quote 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]) (defalias 'electric-c++-brace #[(arg) "À\n„AlƒAŠÃÀxˆn)„ ƒAÅ ˆÆ ˆcˆÅ ˆ ƒ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 "\ Insert character and correct line's indentation." "P"]) (defalias 'electric-c++-semi #[(arg) "ƒÁ\n!‡ÃÄ\n!!‡" [c-auto-newline electric-c++-terminator arg self-insert-command prefix-numeric-value] 3 "\ Insert character and correct line's indentation." "P"]) (defalias 'electric-c++-terminator #[(arg) "À` „lƒŠÄyˆÅÀwˆgÆU†]È=ƒAÉÊ!„AŠËvˆÅÀwˆ` W)ƒAŠËˆÉÌ!)†]Í ˆÎ` \"Ð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 "\ Insert character and correct line's indentation." "P"]) (defalias 'c++-indent-command #[(&optional whole-exp) "ƒ3Á ‰ŠƒÇyˆ`ÈÉ!ˆ` bˆÉyˆ`) V…1Ê Ë$+‡„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 "\ 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." "P"]) (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ˆ -‡" [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[ ]class[ ]" c++-friend-offset 125 c-indent-level 123 c-brace-offset] 7 "\ Indent current line as C++ code. Return the amount the indentation changed by."]) (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ƒ’À‚¨ÀyˆËÁwˆgÏUƒ·ƒ¬× \\‚¨ÔuˆËÁwˆi‚¨× ‚¨\nfÌU„ùƒñÙ 8ƒÚŠ\nTbˆÚÛ!)„ñ\nbˆÀyˆËÁwˆ`\\\nT^bˆi‚¨\nTbˆi‚¨ bˆÍ\n!ˆhÜ>„'Ý\n!ˆiŠ bˆËÁwˆg)Ì=ƒ!‚\"À\\\\‚¨\nbˆŠÔuˆàÁwˆÚáâãäR!ƒlgåUƒHÔyˆ‚.Úæ!ƒWçèÁé#ˆ‚.Úê!ƒcÔyˆ‚.ëìÁé#ˆ‚.` W…si)†¨nƒŠ-ÀUƒŠ.\\‚Œ-ËÁxˆnƒ˜À‚š/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 c++-continued-member-init-offset current-indentation c++-empty-arglist-indent 2 looking-at "\\( \\| \\)*[^/\n]" (nil 44 59 125 58 123) c-backward-to-start-of-continued-exp c-continued-statement-offset c-continued-brace-offset " \n" "#\\|/\\*\\|//" "\\|case[ ]" "\\|[a-zA-Z0-9_$]*:[^:]" "\\|friend[ ]class[ ]" 35 "/\\*" search-forward "*/" move "//\\|friend[ ]class[ ]" re-search-forward ":[^:]" c-indent-level c-brace-offset c-brace-imaginary-offset forward-sexp -1] 6 "\ 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 (quote c++-backward-to-noncomment) #[(lim) "À‰ ?…Zà xˆ`` Å\\Yƒ+ŠÆuˆÇÈ!)ƒ+ÉÊ Ë#ˆ‚ÉÌÍ ]Ë#ƒ=Î`\n\"ƒÏyˆÐÀwˆÇÑ!ƒR` X‰‚Ò\nbˆ‚*‡" [nil stop opoint " \n " lim 2 -2 looking-at "\\*/" search-backward "/*" move "//" c++-point-bol c++-within-string-p 0 " " "#" t] 5]) (defalias 'indent-c++-exp #[nil "ÀC`CÀ‰‰‰‰‰‰‰‰‰‰`Á \n   ŠÑÒ!ˆ)ŠÀ m?… ?…\nÀ  „¡mƒVÓ‰ „¡\n Ô`Àˆ`À‰\n%‰\n@\nAA@ƒƒ\nAA@ÁYƒƒ\nAA@Õ 8ƒÖ ˆ×\n8ƒšÒyˆ‚FÓ‰ ƒK\nÁXƒªÓ  „5Ø\n8VƒÌAAS‰‚±\nU„ÖÀ\nWƒòÀBÀBT‰‚Ø@„\n\nA@†ŠÑÙ!ˆ`) ˆÒyˆÚÀwˆl„5@ƒy@ÁYƒy@fÛU„4@‚‘ŠÜÝ!gÛUÞ !ˆhß>„aà@!ˆ!i ƒY\"‚ZÁ\\\\‚u ƒpã !ˆä ‚u@)‚‘å@…„@[!&&‰ ˆ)Üç!ƒž(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 " " 123 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 calculate-c++-indent val "\\(public\\|private\\|protected\\):" c-indent-level "case[ ]" "[A-Za-z]" ":[^:]" c-label-offset "friend[ ]class[ ]" c++-friend-offset 125 c-brace-offset 35 comment-start-skip re-search-forward indent-for-comment] 16 "\ Indent each line of the C++ grouping following point." nil]) (defalias 'fill-c++-comment #[nil "ŠÂyˆŠÃ ŠÅˆ`)Æ#ˆÂ•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 "\ Fill a comment contained in consecutive lines containing point. The fill lines remain a comment." nil]) (defalias 'c++-point-bol #[nil "ŠÀyˆ`)‡" [0] 1 "\ Returns the value of the point at the beginning of the current line."]) (defalias 'c++-within-string-p #[(point1 point2) " {ÃÄ\n\"ŦÆU)?‡" [point1 point2 s c++-count-char-in-string 34 2 0] 3 "\ Returns true if number of double quotes between two points is odd."]) (defalias (quote c++-count-char-in-string) #[(c s) "À‰ GWƒ\"\n H UƒÅ‚À\\ T‰‚\n*‡" [0 pos count s c 1] 4]) emacs-19.22/lisp/cplus-md1.elc100666 13437 1 151362 5474620520 14560 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:54:39 1993 ;;; from file /home/fsf/rms/e19/lisp/cplus-md1.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ ÂÃÄÅ#ˆÄ‡" [fboundp c-mode load "c-mode" nil t] 4) (defconst c++-emacs-features (byte-code "ÀÁÄ``\"GÅUƒ=Æ ÈÉÊ#ˆËÌÉHÍ\"Î\"ÎUƒ-Ï‚/ÐÑÒ!ƒ:Ó‚<Ô) \n*D‡" [no-dual-comments v18 scanner mse-spec parse-partial-sexp 8 copy-syntax-table table modify-syntax-entry 97 ". 12345678" logand lsh -16 255 8-bit 1-bit fboundp forward-comment v19 old-v19] 4) "\ A list of needed features extant in the Emacs you are using. There are many flavors of Emacs out on the net, each with different features supporting those needed by c++-mode. Here's the current known list, along with the values for this variable: Vanilla GNU 18/Epoch 4: (no-dual-comments v18) GNU 18/Epoch 4 (patch1): (8-bit old-v19) GNU 18/Epoch 4 (patch2): (8-bit v19) Lemacs 19.4 - 19.7: (8-bit old-v19) Lemacs 19.8 and over: (8-bit v19) FSF 19: (1-bit v19) FSF 19 (patched): (8-bit v19)") (defvar c++-mode-abbrev-table nil "\ Abbrev table in use in c++-mode buffers.") (define-abbrev-table (quote c++-mode-abbrev-table) nil) (defvar c++-mode-map nil "\ Keymap used in c++-mode.") (byte-code "„ØÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÆ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÂÒÓ#ˆÂÔÕ#ˆÂÖ×#ˆÂØÙ#ˆÂÚÛ#ˆÂÜÝ#ˆÂÞß#ˆÂàá#ˆÂâã#ˆÂäå#ˆÂæç#ˆÂèé#ˆÂêë#ˆÂìí#ˆÂîï#ˆð1>ƒ¼Âòó#ˆÂôõ#ˆÂöõ#ˆÂ÷õ#ˆÂøõ#ˆÂùõ#ˆÂúû#ˆÂüý#ˆÂþÿ#ˆÂ@A#ˆÁ‡" [c++-mode-map make-sparse-keymap define-key "\n" reindent-then-newline-and-indent "{" c++-electric-brace "}" ";" c++-electric-semi "#" c++-electric-pound "" mark-c-function "" c++-indent-exp " " c++-indent-command " " c++-insert-header "" c++-macroize-region "" c++-comment-region "" c++-uncomment-region "" c++-match-paren "" c++-beginning-of-defun "" c++-end-of-defun "" c++-indent-defun "/" c++-electric-slash "*" c++-electric-star ":" c++-electric-colon "" c++-electric-delete "" c++-toggle-auto-hungry-state "" c++-toggle-hungry-state "" c++-toggle-auto-state v18 c++-emacs-features "'" c++-tame-comments "'" c++-tame-insert "[" "]" "(" ")" "" c++-submit-bug-report "" c++-version "" c++-forward-sexp "" c++-backward-sexp] 4) (defvar c++-mode-syntax-table nil "\ Syntax table used in c++-mode buffers.") (defvar c++-c-mode-syntax-table nil "\ Syntax table used in c++-c-mode buffers.") (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÆ#ˆÂÈÆ#ˆÂÉÆ#ˆÂÊÆ#ˆÂËÆ#ˆÂÌÆ#ˆÂÍÆ#ˆÂÎÏ#ˆÐ>ƒ_ÂÒÓ#ˆÂÔÕ#ˆÂÖ×#ˆ‚Ø>ƒ{ÂÒÙ#ˆÂÔÚ#ˆÂÖÛ#ˆ‚ÂÒÙ#ˆÂÔÕ#ˆÂÖÛ#ˆ„êÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÆ#ˆÂÈÆ#ˆÂÉÆ#ˆÂÊÆ#ˆÂËÆ#ˆÂÌÆ#ˆÂÍÆ#ˆÂÎÏ#ˆÂÒÝ#ˆÂÔÕ#ˆÁ‡" [c++-mode-syntax-table make-syntax-table modify-syntax-entry 92 "\\" 43 "." 45 61 37 60 62 38 124 39 "\"" 8-bit c++-emacs-features 47 ". 1456" 42 ". 23" 10 "> b" 1-bit ". 124" ". 23b" ">" c++-c-mode-syntax-table ". 14"] 4) (defvar c++-tab-always-indent (byte-code "ÀÁ!ƒ ‡Â‡" [boundp c-tab-always-indent t] 2) "\ *Controls the operation of the TAB key. If t (the default), 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 not-nil-or-t, then tab is inserted only within literals (comments and strings) and inside preprocessor directives, but line is always reindented.") (defvar c++-always-arglist-indent-p nil "\ *Control indentation of continued arglists. When non-nil, arglists continued on subsequent lines will always indent `c++-empty-arglist-indent' spaces, otherwise, they will indent to just under previous line's argument indentation.") (defvar c++-block-close-brace-offset 0 "\ *Extra indentation given to close braces which close a block. This variable can be either an integer or a list. If an integer, it describes the extra offset given a block closing brace (and a closing paren if `c++-paren-as-block-close-p' is non-nil), treating all closing parens the same. If a list of the form (OTHERS . TOPLEVEL), OTHERS is an integer describing the offset given to all but top-level (e.g. function) closing braces, while TOPLEVEL is an integer describing offset given only to braces which close top-level constructs.") (defvar c++-paren-as-block-close-p nil "\ *Treat a parenthesis which is the first non-whitespace on a line as a paren which closes a block. When non-nil, `c-indent-level' is subtracted, and `c++-block-close-brace-offset' is added to the line's offset.") (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 class declarations relative to member declarations.") (defvar c++-access-specifier-offset c-label-offset "\ *Extra indentation given to public, protected, and private labels.") (defvar c++-empty-arglist-indent nil "\ *Indicates how far to indent a line following an empty argument list. Nil means indent to just after the paren.") (defvar c++-comment-only-line-offset 0 "\ *Indentation offset for line which contains only C or C++ style comments. This variable can take either a single integer or a list of integers. If a single integer this is the extra indentation offset to apply to all comment-only lines, except those which start in column zero. If a list is used, the first integer is for all non-column-zero comment-only lines and the second integer is for all column-zero lines. You can also use a list containing only 1 integer, in which case, this value is used for all comment-only lines. For example: value meaning ===== ======= 0 comment-only lines do not indent 4 non-col0 lines indent 4 spaces, col0 lines don't indent '(4) all comment-only lines indent 4 spaces '(4 1) non-col0 lines indent 4 spaces, col0 lines indent 1 space") (defvar c++-C-block-comments-indent-p nil "\ *4 styles of C block comments are supported. If this variable is nil, then styles 1-3 are supported. If this variable is non-nil, style 4 is supported. style 1: style 2: style 3: style 4: /* /* /* /* blah * blah ** blah blah blah * blah ** blah blah */ */ */ */ ") (defvar c++-cleanup-list nil "\ *List of various C++ constructs to \"clean up\". These cleanups only take place when the auto-newline feature is turned on, as evidenced by the `/a' or `/ah' appearing next to the mode name. Current legal values are: `brace-else-brace' -- clean up `} else {' constructs by placing entire construct on a single line. This cleanup only takes place when there is nothing but white space between the braces and the else. `empty-defun-braces' -- cleans up empty C++ function braces by placing them on the same line. `defun-close-semi' -- cleans up the terminating semi-colon on class definitions and functions by placing the semi on the same line as the closing brace.") (defvar c++-hanging-braces t "\ *Controls the insertion of newlines before open (left) braces. This variable only has effect when auto-newline is on, as evidenced by the `/a' or `/ah' appearing next to the mode name. If nil, open braces do not hang (i.e. a newline is inserted before all open braces). If t, all open braces hang -- no newline is inserted before open braces. If not nil or t, newlines are only inserted before top-level open braces; all other braces hang.") (defvar c++-hanging-member-init-colon (quote before) "\ *Defines how colons which introduce member initializations are formatted. Legal values are: t -- no newlines inserted before or after colon nil -- newlines inserted before and after colon `after' -- newlines inserted only after colon `before` -- newlines inserted only before colon") (defvar c++-auto-hungry-initial-state (quote none) "\ *Initial state of auto/hungry features when buffer is first visited. Legal values are: `none' -- no auto-newline and no hungry-delete-key. `auto-only' -- auto-newline, but no hungry-delete-key. `hungry-only' -- no auto-newline, but hungry-delete-key. `auto-hungry' -- both auto-newline and hungry-delete-key enabled. Nil is synonymous for `none' and t is synonymous for `auto-hungry'.") (defvar c++-auto-hungry-toggle t "\ *Enable/disable toggling of auto/hungry features. Legal values are: `none' -- auto-newline and hungry-delete-key cannot be enabled. `auto-only' -- only auto-newline feature can be toggled. `hungry-only' -- only hungry-delete-key feature can be toggled. `auto-hungry' -- both auto-newline and hungry-delete-key can be toggled. Nil is synonymous for `none' and t is synonymous for `auto-hungry'.") (defvar c++-relative-offset-p t "\ *Control the calculation for indentation. When non-nil (the default), indentation is calculated relative to the first statement in the block. When nil, the indentation is calculated without regard to how the first statement is indented.") (defvar c++-untame-characters (byte-code "À >…‡" [v18 c++-emacs-features (39)] 2) "\ *Utilize a backslashing workaround of an Emacs syntax parsing bug. If non-nil, this variable should contain a list of characters which will be prepended by a backslash in comment regions. By default, the list contains only the most troublesome character, the single quote. To be completely safe, set this variable to: '(?( ?) ?' ?{ ?} ?[ ?]) This is the full list of characters which can potentially cause problems if they exist unbalanced within comments. Setting this variable to nil will defeat this feature, but be forewarned! Such un-escaped characters in comment regions can potentially break many things such as some indenting and blinking of parenthesis. Note further that only the default set of characters will be escaped automatically as they are typed. But, executing `c++-tame-comments' (\\[c++-tame-comments]) will escape all characters which are members of this set, and which are found in comments throughout the file. Finally, c++-mode can tell if you're running a patched Emacs. If so, taming characters isn't necessary and this variable is automatically set to nil.") (defvar c++-default-macroize-column 78 "\ *Column to insert backslashes.") (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. By supplying a hook, you can make adjustments to the line's standard indentation. If you do use this hook, you will likely need to also set `c++-relative-offset-p' to nil. The call to this hook is wrapped in a `save-excursion' so you don't need to worry about restoring point and mark inside the hook function.") (defvar c++-delete-function (quote backward-delete-char-untabify) "\ *Function called by `c++-electric-delete' when deleting a single char.") (defvar c++-electric-pound-behavior nil "\ *List of behaviors for electric pound insertion. Only currently supported behavior is `alignleft'.") (defvar c++-backscan-limit 2000 "\ *Limit in characters for looking back while skipping syntactic ws. If you typically write really big methods, and start noticing incorrect indentations, try cranking this value up. The larger this value is, though, the slower parts of c++-mode can become. Setting this variable to nil defeats backscan limits.") (defvar c++-hungry-delete-key nil "\ Internal state of hungry delete key feature.") (defvar c++-auto-newline nil "\ Internal state of auto newline feature.") (byte-code "ÀÁ!ˆÀÂ!‡" [make-variable-buffer-local c++-auto-newline c++-hungry-delete-key] 2) (defconst c++-access-key "\\<\\(public\\|protected\\|private\\)\\>:" "\ Regexp which describes access specification keywords.") (defconst c++-class-key (concat "\\(\\(extern\\|typedef\\)\\s +\\)?" "\\(template\\s *<[^>]*>\\s *\\)?" "\\<\\(class\\|struct\\|union\\)\\>") "\ Regexp which describes a class declaration, including templates.") (defconst c++-inher-key (concat "\\(\\\\s +\\)?" c++-class-key "[ ]+\\(\\(\\w\\|_\\)+[ ]*:[ ]*\\)?") "\ Regexp which describes a class inheritance declaration.") (defalias 'c++-mode #[nil "À ˆÁ\n!ˆÃ !ˆÅÇ \nËÌ!ÍPLˆËÏ! LˆËÐ!ÑLˆËÒ!ÑLˆËÓ!ÔLˆËÕ!ÖLˆË×!ØLˆËÙ!ÚLˆËÛ!ÜLˆËÝ!ÞLˆËß!àLˆ!<ƒoÔ\"ãä!\"ˆ\")!åæ!ˆç(é>(ê>\"‡" [kill-all-local-variables use-local-map c++-mode-map set-syntax-table c++-mode-syntax-table c++-mode major-mode "C++" mode-name c++-mode-abbrev-table local-abbrev-table make-local-variable paragraph-start "^$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t require-final-newline parse-sexp-ignore-comments nil indent-line-function c++-indent-line comment-start "// " comment-end "" comment-column 32 comment-start-skip "/\\*+ *\\|// *" comment-indent-hook c++-comment-indent mode-line-format modeline mapcar #[(element) "À \nÃ=ƒ Ä‚\nC\"‰‡" [append modeline element mode-name (mode-name (c++-hungry-delete-key (c++-auto-newline "/ah" "/h") (c++-auto-newline "/a")))] 4] run-hooks c++-mode-hook c++-set-auto-hungry-state c++-auto-hungry-initial-state (auto-only auto-hungry t) (hungry-only auto-hungry t)] 4 "\ Major mode for editing C++ code. 2.353 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 and send the message. 1. Very much like editing C code, 2. Expression and list commands understand all C++ brackets, 3. Tab at left margin indents for C++ code, 4. Both C++ and C style block comments are recognized, 5. Paragraphs are separated by blank lines only, 6. Hungry delete key and auto newline features are optional. IMPORTANT NOTE: You may notice that some characters (by default, only single quote) will get escaped with a backslash when typed in a comment region. This is a necessary workaround of a bug present in GNU Emacs 18 and derivatives. Enter `\\[describe-variable] c++-untame-characters RET' for more information. If you are running a patched Emacs, no characters will be escaped in comment regions, and many functions will run much faster. Key bindings: \\{c++-mode-map} These variables control indentation style. Those with names like c- are inherited from c-mode. Those with names like c++- are unique for this mode, or have extended functionality from their c-mode cousins. c-argdecl-indent Indentation level of declarations of C function arguments. 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-brace-offset Extra indentation for line if it starts with an open brace. c-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to `c-continued-statement-offset'. c-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. 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-label-offset Extra indentation for line that is a label, or case or `default:'. c++-C-block-comments-indent-p Style of C block comments to support. c++-access-specifier-offset Extra indentation given to public, protected, and private keyword lines. c++-always-arglist-indent-p Control indentation of continued arglists. When non-nil, arglists continued on subsequent lines will always indent `c++-empty-arglist-indent' spaces, otherwise, they will indent to just under previous line's argument indentation. c++-auto-hungry-initial-state Initial state of auto/hungry feature when a C++ buffer is first visited. c++-auto-hungry-toggle Enable/disable toggling of auto/hungry features. c++-backscan-limit Limit in characters for looking back while skipping syntactic whitespace. This variable is only used in an un-patched Emacs to help improve performance at the expense of some accuracy. Patched Emacses are both fast and accurate. c++-block-close-brace-offset Extra indentation give to braces which close a block. c++-cleanup-list A list of construct \"clean ups\" which c++-mode will perform when auto-newline feature is on. Current legal values are: `brace-else-brace', `empty-defun-braces', `defun-close-semi'. c++-comment-only-line-offset Extra indentation for a line containing only a C or C++ style comment. Can be an integer or list, specifying the various styles of comment-only line special indentations. 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. c++-default-macroize-column Column to insert backslashes when macroizing a region. c++-delete-function Function called by `c++-electric-delete' when deleting a single char. c++-electric-pound-behavior List of behaviors for electric pound insertion. c++-empty-arglist-indent Extra indentation to apply to a line following an empty argument list. nil means to line it up with the left paren. c++-friend-offset Offset of C++ friend class declarations relative to member declarations. c++-hanging-braces Controls open brace hanging behavior when using auto-newline feature. nil says no braces hang, t says all open braces hang. non-nil-or-t means top-level open braces don't hang, all others do. c++-hanging-member-init-colon Defines how colons which introduce member initialization lists are formatted. t means no newlines are inserted either before or after the colon. nil means newlines are inserted both before and after the colon. `before' inserts newlines only before the colon, and `after' inserts newlines only after colon. c++-member-init-indent Indentation level of member initializations in function declarations, if they are on a separate line beginning with a colon. c++-paren-as-block-close-p If non-nil, treat a parenthesis which is the first non-whitespace on a line as a paren which closes a block (i.e. treat it similar to right curly brace). c++-relative-offset-p Control the calculation for indentation. When non-nil (the default), indentation is calculated relative to the first statement in the block. When nil, the indentation is calculated without regard to how the first statement is indented. Useful when using a `c++-special-indent-hook'. c++-special-indent-hook Hook for user defined special indentation adjustments. You can use this hook, which gets called after a line is indented by the mode, to customize indentations of the line. c++-tab-always-indent Controls the operation of the TAB key. t means always just indent the current line. nil means indent the current line only if point is at the left margin or in the line's indentation; otherwise insert a tab. Any other value means insert tab only within literals (comments and strings) and inside preprocessor directives, but always reindent the line. The default is value for `c-tab-always-indent'. c++-untame-characters When non-nil, inserts backslash escapes before certain untamed characters in comment regions. It is recommended that you keep the default setting to workaround a nasty Emacs bug, unless you are running a patched Emacs. Auto-newlining is no longer an all or nothing proposition. In my opinion, I don't believe it is possible to implement a perfect auto-newline algorithm. Sometimes you want it and sometimes you don't. So now auto-newline (and its companion feature, hungry-delete-key) can be toggled on and off on the fly. Hungry-delete-key is the optional behavior of the delete key so that, when enabled, hitting the delete key once consumes all preceding whitespace, unless point is within a literal (defined as a C or C++ comment, or string). Inside literals, and with hungry-delete-key disabled, the delete key just calls the function in variable `c++-delete-function'. Selection and toggling of these features is controlled by the variables `c++-auto-hungry-initial-state' and `c++-auto-hungry-toggle'. Legal values for both variables are: `none' (or nil) -- no auto-newline or hungry-delete-key. `auto-only' -- function affects only auto-newline feature. `hungry-only' -- function affects only hungry-delete-key feature. `auto-hungry' (or t) -- function affects both features. Thus if `c++-auto-hungry-initial-state' is `hungry-only', then only hungry-delete-key feature is turned on when the buffer is first visited. If `c++-auto-hungry-toggle' is `auto-hungry', and both auto-newline and hungry-delete-key features are on, then hitting `\\[c++-toggle-auto-hungry-state]' will toggle both features. Hitting `\\[c++-toggle-hungry-state]' will always toggle hungry-delete-key feature and hitting `\\[c++-toggle-auto-state]' will always toggle auto-newline feature, regardless of the value of `c++-auto-hungry-toggle'. 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++-access-specifier-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." nil]) (defalias 'c++-c-mode #[nil "À ˆÁà ÇÉ\nË !ˆÍÎ!‡" [c++-mode c++-c-mode major-mode "C" mode-name c-mode-abbrev-table local-abbrev-table "/* " comment-start " */" comment-end set-syntax-table c++-c-mode-syntax-table run-hooks c++-c-mode-hook] 2 "\ Major mode for editing K&R and ANSI C code. 2.353 This mode is based on c++-mode. Documentation for this mode is available by doing a `\\[describe-function] c++-mode'." nil]) (defalias 'c++-comment-indent #[nil "ÀÁ!ƒ‡ŠÃÄxˆiÂUƒ‚iTŠÂyˆo„$ÅyˆÃÄwˆÀÆ!ƒ>iWƒ:‚?i‚?Â)`ÅyˆÉ\nË#ƒX”bˆi‚Z)]])‡" [looking-at "^\\(/\\*\\|//\\)" 0 " " nil -1 "/\\*\\|//" comment-column cur-pt re-search-forward comment-start-skip t] 6 "\ Used by `indent-for-comment' to decide how much to indent a comment in C++ code based on its context."]) (defalias 'c++-set-auto-hungry-state #[(auto-p hungry-p) "\nÄÅ !‡" [auto-p c++-auto-newline hungry-p c++-hungry-delete-key set-buffer-modified-p buffer-modified-p] 2 "\ Set auto/hungry to state indicated by AUTO-P and HUNGRY-P. Update mode line to indicate state to user."]) (defalias 'c++-toggle-auto-state #[(arg) "„ ?‚#Â!‰ÃUƒ ?‚#ÃWƒ\"Ä‚#ÅÇ\")‡" [arg c++-auto-newline prefix-numeric-value 0 nil t auto c++-set-auto-hungry-state c++-hungry-delete-key] 3 "\ Toggle auto-newline feature. This function ignores `c++-auto-hungry-toggle' variable. Optional numeric ARG, if supplied turns on auto-newline when positive, turns off auto-newline when negative and toggles when zero." "P"]) (defalias 'c++-toggle-hungry-state #[(arg) "„ ?‚#Â!‰ÃUƒ ?‚#ÃWƒ\"Ä‚#ÅÇ\")‡" [arg c++-hungry-delete-key prefix-numeric-value 0 nil t hungry c++-set-auto-hungry-state c++-auto-newline] 3 "\ Toggle hungry-delete-key feature. This function ignores `c++-auto-hungry-toggle' variable. Optional numeric ARG, if supplied turns on hungry-delete-key when positive, turns off hungry-delete-key when negative and toggles when zero." "P"]) (defalias 'c++-toggle-auto-hungry-state #[(arg) "À !ÃÄÅEÇÄÅE „' >ƒ\"\n?‚K\n‚K <ƒ4 >‚K\nÌUƒ@\n?‚K ÌWƒJÍ‚KÅ „d >ƒ_?‚ˆ‚ˆ <ƒq >‚ˆ\nÌUƒ}?‚ˆ ÌWƒ‡Í‚ˆÅÑ\"-‡" [prefix-numeric-value arg numarg auto-only auto-hungry t apl hungry-only hpl c++-auto-hungry-toggle c++-auto-newline c++-auto-hungry-initial-state 0 nil auto c++-hungry-delete-key hungry c++-set-auto-hungry-state] 3 "\ Toggle auto-newline and hungry-delete-key features. Actual toggling of these features is controlled by `c++-auto-hungry-toggle' variable. Optional argument has the following meanings when supplied: Universal argument \\[universal-argument] resets features to c++-auto-hungry-initial-state. negative number turn off both auto-newline and hungry-delete-key features. positive number turn on both auto-newline and hungry-delete-key features. zero toggle both features regardless of `c++-auto-hungry-toggle-p'." "P"]) (defalias 'c++-tame-insert #[(arg) " >ƒ Ã>ƒÄcˆÅ!‡" [last-command-char c++-untame-characters c++-in-literal (c c++) "\\" self-insert-command arg] 2 "\ Safely inserts certain troublesome characters in comment regions. Because of syntax bugs in Emacs, characters with string or parenthesis syntax must be escaped with a backslash or lots of things get messed up. Unfortunately, setting `parse-sexp-ignore-comments' to non-nil does not fix the problem, but this function is unnecessary if you are running a patched Emacs. See also the variable `c++-untame-characters'." "p"]) (defalias 'c++-electric-delete #[(arg) "ƒ ƒ\nà !!‡ÄÅ!Æ !Ç>†#ŠÈÉxˆhÊU))„A` ÌÉxˆ` U„<` |‚?\nÍ!)‡\nÍ!‡" [c++-hungry-delete-key arg c++-delete-function prefix-numeric-value c++-point bod c++-in-literal (c c++ string) " " nil 35 here " \n" 1] 3 "\ If `c++-hungry-delete-key' is non-nil, consumes all preceding whitespace unless ARG is supplied, or point is inside a C or C++ style comment or string. If ARG is supplied, this just calls `backward-delete-char-untabify' passing along ARG. If `c++-hungry-delete-key' is nil, just call `backward-delete-char-untabify'." "P"]) (defalias 'c++-electric-pound #[(arg) "À Á>ƒ  !‡Ä onÈ >ƒ!ÊyˆË ˆƒ0Ì  \"cˆ‚8ÎÌ  \"!ˆ „@bˆω“+‡" [c++-in-literal (c c++ string) self-insert-command arg point-marker bolp bobp here alignleft c++-electric-pound-behavior 0 delete-horizontal-space make-string last-command-char insert-before-markers nil] 4 "\ Electric pound command." "p"]) (defalias 'c++-electric-brace #[(arg) "À ÂÃ! „JŠÆÀwˆl)ƒJŠÆÀxˆn)„U ÈU  ƒD\nË=„A\nƒDÌË \"„DÀÇ ƒTÍ ˆŠÎyˆÍ ˆ)* >ƒgÐ !Ñ>ƒgÒcˆ ÈUƒtnƒtÍ ˆ cˆÓ Õ>ƒ®ÌË \"ƒ®ƒ® ×Uƒ®ÎuˆØÀxˆhÈUƒ®Ð Ù>„®`S|ˆbˆÀ‰“ˆ)Ó À‰Ü>ƒ  ÈUƒ ÝÞÀË#à”à•)ƒ Uƒ Ð !á>„ |ˆâã!ˆbˆÀ‰“ˆ‚bˆÀ‰“ˆ+Í ˆÇ ƒ<ŠÓ `äZbˆÍ ˆbäZÀ‰“ˆ*Í ˆŠ ƒE TbˆåÎ!ˆ) ƒ[Š bˆæç !!)‚`æç !!+‡" [nil last-command-char c++-point bod insertpos arg " " c++-auto-newline 123 open-brace-p c++-hanging-braces t c++-at-top-level-p c++-indent-line -1 c++-untame-characters c++-in-literal (c c++) "\\" point-marker here empty-defun-braces c++-cleanup-list 125 " \n" (c c++ string) mend mbeg brace-else-brace re-search-backward "}[ \n]*else[ \n]*{" status 0 (c c++ string) insert-before-markers "} else {" 2 delete-char self-insert-command prefix-numeric-value] 4 "\ Insert character and correct line's indentation." "P"]) (defalias 'c++-electric-slash #[(arg) "`ÀÃÄ !!ˆ\nSf‰… ÆU…Š\nbˆÇ )*‡" [nil char here self-insert-command prefix-numeric-value arg 47 c++-indent-line] 3 "\ Insert slash, and if slash is second of a double-slash comment introducing construct, indent line as comment. This only indents if we're on a comment-only line, otherwise use `indent-for-comment' (\\[indent-for-comment])." "P"]) (defalias 'c++-electric-star #[(arg) "`ÀÃÄ !!ˆ\nSf‰…=Æ Ç>…= È>…=ŠÉÀxˆhÊUƒ1ËuˆÌÀxˆn)…=Š\nbˆÍ )*‡" [nil char here self-insert-command prefix-numeric-value arg c++-in-literal (c) (47 42 9 32 10) "* " 47 -1 " " c++-indent-line] 3 "\ Works with `c++-electric-slash' to auto indent C style comment lines." "P"]) (defalias 'c++-electric-semi #[(arg) "À ƒ Á !!‡Ä Æ>ƒ(ƒ(ÉÊxˆhËUƒ( `|ˆ bˆ ʉ“ˆ)Ì !‡" [c++-in-literal self-insert-command prefix-numeric-value arg point-marker here defun-close-semi c++-cleanup-list c++-auto-newline " \n" nil 125 c++-electric-terminator] 3 "\ Insert character and correct line's indentation." "P"]) (defalias 'c++-electric-colon #[(arg) "À ƒ Á !!‡ `ÅÆ!ŠÈÉxˆhÊUƒ6À!Ë>„6`|ˆÉ`‚šbˆÌÍΈÏÉxˆÐ!ˆhÑUƒSÉ‚šbˆÒÓ\"ƒšÐ!ˆhÔUƒ˜bˆÖ>ƒŒ ƒŒŠ×Éxˆn)„ŒÓÄ ˆ`) …”Ø>‚šÉ)bˆÙ !+‡" [c++-in-literal self-insert-command prefix-numeric-value arg c++-auto-newline c++-point bod insertion-point " \n" nil 58 (c c++ string) premature-end (backward-sexp 1) ((error)) "-" c++-backward-syntactic-ws 63 c++-at-top-level-p t 41 c++-hanging-member-init-colon (nil before) " " (nil after) c++-electric-terminator] 4 "\ Electrify colon. De-auto-newline double colons. No auto-new-lines for member initialization list." "P"]) (defalias 'c++-electric-terminator #[(arg) "À` „˜ŠÄÀwˆl)ƒ˜ŠÅyˆÄÀwˆgÆU†fÈ=ƒGÉÊ!„GŠËvˆÄÀwˆ` W)ƒGŠËˆÉÌ!)†fÍ ˆÎÐ` \"Ò8†eÓ8†eÔ8*)„˜cˆÕ ˆƒŠ× „ŠØ ‰`SÀ“ˆÙ ˆÕ ˆŠ\nƒ“\nTbˆÚÛ!ˆ)\nƒ©Š\nbˆÜÝ !!)‚®ÜÝ !!*‡" [nil end insertpos arg " " 0 35 last-command-char 58 looking-at "case[ ]" 1 ":" c++-beginning-of-defun t parse-sexp-ignore-comments parse-partial-sexp pps 3 4 5 c++-indent-line c++-auto-newline c++-in-parens-p make-marker newline delete-char -1 self-insert-command prefix-numeric-value] 4 "\ Insert character and correct line's indentation." "P"]) (defalias 'c++-indent-command #[(&optional whole-exp) "ÀÁ!\nƒDà !ĉŠÉ=ƒÊyˆ`ËÌ!ˆ`bˆÌyˆ`) V…@Í Î$+‚Ä„pŠÏÄxˆn)ƒkÐÑ!„e`ÀÒ!Uƒenƒkà !‚ÄÓ ‚ÄÉ=ƒ}à !‚ÄÔ !Õ>„‘ŠÏÄxˆhÖU)ƒÁ`Š× ˆ`)Äà !ˆŠ× ˆV…³`U)…½Ó +‚Äà !)‡" [c++-point bod whole-exp c++-indent-line nil end beg shift-amt c++-tab-always-indent t 0 forward-sexp 1 indent-code-rigidly "#" " " looking-at "[ ]*$" boi insert-tab c++-in-literal (c c++ string) 35 back-to-indentation indent-p here] 5 "\ 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 not-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." "P"]) (defalias 'c++-indent-exp #[nil "ÀC`CÀ‰‰‰‰‰‰‰‰‰‰Á` \n   ŠÓÔ!ˆ)ŠÀm?…?… À  „×mƒZÁ‰„×  `ÀˆÕ Ö=ƒuÔyˆ× ˆÀˆ‚bØÀxˆÀˆ`m„„Àuˆ`ÜÀ‰ % bˆ+ @ AA@ƒ¹ AA@ÂYƒ¹ AA@ Ý 8ƒÃ× ˆÞ 8ƒÐÔyˆ‚JÁ‰ ƒO ÂXƒàÁ„9ß 8VƒAAS‰‚ç U„ À  Wƒ(ÀBÀBT‰‚@„@ A@†>ŠÓà!ˆ`) ˆÔyˆØÀwˆÕ á>ƒjŠâãdä#ˆ`)%`%Wƒi× ˆÔyˆ‚Y)l„9@ƒ„@ÂYƒ„@\n‚œæ@…@[!''‰\n ˆ)è)!ƒ­\n*\\\n‚Èèë!„Åèì!ƒÑŠÓÔ!ˆèí!)ƒÑÂ\n.\\]\n‚Èè/!ƒØÀwˆi0Yƒçi‚ñn\nŠò@!ˆhó>)ƒý‚ÿ4\\\"\n‚Èèõ!ƒ\n6\\\n‚Èg÷Uƒ&\n8Z\n‚ÈgùUƒF\n:ûÁ@\"ƒ=‚?8\\\\\n‚ÈŠò@!ˆü ?…fhý>?…fÂyˆØÀwˆè>!?)ƒ¼\n4èÿ!„´Š@@ò@!ˆ@`Wƒ—hAUƒ—Âyˆò ˆ‚ÔyˆÂyˆèÿ!ƒ¯ŠØÀwˆ`)`Z‚°Â*‚µÂ\\\\\n‚ÈèB!ƒÈæ \ni\nU„âgCU„â`Âyˆ`|ˆ\njˆè/!„9â/DE!Á#ƒ9F ˆÂyˆ‚9.‡" [nil t 0 next-depth opoint parse-sexp-ignore-comments 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 c++-in-literal c c++-indent-line " " end line-end start parse-partial-sexp 4 3 6 -1 (c) re-search-forward "\\*/" move eoc c++-calculate-indent val looking-at c++-access-key c++-access-specifier-offset "\\(case[ ]+.*\\|default[ ]*\\):" "[A-Za-z]" ":[^:]" c-label-offset comment-start-skip comment-column c++-comment-offset c++-backward-syntactic-ws (nil 44 59 125 58 123) c-continued-statement-offset "friend[ ]" c++-friend-offset 125 c-indent-level 123 c-brace-offset c++-at-top-level-p c++-in-parens-p (nil 0 59 125 58 123) c++-class-key "[ ]*:" lim 44 "\\(<<\\|>>\\)" 35 c++-point eol indent-for-comment] 17 "\ Indent each line of the C++ grouping following point." nil]) (defalias 'c++-insert-header #[nil "ŠebˆÀÁÂñ)‡" ["// " "This may look like C code, but it is really " "-*- C++ -*-" "\n\n"] 4 "\ Insert header denoting C++ code at top of buffer." nil]) (defalias 'c++-tame-comments #[nil "ÀÁ Ä#PŠÆ ˆm?…5 ÇwˆgÈU„+É Ê>ƒ+hËU„+Ìcˆm„ Íuˆ‚ *‡" ["^" mapconcat #[(char) "Á>ƒ ÂÃ!P‡Ã!‡" [char (92 94 45) "\\" char-to-string] 3] c++-untame-characters "" charset beginning-of-buffer nil 0 c++-in-literal (c c++) 92 "\\" 1] 5 "\ Backslashifies all untamed in comment regions found in the buffer. This is a workaround for Emacs syntax bugs. This function is unnecessary (and un-used automatically) if you are running a patched Emacs. Untamed characters to escape are defined in the variable `c++-untame-characters'." nil]) (defalias 'c++-match-paren #[nil "À >ÃÄ!ƒÅÆ!ˆÇ ‚%ÃÈ!ƒ\"ÉuˆÊÆ!‚%ËÌ!)‡" [v19 c++-emacs-features parse-sexp-ignore-comments looking-at "[([{]" forward-sexp 1 backward-char "[])}]" nil backward-sexp message "Could not find matching paren."] 2 "\ Jumps to the paren matching the one under point, if there is one." nil]) (defalias 'c++-forward-sexp #[(&optional arg) "À >à !)‡" [v19 c++-emacs-features parse-sexp-ignore-comments forward-sexp arg] 2 "\ Safe forward-sexp call." "p"]) (defalias 'c++-backward-sexp #[(&optional arg) "À >à !)‡" [v19 c++-emacs-features parse-sexp-ignore-comments backward-sexp arg] 2 "\ Safe backward-sexp call." "p"]) (defalias 'c++-backward-syntactic-ws #[(&optional lim) "†ÁÂ!Ƀ`ZVƒ`Z ?…ãÇxˆÈ!‰É=ƒYÊxˆËxˆgÌUƒH`TfÌU„`X„ÊxˆËxˆ‚: Í=ƒŽÎxˆÏxˆgÐUƒshÌU„„`X„„ÎxˆÏxˆ‚go„Ñuˆ‚ Ò=ƒŸÓyˆ`X‰‚ hÌUƒÝ`ÔZfÐUƒÝÎxˆÏxˆgÐUƒÂhÌU„Ó`X„ÓÎxˆÏxˆ‚¶o„Ñuˆ‚Õ‰‚ +‡" [lim c++-point bod nil stop literal c++-backscan-limit " \n " c++-in-literal c++ "^/" "/" 47 c "^*" "*" 42 -1 pound 0 2 t] 4 "\ Skip backwards over syntactic whitespace. Syntactic whitespace is defined as lexical whitespace, C and C++ style comments, and preprocessor directives. Search no farther back than optional LIM. If LIM is omitted, `beginning-of-defun' is used."]) (defalias 'c++-fast-backward-syntactic-ws-1 #[(&optional lim) "ŒÀÁ‰‰\n† ÃÄ!\n`W…xÉŽ\n`}ˆ\nË=ƒ1ÌÍÎ#ˆ‚?ÌÐÑ#ˆÌÍÎ#ˆ?…wÓ ˆÔÕ!„QÖuˆÃÆ!‰f‰ƒp ÍUƒpbˆ`\nX‰‚AÀ‰‚A).‡" [t nil lim c++-point bod char boi donep parse-sexp-ignore-comments ((byte-code "Á=ƒÂÃÄ #ˆ‚ÂÆÇ#ˆÂÃÄ#ˆÁ‡" [major-mode c++-mode modify-syntax-entry 35 "." c++-mode-syntax-table 10 " " c++-c-mode-syntax-table] 4)) major-mode c++-mode modify-syntax-entry 35 "< b" c++-mode-syntax-table 10 "> b" c++-c-mode-syntax-table backward-syntactic-ws looking-at "#\\|/\\*\\|//\\|\n" 1] 7 "\ Skip backwards over syntactic whitespace. Syntactic whitespace is defined as lexical whitespace, C and C++ style comments, and preprocessor directives. Search no farther back than optional LIM. If LIM is omitted, `beginning-of-defun' is used."]) (defalias 'c++-fast-backward-syntactic-ws-2 #[(&optional lim) "Œ†ÁÂ!‰`W…FÄŽ`}ˆ Æ=ƒ'ÇÈÉ\n#ˆ‚5ÇËÌ #ˆÇÈÉ #ˆ `U?…E`ÎÏ!ˆ‚5)+‡" [lim c++-point bod here ((byte-code "Á=ƒÂÃÄ #ˆ‚ÂÆÇ#ˆÂÃÄ#ˆÁ‡" [major-mode c++-mode modify-syntax-entry 35 "." c++-mode-syntax-table 10 " " c++-c-mode-syntax-table] 4)) major-mode c++-mode modify-syntax-entry 35 "< b" c++-mode-syntax-table 10 "> b" c++-c-mode-syntax-table forward-comment -1] 5 "\ Skip backwards over syntactic whitespace. Syntactic whitespace is defined as lexical whitespace, C and C++ style comments, and preprocessor directives. Search no farther back than optional LIM. If LIM is omitted, `beginning-of-defun' is used."]) (defalias 'c++-in-literal #[(&optional lim) "Š`ÁÁ †ÅÆ!‰bˆ`Wƒ ÈÉÊ#…&˔˕{‰„/Á‚œ ̘ƒBÁˆ`X…œÍ‚œ ΘƒUÈÏÊ#?…œÐ‚œ јƒnŒ`}ˆÈÒÊ#)?…œÓ‚œ Ô˜ƒ‡Œ`}ˆÈÕÊ#)?…œÓ‚œÖ× \"ƒ›Áˆ`X…œØ‚œÁ‚\n-‡" [here nil state match lim c++-point bod backlim re-search-forward "\\(/[/*]\\)\\|[\"']\\|\\(^[ ]*#\\)" move 0 "//" c++ "/*" "*/" c "\"" "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" string "'" "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" string-match "[ ]*#" pound] 5 "\ Determine if point is in a C++ \"literal\". 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, `c++-beginning-of-defun' is used."]) (defalias 'c++-in-literal-8-bit #[(&optional lim) "Š†ÁÂ!`ÅÇ `\"É8ƒÊ‚FË8ƒ5Ì8ƒ1Í‚F΂F bˆÏyˆÐÑ!ƒEÒ‚FÓ-‡" [lim c++-point bod backlim here t parse-sexp-ignore-comments parse-partial-sexp state 3 string 4 7 c++ c 0 looking-at "[ ]*#" pound nil] 3 "\ Determine if point is in a C++ \"literal\". 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, `c++-beginning-of-defun' is used."]) (defalias 'c++-in-literal-1-bit #[(&optional lim) "Š†ÁÂ!`ÅÇ `\"É8ƒÊ‚FË8ƒ5Ì8ƒ1Í‚F΂F bˆÏyˆÐÑ!ƒEÒ‚FÓ-‡" [lim c++-point bod backlim here t parse-sexp-ignore-comments parse-partial-sexp state 3 string 4 7 c c++ 0 looking-at "[ ]*#" pound nil] 3 "\ Determine if point is in a C++ \"literal\". 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, `c++-beginning-of-defun' is used."]) (byte-code "À >ƒ ÂÃMˆ‚Ä >ƒÂÅMˆÆ >ƒ$ÇÈMˆ‚.É >ƒ.ÇÊMˆÀ‡" [old-v19 c++-emacs-features c++-backward-syntactic-ws c++-fast-backward-syntactic-ws-1 v19 c++-fast-backward-syntactic-ws-2 8-bit c++-in-literal c++-in-literal-8-bit 1-bit c++-in-literal-1-bit] 2) (defalias 'c++-parse-state #[(&optional limit) "†dÁÂ`WƒÅ`Æ#‚\n +‡" [limit t nil state parse-sexp-ignore-comments parse-partial-sexp 0] 4 "\ Determinate the syntactic state of the code at point. Iteratively uses `parse-partial-sexp' from point to LIMIT and returns the result of `parse-partial-sexp' at point. LIMIT is optional and defaults to `point-max'."]) (defalias 'c++-at-top-level-p #[(wrt &optional bod) "Š`À‰‰‰ † ÂÁ!À bˆÉ!‰A@@\nË=ƒ9 ?…¦Ì‚¦ „C ?‚¦ „KÌ‚¦Î ƒTÀ‚¦ bˆÏÐPeÒ#‰ƒ†ÂÁ!Ó !†‚Î !†‚Ô!…‚ÕÀxˆhÖ>)„Wg×>?…¦É ! …¦A@?…¦Ø8…¦ .‡" [nil bod c++-point foundp paren-depth containing-sexp state case-fold-search indent-point c++-parse-state major-mode c++-c-mode 0 wrt c++-in-parens-p re-search-backward "[;}]\\|" c++-class-key t c++-in-literal looking-at " \n" (44 60) (125 59) 2] 8 "\ Return t if point is not inside a containing C++ expression, nil if it is embedded in an expression. When WRT is non-nil, returns nil if not at the top level with respect to an enclosing class, or the depth of class nesting at point. With WRT nil, returns nil if not at the \"real\" top level. Optional BOD is the beginning of defun."]) (defalias 'c++-in-parens-p #[(&optional lim) "†ÁÂ!ÃÄÅ)‡" [lim c++-point bod var (byte-code "ŠŒ`}ˆdbˆÁ`ÂÃ#†efÄU*‡" [lim scan-lists -1 1 40] 4) ((error))] 3 "\ Return t if inside a paren expression. Optional LIM is used as the backward limit of the search."]) (defalias 'c++-in-function-p #[(&optional containing) "Š„ `‚bˆÁ ˆ`hÃUƒ(Ävƒ(ÅÆ!ƒ(Á ˆ‚+\nbˆhÇU*‡" [containing c++-backward-syntactic-ws here 116 -1 looking-at "\\" 41] 2 "\ Return t if inside a C++ function definition. Optional CONTAINING is position of containing s-exp open brace. If not supplied, point is used as search start."]) (defalias 'c++-indent-line #[(&optional bod) "†ÁÀ!ÂÃ\"ÃÃÃÃà d`Z\n <ƒ3 @ A‚;  Ìyˆ` Ã=ƒLÍ ‚P Î=ƒXÏ ‚PÐÑ!ƒcÌ‚PŠÒ ˆÐÓ!)ƒ†ÔÃwˆiYƒ~i‚PÖn \"‚PÔÃwˆ <ƒ’ @Ð!ƒ¡ \\‚PÐÙ!ƒ¯ \\‚PÐÛ!„ÇÐÜ!ƒÑŠÝÞ!ˆÐß!)ƒÑÞ \\]‚PÐà!ƒîÐá!„îŠâ ˆÒ ˆãÃwˆi)‚PÐä!ƒü %\\‚PgæUƒ#'ƒ# (ZŠÞuˆéÃ\")ƒ‚\\‚PgêUƒE (ZŠÞuˆéÃ\")ƒ>‚@\\‚PgëUƒP ,\\ÔÃwˆ iZ‰ÌUƒqd\nZ`Vƒ‡d\nZbˆ‚‡ `|ˆ jˆd\nZ`Vƒ‡d\nZbˆŠíî!ˆ).‡" [bod c++-point c++-calculate-indent nil indent beg shift-amt close-paren top-close-paren case-fold-search pos c++-block-close-brace-offset 0 current-indentation t c++-calculate-c-indent-within-comment looking-at "[ ]*#" back-to-indentation "//\\|/\\*" " " comment-column c++-comment-offset c++-access-key c++-access-specifier-offset "default[ ]*:" c-label-offset "case[ ]+.*:" "[A-Za-z]" forward-sexp 1 ":[^:]" "else\\b" "else\\s_" c++-backward-to-start-of-if "{ " "\\" c++-friend-offset 41 c++-paren-as-block-close-p c-indent-level c++-at-top-level-p 125 123 c-brace-offset run-hooks c++-special-indent-hook] 5 "\ Indent current line as C++ code. Return the amount the indentation changed by. Optional BOD is the point of the beginning of the C++ definition."]) (defalias 'c++-cont-indent #[(ipnt char lim) "ÀÁ‰ bˆÆ!ˆ >?…¦É!ˆ`Š bˆÊË!…3\nbˆÌÁwˆiÊÍ!)ƒ; ‚¦iŠÎyˆÆ!ˆh >)ƒQ‚xÊÐ!ƒ\\‚xÎyˆÑuˆÆ!ˆÉ!ˆÊÐ!ƒw‚xΊ bˆÒÁwˆgÓUƒ‹‚£gÕUƒ¢Öuˆ×Á\"ƒ¢[‚£Î)\\\\+‡" [(nil 0 44 59 125 58 123) nil here streamop-pos charlist ipnt c++-backward-syntactic-ws lim char c-backward-to-start-of-continued-exp looking-at "[ ]*\\(<<\\|>>\\)" "^><\n" "\\(<<\\|>>\\)" 0 c-continued-statement-offset "\\(do\\|else\\|for\\|if\\|while\\)\\b" -1 " " 123 c-continued-brace-offset 125 1 c++-at-top-level-p] 5 "\ Calculate the indentation for a continued statement. IPNT is the indentation point; CHAR is the character before the indentation point, excluding any intervening whitespace; LIM is the minimum point to search backwards to."]) (defalias 'c++-calculate-indent #[(&optional parse-start bod) "ŠÀyˆ`Á‰‰‰‰‰‰‰ÀÁ‰\n†ÃÂ! \n   ƒ:bˆ‚=\nbˆ`Ñ!‰ A@  „iÒÃÂ!‰bˆÑ!‰ A@ `*Ô\n! ŠbˆÕ\n!ˆh) Ö>ƒ†Á‚ž ×>ƒ‘Ò‚žØÒ\n\"‰ƒ(\\‰ _À S]_)bˆÜÁwˆgÝU„ÈÕ!ˆoƒÌÀ‚$Þ ƒébˆÜÁwˆgßUƒä ‚$!‚$hâUƒ÷ãä!ˆÜÁxˆhßU„PŠäyˆÜÁwˆm„ äuˆhßU…gßU?)„PŠhåU…LÃæ!&ç&xˆhßU)…Lè ?…LéuˆÜÁxˆn?…LÀyˆê+!?)ƒ“ÀyˆÜÁwˆê,!ƒ} †d\nbˆÀyˆÜÁwˆêí!ƒvéyˆî Z‚$ êï!ƒŽ0†À‚À\\‚$hñU„ªhòU„ªŠÀyˆêó!)ƒ¹ †°\nbˆî Z‚$Š\n`WƒÐhô>ƒÐÀyˆÕ\n!ˆ‚º5ö=…ÚhòU)ƒø!bˆÕ\n!ˆhåUƒó7‚ôÀ\\‚$ÀyˆÜÁwˆÔ\n!ø>„ êù!ƒÀ‚$gßUƒ>ŠÕ\n!ˆhòU)ƒ>0ƒ0î 0\\‚$äuˆÜÁwˆiZ‚$5ö=„_ê+!ƒ_åUƒ[À•bˆi‚$À‚$gÝUƒlî Z‚$lƒtÀ‚$ŠbˆÀyˆo)ƒ…À‚$ŠbˆÕ\n!ˆhåU…¶Š\n`Wƒ«håUƒ«ÀyˆÕ\n!ˆ‚•äyˆêú!‰\n)?)ƒ¿7‚$è ƒÙè ƒÙ\n`WƒÙéyˆÜÁwˆ‚ÄgßUƒòŠÕ\n!ˆhòU)ƒòäuˆÜÁwˆ\n„ `;Õ\n!ˆhåUƒ\n`WƒÀyˆÜÁwˆ`;Õ\n!ˆ‚þ;bˆ)iZ\\‚ž fÝU„t<ƒg=„Nþ 8ƒNŠ Tbˆêÿ!)ƒg bˆÀyˆÜÁwˆ`<\\ T^bˆi‚ž TbˆÜÁwˆi‚ž@ #†žŠbˆAÁwˆêB!…§C !ˆêD!…§i‰ )ƒ° ‚žŠbˆAÁwˆêE!)ƒÔ bˆF ˆi\\‚ž bˆGƒkŠäuˆAÁwˆêHIJKLM°!ƒUgNUƒ äyˆ‚áêO!ƒ$PQÁR#ˆ‚áêSLMQ!ƒ8äyˆ‚áêE!ƒFäyˆ‚áTUÁR#ˆ‚á`W…giV \n#\\)†žnƒ~ÀUƒ~W7\\‚€ÜÁxˆnƒŒÀ‚Žhò=ƒšXé!ˆî \\\\.‡" [0 nil bod c++-point inclass-unshift inclass-depth inclass-shift char-before-ip streamop-pos containing-sexp in-meminit-p literal do-indentation state case-fold-search indent-point parse-start c++-parse-state t c++-match-header-strongly c++-in-literal c++-backward-syntactic-ws (string) (c c++) c++-at-top-level-p c-indent-level c-brace-imaginary-offset shift/level " " 123 c++-in-function-p 58 c++-member-init-indent c-argdecl-indent 59 backward-char 1 44 bol "^:" c++-in-parens-p -1 looking-at c++-inher-key c++-access-key ":[ ]*\\<\\(public\\|protected\\|private\\)\\>" current-indentation ":[ ]*$" c++-continued-member-init-offset 125 41 "[ ]*\\" (44 59) major-mode c++-c-mode c-continued-statement-offset (c c++) "/[/*]" "[ ]*:" ipnt c++-empty-arglist-indent c++-always-arglist-indent-p 2 "[ ]*[/\n]" c++-cont-indent " \n" "while\\b" c++-backward-to-start-of-do "do\\b" "\\(case[ ]+.*\\|default[ ]*\\):" back-to-indentation c++-relative-offset-p "#\\|/\\*\\|//" "\\|\\(case[ ]+.*\\|default[ ]*\\):" "\\|[a-zA-Z0-9_$]*:[^:]" "\\|friend[ ]" c++-class-key "[ ]" 35 "/\\*" search-forward "*/" move "//\\|friend[ ]" re-search-forward ":[^:]" c++-compound-offset c-brace-offset forward-sexp] 15 "\ 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. Optional PARSE-START is the location to start parsing, and optional BOD is the beginning of the C++ definition."]) (defalias 'c++-calculate-c-indent-within-comment #[nil "À‰‰ŠÄyˆÅÀwˆÆÇ!ƒÄ•Ä”Z‚ÄÈÀxˆ`ÄyˆÅÀwˆÉÊ Ë#ƒZÄ” ƒ>Ä‚W\nÍUƒHÍ‚W\nÎUƒRÄ‚WÄ•Ä”Z\\bˆi,‡" [nil indent stars end 0 " " looking-at "\\*\\*?" " \n" re-search-forward "/\\*[ ]*" t c++-C-block-comments-indent-p 1 2] 4 "\ Return the indentation amount for line, assuming that the current line is to be regarded as part of a block comment."]) (defalias 'c++-comment-offset #[(col0-line-p indent) "À\nƒ <ƒ' A@† @\\‚' <ƒ$ @‚% \\ )‡" [0 offset col0-line-p c++-comment-only-line-offset indent] 2 "\ Calculates and returns the comment-only line offset. Offset is based on the value of `c++-comment-only-line-offset', the argument COL0-LINE-P, and the current indentation INDENT."]) (defalias 'c++-compound-offset #[(char-before-ip containing-sexp bod) "ÁU„‡ Uƒ1 bˆÅyˆ`LjÈ!ˆhÉU)„/ÂyˆÊË!ƒ1‡ÌÇ  bˆ `WƒbÈ ˆhÏ>ƒO bˆ‚:ÐÅ!ˆÊÑ!ƒ: bˆÌ ‚: *ƒj‡‡" [char-before-ip 44 0 containing-sexp bod -1 lim nil c++-backward-syntactic-ws 61 looking-at "\\(^\\|[ ]*\\)enum[ ]" t in-enum-p parse-sexp-ignore-comments (41 34 59 125) forward-sexp "\\(enum[ \n]\\|\\[.*\\]\\)" c-continued-statement-offset] 2 "\ Calculates any addition offset due a comma separated compound statement. CHAR-BEFORE-IP is the character before the indentation point and CONTAINING-SEXP is the buffer position of the open brace or paren. BOD is the `beginning-of-defun' point."]) (defalias 'c++-backward-to-start-of-do #[(&optional limit) "ÀÁ\n† ÃÄ!ÇU?…ÈÉʈ‚ +‡" [1 nil limit c++-point bod case-fold-search do-level 0 err (byte-code "ÀÁ!ˆÂ !Ä>„4ÅÆ!ƒT‚4ÅÈ!ƒ(S‚4` Wƒ4É bˆÀ‡" [backward-sexp 1 c++-in-literal limit (c c++) looking-at "while\\b" do-level "do\\b" 0] 2) ((error (byte-code "bˆÁÁ‡" [limit 0 do-level] 1)))] 4 "\ Move to the start of the last \"unbalanced\" do."]) (defalias 'c++-backward-to-start-of-if #[(&optional limit) "ÀÁ\n† ÃÄ!o?…LÇU?…LÈ ˆÉÀ!ˆÊË!ƒ/T‚ ÊÌ!ƒ=S‚ `\nWƒ Ç\nbˆ‚ +‡" [1 nil limit c++-point bod case-fold-search if-level 0 c++-backward-syntactic-ws c++-backward-sexp looking-at "else\\b" "if\\b"] 4 "\ Move to the start of the last \"unbalanced\" if."]) (defalias 'c++-auto-newline #[nil "ÀÁ!\n…à !?…Ä ?)‡" [c++-point bod c++-auto-newline c++-in-literal newline] 2 "\ Insert a newline iff we're not in a literal. Literals are defined as being inside a C or C++ style comment or open string according to mode's syntax."]) (defalias 'c++-point #[(position) "`À Ä=ƒÅyˆ‚1 Æ=ƒÀˆ‚1 Ç=ƒ(È ˆ‚1 É=ƒ1Ê ˆ`\nbˆ *‡" [nil bufpos here position bol 0 eol bod c++-beginning-of-defun boi back-to-indentation] 2 "\ 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 This function does not modify point or mark."]) (defalias 'c++-macroize-region #[(from to arg) "ŠbˆÁyˆÂe`\"Š bˆÂe`\")‰ W…,Æ?!ˆÈyˆ T‰‚+‡" [from 0 count-lines to to-line line c++-backslashify-current-line arg 1] 5 "\ Insert backslashes at end of every line in region. Useful for defining cpp macros. If called with a prefix argument, it will remove trailing backslashes." "r\nP"]) (defalias 'c++-backslashify-current-line #[(doit) "Àˆ ƒAŠÂuˆÃÄ!)?…Pi YƒÆc‡i Xƒ+ÇcˆÈˆ‚ÉÂ!ˆi Wƒ>ÊcˆÈˆ‚/Ëc‡ÂuˆÃÄ!…PÌÈxˆÍ ‡" [1 doit -1 looking-at "\\\\" c++-default-macroize-column " \\" " " nil delete-char " " "\\" " " kill-line] 2 "\ Backslashifies current line."]) (defalias 'c++-comment-region #[(beg end) "ŠŒbˆÁyˆ`\nbˆn„Ãyˆ`}ˆebˆm„& cˆÃyˆ‚ Æ=…/c*‡" [beg 0 end 1 comment-start major-mode c++-c-mode comment-end] 2 "\ Comment out all lines in a region between mark and current point by inserting `comment-start' in front of each line." "*r"]) (defalias 'c++-uncomment-region #[(beg end) "ŠŒbˆÁyˆ`\nbˆÃyˆ`}ˆebˆ Å=ƒ+ÆÇ!ÉÇ\n!Ë°‚1ÌÇ!P m?…KÎ !ƒEÁ”Á•|ˆÃyˆ‚3+‡" [beg 0 end 1 major-mode c++-c-mode "\\s *\\(" regexp-quote comment-start "\\|" comment-end "\\)" "\\s *" comment-regexp looking-at] 5 "\ Uncomment all lines in region between mark and current point by deleting the leading `// ' from each line, if any." "*r"]) (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\\|union\\|enum\\)" "\ Regexp to match names of structure declaration blocks in C++") (defconst c++-defun-header-strong (byte-code "ÀÂÄÆ Ç È° Ê Ì ÍQÏÈQ‰ÑPÓPÆÕÆ Ç ȉ°\n×ÆÇ Ù Ç È° ÛÆ ÜÝÞ ßàÇá°\"Æ#ä °%æäÆ%Ç%çÇ%èÈ°)ê+Æ+ìR‰-)\"°.Ûï È°0# 0ñà°2ó.Ç2È°.‡" ["\\(\\w\\|_\\)+" id "[---+*/%^&|~!=<>]\\|[---+*/%^&|<>=!]=\\|<<=?\\|>>=?" op-sym1 "&&\\|||\\|\\+\\+\\|--\\|()\\|\\[\\]" op-sym2 "\\(" "\\|" "\\)" op-sym "[^\\*]*\\(\\*+[^/\\*][^\\*]*\\)*" middle "/\\*" "\\*+/" c-comment "\\(\\s \\|\n\\|//.*$\\|" wh "*" wh-opt "+" wh-nec "operator" oper "([^():]*)" dcl-list "::" func-name "\\(:" "(.*\\()" "," "\\)\\)*" "(.*)" "{" "{\\)" inits c++-defun-header-strong-struct-equivs "\\)?" type-name "\\(const" "\\*+" "&" type "\\(inline\\|virtual\\|overload\\|auto\\|static\\)" modifier "\\)*" modifiers func-header "\\(public\\|protected\\|private\\)?" inherit "?" cs-header "^\\("] 17) "\ Strongly-defined regexp to match beginning of structure or function definition.") (defconst c++-defun-header-weak "^{\\|^[_a-zA-Z].*{" "\ Weakly-defined regexp to match beginning of structure or function definition.") (defalias 'c++-beginning-of-defun #[(&optional arg) "„Á\nƒ ‚ ÆU„ ÆVƒ$oƒ$Ç‚œÈ !„u`ÉÊÇË#…4`Ì ÇË#…>Æ” ƒl ƒl WƒlVƒl bˆÁU…qЂqbˆÇ+†œÈ !ƒŒo„ŒÆWƒ‰Á‚ŠÑuˆÌ Lj•Á$…œÆ”b)‡" [arg 1 c++-match-header-strongly c++-defun-header-strong c++-defun-header-weak c++-defun-header 0 nil looking-at search-forward "{" move re-search-backward beg-pos open-pos curr-pos t -1] 6 "\ Find the beginning of the C++ function or class." "p"]) (defalias 'c++-end-of-defun #[(arg) "ƒ ‚ \nÃm…ÇV?…xÇVƒ(È !ƒ(Éuˆ`\nËÇWƒCmƒ=Ç‚>ÉZ[‚E!ˆÇWƒRo„vÌ ÍÎ#ƒcÏuˆÐ ˆÉyˆ\n`UƒvÌ ÍÎ#ƒvÑÉ!ˆ)Ã*‡" [c++-match-header-strongly c++-defun-header-strong c++-defun-header-weak t parse-sexp-ignore-comments c++-defun-header arg 0 looking-at 1 pos c++-beginning-of-defun re-search-forward nil move -1 forward-sexp c++-end-of-defun] 4 "\ Find the end of the C++ function or class." "p"]) (defalias 'c++-indent-defun #[nil "`ÁÂ!ˆÃyˆÄ Æ ˆ` Wƒ!Ç ˆÂyˆÃyˆ‚ ȉ“ˆ)b)‡" [restore c++-end-of-defun 1 0 point-marker end c++-beginning-of-defun c++-indent-line nil] 3 "\ Indents the current function def, struct or class declaration." nil]) (defconst c++-version "2.353" "\ c++-mode version number.") (defconst c++-mode-help-address "c++-mode-help@anthem.nlm.nih.gov" "\ Address accepting submission of bug reports.") (defalias 'c++-version #[nil "ÀÁ\n\"‡" [message "Using c++-mode.el %s" c++-version] 3 "\ Echo the current version of c++-mode." nil]) (defalias 'c++-submit-bug-report #[nil "ÀÁ!ˆÂÃ!…FÄ ÆÈ Ê=ƒË‚ÌÍ°ÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïð¯#ñ$‡" [require reporter y-or-n-p "Do you want to submit a report on c++-mode? " reporter-submit-bug-report c++-mode-help-address "c++-mode.el " c++-version " (editing " major-mode c++-mode "C++" "C" " code)" c++-emacs-features c++-C-block-comments-indent-p c++-access-specifier-offset c++-always-arglist-indent-p c++-auto-hungry-initial-state c++-auto-hungry-toggle c++-auto-newline c++-backscan-limit c++-block-close-brace-offset c++-cleanup-list c++-comment-only-line-offset c++-continued-member-init-offset c++-default-macroize-column c++-defun-header-strong-struct-equivs c++-delete-function c++-electric-pound-behavior c++-empty-arglist-indent c++-friend-offset c++-hanging-braces c++-hanging-member-init-colon c++-hungry-delete-key c++-match-header-strongly c++-member-init-indent c++-paren-as-block-close-p c++-relative-offset-p c++-tab-always-indent c++-untame-characters c-argdecl-indent c-brace-imaginary-offset c-brace-offset c-continued-brace-offset c-continued-statement-offset c-indent-level c-label-offset tab-width #[nil "ƒÁÂÃÄ\"ÅÆ°‚Çc‡" [c++-special-indent-hook "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" "c++-special-indent-hook is set to '" format "%s" ".\nPerhaps this is your problem?\n" "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n" "\n"] 5]] 38 "\ Submit via mail a bug report on c++-mode." nil]) (provide (quote c++-mode)) emacs-19.22/lisp/cust-print.elc100666 13437 1 20601 5416163047 15034 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:40:38 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/cust-print.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (provide (quote custom-print)) (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 untrappable 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 untrappable 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. Currently, there is no way to read this representation in Emacs.") (defconst custom-print-list nil "\ An alist for custom printing of lists. Pairs are of the form (PRED . CONVERTER). If PREDICATE is true for an object, then CONVERTER is called with the object and should return a string to be printed with `princ'. Also see `custom-print-vector'.") (defconst custom-print-vector nil "\ An alist for custom printing of vectors. Pairs are of the form (PRED . CONVERTER). If PREDICATE is true for an object, then CONVERTER is called with the object and should return a string to be printed with `princ'. Also see `custom-print-list'.") (defalias 'add-custom-print-list #[(pred converter) " B ž \"B‰‡" [pred converter delq custom-print-list] 4 "\ Add a pair of PREDICATE and CONVERTER to `custom-print-list'. Any pair that has the same PREDICATE is first removed."]) (defalias 'add-custom-print-vector #[(pred converter) " B ž \"B‰‡" [pred converter delq custom-print-vector] 4 "\ Add a pair of PREDICATE and CONVERTER to `custom-print-vector'. Any pair that has the same PREDICATE is first removed."]) (byte-code "ÀÁÂ\"ˆÃÄ!„ÅÁÆ\"ˆÀ‡" [defalias cust-print-set-function-cell #[(symbol-pair) "À @ A@K\"‡" [defalias symbol-pair] 3] fboundp cust-print-internal-prin1 mapcar ((cust-print-internal-prin1 prin1) (cust-print-internal-princ princ) (cust-print-internal-print print) (cust-print-internal-prin1-to-string prin1-to-string) (cust-print-internal-format format) (cust-print-internal-message message) (cust-print-internal-error error))] 3) (defalias 'install-custom-print-funcs #[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))] 3 "\ Replace print functions with general, customizable, Lisp versions. The internal subroutines are saved away, and you can reinstall them by running `uninstall-custom-print-funcs'." nil]) (defalias 'uninstall-custom-print-funcs #[nil "ÀÁÂ\"‡" [mapcar cust-print-set-function-cell ((prin1 cust-print-internal-prin1) (princ cust-print-internal-princ) (print cust-print-internal-print) (prin1-to-string cust-print-internal-prin1-to-string) (format cust-print-internal-format) (message cust-print-internal-message) (error cust-print-internal-error))] 3 "\ Reset print functions to their internal subroutines." nil]) (defalias 'custom-prin1 #[(object &optional stream) "À \nÃ#‡" [cust-print-top-level object stream cust-print-internal-prin1] 4 "\ Replacement for standard `prin1'. Uses the appropriate printer depending on the values of `print-level' and `print-circle' (which see). 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)."]) (defalias 'custom-princ #[(object &optional stream) "À \nÃ#‡" [cust-print-top-level object stream cust-print-internal-princ] 4 "\ Same as `custom-prin1' except no quoting."]) (defalias 'custom-prin1-to-string-func #[(c) " B‰‡" [c custom-prin1-chars] 2 "\ Stream function for `custom-prin1-to-string'."]) (defalias 'custom-prin1-to-string #[(object) "À Ä\"ˆ Ÿ°)‡" [nil custom-prin1-chars custom-prin1 object custom-prin1-to-string-func] 3 "\ Replacement for standard `prin1-to-string'."]) (defalias 'custom-print #[(object &optional stream) "ÀÁ!ˆÂ \"ˆÀÁ!‡" [cust-print-internal-princ "\n" custom-prin1 object stream] 3 "\ Replacement for standard `print'."]) (defalias 'custom-format #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply cust-print-internal-format fmt mapcar #[(arg) "<„ Á!ƒÂ!‡‡" [arg vectorp custom-prin1-to-string] 2] args] 6 "\ Replacement for standard `format'. Calls format after first making strings for list or vector 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-message #[(fmt &rest args) "ÀÁ\nÃÄ \"#‡" [apply cust-print-internal-message fmt mapcar #[(arg) "<„ Á!ƒÂ!‡‡" [arg vectorp custom-prin1-to-string] 2] args] 6 "\ Replacement for standard `message' that works like `custom-format'."]) (defalias 'custom-error #[(fmt &rest args) "ÀÁÂà #C\"‡" [signal error apply custom-format fmt args] 6 "\ Replacement for standard `error' that uses `custom-format'"]) (defalias 'cust-print-top-level #[(object stream internal-printer) "† \n… à ! †ÆÉÊ \"ˆÉÌ „,„, ƒ0Ï‚:ƒ9Ђ:Ê\"ˆÉуGÒ‚HÌ\"ˆÑ !ˆ +‡" [stream standard-output print-circle cust-print-preprocess-circle-tree object print-level -1 circle-level circle-table defalias cust-print-internal-printer internal-printer cust-print-low-level-prin custom-print-list custom-print-vector cust-print-custom-object cust-print-object cust-print-prin cust-print-circular] 3 "\ Set up for printing."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias cust-print-object #[(object) "„Á!‡:ƒÂ!‡Ã!ƒÄ!‡Á!‡" [object cust-print-internal-printer cust-print-list vectorp cust-print-vector] 2] cust-print-custom-object #[(object) "„Á!‡:ƒ\nƒÃ\n\"†6Ä!‡Å!ƒ3ƒ/Ã\"†6Ç!‡Á!‡" [object cust-print-internal-printer custom-print-list cust-print-custom-object1 cust-print-list vectorp custom-print-vector cust-print-vector] 3] cust-print-custom-object1 #[(object alist) "ƒ@@ !„A‰„…Â@A !!‡" [alist object cust-print-internal-princ] 4]] 3) (defalias 'cust-print-circular #[(object) " ž‰ƒ8\nA‰ÄVƒÅÆ!ˆÅ !ˆÅÆ!‚4\n [¡ˆÅÆ!ˆÅ [!ˆÅÇ!ˆÈ!)‚;È!)‡" [object circle-table tag id 0 cust-print-internal-princ "#" "=" cust-print-low-level-prin] 3 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias cust-print-list #[(list) "ÁUƒ ÂÃ!ˆ‚SÂÄ!ˆ †ÁÇ@!ˆA‰ƒ.ÂÉ!ˆSƒxÁU„x<ƒ[\nž„[Ç@!ˆA‚gÂË!ˆÇ!ˆÌSƒ3ÂÉ!ˆ‚3ƒˆÁUƒˆÂÍ!ˆÂÎ!ˆ*‡" [circle-level 0 cust-print-internal-princ "#" "(" print-length length cust-print-prin list " " circle-table ". " nil "..." ")"] 3] cust-print-vector #[(vector) "ÁUƒ ÂÃ!ˆ‚VSÁ GÂÇ!ˆƒ$ ^ WƒEÉ H!ˆT‰ GWƒ$ÂÊ!ˆ‚$ GWƒQÂË!ˆÂÌ!ˆ+ ‡" [circle-level 0 cust-print-internal-princ "#" vector len i "[" print-length cust-print-prin " " "..." "]"] 4] 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] cust-print-walk-circle-tree #[(object) "À‰ …t §† 9‰?… Až‰ƒ% Å¡ˆ‚1\n„1 C AB¡ˆ ƒ9À‚n :ƒHÆ @!ˆ A‚nÇ !…n GÈ \n \nW…mÆ  H!ˆ T‰ ‚W*‰„À*‡" [nil tag read-equivalent-p object circle-table t cust-print-walk-circle-tree vectorp 0 j i] 4]] 3) emacs-19.22/lisp/dabbrev.elc100666 13437 1 10215 5416163064 14330 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:40:52 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/dabbrev.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar dabbrevs-limit nil "\ *Limits region searched by `dabbrevs-expand' to this many chars away.") (make-variable-buffer-local (quote dabbrevs-limit)) (defvar dabbrevs-backward-only nil "\ *If non-NIL, `dabbrevs-expand' only looks backwards.") (defvar last-dabbrevs-table nil "\ Table of expansions seen so far (local)") (make-variable-buffer-local (quote last-dabbrevs-table)) (defvar last-dabbrevs-abbreviation "" "\ Last string we tried to expand (local).") (make-variable-buffer-local (quote last-dabbrevs-abbreviation)) (defvar last-dabbrevs-direction 0 "\ Direction of last dabbrevs search (local)") (make-variable-buffer-local (quote last-dabbrevs-direction)) (defvar last-dabbrevs-abbrev-location nil "\ Location last abbreviation began (local).") (make-variable-buffer-local (quote last-dabbrevs-abbrev-location)) (defvar last-dabbrevs-expansion nil "\ Last expansion of an abbreviation. (local)") (make-variable-buffer-local (quote last-dabbrevs-expansion)) (defvar last-dabbrevs-expansion-location nil "\ Location the last expansion was found. (local)") (make-variable-buffer-local (quote last-dabbrevs-expansion-location)) (defalias 'dabbrev-expand #[(arg) "À‰‰‰‰‰‰ … \n \nŠ „;  =ƒ;ƒ;\n‚k „MƒIÓ‚QÔ‚QÕ !`Övˆ``{‰\nÀÀÙÚ\n!ÛQÔYƒ¹Ó]ƒˆbˆ ÔVƒ«Ü Ý #‰ ƒ«Þ  B S‰‚‰ „³ÀÓ^ÔXƒú „úÓ[]ƒÔbˆ ÔVƒ÷Ü À #‰ ƒ÷Þ  B S‰‚ÕÖ) „A\n˜À„/à ˆá!ˆ\"ã=ƒ(ä\nÝå#ˆ‚/æ\nÝå#ˆçƒ9è‚:é\n\")‚¾à ˆá!ˆŠ\"ã=ƒ[ä\nÝå#ˆ‚bæ\nÝå#ˆ)ê\n!ˆ …x ÓÀO ÓÀO—˜Šæ\nÝå#ˆ)\"ã=ƒžä ƒ” —‚– ?å#ˆ‚°æ ƒ© —‚« ?å#ˆ)\n ‰.‡" [nil case-fold-search case-replace do-case pattern n loc which old expansion abbrev arg last-command this-command last-dabbrevs-abbrev-location last-dabbrevs-abbreviation last-dabbrevs-expansion last-dabbrevs-direction dabbrevs-backward-only 1 0 prefix-numeric-value -1 last-dabbrevs-expansion-location last-dabbrev-table "\\b" regexp-quote "\\(\\sw\\|\\s_\\)+" dabbrevs-search t point-marker first undo-boundary search-backward major-mode picture-mode picture-replace-match literal replace-match error "No dynamic expansion for \"%s\" found." "No further dynamic expansions for \"%s\" found." search-forward] 9 "\ 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 `case-fold-search' and `case-replace' are non-nil (usually true) then the substituted word may be case-adjusted to match the abbreviation that you had typed. This takes place if the substituted word, as found, is all lower case, or if it is at the beginning of a sentence and only its first letter was upper case. A positive prefix arg N says to take the Nth backward DISTINCT possibility. A negative argument says search forward. The variable `dabbrev-backward-only' may be used to limit the direction of search to backward if set non-nil. 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." "*P"]) (byte-code "À ÂÃ#ˆÄÅÆ\"ˆÇÈ!‡" [define-key esc-map "/" dabbrev-expand defalias dabbrevs-search #[(pattern reverse ignore-case) "À‰ Œ ƒ` ƒÈ‚É_\\}ˆÀÀ „{ „{ƒ7Ê ÀÌ#‚=Í ÀÌ#?‰„!ΔΕ{‰ƒp ƒ_@— —˜‚d@ ˜„pA‰„QƒwÀ)‚! ƒÄŠÎ”‰bˆ ƒÃ ÉÀO ÉÀO—˜ƒÃÓP˜ƒ³ÊÀÌ#ƒÃΕU‚½ÉuˆÖ ˆ`UƒÃ —* ,‡" [nil ignore-case case-fold-search result missing dabbrevs-limit last-dabbrevs-abbrev-location reverse -1 1 re-search-backward pattern t re-search-forward 0 last-dabbrev-table test beg paragraph-start "^$\\|" page-delimiter sentence-end backward-sentence] 5] provide dabbrev] 4) emacs-19.22/lisp/debug.elc100666 74777 1 17250 5416163106 14033 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:41:10 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/debug.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar debug-function-list nil "\ List of functions currently set for debug on entry.") (byte-code "ÀÀ‡" [debug debugger] 1) (defalias 'debug #[(&rest debugger-args) "ÀÁ!ˆÂà ‰ÄÆÇ!)p‰‰ \n   ÑŽŠÒ‹ˆ*\n. ‡" [message "Entering debugger..." nil match-data fundamental-mode default-major-mode generate-new-buffer "*Backtrace*" cursor-in-echo-area executing-macro debugger-step-after-exit debugger-old-buffer debugger-buffer debug-on-quit debug-on-error debugger-match-data debugger-value ((byte-code "À !ˆÂ !‡" [kill-buffer debugger-buffer store-match-data debugger-match-data] 2)) ((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 4 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] 9 "\ Enter debugger. Returns if user says \"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 'debugger-step-through #[nil "ÀÂÃ!ˆÄ ‡" [t debugger-step-after-exit message "Proceeding, will debug on next eval or call." exit-recursive-edit] 2 "\ Proceed, stepping through subexpressions of this expression. Enter another debugger on next entry to eval, apply or funcall." nil]) (defalias 'debugger-continue #[nil "ÀÁ!ˆÂ ‡" [message "Continuing." exit-recursive-edit] 2 "\ Continue, evaluating this expression without stopping." nil]) (defalias 'debugger-return-value #[(val) "ÂÃÄ\"ˆÅ !ˆÆ ‡" [val debugger-value princ "Returning " t prin1 exit-recursive-edit] 3 "\ 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." "XReturn value (evaluated): "]) (defalias 'debugger-jump #[nil "Á\\ ˆ) ‰ƒ! @Å @ @KÆ#Mˆ A‰„)ÇÈ!ˆÉ ‡" [debugger-frame-offset 2 debugger-frame debug-function-list list debug-on-entry-1 nil message "Continuing through this frame" exit-recursive-edit] 6 "\ Continue to exit from this frame, with all debug-on-entry suspended." nil]) (defalias 'debugger-reenable #[nil "‰…& @K:„ @!ˆ @à @ @KÄ#Mˆ A‰„Å)‡" [debug-function-list list debug-convert-byte-code debug-on-entry-1 t nil] 6 "\ Turn all debug-on-entry functions back on."]) (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 "\ Return number of frames in backtrace before the one point points at."]) (defconst debugger-frame-offset 8 "\ ") (defalias 'debugger-frame #[nil "ÀyˆÁ Ã\n \\Å\"ˆ)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 "\ Request entry to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." nil]) (defalias 'debugger-frame-clear #[nil "ÀyˆÁ Ã\n \\Å\"ˆ)gÆUƒÅÈÉ!ˆÊcˆ)ÀyˆÅ‡" [0 debugger-frame-number level backtrace-debug debugger-frame-offset nil 42 buffer-read-only delete-char 1 32] 3 "\ Do not enter to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." nil]) (byte-code "ÀÁÂ\"ˆÃÄ!„ Å „dÆÈ É !ˆÊ ËÌ#ˆÊ ÍÎ#ˆÊ ÏÐ#ˆÊ ÑÒ#ˆÊ ÓÔ#ˆÊ ÕÖ#ˆÊ ×Ø#ˆÊ ÙÚ#ˆÊ ÛÜ#ˆÊ ÝÞ#ˆÊ ßÁ#ˆÊ àá#ˆ)âãäå#‡" [defalias debugger-eval-expression #[(exp) "ŠÀ !„ p qˆÂ !)‡" [buffer-name debugger-old-buffer eval-expression exp] 2 nil "xEval: "] boundp debugger-mode-map nil 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" " " next-line put debugger-mode mode-class special] 4) (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 "\ 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 '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 "\ 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." "aDebug on entry (to function): "]) (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 "\ Undo effect of \\[debug-on-entry] on FUNCTION. If argument is nil or an empty string, cancel for all functions." (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))))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias debug-convert-byte-code #[(function) "K‰:?…D Ã\"Å A@Æ 8Ç 8FCÉ ›ƒ,ÊÉ 8DBË 8ƒ:Ë 8BÌ @BBM*)‡" [function defn append nil contents byte-code 2 3 body 5 interactive 4 lambda] 6] debug-on-entry-1 #[(function defn flag) "À !ƒ Âà \"‡ @Å=ƒÆ A#‡ @È=„&ÂÉ \"ˆÊ‰  AA@;ƒHÍ › @ A@ AA@E ‚U AA @ A@D  @Κ=ƒd ‚yƒs Ï B¤‚y  A¤*‡" [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]] 3) (defalias 'debugger-list-functions #[nil "À „ ÂÃ!‚-ÂÄ!ˆ ‰ƒ%Æ @!ˆÇ ˆ A‰„)ÂÈ!ˆÂÉ!‘‡" ["*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."] 4 "\ Display a list of all the functions now set to debug on entry." nil]) emacs-19.22/lisp/delsel.elc100666 13437 1 4412 5416163114 14151 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:41:16 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/delsel.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆÃ\"ˆÇÈÉÊ#ˆÇËÉÊ#ˆÇÌÉÊ#ˆÇÍÉÎ#ˆÇÏÉÎ#ˆÇÐÉÎ#ˆÇÑÉÊ#ˆÇÒÉÊ#ˆÇÓÉÊ#ˆÀÔÕ\"‡" [defalias delete-active-region #[(&optional killp) "ƒ Á` \"ˆ‚` |ˆÃÅÆ!ˆÇ‡" [killp kill-region mark nil mark-active run-hooks deactivate-mark-hook t] 3] delete-selection-pre-hook #[nil "…C ?…C\n…C …C 9… ÅN‰Ç=ƒ'ÈÉ!‚BÊ=ƒ:ÈË!…B̉‚B…BÈË!)‡" [delete-selection-mode buffer-read-only transient-mark-mode mark-active this-command delete-selection type kill delete-active-region t supersede nil (lambda nil (interactive))] 3] add-hook pre-command-hook put self-insert-command delete-selection t yank insert-register delete-backward-char supersede backward-delete-char-untabify delete-char newline-and-indent newline open-line pending-delete-mode delete-selection-mode] 4) (defalias 'delete-selection-mode #[(arg) "„ ?‚Â!ÃVÄÅ !‡" [arg delete-selection-mode prefix-numeric-value 0 set-buffer-modified-p buffer-modified-p] 2 "\ 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." "P"]) (defalias 'minibuffer-keyboard-quit #[nil "ƒ ƒ\nƒÉ‡Å ‡" [delete-selection-mode transient-mark-mode mark-active t deactivate-mark abort-recursive-edit] 2 "\ 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." nil]) (byte-code "À ÂÃ#ˆÀ ÂÃ#ˆÀ ÂÃ#ˆÀÂÃ#ˆÀÂÃ#ˆÈÉ!‡" [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.22/lisp/desktop.elc100666 12120 1 14031 5456157366 14254 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 11 00:20:05 1993 ;;; from file /home/fsf/rms/e19/lisp/desktop.el ;;; emacs version 19.19.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"))) (error "This file was compiled for Emacs 19")) (defconst desktop-basefilename (byte-code "Ášƒ‡Ç" [system-type ms-dos "emacs.dsk" ".emacs.desktop"] 2) "\ File for Emacs desktop. A directory name will be prepended to this name.") (defvar desktop-missing-file-warning t "\ *If non-nil then issue warning if a file no longer exists. Otherwise simply ignore the file.") (defvar desktop-globals-to-save (list (quote desktop-missing-file-warning) (quote tags-file-name) (quote tags-table-list)) "\ List of global variables to save when killing Emacs.") (defvar desktop-buffers-not-to-save "\\(\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" "\ Regexp identifying buffers that are to be excluded from saving.") (defvar desktop-buffer-handlers (quote (desktop-buffer-dired desktop-buffer-rmail 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-dirname nil "\ The directory in which the current desktop file resides.") (defconst desktop-header ";; --------------------------------------------------------------------------\n;; Desktop File for Emacs\n;; --------------------------------------------------------------------------\n" "\ *Header to place in Desktop file.") (defconst postv18 (string-lessp "19" emacs-version) "\ t if Emacs version 19 or later.") (defalias 'desktop-clear #[nil "ÀÀÃÄÅ \"‡" [nil kill-ring kill-ring-yank-pointer mapcar kill-buffer buffer-list] 3 "\ Empty the Desktop." nil]) (byte-code "ÀÁ!„\nƒÃÄÁ\"ˆ‚ ÆÇÁÈ\"‡" [boundp desktop-kill postv18 add-hook kill-emacs-hook old-kill-emacs #[nil "À ˆ ƒ 9ƒ !‡ ‡" [desktop-kill old-kill-emacs run-hooks] 2] defalias #[nil "…Á!‡" [desktop-dirname desktop-save] 2]] 3) (defalias 'desktop-outvar #[(VAR) "À !…ÂcˆÃ p\"ˆÄcˆÃ Jp\"ˆÅc‡" [boundp VAR "(setq " prin1 " '" ")\n"] 3 "\ Output a setq statement for VAR to the desktop file."]) (defalias 'desktop-save-buffer-p #[(filename bufname mode) "ƒ Á\n \"?†?… Å>‡" [filename string-match desktop-buffers-not-to-save bufname mode (Info-mode dired-mode rmail-mode)] 3 "\ Return t if 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 #[(dirname) "ŠÀ \nP!ÃÄÅ \"ŸÆÇ! \nqˆË ˆ ÍÎ ÏÐÒÓ±ˆÃÔ\"ˆÖ>ƒE×ØGGZ!Ú±ˆÛcˆÃÜ \"ˆ Þ\n!ƒ]ß\n!ˆàed\náâ%ˆ, ‰#‡" [expand-file-name dirname desktop-basefilename mapcar #[(b) "qˆÁ  à Dà ƒ‚??DD`ƒ,ÃÉÊ! E‚.É   à њƒGD‚^ Ôš…^ƒ[ÕÖ\"Ÿ‚^CD¯ ‡" [b buffer-file-name buffer-name quote major-mode overwrite-mode postv18 auto-fill-function auto-fill-hook mark t mark-active buffer-read-only truncate-lines fill-column case-fold-search case-replace Info-mode Info-current-file Info-current-node dired-mode mapcar car dired-subdir-alist default-directory] 15] 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) "À @ A@ 8A@#…ÃcˆÄÅ \"ˆÆc‡" [desktop-save-buffer-p l 2 "(desktop-buffer" mapcar #[(e) "ÀcˆÁ\np\"‡" ["\n " prin1 e] 3] ")\n\n"] 5] default-directory file-exists-p delete-file write-region nil nomessage desktop-dirname] 8 "\ Save the Desktop file. Parameter DIRNAME specifies where to save desktop." "DDirectory to save desktop file in: "]) (defalias 'desktop-remove #[nil "… PÃ\n!ƒÄ\n!ˆÅ‰)‡" [desktop-dirname desktop-basefilename filename file-exists-p delete-file nil] 2 "\ Delete the Desktop file and inactivate the desktop system." nil]) (defalias 'desktop-read #[nil "ÀÂà P!ƒÅÃ!‚%ÂÇ P!ƒ\"ÅÇ!‚%Àƒ:È Pɉ‰$ˆÊË!‚<Ì )‡" [nil filename file-exists-p "./" desktop-basefilename expand-file-name desktop-dirname "~/" load t message "Desktop loaded." desktop-clear] 5 "\ Read the Desktop file and the files it specifies." nil]) (defalias 'desktop-load-default #[nil "?…ÁÂÉ#ˆÃ‰‡" [inhibit-default-init load "default" t] 4 "\ 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-buffer-info #[nil "Áš…ÂÃ!ˆÄ @ A@\"ˆÆ‡" [mam Info-mode require info Info-find-node misc t] 3 "\ Load an info file."]) (defalias 'desktop-buffer-rmail #[nil "Áš…  !ˆÄ‡" [mam rmail-mode rmail-input fn t] 2 "\ Load a RMAIL file."]) (defalias 'desktop-buffer-dired #[nil "Áš… @!ˆÄÅ A\"ˆÆ‡" [mam dired-mode dired misc mapcar dired-maybe-insert-subdir t] 3 "\ Load a directory using dired."]) (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 "\ Load a file."]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias desktop-buffer #[(fn bn mam mim pt mk ro tl fc cfs cr misc) "Á‰ „ ƒ @‰  A‚ Åš…ˆÆ š„-È!ˆ @ƒ:ÊË!ˆ‚>ÊÌ!ˆ A@ƒLÍË!ˆ‚PÊÌ!ˆbˆ:ƒiÐ@!ˆA@‚nÐ!ˆƒw‰+‡" [desktop-buffer-handlers nil handler result hlist t buffer-name bn rename-buffer mim overwrite-mode 1 0 auto-fill-mode pt mk set-mark mark-active ro buffer-read-only tl truncate-lines fc fill-column cfs case-fold-search cr case-replace] 4] provide desktop] 3) emacs-19.22/lisp/diary-ins.elc100666 13437 1 20343 5416163172 14625 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:42:02 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/diary-ins.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote diary)) (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 "\ Insert a diary entry STRING which may be NONMARKING in FILE. If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."]) (defalias 'insert-diary-entry #[(arg) "ÀÁ †\nÃÄ!ʼn#\"‡" [make-diary-entry calendar-date-string calendar-cursor-to-date error "Cursor is not on a date!" t arg] 5 "\ Insert a diary entry for the date indicated by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-weekly-diary-entry #[(arg) "ÀÁ †\nÃÄ!! \"‡" [make-diary-entry calendar-day-name calendar-cursor-to-date error "Cursor is not on a date!" arg] 4 "\ Insert a weekly diary entry for the day of the week indicated by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-monthly-diary-entry #[(arg) "ƒÁ‚ ÂÄÅÆ †ÇÈ!É\"\n\")‡" [european-calendar-style (day " * ") ("* " day) calendar-date-display-form make-diary-entry calendar-date-string calendar-cursor-to-date error "Cursor is not on a date!" t arg] 4 "\ Insert a monthly diary entry for the day of the month indicated by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-yearly-diary-entry #[(arg) "ƒÁ‚ ÂÄÅÆ †ÇÈ!É\"\n\")‡" [european-calendar-style (day " " monthname) (monthname " " day) calendar-date-display-form make-diary-entry calendar-date-string calendar-cursor-to-date error "Cursor is not on a date!" t arg] 4 "\ Insert an annual diary entry for the day of the year indicated by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-anniversary-diary-entry #[(arg) "ƒÁ‚ ÂÄÅÆÈÉ †ÊË!ÌÍ##\")‡" [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 error "Cursor is not on a date!" nil t arg] 8 "\ Insert an anniversary diary entry for the date given by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-block-diary-entry #[(arg) "ƒÁ‚ ÂÄ †ÅÆ!@†ÅÉ!\nË Ë \nAA@\n@\nA@\nAA@SÑ_\\ÓVƒ|Ô_Õ\\Ö¥ZÔ¦×Uƒ|ئ×UƒwÙ¦×Uƒ|T,SÚ_SÔ¥SØ¥[SÙ¥\\\\\\\\)AA@@A@AA@SÑ_\\ÓVƒðÔ_Õ\\Ö¥ZÔ¦×Uƒðئ×UƒëÙ¦×UƒðT,SÚ_SÔ¥SØ¥[SÙ¥\\\\\\\\)Wƒ\n  ‚$ \n ÛÜÝß Ëà#ß Ëà#$!\"-‡" [european-calendar-style (day " " month " " year) (month " " day " " year) calendar-date-display-form calendar-cursor-to-date error "Cursor is not on a date!" cursor calendar-mark-ring "No mark set in this buffer" mark nil start end year month day 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 t arg] 9 "\ Insert a block diary entry for the days between the point and marked date. Prefix arg will make the entry nonmarking." "P"]) (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 error "Cursor is not on a date!" nil t arg] 9 "\ Insert a cyclic diary entry starting at the date given by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-hebrew-diary-entry #[(arg) " ÄÅÆ †ÇÈ!AA@ Æ †ÇÈ!@\nÆ †&ÇÈ!A@ Æ †2ÇÈ!AA@  \nSÌ_\\ \nÎVƒu \nÏ_Ð\\Ñ¥Z  ϦÒUƒu Ó¦ÒUƒp Ô¦ÒUƒu T  , SÕ_ SÏ¥ SÓ¥[ SÔ¥\\\\\\\\)!Ö×#P\")‡" [calendar-hebrew-month-name-array-leap-year calendar-month-name-array make-diary-entry hebrew-diary-entry-symbol calendar-date-string calendar-hebrew-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" year month day 31 day-of-year 2 4 23 10 0 100 400 365 nil t arg] 10 "\ Insert a diary entry. For the Hebrew date corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-monthly-hebrew-diary-entry #[(arg) "ƒÁ‚  ÆÈÉÊ †ËÌ!AA@ Ê †&ËÌ!@Ê †1ËÌ!A@Ê †=ËÌ!AA@ SÐ_\\ÒVƒ€Ó_Ô\\Õ¥Z Ó¦ÖUƒ€ צÖUƒ{ ئÖUƒ€T, SÙ_ SÓ¥ S×¥[ SØ¥\\\\\\\\)!!P\"*‡" [european-calendar-style (day " * ") ("* " day) calendar-date-display-form calendar-hebrew-month-name-array-leap-year calendar-month-name-array make-diary-entry hebrew-diary-entry-symbol calendar-date-string calendar-hebrew-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" year month day 31 day-of-year 2 4 23 10 0 100 400 365 arg] 10 "\ 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." "P"]) (defalias 'insert-yearly-hebrew-diary-entry #[(arg) "ƒÁ‚  ÆÈÉÊ †ËÌ!AA@ Ê †&ËÌ!@Ê †1ËÌ!A@Ê †=ËÌ!AA@ SÐ_\\ÒVƒ€Ó_Ô\\Õ¥Z Ó¦ÖUƒ€ צÖUƒ{ ئÖUƒ€T, SÙ_ SÓ¥ S×¥[ SØ¥\\\\\\\\)!!P\"*‡" [european-calendar-style (day " " monthname) (monthname " " day) calendar-date-display-form calendar-hebrew-month-name-array-leap-year calendar-month-name-array make-diary-entry hebrew-diary-entry-symbol calendar-date-string calendar-hebrew-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" year month day 31 day-of-year 2 4 23 10 0 100 400 365 arg] 10 "\ 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." "P"]) (defalias 'insert-islamic-diary-entry #[(arg) " ÄÅÆ †ÇÈ!AA@ Æ †ÇÈ!@\nÆ †&ÇÈ!A@ Æ †2ÇÈ!AA@  \nSÌ_\\ \nÎVƒu \nÏ_Ð\\Ñ¥Z  ϦÒUƒu Ó¦ÒUƒp Ô¦ÒUƒu T  , SÕ_ SÏ¥ SÓ¥[ SÔ¥\\\\\\\\)!Ö×#P\")‡" [calendar-islamic-month-name-array calendar-month-name-array make-diary-entry islamic-diary-entry-symbol calendar-date-string calendar-islamic-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" year month day 31 day-of-year 2 4 23 10 0 100 400 365 nil t arg] 10 "\ Insert a diary entry. For the Islamic date corresponding to the date indicated by point. Prefix arg will make the entry nonmarking." "P"]) (defalias 'insert-monthly-islamic-diary-entry #[(arg) "ƒÁ‚  ÆÈÉÊ †ËÌ!AA@ Ê †&ËÌ!@Ê †1ËÌ!A@Ê †=ËÌ!AA@ SÐ_\\ÒVƒ€Ó_Ô\\Õ¥Z Ó¦ÖUƒ€ צÖUƒ{ ئÖUƒ€T, SÙ_ SÓ¥ S×¥[ SØ¥\\\\\\\\)!!P\"*‡" [european-calendar-style (day " * ") ("* " day) calendar-date-display-form calendar-islamic-month-name-array calendar-month-name-array make-diary-entry islamic-diary-entry-symbol calendar-date-string calendar-islamic-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" year month day 31 day-of-year 2 4 23 10 0 100 400 365 arg] 10 "\ 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." "P"]) (defalias 'insert-yearly-islamic-diary-entry #[(arg) "ƒÁ‚  ÆÈÉÊ †ËÌ!AA@ Ê †&ËÌ!@Ê †1ËÌ!A@Ê †=ËÌ!AA@ SÐ_\\ÒVƒ€Ó_Ô\\Õ¥Z Ó¦ÖUƒ€ צÖUƒ{ ئÖUƒ€T, SÙ_ SÓ¥ S×¥[ SØ¥\\\\\\\\)!!P\"*‡" [european-calendar-style (day " " monthname) (monthname " " day) calendar-date-display-form calendar-islamic-month-name-array calendar-month-name-array make-diary-entry islamic-diary-entry-symbol calendar-date-string calendar-islamic-from-absolute calendar-cursor-to-date error "Cursor is not on a date!" year month day 31 day-of-year 2 4 23 10 0 100 400 365 arg] 10 "\ 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." "P"]) (provide (quote diary-ins)) emacs-19.22/lisp/diary.elc100666 13437 1 154373 5462656374 14105 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 25 00:58:35 1993 ;;; from file /home/fsf/rms/e19/lisp/diary.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (require (quote calendar)) (defalias 'diary #[(&optional arg) "À ! ‰ƒAÅ !ƒAÆ !ƒ;Ç ƒ%É!‚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 "\ 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." "P"]) (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 error "Cursor is not on a date!" arg "Your diary file is not readable!" "You don't have a diary file!"] 4 "\ 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." "p"]) (autoload (quote 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 (quote 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 (quote diary-french-date) "cal-french" "\ French calendar equivalent of date diary entry." t) (autoload (quote diary-mayan-date) "cal-mayan" "\ Mayan calendar equivalent of date diary entry." t) (autoload (quote diary-phases-of-moon) "lunar" "\ Moon phases diary entry." t) (autoload (quote diary-sunrise-sunset) "solar" "\ Local time of sunrise and sunset as a diary entry." t) (autoload (quote 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 (byte-code "ÀÁ !‡" [copy-syntax-table standard-syntax-table] 2) "\ 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 42 "w" diary-syntax-table) (defalias 'list-diary-entries #[(date number) "À W…“\nÄÄÇ\n!É\n! ÌÍ!ˆŠÎ !‰ƒ,‚1Ð Ñ\"qˆ)ÑÄÔ Õ!ˆ×ŽÄØ Ù!dSbˆÞß!„bàuˆáâ!ˆebˆÞß!„oáâ!ˆãedäåÑ%ˆÀ& &T‰&Yƒ['\n@\nA@\nAA@è\n!)*+,‰-ƒ¹-@@±-@A‚´-@/-@@îš.ð\n!ñð\n!ÀòOóR4õö,!ñö,!ÀòOó°7øù,!P,øù+!P+øù*!:ƒñù*û¦!P‚üQ*ýþÿ@/A#B°CÑDebˆECÄÑ#ƒ®.ƒ<FGÄÑ#ˆHhå\"„NHhä\"ƒ_ÞI!„_Jà!ˆ‚\"Ñ)`ÄKLFM!ˆ`KEßÄÑN$ˆÞI!ƒ‘EßÄÑ#ˆ‚~Jà!ˆãK`åäÑ%ˆO\nL`{\"ˆ*‚\". -A‰-„¡)„ÏPƒÏQ\nüDC\"R\nAA@SS\n@,\nA@+\nAA@*+,ST_\\U,NVƒ2U,V_W\\ä¥ZU*V¦ÀUƒ2*û¦ÀUƒ-*X¦ÀUƒ2UTUU,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 "\ 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 'include-other-diary-files #[nil "ebˆÀÁ !ÄQÅÆ#ƒ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 "\ 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 'simple-diary-display #[nil "…Á\n!ÄÅ ƒÇ‚ÈPÉÊ Ë##  ƒ3 A„r @A@Șƒr GÎ XƒCÏ !‚‘Ð!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 "\ Display the diary buffer if there are any relevant entries or holidays."]) (defalias 'fancy-diary-display #[nil "ƒA„m@A@Á˜ƒm\n…à !ÆÇ ƒ&É‚'ÁPÊË Ì##‰ GÎ Xƒ?Ï !‚kÐ!qˆÒÔ!ˆÕ ˆÊË Ö#cˆebˆ×Ò!ˆØÙ!ˆÏÚ\"*‡ŠÛÜ!!qˆÞ àedáâØ%ˆÒ#äå!ˆ×!ˆ*ŠÐ&!qˆÒçå!ˆÔè!ˆÕ ˆÒé‰ê‰‰E+,-‰.ƒòï+.@@\"„Õ.@@+\nƒ^ð-‰ñUƒöò,ó¦!ƒöò,ô¦!ƒòò,õ¦!ƒöö‚û÷-SH,EC+C\"ƒ^+@‰-ƒ^+AA@‰,ƒ^,ø_-ùé\\\\\\‰:ø¦T-:ø¥‰,)ƒ^-,;<ý *‰ƒ^,ø_-\\‰:ø¦T-:ø¥,)þ+! Ò?‰@ƒŽï+@@@\"ƒ…A?@@A\"?@A‰@„n?*B`eUƒÁ‚žâ±ˆBƒ­CcˆiDÊËBÖEDF\"P#cˆ)iDâEDG\"ⱈ+ê.@A@GWƒé.@A@ⱈ.A‰.„¹-×Ò!ˆebˆØÙ&!ˆÏH!)‡" [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 nil buffer-read-only calendar-set-mode-line erase-buffer "\n" set-buffer-modified-p t display-buffer "No diary entries for %s" get-file-buffer substitute-in-file-name diary-file buffer-modified-p diary-modified subst-char-in-region 13 10 selective-display kill-local-variable mode-line-format fancy-diary-buffer make-local-variable "Diary Entries" 1 0 date holiday-list-last-year holiday-list-last-month entry-list calendar-date-equal calendar-date-compare 2 zerop 4 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] 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 "Preparing diary...done"] 8 "\ 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 'print-diary-entries #[nil "ÀÁ\n!!ƒŠÁ\n!qˆÃÄ!)‡ÅÆ!!‰ƒ{ÉÊ!Ë  Šqˆ;„6Ï‚CÐÑ\"ˆÒ”Ò•O Ó ed#ˆ qˆÔÕËÖ#ƒ_×Ø!ˆ‚Pebˆ ÙÚ GÛ\"Ù±ˆÃÄ!ˆÜ !+‚~ÝÞ!)‡" [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 "\ 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." nil]) (defalias 'show-all-diary-entries #[nil "À !‰ƒUÃ\n!ƒUÄ\n!ƒOŠÅ\n!‰ƒ#‚'Ç\nÈ\"qˆÉÊ   Í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 "\ 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." nil]) (defalias 'diary-name-pattern #[(string-array &optional fullname) "À GS T‰Yƒ5 ‰À˜ƒÀ‚Å Hƒ'À‚0Å HÇÈOÉQR‚) )‡" ["" pattern -1 i string-array "\\|" fullname 0 3 ".?"] 7 "\ 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 'mark-diary-entries #[nil "À !‰ƒ.Å !ƒ.Æ !ƒ$ŠÇÈ!ˆÉ À\"qˆ\nË  Î  Ï!ˆ ƒ @@ÑšƒF @A‚I @Ó!Ó!×PÙÙÙG‰Õ>GZU?…}ß\\Ø>GZ  U?…– ß\\ Û>GZ!!U?…¯!ß\\!Ú>GZ\"\"U?…È\"ß\\\"Ü>GZ##U?…á#ß\\#äåæç#èQ)À*ebˆë)ËÀ#ƒü… ”•{, … ” •{-î\"ƒ)\"”\"•{‚*ï!0î!ƒ=!”!•{‚>ï!1#…M#”#•{‰2„Wó‚£2GßUƒŸ4ƒŸõ AA@6î2!6÷¥÷_\\‰86ZùVƒˆ8÷Z‚›68ZùVƒ™8÷\\‚›8*‚£î2!:,ƒÂûüý,óþO!ÿó@#\"A!ˆ‚÷-ƒì-A˜ƒÖó0‚ìüý-óþO!ÿBC#\"A0D01:#ˆ.‚ô A .‚1E ˆFGH\"ˆÏ !ˆÇI!+‚5JK!‚5JL!)‡" [t mark-diary-entries-in-calendar substitute-in-file-name diary-file 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 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 "\ 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." nil]) (defalias 'mark-sexp-diary-entries #[nil "À !Ã\nÄQÆÆÆ Æ\nŠ qˆ  )Î_Ï\\\\‰ΦTÎ¥)ÑEAA@SÑE@ÑEA@ÑEAA@SÖ_\\ØVƒ£Ù_Ú\\Û¥ZÙ¦ÜUƒ£ݦÜUƒžÞ¦ÜUƒ£T,ß_٥ݥ[Þ¥\\\\\\\\) Î_Ñ\\\\‰ΦTÎ¥)‰ØUƒýÙ¦ÜUƒýݦÜUƒùÞ¦ÜUƒýà‚áSHEAA@S‰ØUƒ2Ù¦ÜUƒ2ݦÜUƒ.Þ¦ÜUƒ2à‚7áSHE@‰ØUƒdÙ¦ÜUƒdݦÜUƒ`Þ¦ÜUƒdà‚iáSHEA@‰ØUƒ—Ù¦ÜUƒ—ݦÜUƒ“Þ¦ÜUƒ—à‚œáSHEAA@SÖ_\\ØVƒâÙ_Ú\\Û¥ZÙ¦ÜUƒâݦÜUƒÝÞ¦ÜUƒâT,ß_٥ݥ[Þ¥\\\\\\\\)\nebˆâ Æã#…¯äÑ!ˆ`Ɖ‰‰%&'()ê ˆ)`{(Šëì!ˆ`%)Ñuˆíhî\"„>íhÛ\"ƒNïð!„NäÑ!ˆñ'‚‚`&âòÆã#ˆïð!ƒfâòÆã#ˆ‚WäÑ!ˆ&`{'óô'\"ƒ‚'Ü”ÛIˆ‚p S5\n5T‰5Yƒªö('÷5!#ƒ‡ø÷5!!ˆ‚‡.‚.‡" [regexp-quote sexp-diary-entry-symbol sexp-mark "\\(\\`\\| \\|\n\\)" "(" s-entry nil m y first-date last-date calendar-buffer displayed-month displayed-year 12 -2 macro-y 1 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 backward-char line-start entry-start entry sexp sexp-start forward-sexp re-search-backward " \\|\n\\|\\`" char-equal 13 looking-at " \\| " "" " \\|\n" string-match "[ ]" date diary-sexp-entry calendar-gregorian-from-absolute mark-visible-calendar-date] 7 "\ 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-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 "\ 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-calendar-days-named #[(dayname) "Šqˆ \n \nÉ Ê_\\‰ ʦT Ê¥)Ê_ Ì\\\\‰ ʦT  Ê¥)ÍÎ $AA@SÍÎ $@ÍÎ $A@ÍÎ $AA@ SÓ_\\ÕVƒ´Ö_×\\Ø¥ZÖ¦ÙUƒ´Ú¦ÙUƒ¯Û¦ÙUƒ´T,Ü_Ö¥Ú¥[Û¥\\\\\\\\)ÍÝ$AA@SÍÝ$@ÍÝ$A@ÍÝ$AA@ SÓ_\\ÕVƒ@Ö_×\\Ø¥ZÖ¦ÙUƒ@Ú¦ÙUƒ;Û¦ÙUƒ@T,Ü_Ö¥Ú¥[Û¥\\\\\\\\) X…nÞß !!ˆ à\\‰‚[.‡" [calendar-buffer displayed-month displayed-year nil day last-day succ-year succ-month prev-year prev-month 12 macro-y -2 calendar-nth-named-day 1 dayname prior-years month year 31 day-of-year 2 4 23 10 0 100 400 365 -1 mark-visible-calendar-date calendar-gregorian-from-absolute 7] 7 "\ 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-date-pattern #[(month day year) "Šqˆ \n Å_ Æ\\\\‰ŦTÅ¥)È Ê T‰ Y…JË   %ˆ Å_ \\‰ŦTÅ¥)‚,‡" [calendar-buffer displayed-month displayed-year y m 12 -2 macro-y -1 i 2 mark-calendar-month month day year] 7 "\ 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-month #[(month year p-month p-day p-year) " Uƒ\nÃU„$ \nU„$ ÃU…p\nÃU„$ \nU…p ÃUƒjÃÇUƒO ȦÃUƒO ɦÃUƒK ʦÃUƒOË‚SÌSHT‰Y…hÍ E!ˆ‚-)‡Í E!‡" [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] 4 "\ 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 'sort-diary-entries #[nil "À Â\"‰‡" [sort diary-entries-list diary-entry-compare] 3 "\ Sort the list of diary entries by time of day."]) (defalias 'diary-entry-compare #[(e1 e2) "À \n\"†à @\n@\"…Ä A@!Ä\nA@!W‡" [calendar-date-compare e1 e2 calendar-date-equal diary-entry-time] 3 "\ Returns t if E1 is earlier than E2."]) (defalias 'diary-entry-time #[(s) "ÀÁ\n\"ƒÃ\nĔĕO!Å_Ã\nƔƕO!\\‡ÀÇ\n\"ƒ@Ã\nĔĕO!ȦÅ_\nƔƕOɘƒ=Ê‚>Ë\\‡ÀÌ\n\"ƒnÃ\nĔĕO!ȦÅ_Ã\nƔƕO!\n͔͕OɘƒjÊ‚kË\\\\‡Î‡" [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 "\ 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 'list-hebrew-diary-entries #[nil "À Wƒ9Âà Å! \nÀ  T‰ Yƒ0  ÎAA@S@A@AA@SÓ_\\ÕVƒÖ_×\\Ø¥ZÖ¦ÀUƒÙ¦ÀUƒ|Ú¦ÀUƒT,Û_Ö¥Ù¥[Ú¥\\\\\\\\)!‰@A@AA@ ƒ´ @@ÝšƒÃ @A‚Æ @ @@Ýšß!àß!ÀáOâR#$%æç!P(éê!Péê!Péê!+ƒàêÙ¦!P‚ìQíîÅ/!ðñòó#ô°5ö7ebˆø5Âö#ƒ©ƒCùúÂö#ˆûhü\"„QûhØ\"ƒ`ýþ!„`ÿ@!ˆ‚/`ÂABùC!ˆ`AøDÂöÕ$ˆýþ!ƒ‰øDÂö#ˆ‚xÿ@!ˆEA`üØö%ˆFB`{\"ˆ*‚/.\n A‰ „³-GAA@S@A@AA@SÓ_\\ÕVƒÖ_×\\Ø¥ZÖ¦ÀUƒÙ¦ÀUƒ Ú¦ÀUƒT,Û_Ö¥Ù¥[Ú¥\\\\\\\\)T!‚)H !,‡eb‡" [0 number nil buffer-modified-p original-date regexp-quote diary-nonmarking-symbol mark gdate diary-modified buffer-read-only i diary-date-forms d calendar-hebrew-from-absolute prior-years month day year 31 day-of-year 2 4 23 10 100 400 365 hdate backup date-form calendar-day-name "\\|" 3 ".?" dayname calendar-hebrew-month-name-array-leap-year calendar-month-name-array "\\*\\|" calendar-month-name monthname "\\*\\|0*" int-to-string abbreviated-calendar-year "" "\\(\\`\\| \\|\n\\)" "?" hebrew-diary-entry-symbol "\\(" mapconcat eval "\\)\\(" "\\)" regexp t case-fold-search re-search-forward re-search-backward "\\<" char-equal 13 looking-at " \\| " backward-char 1 date-start entry-start " \\|\n\\|\\`" " \\|\n" subst-char-in-region add-to-diary-list calendar-gregorian-from-absolute set-buffer-modified-p] 10 "\ 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'."]) (defalias 'mark-hebrew-diary-entries #[nil "‰…6 @@šƒ @A‚ @Ä !ÄÈ\"ÉP\nË Ë Ë G‰Æ >GZU?…GÑ\\Ê >GZU?…_Ñ\\Í >GZU?…wÑ\\Ì >GZU?…Ñ\\Î >GZU?…§Ñ\\Ö×!ÙÚÛ Ü#Ý°ÈebˆàáÈ#ƒ,…Ô”•{\"…┕{#äƒô”•{‚õå!&䃔•{‚ å!'…”•{‰(„\"é‚ß(GÑUƒÛ*ƒÛëì AA@S-ì @ ì A@ ì AA@  Sî_\\/ ÑVƒˆ/ ð_ñ\\ò¥Z/ð¦éUƒˆó¦éUƒƒô¦éUƒˆ/T//,-õ_-ð¥-ó¥[-ô¥\\\\\\\\)!AA@6ä(!6ó¥ó_\\‰76ZøVƒÄ7óZ‚×67ZøVƒÕ7ó\\‚×7*‚ßä(!9\"ƒûúûü\"éýO!þ éÿ#\"A!ˆ‚'#ƒ#@˜ƒé&‚ûü#!þ!\"A&A&'9#ˆ.‚¿. A‰„á)‡" [diary-date-forms d backup date-form diary-name-pattern calendar-day-name-array dayname calendar-hebrew-month-name-array-leap-year t "\\|\\*" monthname "[0-9]+\\|\\*" month day year l d-name-pos 2 m-name-pos d-pos m-pos y-pos "\\(\\`\\| \\|\n\\)" regexp-quote hebrew-diary-entry-symbol "\\(" mapconcat eval "\\)\\(" "\\)" regexp case-fold-search re-search-forward nil dd-name mm-name string-to-int "" mm dd y-str 0 abbreviated-calendar-year calendar-hebrew-from-absolute calendar-current-date prior-years 31 day-of-year 4 23 10 100 400 365 current-y y 50 yy mark-calendar-days-named assoc capitalize 3 calendar-make-alist (lambda (x) (substring x 0 3)) "*" mark-hebrew-calendar-date-pattern] 8 "\ 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."]) (defalias 'mark-hebrew-calendar-date-pattern #[(month day year) "Šqˆ ÂU„š ÂU„š ÂU„/ÅÆ E!!È!…+É!)‚É\nË Wƒ= ËZ‚@ Ì\\Í WƒL ÍZ‚O Î\\Ï Wƒ[ ÏZ‚^ Ð\\Ñ Wƒj ÑZ‚m Ò\\Ó Wƒy ÓZ‚| Ô\\¯>…É\n\nÖÛ_Ü\\\\‰Û¦TÛ¥)Û_\\‰Û¦TÛ¥)ÌEAA@SÌE@ÌEA@ÌEAA@ Sß_\\ ÎVƒ  Ò_á\\Í¥Z Ò¦ÂUƒ  â¦ÂUƒ ã¦ÂUƒ  T  ,ä_Ò¥â¥[ã¥\\\\\\\\)%‰ÎUƒbÒ¦ÂUƒbâ¦ÂUƒ^ã¦ÂUƒbæ‚gçSHEAA@S‰ÎUƒ—Ò¦ÂUƒ—â¦ÂUƒ“ã¦ÂUƒ—æ‚œçSHE@‰ÎUƒÈÒ¦ÂUƒÈâ¦ÂUƒÄã¦ÂUƒÈæ‚ÍçSHEA@‰ÎUƒúÒ¦ÂUƒúâ¦ÂUƒöã¦ÂUƒúæ‚ÿçSHEAA@ Sß_\\ ÎVƒ= Ò_á\\Í¥Z Ò¦ÂUƒ= â¦ÂUƒ8 ã¦ÂUƒ= T  ,ä_Ò¥â¥[ã¥\\\\\\\\)(é%!*é(!+*AA@,+AA@-î Wƒ}-‚,ÅÆ E!!È!…•É!. ‚É\nÖ‰/0121Û_2Ü\\\\‰Û¦T2Û¥1)2Ì1EAA@S2Ì1E@2Ì1EA@2Ì1EAA@ Sß_\\ ÎVƒ Ò_á\\Í¥Z Ò¦ÂUƒ â¦ÂUƒ ã¦ÂUƒ T  ,ä_Ò¥â¥[ã¥\\\\\\\\)01Û_2Ì\\\\‰Û¦T2Û¥1)2‰ÎUƒx1Ò¦ÂUƒx1â¦ÂUƒt1ã¦ÂUƒxæ‚}ç2SH1EAA@S2‰ÎUƒ­1Ò¦ÂUƒ­1â¦ÂUƒ©1ã¦ÂUƒ­悲ç2SH1E@2‰ÎUƒÞ1Ò¦ÂUƒÞ1â¦ÂUƒÚ1ã¦ÂUƒÞæ‚ãç2SH1EA@2‰ÎUƒ1Ò¦ÂUƒ1â¦ÂUƒ 1ã¦ÂUƒæ‚ç2SH1EAA@ Sß_\\ ÎVƒS Ò_á\\Í¥Z Ò¦ÂUƒS â¦ÂUƒN ã¦ÂUƒS T  ,ä_Ò¥â¥[ã¥\\\\\\\\)/0S/T‰Y…Èé!‰3@43A@53AA@6 ÂU„£ 4UƒÄ ÂU„° 5UƒÄ ÂU„½ 6UƒÄÉÅ!!ˆ,‚s-)‡" [calendar-buffer month 0 day year calendar-gregorian-from-absolute calendar-absolute-from-hebrew date calendar-date-is-visible-p mark-visible-calendar-date displayed-month 11 1 10 2 9 3 8 4 7 5 displayed-year nil y2 m2 y1 m1 12 -2 macro-y prior-years 31 day-of-year 23 100 400 365 start-date 29 [31 28 31 30 31 30 31 31 30 31 30 31] end-date calendar-hebrew-from-absolute hebrew-start hebrew-end hebrew-y1 hebrew-y2 6 last-date first-date y m h-date h-month h-day h-year] 8 "\ Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR. A value of 0 in any position is a wildcard."]) (defalias 'list-sexp-diary-entries #[(date) "À !À !Å\nÆ Ç°É\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 "\ 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-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-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 '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ˆÃÅÆÇÈ#ƒ T‚ + \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 "\ Process a SEXP diary ENTRY for DATE."]) (defalias 'diary-block #[(m1 d1 y1 m2 d2 y2) "ƒ \n E‚\n EAA@Sƒ \n E‚#\n E@ƒ0 \n E‚4\n EA@ƒC \n E‚G\n EAA@ SÈ_\\ ÊVƒ‡ Ë_Ì\\Í¥Z ˦ÎUƒ‡ϦÎUƒ‚ЦÎUƒ‡ T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)ƒªE‚±EAA@SƒÄE‚ËE@ƒÛE‚âEA@ƒôE‚ûEAA@ SÈ_\\ ÊVƒ; Ë_Ì\\Í¥Z ˦ÎUƒ;ϦÎUƒ6ЦÎUƒ; T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)AA@S@A@AA@ SÈ_\\ ÊVƒ£ Ë_Ì\\Í¥Z ˦ÎUƒ£ϦÎUƒžЦÎUƒ£ T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)‰X…ÏX…Ï+‡" [european-calendar-style d1 m1 y1 prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 d2 m2 y2 date d date2 date1 entry] 9 "\ 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-float #[(month dayname n) "@AA@ <ƒ\n >„\n š„ Ä=…/ÅÆ\n $\"…/ *‡" [date y m month t calendar-date-equal calendar-nth-named-day n dayname entry] 7 "\ 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-anniversary #[(month day year) "ƒ ‚ \nƒ\n‚  AA@‰Z ÉUƒK ÊUƒK˦ÌUƒGͦÌUƒKΦÌU„KÏÐÌV…gÑ E \"…gÒÔ!#,‡" [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 "\ 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-cyclic #[(n month day year) "ƒ ‚ \nƒ\n‚  AA@S @ A@ AA@\n SÈ_\\ ÊVƒb Ë_Ì\\Í¥Z ˦ÎUƒbϦÎUƒ]ЦÎUƒb T  ,Ñ_˥ϥ[Ð¥\\\\\\\\) EAA@S E@ EA@ EAA@\n SÈ_\\ ÊVƒÙ Ë_Ì\\Í¥Z ˦ÎUƒÙϦÎUƒÔЦÎUƒÙ T  ,Ñ_˥ϥ[Ð¥\\\\\\\\)Z‰¥ÎY…¦ÎU…Õ×!#,‡" [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] 8 "\ 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-ordinal-suffix #[(n) "Á¦Â>„ÃĦWƒŇÆĦH‡" [n 100 (11 12 13) 3 10 "th" ["th" "st" "nd" "rd"]] 3 "\ Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"]) (defalias 'diary-day-of-year #[nil "AA@@A@AA@ \nSÄ_\\\nÆVƒC \nÇ_È\\É¥Z ǦÊUƒC ˦ÊUƒ@ ̦ÊUƒC T ,ÍÄ E@ÍÄ EA@ÍÄ EAA@ \nSÄ_\\\nÆVƒ \nÇ_È\\É¥Z ǦÊUƒ ˦ÊUƒŠ ̦ÊUƒ T , ZÏÐ ‰ÑUƒ£Ò‚¤Ó%+‡" [date 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"] 7 "\ Day of year and number of days remaining in the year of date diary entry."]) (defalias 'diary-iso-date #[nil "AA@S@A@AA@ \nSÅ_\\\nÇVƒI\nÈ_É\\Ê¥Z ȦËUƒI ̦ËUƒD ͦËUƒIT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)ϦÐAA@S@A@AA@ \nSÅ_\\\nÇVƒª\nÈ_É\\Ê¥Z ȦËUƒª ̦ËUƒ¥ ͦËUƒªT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)!ÒÓ ËUƒÏÏ‚Ð @AA@$*‡" [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 7 calendar-iso-from-absolute iso-date format "ISO date: Day %s of week %d of %d."] 8 "\ ISO calendar equivalent of date diary entry."]) (defalias 'diary-islamic-date #[nil "À AA@S @ A@ AA@ SÆ_\\ ÈVƒJ É_Ê\\Ë¥Z ɦÌUƒJ ͦÌUƒE ΦÌUƒJT,\nÏ_\nÉ¥\nÍ¥[\nÎ¥\\\\\\\\)!AA@ÓY…yÔÕÖ×Ø#\"*‡" [calendar-islamic-from-absolute date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 i-date calendar-islamic-month-name-array calendar-month-name-array 1 format "Islamic date: %s" calendar-date-string nil t] 7 "\ Islamic calendar equivalent of date diary entry."]) (defalias 'diary-hebrew-date #[nil "À AA@S @ A@ AA@ SÆ_\\ ÈVƒJ É_Ê\\Ë¥Z ɦÌUƒJ ͦÌUƒE ΦÌUƒJT,\nÏ_\nÉ¥\nÍ¥[\nÎ¥\\\\\\\\)!ÑAA@!ƒq‚sÕÖ×ØÙ#\"*‡" [calendar-hebrew-from-absolute date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 h-date hebrew-calendar-leap-year-p calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year calendar-month-name-array format "Hebrew date: %s" calendar-date-string nil t] 7 "\ Hebrew calendar equivalent of date diary entry."]) (defalias 'diary-julian-date #[nil "ÀÁÂà AA@S @ A@ AA@SÉ_\\\nËVƒW\nÌ_Í\\Î¥Z\n̦ÏUƒWЦÏUƒRѦÏUƒW\nT\n\n, Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\)!!ÓÔ$‡" [format "Julian date: %s" calendar-date-string calendar-julian-from-absolute date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 nil t] 10 "\ Julian calendar equivalent of date diary entry."]) (defalias 'diary-astro-day-number #[nil "ÀÁ\nAA@S\n@\nA@\nAA@ SÇ_\\ ÉVƒO Ê_Ë\\Ì¥ZʦÍUƒOΦÍUƒJϦÍUƒOT, Ð_ Ê¥ Î¥[ Ï¥\\\\\\\\)Ñ\\\"‡" [format "Astronomical (Julian) day number %d" date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 1721425] 8 "\ Astronomical (Julian) day number diary entry."]) (defalias 'diary-omer #[nil "ÀÁ AA@Ä\\E! AA@S @ A@ AA@ SÊ_\\ ÌVƒ` Í_Î\\Ï¥Z  ͦÐUƒ` ѦÐUƒ[ Ò¦ÐUƒ` T  ,Ó_ͥѥ[Ò¥\\\\\\\\) Z‰Õ¥Õ¦ÐV…Ñ×W…ÑØÙÐUƒ¥Ú‚ÐØÛ‰ÁUƒ³Ú‚´ÜÐUƒ¿Ú‚ÏØ݉ÁUƒÍÚ‚ÎÜ#$#,‡" [calendar-absolute-from-hebrew 1 15 date 3760 passover prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 omer 7 week 50 format "Day %d%s of the omer (until sunset)" "" ", that is, %d week%s%s" "s" " and %d day%s"] 13 "\ Omer count diary entry. Entry applies if date is within 50 days after Passover."]) (defalias 'diary-yahrzeit #[(death-month death-day death-year) "À ƒ \n E‚ \n EAA@S ƒ \n E‚$ \n E@ ƒ2\n E‚6 \n EA@ ƒE\n E‚I \n EAA@SÉ_\\\nËVƒŒ\nÌ_Í\\Î¥Z\n̦ÏUƒŒЦÏUƒ‡ѦÏUƒŒ\nT\n\n, Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\)!‰@A@AA@AA@S@A@AA@SÉ_\\\nËVƒ \nÌ_Í\\Î¥Z\n̦ÏUƒ ЦÏUƒѦÏUƒ \nT\n\n, Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\)À!AA@‰ZÛ\"ÏV…U„RTU…ÝÞUƒbà‚cá‰Î¦âUƒqã‚ŒΦËUƒ~ä‚ŒΦåUƒ‹æ‚Œç%.‡" [calendar-hebrew-from-absolute european-calendar-style death-day death-month death-year prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 h-date h-month h-day h-year date d yr diff hebrew-calendar-yahrzeit y format "Yahrzeit of %s%s: %d%s anniversary" entry "" " (evening)" 1 "st" "nd" 3 "rd" "th"] 8 "\ 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."]) (defalias 'diary-rosh-hodesh #[nil "AA@S@A@AA@ \nSÅ_\\\nÇVƒI\nÈ_É\\Ê¥Z ȦËUƒI ̦ËUƒD ͦËUƒIT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)Ð!‰@A@AA@Õ!×\"ƒ‚‘‰SHÐS!A@ÞU„¸ßUƒáàU„ááâÞUƒÌáãH\"‚ÝÞUƒÛáä\"‚Ý\"‚à¦åUƒZæVƒåU„çUƒáèé!UƒË‚H*çZH#‚ÞW…æV…ÞU…áëHçUƒFì‚M*çZH*ÞZà¦H$‚çU…åU?…áíé!Uƒ{Ë‚}H\".\n‡" [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 d calendar-hebrew-from-absolute h-date h-month h-day h-year hebrew-calendar-leap-year-p leap-year hebrew-calendar-last-day-of-month last-day calendar-hebrew-month-name-array-leap-year calendar-hebrew-month-name-array-common-year h-month-names this-month h-yesterday 30 1 7 format "Rosh Hodesh %s" "%s (first day)" "%s (second day)" 6 22 29 "Mevarhim Rosh Hodesh %s (%s)" hebrew-calendar-last-month-of-year calendar-day-name-array "Mevarhim Rosh Hodesh %s (%s-%s)" "tomorrow" "Erev Rosh Hodesh %s"] 8 "\ Rosh Hodesh diary entry. Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."]) (defalias 'diary-parasha #[nil "AA@S@A@AA@ \nSÅ_\\\nÇVƒI\nÈ_É\\Ê¥Z ȦËUƒI ̦ËUƒD ͦËUƒIT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)‰ЦÑU…Ò!AA@ÔÐÕE!ÔÕ×E!ЦHЦHÜ!Þ!ƒ¯„¯à‚¾„½ƒ½á‚¾â#äåæ#$!J'èÑÑ\\\"))ZÐ¥*'*H‰+…åì+<ƒ+@ƒ åíî+@!î+A!#‚åïî+A!\"‚î+!\". )‡" [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 d 7 6 calendar-hebrew-from-absolute h-year calendar-absolute-from-hebrew 1 rosh-hashannah 15 passover calendar-day-name-array rosh-hashannah-day passover-day hebrew-calendar-long-heshvan-p long-h hebrew-calendar-short-kislev-p short-k "complete" "incomplete" "regular" type intern format "hebrew-calendar-year-%s-%s-%s" year-format calendar-dayname-on-or-before first-saturday saturday parasha "Parashat %s" "%s (diaspora), %s (Israel)" hebrew-calendar-parasha-name "%s (Israel)"] 8 "\ Parasha diary entry--entry applies if date is a Saturday."]) (defalias 'add-to-diary-list #[(date string) "… …  DC\"‰‡" [date string append diary-entries-list] 4 "\ Add the entry (DATE STRING) to `diary-entries-list'. Do nothing if DATE or STRING is nil."]) (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.") (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.") (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.") (defalias 'hebrew-calendar-parasha-name #[(p) "À !ƒÂà ÅHH ÆHH#‡ H‡" [arrayp p format "%s/%s" hebrew-calendar-parashiot-names 0 1] 6 "\ Name(s) corresponding to parasha P."]) (defalias 'list-islamic-diary-entries #[nil "À Wƒ9Âà Å! \nÀ  T‰ Yƒ0  ÎAA@S@A@AA@SÓ_\\ÕVƒÖ_×\\Ø¥ZÖ¦ÀUƒÙ¦ÀUƒ|Ú¦ÀUƒT,Û_Ö¥Ù¥[Ú¥\\\\\\\\)!‰@A@AA@ ƒ´ @@ÝšƒÃ @A‚Æ @ @@Ýšß!àß!ÀáOâR#$%æç!P(éê!Péê!Péê!+ƒàêÙ¦!P‚ìQíîÅ/!ðñòó#ô°5ö7ebˆø5Âö#ƒ©ƒCùúÂö#ˆûhü\"„QûhØ\"ƒ`ýþ!„`ÿ@!ˆ‚/`ÂABùC!ˆ`AøDÂöÕ$ˆýþ!ƒ‰øDÂö#ˆ‚xÿ@!ˆEA`üØö%ˆFB`{\"ˆ*‚/.\n A‰ „³-GAA@S@A@AA@SÓ_\\ÕVƒÖ_×\\Ø¥ZÖ¦ÀUƒÙ¦ÀUƒ Ú¦ÀUƒT,Û_Ö¥Ù¥[Ú¥\\\\\\\\)T!‚)H !,‡eb‡" [0 number nil buffer-modified-p original-date regexp-quote diary-nonmarking-symbol mark gdate diary-modified buffer-read-only i diary-date-forms d calendar-islamic-from-absolute prior-years month day year 31 day-of-year 2 4 23 10 100 400 365 idate backup date-form calendar-day-name "\\|" 3 ".?" dayname calendar-islamic-month-name-array calendar-month-name-array "\\*\\|" calendar-month-name monthname "\\*\\|0*" int-to-string abbreviated-calendar-year "" "\\(\\`\\| \\|\n\\)" "?" islamic-diary-entry-symbol "\\(" mapconcat eval "\\)\\(" "\\)" regexp t case-fold-search re-search-forward re-search-backward "\\<" char-equal 13 looking-at " \\| " backward-char 1 date-start entry-start " \\|\n\\|\\`" " \\|\n" subst-char-in-region add-to-diary-list calendar-gregorian-from-absolute set-buffer-modified-p] 10 "\ 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'."]) (defalias 'mark-islamic-diary-entries #[nil "‰…6 @@šƒ @A‚ @Ä !ÄÈ\"ÉP\nË Ë Ë G‰Æ >GZU?…GÑ\\Ê >GZU?…_Ñ\\Í >GZU?…wÑ\\Ì >GZU?…Ñ\\Î >GZU?…§Ñ\\Ö×!ÙÚÛ Ü#Ý°ÈebˆàáÈ#ƒ,…Ô”•{\"…┕{#äƒô”•{‚õå!&䃔•{‚ å!'…”•{‰(„\"é‚ß(GÑUƒÛ*ƒÛëì AA@S-ì @ ì A@ ì AA@  Sî_\\/ ÑVƒˆ/ ð_ñ\\ò¥Z/ð¦éUƒˆó¦éUƒƒô¦éUƒˆ/T//,-õ_-ð¥-ó¥[-ô¥\\\\\\\\)!AA@6ä(!6ó¥ó_\\‰76ZøVƒÄ7óZ‚×67ZøVƒÕ7ó\\‚×7*‚ßä(!9\"ƒûúûü\"éýO!þ éÿ#\"A!ˆ‚'#ƒ#@˜ƒé&‚ûü#!þ!\"A&A&'9#ˆ.‚¿. A‰„á)‡" [diary-date-forms d backup date-form diary-name-pattern calendar-day-name-array dayname calendar-islamic-month-name-array t "\\|\\*" monthname "[0-9]+\\|\\*" month day year l d-name-pos 2 m-name-pos d-pos m-pos y-pos "\\(\\`\\| \\|\n\\)" regexp-quote islamic-diary-entry-symbol "\\(" mapconcat eval "\\)\\(" "\\)" regexp case-fold-search re-search-forward nil dd-name mm-name string-to-int "" mm dd y-str 0 abbreviated-calendar-year calendar-islamic-from-absolute calendar-current-date prior-years 31 day-of-year 4 23 10 100 400 365 current-y y 50 yy mark-calendar-days-named assoc capitalize 3 calendar-make-alist (lambda (x) (substring x 0 3)) "*" mark-islamic-calendar-date-pattern] 8 "\ 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."]) (defalias 'mark-islamic-calendar-date-pattern #[(month day year) "Šqˆ ÂU„þ ÂU„þ ÂU„/ÅÆ E!!È!…+É!)‚-Ê Ì EAA@S Ì E@ Ì EA@ Ì EAA@ SÏ_\\ ÑVƒŽ Ò_Ó\\Ô¥Z Ò¦ÂUƒŽ Õ¦ÂUƒ‰ Ö¦ÂUƒŽT,×_Ò¥Õ¥[Ö¥\\\\\\\\)!‰@AA@ÛÜW?…úÝ_Ô ZÞ\\\\\\‰ݦTÝ¥)àV…úÅÆ E!!È!…ùÉ!),‚-  Û‰!\"Ý_ã\\\\‰ݦTÝ¥)ÜEAA@SÜE@ÜEA@ÜEAA@ SÏ_\\ ÑVƒ‚ Ò_Ó\\Ô¥Z Ò¦ÂUƒ‚ Õ¦ÂUƒ} Ö¦ÂUƒ‚T,×_Ò¥Õ¥[Ö¥\\\\\\\\)\"Ý_Ü\\\\‰ݦTÝ¥)‰ÑUƒÜÒ¦ÂUƒÜÕ¦ÂUƒØÖ¦ÂUƒÜä‚áåSHEAA@S‰ÑUƒÒ¦ÂUƒÕ¦ÂUƒ Ö¦ÂUƒä‚åSHE@‰ÑUƒBÒ¦ÂUƒBÕ¦ÂUƒ>Ö¦ÂUƒBä‚GåSHEA@‰ÑUƒtÒ¦ÂUƒtÕ¦ÂUƒpÖ¦ÂUƒtä‚yåSHEAA@ SÏ_\\ ÑVƒ· Ò_Ó\\Ô¥Z Ò¦ÂUƒ· Õ¦ÂUƒ² Ö¦ÂUƒ·T,×_Ò¥Õ¥[Ö¥\\\\\\\\)!\"S!T‰Y…,Ê!‰&@'&A@(&AA@) ÂU„ 'Uƒ( ÂU„ (Uƒ( ÂU„! )Uƒ(ÉÅ!!ˆ,‚×-)‡" [calendar-buffer month 0 day year calendar-gregorian-from-absolute calendar-absolute-from-islamic date calendar-date-is-visible-p mark-visible-calendar-date calendar-islamic-from-absolute displayed-month 15 displayed-year prior-years 31 day-of-year 2 4 23 10 100 400 365 islamic-date m y nil 1 12 -1 macro-y 7 last-date first-date -2 29 [31 28 31 30 31 30 31 31 30 31 30 31] i-date i-month i-day i-year] 8 "\ Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. A value of 0 in any position is a wildcard."]) (provide (quote diary)) emacs-19.22/lisp/diff.elc100666 12062 1 11474 5451135112 13445 0ustar bobdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:38:18 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/diff.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (require (quote compile)) (defvar diff-switches "-c" "\ *A string or list of strings specifying switches to be be passed to diff.") (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))) "\ 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.") (defalias (quote diff-parse-differences) #[(limit-search find-at-least) "ÀÂÃ!ˆ ƒ bˆÅÆÈ#É\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ˆ*ŠÊ !ˆÂ +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]) (defalias 'diff #[(old new &optional switches) "À !À\n!Ã\n!à !ÄÄŽÈÉÊË ƒ0 :ƒ* ‚> C‚> :ƒ; ‚> C„H…MÎ\nÎ F†S\nC†Z C%Ï#ÑÒÓÔ$Š qˆÕÖ!\nLˆÕ×! LˆÕØ!LˆÕÙ!LˆÕÚ!ÛLˆ) -‡" [expand-file-name new old file-local-copy nil buf new-alt old-alt mapconcat identity append ("diff") switches diff-switches "-L" " " command compile-internal "No more differences" "Diff" diff-parse-differences 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 "\ 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." (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)]) (defalias 'diff-backup #[(file &optional switches) "À‰à !ƒ Å !‚ Æ !†ÇÈ \" É\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 "\ 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'." (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))]) (defalias 'diff-latest-backup-file #[(fn) "À ! !Ä !… )†1Å !Ç !ÈP‰ G\nËÌ \"Í\"@P+‡" [expand-file-name fn make-backup-file-name bak file-exists-p file-name-directory dir file-name-nondirectory ".~" base-versions bv-length sort file-name-all-completions #[(fn1 fn2) "À !À\n!V‡" [backup-extract-version fn1 fn2] 3]] 6 "\ Return the latest existing backup of FILE, or nil."]) (provide (quote diff)) emacs-19.22/lisp/dired-aux.elc100666 12062 1 107673 5474512122 14453 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Nov 23 17:53:05 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/dired-aux.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (defalias 'dired-diff #[(file &optional switches) "À ÂÃ! #‡" [diff file dired-get-filename t switches] 4 "\ 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'." (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)]) (defalias 'dired-backup-diff #[(&optional switches) "ÀÁ \n\"‡" [diff-backup dired-get-filename switches] 3 "\ 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'." (byte-code "…Á ;ƒ ‚ÄÅ Æ#\"C‡" [current-prefix-arg read-string "Options for diff: " diff-switches mapconcat identity " "] 6)]) (defalias (quote dired-do-chxxx) #[(attribute-name program op-symbol arg) "ÀÁ\n\"ÄÅÇQÈ \n %\n Ì\nQ ÈÏÐÑ  \nE $Ò\n!ˆ…=ÓÔÕ \"È\",‡" [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"] 6]) (defalias 'dired-do-chmod #[(&optional arg) "ÀÁÂà $‡" [dired-do-chxxx "Mode" "chmod" chmod arg] 5 "\ Change the mode of the marked (or next ARG) files. This calls chmod, thus symbolic modes like `g+w' are allowed." "P"]) (defalias 'dired-do-chgrp #[(&optional arg) "ÀÁÂà $‡" [dired-do-chxxx "Group" "chgrp" chgrp arg] 5 "\ Change the group of the marked (or next ARG) files." "P"]) (defalias 'dired-do-chown #[(&optional arg) "ÀÁ\nà $‡" [dired-do-chxxx "Owner" dired-chown-program chown arg] 5 "\ Change the owner of the marked (or next ARG) files." "P"]) (defalias (quote dired-bunch-files) #[(max function args files) "ÀÁÀ ƒH @‰GÇ\\ A ƒ6 \\\nVƒ6Ë Í \"\"\n¤ÀÁ ¡ˆ  \\ +‚Ë Í \"\"\n¤+‡" [nil 0 failures pending-length pending files thisfile 3 thislength rest max apply function append args] 6]) (defalias 'dired-do-print #[(&optional arg) "ÀÁ\n\"ÄÅÆÇÉ\n$Ë\n % ÍÎ Ï#!*‡" [dired-get-marked-files t arg file-list dired-mark-read-string "Print %s with: " apply concat lpr-command " " lpr-switches print command dired-run-shell-command dired-shell-stuff-it nil] 7 "\ Print the marked (or next ARG) files. Uses the shell command coming from variables `lpr-command' and `lpr-switches' as default." "P"]) (defalias (quote dired-mark-read-string) #[(prompt initial op-symbol arg files) "ÀÁ\n ÄÅÇ \"\" &‡" [dired-mark-pop-up nil op-symbol files read-string format prompt dired-mark-prompt arg initial] 10]) (defalias 'dired-clean-directory #[(keep) "ƒ\nÁ!‚ \n‰ÃWƒ[‚ ÃXƒ\"\n‚#ÅÉÊ#ˆËÌ!ˆ‰ ƒxÎÏ @AÐ\"B‰G‰\\Vƒf›Z›¡ˆ @A¡ˆ* A‰ „>)ËÓ!ˆÉÔ!+‡" [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"] 5 "\ 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." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias dired-map-dired-file-lines #[(fun) "ŠÀ‰ebˆm?…0ŠÃ !„)l„)ÅÀÆ\"‰ƒ)Àˆ\n!ˆ)Èyˆ‚+‡" [nil buffer-read-only file looking-at dired-re-dir dired-get-filename t fun 1] 3] dired-collect-file-versions #[(fn) "À !ÂP‰GÅ Æ !\"ÈÉ\"‰\n…& \nB B‰ ,‡" [file-name-nondirectory fn ".~" base-versions bv-length file-name-all-completions file-name-directory possibilities mapcar backup-extract-version versions dired-file-version-alist] 5] dired-trample-file-versions #[(fn) "ÀÁ\n\"Ä …0Æ\nÇ O\"‰…0É\n Ê\\ÄO! >?…0Ç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] 4]] 3) (defalias 'dired-shell-quote #[(filename) "ÀÁÂÆÇ #ƒ'Á”  OÉ ‰TOR T‚  ÂOP+‡" ["" 0 nil end start result string-match "[^---0-9a-zA-Z_./]" filename "\\"] 6 "\ Quote a file name for inferior shell (see variable `shell-file-name')."]) (defalias (quote dired-read-shell-command) #[(prompt arg files) "ÀÁ ÄÅÇ \"\"%‡" [dired-mark-pop-up nil shell files read-string format prompt dired-mark-prompt arg] 10]) (defalias 'dired-do-shell-command #[(command &optional arg) "ÀÁ\n\"?ÄÅ\" ƒÈÉ\nGZÊË$‚(ÌÍ\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] 6 "\ 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." (list (dired-read-shell-command (concat "! on " "%s: ") current-prefix-arg (dired-get-marked-files t current-prefix-arg)) current-prefix-arg)]) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias dired-shell-stuff-it #[(command file-list on-each &optional raw-arg) "ÀÁ\n\"ƒ  ÄƒÇ ÈÉ\n\"Ë#‚=ÇÉ\n # \nGÎVƒ8 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] 5] dired-run-shell-command #[(command) "À !ˆÂ‡" [shell-command command nil] 2] dired-call-process #[(program discard &rest arguments) "ÀÁ\nà ?à &‡" [apply call-process program nil discard arguments] 7] dired-check-process #[(msg program &rest arguments) "À‰ ÅÆ\"ˆŠÈÉ!‰qˆÊ ˆ\nËÌ À$ÏU?‰ƒGÐ ÑÒ!ÓR!ˆÐ !ˆ†R †RÔ‚RÕ !ˆÅÖ\"ˆÀ,‡" [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"] 6] dired-kill-line #[(&optional arg) "À !‰ ÅU„MÆÂÇ\"‰„ÈÉ!ˆ‚Š ƒ,Ê !ƒ,Ë ˆ)Åyˆ`Ìyˆ`|ˆ ÅVƒD S‰‚ TÍyˆ‚Î *‡" [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] 4 nil "P"]] 3) (defalias 'dired-do-kill-lines #[(&optional arg fmt) "ƒÁ ƒ  ‡Ã!‡ŠebˆÄÅ„EÈ  m„AÊ ÄË#ƒATÅyˆ`Ìyˆ`|ˆ‚\")‚km„kÍ „TÎÏ!„ZÌyˆ‚ET`ŠÌyˆ`)|ˆ‚EК„Ò†yÓÔ!#ˆ+‡" [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] 5 "\ 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)." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊ!„Ë\nÀÌÍ\"‡" [defalias dired-compress #[nil "À Ä !‰ƒ\"`ÀÇȈbˆÉ !ˆ)À‚)ÊË 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"] 4] dired-compress-file #[(file) "À !‰ƒ\nà \"‚tÄ !ƒÅ‚tÅÇÈ \")ƒ6ÉÊ PË #?…t ÌÍO‚tÅÇÎ \")ƒSÉÊ PÏ #?…t ÌÐO‚tÅÇÑ \")ƒpÉÊ PÏ #?…t ÌÍO‚tÅÒÓ)‡" [find-file-name-handler file handler dired-compress-file 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$?…Å\nÆP!ƒ\nÆP‡\nÇP‡" [dired-check-process "Compressing " file "gzip" "-f" file-exists-p ".gz" ".z"] 5) ((file-error (byte-code "ÀÁ\nPÃÄ\n$?…\nÅP‡" [dired-check-process "Compressing " file "compress" "-f" ".Z"] 5)))] 5] dired-mark-confirm #[(op-symbol arg) " >†/Âà \"Å=ƒÆ‚ÇÈ!! \nËÌ\nÍ ÎÏ \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 "? "] 10] dired-map-over-marks-check #[(fun arg op-symbol &optional show-progress) "À \n\"…áɉ‰\nƒ5\n¨ƒ.È\nÉ\"ˆ\nÊWƒ* Ÿ‚• ‚• C‚•Ì à ŠebˆÏÃÐ#…KÑ ‰ ?? ƒ‡ bˆƒcÓÊ!ˆ B bˆÔyˆ É“ˆÏÃÐ#…Ñ ‰ „V) ƒ ‚” C*,Õ ˆ‰GØÃ\"‰G Û=ƒ´Ü‚¹ÝÞ !!„Îàáâ!$‚àãäå—â!%\"-‡" [dired-mark-confirm op-symbol arg nil results found case-fold-search buffer-read-only dired-repeat-over-lines #[nil "ƒÁÂ!ˆ B‰‡" [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"] 9] boundp dired-query-alist ((121 . y) (32 . y) (110 . n) (127 . n) (33 . yes) (113 . no) (27 . no)) dired-query #[(qs-var qs-prompt &rest qs-args) "J \"A‰Å=ƒÆ‚t Ç=ƒÈ‚t \nƒ0ËÌÍÎ!!\"‚1ÐPȉÔÕ#ˆ× L \"‰„nÕØ\"ˆÙ ˆÚÛ!ˆÔÕ#ˆ× L‚GAÜ>+*‡" [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)] 7]] 3) (defalias 'dired-do-compress #[(&optional arg) "ÀÁ\nÃÄ$‡" [dired-map-over-marks-check dired-compress arg compress t] 5 "\ Compress or uncompress marked (or next ARG) files." "P"]) (defalias (quote dired-byte-compile) #[nil "À \nÃ=ƒ ÄÅÆ \"OÇP‚ ÇPÉ\nÉ ÌÍΈ ƒ7ÏÐ  #ˆÑ !‚EÒ!ˆÉyˆÓ!ˆÉ,‡" [dired-get-filename filename system-type vax-vms 0 string-match ";" "c" elc-file nil buffer-read-only failure err (byte-code "ŠÀ !ˆ)À‡" [byte-compile-file filename] 2) ((error (byte-code "‡" [err failure nil] 1))) dired-log "Byte compile error for %s:\n%s\n" dired-make-relative dired-remove-file dired-add-file] 5]) (defalias 'dired-do-byte-compile #[(&optional arg) "ÀÁ\nÃÄ$‡" [dired-map-over-marks-check dired-byte-compile arg byte-compile t] 5 "\ Byte compile marked (or next ARG) Emacs Lisp files." "P"]) (defalias (quote dired-load) #[nil "À ÁÄÅƈ\n??…ÇÈ \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] 4]) (defalias 'dired-do-load #[(&optional arg) "ÀÁ\nÃÄ$‡" [dired-map-over-marks-check dired-load arg load t] 5 "\ Load the marked (or next ARG) Emacs Lisp files." "P"]) (defalias 'dired-do-redisplay #[(&optional arg test-for-subdir) "ƒÁ ƒÂÁ …ÄÅ\"\"‡ÇÈ!ˆÉ‰‰‰\n   ƒU ¨ƒBÎ Ï\"ˆ ÐWƒÄ\nŸˆ‚ÄÑ ÇÓ\"ˆÔ!ˆ)‚ÄÕ ÉŠebˆØÉÙ#…kÚ ‰?? ƒ­bˆÑ ÇÓ\"ˆÔ!)\nB\nbˆÛyˆɉ“ˆØÉÙ#…§Ú ‰„w) „ÃÑ ÇÓ\"ˆÔ!ˆ)*,Ü ˆÜ ˆÇÝ!‡" [test-for-subdir dired-get-subdir dired-insert-subdir arg read-string "Switches for listing: " dired-actual-switches message "Redisplaying..." 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"] 6 "\ 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." "P\np"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"‡" [defalias dired-update-file-line #[(file) "Àyˆg`Á`Åyˆ`|ˆƒ\"Ç!ˆÈ ‰TÉ $ˆ+Ê ‡" [0 nil buffer-read-only opoint char 1 file dired-add-entry subst-char-in-region 32 dired-move-to-filename] 5] dired-fun-in-all-buffers #[(directory fun &rest args) "À !p‰ƒ1@AÇŽ qˆÈ \n\"ƒ-Ë ! B)‚ ,‡" [dired-buffers-for-dir directory nil success-list buf obuf buf-list ((set-buffer obuf)) apply fun args buffer-name] 4] dired-add-file #[(filename &optional marker-char) "ÀÁ\n!Ã\n $‡" [dired-fun-in-all-buffers file-name-directory filename dired-add-entry marker-char] 5] dired-add-entry #[(filename &optional marker-char) "À !` à !ÄÉ !Êˉƒ\"bˆ ,?‡" [directory-file-name filename dired-current-directory file-name-directory nil reason directory cur-dir opoint file-name-nondirectory not-found (byte-code " ˜ƒ'ÂÃwˆgÄ=ƒÅ ˆÆ !`Wƒ#bˆ)‚AÈ!ƒ<ÉÊ!ƒ6Å ˆË ˆ‚AÌÍÎ\"ˆÃÐyˆÑ!ˆÓÔ\"×P\"ˆØyˆÙÚ!Ü {|ˆÞ!cˆ*ƒŠŒÐ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" buffer-read-only 0 dired-add-entry-do-indentation marker-char insert-directory dired-make-absolute filename dired-actual-switches "d" -1 dired-move-to-filename t beg dired-move-to-end-of-filename end file-name-nondirectory dired-after-readin-hook 1 run-hooks] 4)] 5] dired-add-entry-do-indentation #[(marker-char) "ƒ¨ƒ ‚ ‚±‡" [marker-char dired-marker-char 32] 2] dired-after-subdir-garbage #[(dir) "ŠÀ !„ ÂÃ!ˆÄyˆl„Å „Äyˆ‚`)‡" [dired-goto-subdir dir error "This cannot happen" 1 dired-move-to-filename] 2] dired-remove-file #[(file) "ÀÁ\n!Ã\n#‡" [dired-fun-in-all-buffers file-name-directory file dired-remove-entry] 4] dired-remove-entry #[(file) "ŠÀ !…ÂÄyˆ`ŠÅyˆ`)|))‡" [dired-goto-file file nil buffer-read-only 0 1] 2] dired-relist-file #[(file) "ÀÁ\n!Ã\n#‡" [dired-fun-in-all-buffers file-name-directory file dired-relist-entry] 4] dired-relist-entry #[(file) "À‰ŠÃ !ƒÅyˆg`ŠÆyˆ`)|ˆÇ !È É=?…' \"+‡" [nil marker buffer-read-only dired-goto-file file 0 1 directory-file-name dired-add-entry 32] 4]] 3) (defvar dired-backup-overwrite nil "\ *Non-nil if Dired should ask about making backups before overwriting files. Special value `always' suppresses confirmation.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"‡" [defalias dired-handle-overwrite #[(to) "…- …-Â=„ÃÄÅÆ\"\"…-È!@ Ê Ë#ˆÌ !)‡" [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] 5] dired-copy-file #[(from to ok-flag) "À !ˆÂ $‡" [dired-handle-overwrite to copy-file from ok-flag dired-copy-preserve-time] 5] dired-rename-file #[(from to ok-flag) "À !ˆÂ #ˆÅ !ƒ$ŠÅ !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] 4] dired-rename-subdir #[(from-dir to-dir) "À !À\n!Ã Ä \n$ˆÅ ‰…PŠ@qˆƒEÈ \"ƒEÉ ÊËÌ !P\n# Ï !ˆÐ!ˆ*)A‰„Ñ)‡" [file-name-as-directory from-dir to-dir dired-fun-in-all-buffers dired-rename-subdir-1 buffer-list blist 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] 6] dired-rename-subdir-1 #[(dir to) "Á ƒ @ AÄ\n@ \"ƒÆ\n #ˆ‚ š…PÉ !ˆÊË !\" ËÍ !!Ï!„MÐ!ˆ)Ñ *‡" [dired-subdir-alist nil elt alist dired-in-this-tree dir dired-rename-subdir-2 to default-directory dired-unadvertise expand-file-name file-name-nondirectory dired-directory directory-file-name new-name get-buffer rename-buffer dired-advertise] 4] dired-rename-subdir-2 #[(elt dir to) "ŠÀÁ\n!!Á !ÄÈ !bˆÊ !„$ÌÍ\n\"ˆ‚DΔbˆÏΕÐ#ƒ<ÑЉ#ˆ‚DÌÒ\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] 6]] 3) (defalias 'dired-string-replace-match #[(regexp string newtext &optional literal global) "ƒOÁÂÉÈ \n#ƒ@”•\n O ƒ1 ‚7Í\n \"Q ‚ …M\nÃOP,‡È \nÂ#??…x\n‰”O ƒk ‚qÍ\n \"\n•ÃOQ‡" [global "" 0 nil me mb start result string-match regexp string literal newtext dired-expand-newtext] 5 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias dired-expand-newtext #[(string newtext) "À G‰ Wƒp H‰ÇUƒb T‰H‰ÈUƒ1 À”À•O‚fÊYƒ[ËXƒ[ÌZ‰ ”ƒV  ” •O‚WÂ)‚fÎ!‚fÎ!)P T‰‚ +‡" [0 newtext "" expanded-newtext len pos c 92 38 string 49 57 48 n char-to-string] 5] dired-create-files #[(file-creator operation fn-list name-constructor &optional marker-char) "À‰Á\nGÀ‰‰ ÊË\n\"ˆ+ƒ2ÌÍÎG Ð !%\"ˆ‚R ƒHÌÍÑ G Ð !% \"ˆ‚RÒÓ Ð !$ˆ,Ô ‡" [nil 0 fn-list total success-count skipped failures overwrite-backup-query overwrite-query to mapcar #[(from) " !‰ šƒÃÄÅ— #ˆ\n„\"Ç !B‰‡É\n!‰\n…4Ë ÍÎÏ\n#)¨ƒA‚MƒLÒ !‚MÃÔÕÖ+‡" [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 #ˆ ƒÅ\n!ˆTÇÈ \n$ˆË\n \"‡" [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] 8] dired-do-create-files #[(op-symbol file-creator operation arg &optional marker-char op1 how-to) "„ Âà \"‰GÇÈÉUƒ‚ ÊPË  ÍÎ \"%!„8Ñ!‚HÒ=ƒCÂH!ÉVƒ]„]ÔÕ #ˆ„hÖ!× ƒvÙ‚wÚ%,‡" [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] (lambda (from) target) marker-char] 10] dired-mark-read-file-name #[(prompt dir op-symbol arg files) "ÀÁ\n ÄÅÇ \"\" &‡" [dired-mark-pop-up nil op-symbol files read-file-name format prompt dired-mark-prompt arg dir] 10] dired-dwim-target-directory #[nil "Á=…  ƒ,ÅÆ !ŠqˆÁ=…  )‰†( *‚- )‡" [major-mode dired-mode dired-current-directory this-dir dired-dwim-target window-buffer next-window other-buf other-dir] 3]] 3) (defalias 'dired-create-directory #[(directory) "ÀÁ\n!!Ä !ˆÅ !ˆÆ )‡" [directory-file-name expand-file-name directory expanded make-directory dired-add-file dired-move-to-filename] 3 "\ Create a directory called DIRECTORY." (list (read-file-name "Create directory: " (dired-current-directory)))]) (defalias (quote dired-into-dir-with-symlinks) #[(target) "À !…\n !?‡" [file-directory-p target file-symlink-p] 2]) (defalias 'dired-do-copy #[(&optional arg) "ÀÁ ƒ Ä‚ Å%‡" [dired-do-create-files copy dired-copy-file dired-copy-preserve-time "Copy [-p]" "Copy" arg dired-keep-marker-copy] 6 "\ 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 symbolic links are made in that directory with the same names that the files currently have." "P"]) (defalias 'dired-do-symlink #[(&optional arg) "ÀÁÂà %‡" [dired-do-create-files symlink make-symbolic-link "Symlink" arg dired-keep-marker-symlink] 6 "\ 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." "P"]) (defalias 'dired-do-hardlink #[(&optional arg) "ÀÁÂà %‡" [dired-do-create-files hardlink add-name-to-file "Hardlink" arg dired-keep-marker-hardlink] 6 "\ 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." "P"]) (defalias 'dired-do-rename #[(&optional arg) "ÀÁÂà Æ&‡" [dired-do-create-files move dired-rename-file "Move" arg dired-keep-marker-rename "Rename"] 7 "\ 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." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias dired-do-create-files-regexp #[(file-creator operation arg regexp newname &optional whole-path marker-char) "ÀÁ\n\"‰G ÆPÈÉ — —#\n ƒÌ‚ ÍÁÐ %.‡" [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 # ‰ƒÇÈ \n$…$‚$ÊË \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) "À  ! #‰…Æ Ç !\" \nƒ1ËÌ Î !Î!$…:‚:ÏР! $+‡" [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] 7] dired-mark-read-regexp #[(operation) "À !š‰?… Å ƒÆ‚ÇÉQ!\nË ƒ'Æ‚(ÇÌ\nÍ°!\n F,‡" [prefix-numeric-value current-prefix-arg 0 whole-path arg dired-read-regexp "Path " "" operation " from (regexp): " regexp read-string " " " to: " newname] 7]] 3) (defalias 'dired-do-rename-regexp #[(regexp newname &optional arg whole-path) "ÀÁ &‡" [dired-do-create-files-regexp dired-rename-file "Rename" arg regexp newname whole-path dired-keep-marker-rename] 8 "\ 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." (dired-mark-read-regexp "Rename")]) (defalias 'dired-do-copy-regexp #[(regexp newname &optional arg whole-path) "ÀÁ\nƒ\nÂ Ä  &‡" [dired-do-create-files-regexp dired-copy-file dired-copy-preserve-time "Copy [-p]" "Copy" arg regexp newname whole-path dired-keep-marker-copy] 8 "\ Copy all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." (dired-mark-read-regexp "Copy")]) (defalias 'dired-do-hardlink-regexp #[(regexp newname &optional arg whole-path) "ÀÁ &‡" [dired-do-create-files-regexp add-name-to-file "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink] 8 "\ Hardlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." (dired-mark-read-regexp "HardLink")]) (defalias 'dired-do-symlink-regexp #[(regexp newname &optional arg whole-path) "ÀÁ &‡" [dired-do-create-files-regexp make-symbolic-link "SymLink" arg regexp newname whole-path dired-keep-marker-symlink] 8 "\ Symlink all marked files containing REGEXP to NEWNAME. See function `dired-rename-regexp' for more info." (dired-mark-read-regexp "SymLink")]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias dired-create-files-non-directory #[(file-creator basename-constructor operation arg) "À ÅÀ\"Ç%)‡" [nil rename-non-directory-query dired-create-files file-creator operation dired-get-marked-files arg #[(from) "À !\nà !!PÅÆ——#ÉÊËPÌ !Ì !$)…' )‡" [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] 6] dired-rename-non-directory #[(basename-constructor operation arg) "ÀÁ\n $‡" [dired-create-files-non-directory dired-rename-file basename-constructor operation arg] 5]] 3) (defalias 'dired-upcase #[(&optional arg) "ÀÁ #‡" [dired-rename-non-directory upcase "Rename upcase" arg] 4 "\ Rename all marked (or next ARG) files to upper case." "P"]) (defalias 'dired-downcase #[(&optional arg) "ÀÁ #‡" [dired-rename-non-directory downcase "Rename downcase" arg] 4 "\ Rename all marked (or next ARG) files to lower case." "P"]) (defalias 'dired-maybe-insert-subdir #[(dirname &optional switches no-error-if-not-dir-p) "`Á\n! „Ä\n!„Å\n #ˆÇ!)‡" [opoint file-name-as-directory dirname switches dired-goto-subdir dired-insert-subdir no-error-if-not-dir-p push-mark] 4 "\ 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." (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " dired-actual-switches)))]) (defalias 'dired-insert-subdir #[(dirname &optional switches no-error-if-not-dir-p) "ÀÁ\n!!Ã\n \"ˆ „Æ\n!„ÇÈ\n\"ˆÉ\n\n\"ˉ‰‰   …5ÑÒ \"‰ƒAÓ\nÔ\"ƒRÕ!¤‚VÖ\n!ˆ×\nØ\n \"#ˆƒhÙ ˆÚ\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] 6 "\ 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." (list (dired-get-filename) (if current-prefix-arg (read-string "Switches for listing: " dired-actual-switches)))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"‡" [defalias dired-insert-subdir-validate #[(dirname &optional switches) "À \n\"„ ÃÄ \"ˆ …ÆÈÉÊ\")‡" [dired-in-this-tree dirname default-directory error "%s: not in this directory tree" switches nil case-fold-search mapcar #[(x) "À \n\"?À \"?=†ÄÅ \"‡" [string-match x switches dired-actual-switches error "Can't have dirs with and without -%s switches together"] 4] ("F" "b")] 3] dired-alist-add #[(dir new-marker) "À \n\"ˆÃ ‡" [dired-alist-add-1 dir new-marker dired-alist-sort] 3] dired-alist-sort #[nil "À Â\"‰‡" [sort dired-subdir-alist #[(elt1 elt2) "À !À\n!V‡" [dired-get-subdir-min elt1 elt2] 3]] 3] dired-kill-tree #[(dirname &optional remember-marks) "Á‰ ƒ. @@ A ˜„Æ \"ƒÇ !ƒÈ !\n¤‚\n+‡" [dired-subdir-alist nil m-alist dir s-alist dirname dired-in-this-tree dired-goto-subdir dired-kill-subdir remember-marks] 3 nil "DKill tree below directory: "] dired-insert-subdir-newpos #[(new-dir) "Á‰‰‰ƒ3@A @Ç !È  \"ƒ Ê !Á‰„\nbˆ-m„>Ë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"] 6] dired-insert-subdir-del #[(element) "À !‰bˆÃ bˆm„ÄuˆÅ\n`\"\n`|ˆ)‡" [dired-get-subdir-min element begin-marker dired-subdir-max -1 dired-remember-marks] 4] dired-insert-subdir-doinsert #[(dirname switches) "`ÀÃÄ \"ˆ†ÇÈÉ\n#\n Ë !@@šƒ)Í!ˆ‚1Ï \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 insert-directory t "Reading directory %s...done" point-marker indent-rigidly 2 dired-insert-headerline marker-position] 5] dired-insert-subdir-doupdate #[(dirname elt beg-end) "ƒÁ! Óˆ‚Ä Â \"ˆ…4Š@A@‰ bˆŒ }ˆÊÆ!,‡" [elt dired-get-subdir-min point-marker nil dired-alist-add dirname dired-after-readin-hook beg-end end begin run-hooks] 4] dired-tree-lessp #[(dir1 dir2) "À !À\n!ÃÄ \"ÃÄ\n\"ƒ0 ƒ0@ @šƒ0A A‚@ @‰ƒJƒJ™‚m„X„XÉ‚m„aÊ‚m„jÉ‚mËÌ!,‡" [file-name-as-directory dir1 dir2 dired-split "/" components-2 components-1 c2 c1 nil t error "This can't happen"] 5]] 3) (defalias 'dired-split #[(pat str &optional limit) "À \n\"\nÄ OCÆ …Ä•‰ƒJ ¨ƒ( WƒJÀ \n#ƒJÄ”T\n O BÄ•‰‚ ¨ƒX Wƒeƒe\nÊO B Ÿ,‡" [string-match pat str start 0 result 1 count end limit nil] 5 "\ 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-prev-subdir #[(arg &optional no-error-if-not-found no-skip) "À [\n #‡" [dired-next-subdir arg no-error-if-not-found no-skip] 4 "\ Go to previous subdirectory, regardless of level. When called interactively and not on a subdir line, go to this subdir's line." (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) (if (dired-get-subdir) 1 0)))]) (defalias (quote dired-subdir-min) #[nil "ŠÀÁ‰#„ÃÄ!‚`)‡" [dired-prev-subdir 0 t error "Not in a subdir!"] 4]) (defalias 'dired-goto-subdir #[(dir) "À ! \"‰…Å !b…ÆÇwˆ`)‡" [file-name-as-directory dir assoc dired-subdir-alist elt dired-get-subdir-min "^ \n" nil] 4 "\ 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." (byte-code "ÀÁ ÄÅÆ %!CÇ ˆ‡" [expand-file-name completing-read "Goto in situ directory: " dired-subdir-alist nil t dired-current-directory push-mark] 7)]) (defalias 'dired-mark-subdir-files #[nil "À  à \")‡" [dired-subdir-min p-min dired-mark-files-in-region dired-subdir-max] 3 "\ Mark all files except `.' and `..'." "P"]) (defalias 'dired-kill-subdir #[(&optional remember-marks) "À Á ‰Ç ‰šƒÉÊ!ˆ …#Ì \" |ˆmƒ0ÍÎ!ˆÏ !ˆ,‡" [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] 5 "\ Remove all lines of current subdirectory. Lower levels are unaffected." nil]) (defalias (quote dired-unsubdir) #[(dir) "ÀÁ\n \" \"‰‡" [delq assoc dir dired-subdir-alist] 4]) (defalias 'dired-tree-up #[(arg) "À \nÃYƒ\nSÄÅ !!‚Æ !†ÇÈ \")‡" [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."] 3 "\ Go up ARG levels in the dired tree." "p"]) (defalias 'dired-tree-down #[nil "À Á‰Å!Áƒ6@AÉÊ@! \"ƒÁË@!‚* ƒ@ b‚CÌÍ!+‡" [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"] 3 "\ Go down in the dired tree." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias dired-unhide-subdir #[nil "ÀÂÃ Ä ÅÆ$)‡" [nil buffer-read-only subst-char-in-region dired-subdir-min dired-subdir-max 13 10] 5] dired-hide-check #[nil "†ÁÂ!‡" [selective-display error "selective-display must be t for subdir hiding to work!"] 2] dired-subdir-hidden-p #[(dir) "… ŠÁ\n!ˆÃÄ!)‡" [selective-display dired-goto-subdir dir looking-at " "] 2]] 3) (defalias 'dired-hide-subdir #[(arg) "À ˆ S‰ÂY…Pà Å !Ç \" Ê !S Ì Î !bˆÏÌwˆƒ?Ð` ÑÒ$ˆ‚GÐ` ÒÑ$ˆ-ÓÔÕ\"ˆ‚‡" [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] 5 "\ 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." "p"]) (defalias 'dired-hide-all #[(arg) "À ˆÁŠebˆÃÄÁÅ#)ƒÆedÇÈ$‚Md \n \n…LÆÌ\n@!Š bˆÍyˆ`)ÈÇ$ˆÌ\n@! \nA‰\n„'Á*)‡" [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] 6 "\ 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." "P"]) emacs-19.22/lisp/dired.elc100666 12062 1 152143 5474620732 13657 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:56:56 1993 ;;; from file /home/fsf/rms/e19/lisp/dired.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (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'.") (defvar dired-chown-program (byte-code "Á>ƒ‡Ç" [system-type (hpux dgux usg-unix-v irix) "chown" "/etc/chown"] 2) "\ 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.)") (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.") (defvar dired-marker-char 42 "\ In Dired, the current mark character. This is what the `do' commands look for and what the `mark' commands store.") (defvar dired-del-marker 68 "\ Character used to flag files for deletion.") (defvar dired-shrink-to-fit t "\ Non-nil means Dired shrinks the display buffer to fit the marked files.") (byte-code "ÀÁ!„‡" [boundp dired-flagging-regexp nil] 2) (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 ]*" "\ Regexp for optional initial inode and file size as made by `ls -i -s'.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ ÇQÀÈ!„) ÉQÀÊ!„6ËÌÍÎ#\nÀÏ!„?ÐÀ‡" [boundp dired-re-mark "^[^ \n]" 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-dot "^.* \\.\\.?$"] 4) (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 ]+\\)\\(:\\)[\n ]" "\ 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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias dired-mark-if (macro . #[(predicate msg) "ÀÁÂÃÄ ÆÇ EEÈÉÊÄ ÌEÍFÄ ÎÏ CÐ#E¯ÑF‡" [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) append (message "%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)] 13]) dired-map-over-marks (macro . #[(body arg &optional show-progress) "ÀÁÂà ÃÅ DÆÇ ÈÉÊà ÌEÍÎÏÎEEFDEÃÑ ÒEÓÎFEÔDFÁÕÖ×ØÙÚà ÛEÍÎÏÎEEDÜ#FÃÝÎÔDFFFEÞE‡" [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 < 0 (nreverse 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))) append (while next-position (goto-char next-position)) (sit-for 0) ((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)] 19])] 3) (defalias 'dired-get-marked-files #[(&optional localp arg) "ŠÀ‰‰‰ ƒ. ¨ƒ&Æ Ç\"ˆ ÈWƒ\" Ÿ‚‡ ‚‡É\n!C‚‡Ë À  ŠebˆÎ ÀÏ#…DÐ ‰ ?? ƒx bˆÉ\n! B bˆÑyˆ À‰“ˆÎ ÀÏ#…rÐ ‰ „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 "\ 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 (quote dired-read-dir-and-switches) #[(str) "À … Âà \"ÅÆÇ\"É\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]) (defalias 'dired #[(dirname &optional switches) "ÀÁ\n \"!‡" [switch-to-buffer dired-noselect dirname switches] 4 "\ \"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." (dired-read-dir-and-switches "")]) (defalias 'dired-other-window #[(dirname &optional switches) "ÀÁ\n \"!‡" [switch-to-buffer-other-window dired-noselect dirname switches] 4 "\ \"Edit\" directory DIRNAME. Like `dired' but selects in another window." (dired-read-dir-and-switches "in other window ")]) (defalias 'dired-other-frame #[(dirname &optional switches) "ÀÁ\n \"!‡" [switch-to-buffer-other-frame dired-noselect dirname switches] 4 "\ \"Edit\" directory DIRNAME. Like `dired' but makes a new frame." (dired-read-dir-and-switches "in other frame ")]) (defalias 'dired-noselect #[(dir-or-list &optional switches) "„ Â:ƒ@‚ÄÅ !!Æ !ƒ%Ç !:ƒ2 AB‚4 È \")‡" [dir-or-list default-directory nil dirname expand-file-name directory-file-name file-directory-p file-name-as-directory dired-internal-noselect switches] 3 "\ Like `dired' but returns the dired buffer as value, does not select it."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"‡" [defalias dired-internal-noselect #[(dir-or-list &optional switches) ":ƒ\n@‚ Â!‰?p „#ÆÈÉ !!) qˆ „7\nƒpË\n!ˆ‚pÌÍ !ƒB ‚EÎ !!\n„Q\nÑ \n\"ˆÒÔŽÕ \"ˆÖ*×Ø!ˆebˆÙ !ˆ qˆ ,‡" [dir-or-list dirname dired-find-buffer-nocreate buffer new-buffer-p old-buf fundamental-mode default-major-mode create-file-buffer directory-file-name switches dired-sort-other abbreviate-file-name file-directory-p file-name-directory default-directory dired-listing-switches dired-mode t failed ((byte-code "ƒÁ\n!ˆÁ‡" [failed kill-buffer buffer] 2)) dired-readin nil run-hooks dired-after-readin-hook dired-initial-position] 4] dired-find-buffer-nocreate #[(dirname) "ÀÁ \nƒ+Š\n@qˆ Å=ƒ$šƒ$\n@À‚'\nA)‚ *‡" [nil buffer-list blist found major-mode dired-mode dired-directory dirname] 2] dired-readin #[(dir-or-list buffer) "À\n:ƒ \n@‚\nà !\n:ƒ \nABÄÅ!ˆŠÆÇ \"ˆqˆÀÉ\n ~ˆÌ ˆÍ\n!ˆÎedÏ#ˆebˆÐ!ˆ*ÆÒ \"ˆÓÀ!ˆÔÕ!ÀLˆÖ *‡" [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" set-buffer-modified-p make-local-variable dired-subdir-alist dired-build-subdir-alist] 4] dired-readin-insert #[(dir-or-list) "À\n:ƒ \n@‚\nà !à !šƒ(\n:„(Å\nÀÇ$‚NÈÉÊ !!!„9ËÌ \"‚NÅ\n\nÎÁÍ\"‰\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] dired-mark-remembered #[(alist) "À‰‰ …+ @ A @ AÅ\n!ƒŠÆyˆÇÈ!ˆ cˆ)‚+‡" [nil chr fil elt alist dired-goto-file 0 delete-char 1] 3] dired-remember-hidden #[nil "Á‰‰ ƒ+ @@ @A A bˆÆÁwˆgÇ=ƒ \nB‚\n,‡" [dired-subdir-alist nil result pos dir l "^ \n" 13] 4] 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] dired-uncache #[(dir) "À !‰… \nà \")‡" [find-file-name-handler dir handler dired-uncache] 4]] 3) (defvar dired-mode-map nil "\ Local keymap for dired-mode buffers.") (byte-code "„hÁÂÃ\"ˆÄ Å!ˆÆÇÈ#ˆÆÉÊ#ˆÆËÌ#ˆÆÍÎ#ˆÆÏÐ#ˆÆÑÒ#ˆÆÓÔ#ˆÆÕÖ#ˆÆ×Ø#ˆÆÙÚ#ˆÆÛÜ#ˆÆÝÞ#ˆÆßà#ˆÆáâ#ˆÆãä#ˆÆåæ#ˆÆçè#ˆÆéê#ˆÆëì#ˆÆíê#ˆÆîï#ˆÆðñ#ˆÆòó#ˆÆôõ#ˆÆö÷#ˆÆøù#ˆÆúû#ˆÆüý#ˆÆþÿ#ˆÁ@A \"ˆÆB@#ˆÆCD#ˆÆEF#ˆÆGH#ˆÆIJ#ˆÆKL#ˆÆMN#ˆÆOP#ˆÆQL#ˆÆRS#ˆÆTU#ˆÆVW#ˆÆXÃ#ˆÆYÂ#ˆÆZ[#ˆÆ\\]#ˆÆ^_#ˆÆ`a#ˆÆbc#ˆÆde#ˆÆfg#ˆÆhi#ˆÆjk#ˆÆlm#ˆÆno#ˆÆpq#ˆÆrs#ˆÆtu#ˆÆvw#ˆÆxy#ˆÆz{#ˆÆ|}#ˆÆ~#ˆÆ€g#ˆÆg#ˆÆ‚m#ˆÆƒ„#ˆÆ…†#ˆÆ‡ˆ#ˆÆ‰Š#ˆÆ‹Œ#ˆÆŒ#ˆÆŽ#ˆÆ‘A‘!B#ˆÆ’“#ˆÆ”•#ˆÆ–—#ˆÆ˜™#ˆÆš›#ˆÆœ#ˆÆžŸ#ˆÆ ¡#ˆÆ¢£#ˆÆ¤¥#ˆÆ¦§A§!B#ˆÆ¨©#ˆÆª«#ˆÆ¬­#ˆÆ®¯#ˆÆ°±#ˆÆ²³#ˆÆ´µ#ˆÆ¶·A·!B#ˆÆ¸¹#ˆÆº»#ˆÆ¼½#ˆÆ¾¿#ˆÆÀÁ#ˆÆÂÃ#ˆÆÄÅ#ˆÆÆÇ#ˆÆÈÉAÉ!B#ˆÆÊË#ˆÆÌÍ#ˆÆÎÏ#ˆÆÐÑ#ˆÆÒÓ#ˆÆÔÕ#ˆÆÖ×#ˆÆØÙ#ˆÆÚÛ#ˆÆÜÝ#ˆÆÞß#ˆÆàá#ˆÆâã#ˆÆäåAå!B#ˆÆæç#ˆÆèé#ˆÆêë#ˆÆìí#ˆÆîï#ˆÆðñ#ˆÆòó#ˆÆôõ#ˆÆö÷#ˆÆøù#ˆÆúû#ˆÆüý#ˆÆþÿ#ˆ#‡" [dired-mode-map defalias dired-advertised-find-file dired-find-file make-keymap suppress-keymap define-key "#" dired-flag-auto-save-files "*" dired-mark-executables "." dired-clean-directory "/" dired-mark-directories "@" dired-mark-symlinks "~" dired-flag-backup-files "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 "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 dired-regexp-prefix make-sparse-keymap "%" "%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" "f" "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 " " "" "" "$" dired-hide-subdir "¤" dired-hide-all "?" dired-summary "" dired-unmark-backward "" dired-undo "u" [menu-bar edit] undefined [menu-bar subdir] "Subdir" [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 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) (defalias 'dired-mode #[(&optional dirname switches) "À ˆÁ\n!ˆÃ ˆÄÆÈ È\nË ÍÎ!ÏLˆÍÐ!ÑLˆÍÒ!†.LˆÍÕ!LˆÍÖ!†ALˆÙÈ\"ˆÚÛ!‡" [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 dired-actual-switches switches dired-listing-switches dired-sort-other run-hooks dired-mode-hook] 3 "\ 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-quit #[nil "À ‡" [bury-buffer] 1 "\ Bury the current dired buffer." nil]) (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 "\ Summarize basic Dired commands and show recent Dired errors." nil]) (defalias 'dired-undo #[nil "À )‡" [nil buffer-read-only undo] 1 "\ 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." nil]) (defalias 'dired-next-line #[(arg) "À !ˆÂ ‡" [next-line arg dired-move-to-filename] 2 "\ Move down lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." "p"]) (defalias 'dired-previous-line #[(arg) "À !ˆÂ ‡" [previous-line arg dired-move-to-filename] 2 "\ Move up lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." "p"]) (defalias 'dired-next-dirline #[(arg &optional opoint) "„` ÂVƒà ÅÆ $‚ÂyˆÇ ÅÆ [$ƒ%È ‡bˆÉÊ!‡" [opoint arg 0 re-search-forward dired-re-dir nil t re-search-backward dired-move-to-filename error "No more subdirectories"] 5 "\ Goto ARG'th next directory file line." "p"]) (defalias 'dired-prev-dirline #[(arg) "À [!‡" [dired-next-dirline arg] 2 "\ Goto ARG'th previous directory file line." "p"]) (defalias 'dired-up-directory #[nil "À Âà !!Åà !!†$AƒÇ !†$È !ˆÅ !*‡" [dired-current-directory dir file-name-directory directory-file-name up dired-goto-file dired-subdir-alist dired-goto-subdir dired] 3 "\ Run dired on parent directory of current directory. Find the parent directory either in this buffer or another buffer. Creates a buffer if necessary." nil]) (defalias 'dired-find-file #[nil "ÀÁ Ã\"!‡" [find-file file-name-sans-versions dired-get-filename t] 4 "\ In dired, visit the file or directory named on this line." nil]) (defalias 'dired-view-file #[nil "ÀÁ !ƒ\nAƒÃÁ !†ÄÁ !‡ÅÁ !‡" [file-directory-p dired-get-filename dired-subdir-alist dired-goto-subdir dired view-file] 2 "\ 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." nil]) (defalias 'dired-find-file-other-window #[nil "ÀÁ Ã\"!‡" [find-file-other-window file-name-sans-versions dired-get-filename t] 4 "\ In dired, visit this file or directory in another window." nil]) (defalias 'dired-display-file #[nil "ÀÁ Â\"ÄÅ !!)‡" [file-name-sans-versions dired-get-filename t file display-buffer find-file-noselect] 3 "\ In dired, display this file or directory in another window." nil]) (defalias 'dired-get-filename #[(&optional localp no-error-if-not-filep) "À‰‰‰ŠÅ?!‰ƒÇ!)\n…$ …$\n {‰ƒ@ÈÉ\n\"ƒ@ËÌÍÎ Ï#†< Ì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 string-match "b" dired-actual-switches read "\"" dired-string-replace-match "\\([^\\]\\)\"" "\\1\\\\\"" localp no-dir dired-current-directory] 6 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias dired-make-absolute #[(file &optional dir) "† \nP‡" [dir default-directory file] 2] 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] dired-move-to-filename #[(&optional raise-error eol) "„ Áˆ`ÂyˆÃÄÅ#ƒ\"ÆÁwˆÇwˆÆwˆ`‡…*ÉÊ!‡" [eol nil 0 re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+" t " " "^ " raise-error error "No file on this line"] 4] dired-move-to-end-of-filename #[(&optional no-error) "À‰‰‰‰‰‰‰ÉÊ \"`ŠÀˆ`) …/ŠÍÎ Ï#)‰„¦ŠÐÑÀÏ#ƒbÒ”f‰Ó=\n…]ÉÔÕ”Õ•{Ö”Ö•{הו{Q\"‚k„kÙÚ!ˆ) ƒÍÛ Ï#ƒ¦Üuˆ\nƒ¦ƒ¦hÞ=ƒ¦ßuˆ‚¦ bˆ\nƒ¦à>„£ƒ¦ßuˆ„À`=ƒÀÙ ƒ½áâ!‚¾Ú!ˆ`=?…É`.‡" [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]] 3) (defvar dired-buffers nil "\ Alist of directories and their associated dired buffers.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"‡" [defalias dired-buffers-for-dir #[(dir) "À !\nɉƒK@Ç @\"ƒB AÉ!ƒ<Ê Šqˆ )\"ƒA B‚AÌ \n\")A‰„ +‡" [file-name-as-directory dir dired-buffers nil elt result alist dired-in-this-tree buf buffer-name assoc dired-subdir-alist delq] 4] dired-advertise #[nil "pÀ !>ƒ\n‡ pB B‰‡" [dired-buffers-for-dir default-directory t dired-buffers] 3] dired-unadvertise #[(dir) "ÀÁ\n \" \"‰‡" [delq assoc dir dired-buffers] 4] dired-in-this-tree #[(file dir) "ÀÂÃÄ !P\")‡" [nil case-fold-search string-match "^" regexp-quote dir file] 4] dired-normalize-subdir #[(dir) "ÀÁ\n!ƒ \n‚Ã\n \"!‡" [file-name-as-directory file-name-absolute-p dir expand-file-name default-directory] 4] dired-get-subdir #[nil "ŠÀ Âyˆ`ÃÄ \"!ZÂU… *‡" [dired-current-directory cur-dir 0 dired-get-subdir-min assoc dired-subdir-alist] 5] dired-get-subdir-min cdr dired-get-subdir-max #[(elt) "ŠÀ !bˆÂ )‡" [dired-get-subdir-min elt dired-subdir-max] 2] dired-clear-alist #[nil "…Á@!‰“ˆA‰„‡" [dired-subdir-alist dired-get-subdir-min nil] 4] dired-subdir-index #[(dir) "ÀÁ\n ƒ# @@˜ƒÀÇ‚ A T‚ …( +‡" [nil 0 dired-subdir-alist alist index found dir t] 3]] 3) (defalias 'dired-next-subdir #[(arg &optional no-error-if-not-found no-skip) "À Á‰Å !Z‰ÇY…È\n 8!‰ƒ/ bˆ\n„+ËÁwˆ`‚D ?…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 "\ Go to next subdirectory, regardless of level." "p"]) (defalias 'dired-build-subdir-alist #[nil "À ˆŠÁ‰ebˆÂÇÂÉ#ƒCŠÊ”bˆË`Ê•{!`Ê•|ˆ cˆ) TÌ ŠÁ”bˆÁyˆÍ )\"ˆ‚ ÊVƒNÎÏ \"ˆ,‡" [dired-clear-alist 0 nil new-dir-name buffer-read-only count dired-subdir-alist re-search-forward dired-subdir-regexp t 1 expand-file-name dired-alist-add-1 point-marker message "Buffer includes %d directories"] 4 "\ Build `dired-subdir-alist' by parsing the buffer. Returns the new value of the alist." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias dired-alist-add-1 #[(dir new-marker) "À !\nB B‰‡" [dired-normalize-subdir dir new-marker dired-subdir-alist] 2] 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] dired-goto-next-file #[nil "À S ?…` W…Ãyˆ‚)‡" [dired-subdir-max max dired-move-to-filename 1] 2]] 3) (defalias 'dired-goto-file #[(file) "À !‰‰Æ !†ÇÈ \"Š  ˜ƒ\"eb‚+\nAƒ_Ë !ƒ_Ì !Í  „^ÐÑPÒ#ƒ^ÓÔÕ\"šƒXÖ ‰‚8×yˆ‚7*) …f b+‡" [directory-file-name file nil dir case-fold-search found file-name-directory error "Need absolute pathname for %s" 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 "\ Go to file line of FILE in this dired buffer." (byte-code "ÀÁÂà \"!CÄ ˆ‡" [expand-file-name read-file-name "Goto file: " dired-current-directory push-mark] 4)]) (defalias (quote dired-initial-position) #[(dirname) "Àˆ …  ‡" [nil dired-trivial-filenames dired-goto-next-nontrivial-file] 1]) (defalias 'dired-current-directory #[(&optional localp) "`† ÁÂp\"Ƀ0@‰@È !X?…*A‰„ ƒ=Ê  \"‚> ,‡" [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 "\ 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 (quote dired-subdir-max) #[nil "ŠAƒÁÂÉ#„d‚`)‡" [dired-subdir-alist dired-next-subdir 1 t] 4]) (defalias 'dired-do-flagged-delete #[nil " ÄŠebˆÆ ÄÇ#)ƒ„Èĉ‰‰ \n  Ä ŠebˆÆ ÄÇ#…4Í ‰ ??\n ƒj bˆÎ `B B  bˆÏyˆ ĉ“ˆÆ ÄÇ#…dÍ ‰ „@)\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 message "(No deletions requested)"] 6 "\ In dired, delete the files flagged for deletion." nil]) (defalias 'dired-do-delete #[(&optional arg) "ÀÁ‰‰‰ƒ2¨ƒ*ÇÈ\"ˆÉWƒ&\nŸ‚‹\n‚‹Ê `BC‚‹Ë Á  ŠebˆÎ ÁÏ#…HÐ ‰ ?? ƒ| bˆÊ `B\nB bˆÑyˆ Á‰“ˆÎ ÁÏ#…vÐ ‰ „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 "\ Delete all marked (or next ARG) files." "P"]) (byte-code "ÀÁ!„ÂÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"ˆÃÊË\"ˆÃÌÍ\"ˆÃÎÏ\"ˆÀÐ!„/ÑÃÒÓ\"ˆÃÔÕ\"ˆÃÖ×\"ˆÃØÙ\"‡" [boundp dired-deletion-confirmer yes-or-no-p 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\"ˆ @@ BÀ‡" [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] dired-clean-up-after-deletion #[(fn) "ŠA…Á\n!…à )‡" [dired-subdir-alist dired-goto-subdir fn dired-kill-subdir] 2] dired-marker-regexp #[nil "ÀÁ !!P‡" ["^" regexp-quote char-to-string dired-marker-char] 4] dired-plural-s #[(count) "ÁUƒ‡Ç" [count 1 "" "s"] 2] dired-mark-prompt #[(arg files) "G‰ÂUƒ@‚ ¨ƒÄÅ \"‚ ÄÆ #)‡" [files count 1 arg format "[next %d files]" "%c [%d files]" dired-marker-char] 5] 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] dired-no-confirm nil dired-mark-pop-up #[(bufname op-symbol files function &rest args) "„Á\n >„ GÅUƒÆ\"‡ŠÉ!qˆÊ ˆË !ˆ)Ì‹‡" [bufname " *Marked Files*" op-symbol dired-no-confirm files 1 apply function args get-buffer-create erase-buffer dired-format-columns-of-files ((byte-code "À !ˆÂ \"‡" [dired-pop-to-buffer bufname apply function args] 3))] 3] dired-format-columns-of-files #[(files) "ÀÁÂà \"\"Å\\ÇÈ !ÅZ Ê ¥] G‰  ¥  ¦ÍUƒ2Í‚3Ê\\ÍÍÑ !Ò _ ZÓ\"¤‰GS › ¡ˆWƒŽ Wƒ}_jˆ @cˆ ›T‰‚^ÔcˆÍT A‚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] 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] dired-between-files #[nil "ÀÁ!† À\n!‡" [looking-at "^$\\|^. *$\\|^. total\\|^. wildcard" dired-subdir-regexp] 2]] 3) (defalias 'dired-next-marked-file #[(arg &optional wrap opoint) "„` ÂVƒà ÅÆ $‚ÂyˆÇ ÅÆ [$ƒ%È ‡ „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 "\ Move to the next marked file, wrapping around the end of the buffer." "p\np"]) (defalias 'dired-prev-marked-file #[(arg &optional wrap) "À [\n\"‡" [dired-next-marked-file arg wrap] 3 "\ Move to the previous marked file, wrapping around the end of the buffer." "p\np"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias dired-file-marker #[(file) "ŠÀ !…ÂyˆgÚ?…g)‡" [dired-goto-file file 0 32] 2] dired-mark-files-in-region #[(start end) "À\n Vƒ ÄÅ!ˆ\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]] 3) (defalias 'dired-mark #[(arg) "AƒÁ ƒŠÂ )‡ÃÅÆ!È\")‡" [dired-subdir-alist 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 "\ 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." "P"]) (defalias 'dired-unmark #[(arg) "À !)‡" [32 dired-marker-char dired-mark arg] 2 "\ Unmark the current (or next ARG) files. If looking at a subdir, unmark all its files except `.' and `..'." "P"]) (defalias 'dired-flag-file-deletion #[(arg) " !)‡" [dired-del-marker dired-marker-char dired-mark arg] 2 "\ 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 `..'." "P"]) (defalias 'dired-unmark-backward #[(arg) "À [!‡" [dired-unmark arg] 2 "\ In dired, move up lines and remove deletion flag there. Optional prefix ARG says how many lines to unflag; default is one line." "p"]) (defvar dired-regexp-history nil "\ History list of regular expressions used in Dired commands.") (defalias (quote dired-read-regexp) #[(prompt) "À ‰‰Ã%‡" [read-from-minibuffer prompt nil dired-regexp-history] 6]) (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 "\ 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." (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") " files (regexp): ")) (if current-prefix-arg 32))]) (defalias 'dired-flag-files-regexp #[(regexp) "À \n\"‡" [dired-mark-files-regexp regexp dired-del-marker] 3 "\ 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." (list (dired-read-regexp "Flag for deletion (regexp): "))]) (defalias 'dired-mark-symlinks #[(unflag-p) "ƒÁ‚ \nÉŠÆÇÈÉ\"ˆebˆm„4Ê !ƒ.ÌÍ!ˆ\ncˆ TÍyˆ‚ÇÎ ÉÏ !\nÁ=ƒEЂFÑ\n=ƒQÓ‚RÔ&ˆ) ÆV…] +‡" [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 "\ Mark all symbolic links. With prefix argument, unflag all those files." "P"]) (defalias 'dired-mark-directories #[(unflag-p) "ƒÁ‚ \nÉŠÆÇÈÉ\"ˆebˆm„;Ê !ƒ5Ê !„5ÍÎ!ˆ\ncˆ TÎyˆ‚ÇÏ ÉÐ !\nÁ=ƒLÑ‚MÒ\n=ƒXÔ‚YÕ&ˆ) ÆV…d +‡" [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 "\ Mark all directory file lines except `.' and `..'. With prefix argument, unflag all those files." "P"]) (defalias 'dired-mark-executables #[(unflag-p) "ƒÁ‚ \nÉŠÆÇÈÉ\"ˆebˆm„4Ê !ƒ.ÌÍ!ˆ\ncˆ TÍyˆ‚ÇÎ ÉÏ !\nÁ=ƒEЂFÑ\n=ƒQÓ‚RÔ&ˆ) ÆV…] +‡" [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 "\ Mark all executable files. With prefix argument, unflag all those files." "P"]) (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 "\ Flag for deletion files whose names suggest they are auto save files. A prefix argument says to unflag those files instead." "P"]) (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 "\ Flag all backup files (names ending with `~') for deletion. With prefix argument, unflag these files." "P"]) (defalias 'dired-change-marks #[(&optional old new) "Á=„ \nÁ=ƒà ‡ÄÅ\"ÆŠebˆÉÆÊ#…1Ë̔̕\n$ˆ‚+‡" [old 13 new ding format "\n%c" nil buffer-read-only string search-forward t subst-char-in-region 0] 5 "\ Change all OLD marks to NEW marks. OLD and NEW are both characters used to mark files." (byte-code "ÀÂÃ!ˆÄ ÂÆ \"ˆÄ  +D‡" [t cursor-in-echo-area message "Change (old mark): " read-char old "Change %c marks to (new mark): " new] 3)]) (defalias 'dired-unmark-all-files-no-query #[nil "ÀÁ!‡" [dired-unmark-all-files 13] 2 "\ Remove all marks from all files in the Dired buffer." nil]) (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 "\ 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." "cRemove marks (RET means all): \nP"]) (byte-code "ÀÁ!„ÂÀ‡" [boundp dired-log-buffer "*Dired log*"] 2) (defalias 'dired-why #[nil "À !… ÃÀ !!ÆŽÇ !ˆdbˆÈÉ!+‡" [get-buffer dired-log-buffer selected-window display-buffer window owindow ((select-window owindow)) select-window recenter -1] 4 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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 \n"] 5] dired-log-summary #[(string failures) "À ƒ ‚\nà #ˆÅÆ P!ˆÅÇ!‡" [message failures "%s--type ? for details (%s)" "%s--type ? for details" string dired-log "\n" t] 4]] 3) (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.") (defalias (quote dired-sort-set-modeline) #[nil "À \"ƒ Å‚Â \"ƒÇ‚È P) ÊË !‡" [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 set-buffer-modified-p buffer-modified-p] 3]) (defalias 'dired-sort-toggle-or-edit #[(&optional arg) "ƒ ÁÂà \"!‡Å ‡" [arg dired-sort-other read-string "ls switches (must contain -l): " dired-actual-switches dired-sort-toggle] 4 "\ Toggle between sort by date/name and refresh the dired buffer. With a prefix argument you can edit the current listing switches instead." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [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] dired-replace-in-string #[(regexp newtext string) "ÀÁ‰Ç #ƒ*Á”Á• O\nQ ‚  ÂOP,‡" ["" 0 nil me mb start result string-match regexp string newtext] 4] dired-sort-other #[(switches &optional no-revert) " ˆ † Ä ‡" [switches dired-actual-switches dired-sort-set-modeline no-revert revert-buffer] 1]] 3) (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'." t) (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'." t) (autoload (quote 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 (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) (autoload (quote dired-do-chgrp) "dired-aux" "\ Change the group of the marked (or next ARG) files." t) (autoload (quote dired-do-chown) "dired-aux" "\ Change the owner of the marked (or next ARG) files." t) (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) (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) (autoload (quote 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 (quote dired-do-compress) "dired-aux" "\ Compress or uncompress marked (or next ARG) files." t) (autoload (quote dired-do-byte-compile) "dired-aux" "\ Byte compile marked (or next ARG) Emacs Lisp files." t) (autoload (quote dired-do-load) "dired-aux" "\ Load the marked (or next ARG) Emacs Lisp files." t) (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) (autoload (quote 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 (quote dired-create-directory) "dired-aux" "\ Create a directory called DIRECTORY." t) (autoload (quote 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 (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) (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) (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) (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) (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) (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) (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) (autoload (quote dired-upcase) "dired-aux" "\ Rename all marked (or next ARG) files to upper case." t) (autoload (quote dired-downcase) "dired-aux" "\ Rename all marked (or next ARG) files to lower case." t) (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) (autoload (quote dired-next-subdir) "dired-aux" "\ Go to next subdirectory, regardless of level." t) (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) (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) (autoload (quote dired-mark-subdir-files) "dired-aux" "\ Mark all files except `.' and `..'." t) (autoload (quote dired-kill-subdir) "dired-aux" "\ Remove all lines of current subdirectory. Lower levels are unaffected." t) (autoload (quote dired-tree-up) "dired-aux" "\ Go up ARG levels in the dired tree." t) (autoload (quote dired-tree-down) "dired-aux" "\ Go down in the dired tree." t) (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) (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) (byte-code "Á=ƒ\nÂÃ!ˆÄÅ!ˆÆÇ!‡" [system-type vax-vms load "dired-vms" provide dired run-hooks dired-load-hook] 2) emacs-19.22/lisp/disass.elc100666 13437 1 7166 5451135222 14176 0ustar jimbdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:39:30 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/disass.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (require (quote byte-compile) "bytecomp") (defvar disassemble-column-1-indent 5 "\ *") (defvar disassemble-column-2-indent 10 "\ *") (defvar disassemble-recursive-indent 3 "\ *") (defalias 'disassemble #[(object &optional buffer indent interactive-p) "¢Á=ƒ ÂÃE „ÅŠ„„.ÈÈqˆÉ ?#‘ˆ‚8qˆÉ Ã#ˆ)Ç" [object byte-code lambda nil indent 0 interactive-p buffer "*Disassemble*" disassemble-internal] 5 "\ 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." (list (intern (completing-read "Disassemble function: " obarray (quote fboundp) t)) nil 0 t)]) (defalias (quote disassemble-internal) #[(obj indent interactive-p) "À‰‰‰ 9ƒ  K‰‚ Æ !ƒ!ÇÈ \"ˆ <ƒ6 @É=ƒ6Ê A@!ˆ K ¢Ä=ƒBË A <ƒS @Ì=ƒSÍÀ E <ƒc @Í=„cÇÎ!ˆ :ƒÌ ž„ƒ€Ð ƒ|Ñ‚}Ò \"ˆÓ !ƒÐÔ!ˆ :ƒž A‰@ A‚¢ ÕHÕUƒÔjˆ×Ø „· ƒ»Ù‚¼Ú ƒÄÛ‚ÅÚ ƒÐ×Ü \"‚ÑÚ$cˆ :ƒä @;…î @‚î GÝV…î ÝH‰ƒ\n;ƒ :ƒ AjˆÞßp\"ˆàá\n\"ƒ\nÕ‰”OâP\n᱈)jˆãcˆä p\"ˆácˆ :ƒ8å ž‚D GæV…Då æHD‰%ƒ‡%A@% ¢¢å=ƒ[ Ajˆçcˆ%¢Ì=ƒzá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" 4 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]) (defalias 'disassemble-1 #[(obj indent) "À‰ :ƒ A@ AA@‚ ÄH ÅHÆ\n \"À‰‰ \nËÀ\n\n  Î\nž‰ ƒV A T‰  ˆ \n>A\n‚6+\nƒª\n@@ \n@Ajˆ Î=ƒÐ@!ѱˆ‚¡\\jˆ ƒ¢ÓÔÕ !‰\"ƒ¢ÖÀO‚¥× Ø=ƒ¯ÙcˆcˆÛ\\\\\\jˆÜcˆ >ƒÕÐA@!cˆ‚ž Þ>ƒåÐ!cˆ‚ž ß>ƒöà@p\"ˆ‚ž á>ƒž@â!„9¢ã=ƒäž„9¢å=ƒgâA!„9A¢ã=ƒgäAžƒgâ!ƒFæcˆ‚W¢ã=ƒTçcˆ‚Wècˆé*Ä\\\\À#ˆ‚ž¢ä=ƒëcˆì*\\\"ˆ‚ž¢¢ä=ƒ”ícˆîï\"ˆ‚žð1àp\"ˆ)òcˆ\nA‰\n„\\.À‡" [nil constvec bytes obj 1 2 byte-decompile-bytecode opname arg op lap 0 tmp tagno TAG indent int-to-string ":" 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"] 6 "\ Prints the byte-code call OBJ in the current buffer. OBJ should be a call to BYTE-CODE generated by the byte compiler."]) emacs-19.22/lisp/disp-table.elc100666 13437 1 6424 5470156760 14743 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Nov 10 07:26:23 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/disp-table.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (defalias 'describe-display-table #[(dt) "ÀÁÂ!ˆÃ ÅH!ˆÁÆ!ˆÃ ÇH!ˆÁÈ!ˆÃ ÉH!ˆÁÊ!ˆÃ ËH!ˆÁÌ!ˆÃ ÍH!ˆÁÎ!ˆŠqˆÐÅÑ\"ÒÅWƒ` HIˆT‰‚HÕ!ˆ+Ö ‘‡" ["*Help*" princ "\nTruncation glyph: " prin1 dt 256 "\nWrap glyph: " 257 "\nEscape glyph: " 258 "\nCtrl glyph: " 259 "\nSelective display glyph sequence: " 260 "\nCharacter display glyph sequences:\n" standard-output make-vector nil 0 i vector describe-vector print-help-return-message] 6 "\ Describe the display table DT in a help buffer."]) (defalias 'describe-current-display-table #[nil "ÀÁ !† \n† ‰ƒÅ !‚ÆÇ!)‡" [window-display-table selected-window buffer-display-table standard-display-table disptab describe-display-table message "No display table"] 3 "\ Describe the display table in use in the selected window and buffer." nil]) (defalias 'make-display-table #[nil "ÀÁÂ\"‡" [make-vector 261 nil] 3 "\ Return a new, empty display table."]) (defalias 'standard-display-8bit #[(l h) " X…5ÂYƒÃWƒ ƒ. ÅIˆ‚. „'ÆÇÅ\" È!IˆT‰‚‡" [l h 32 127 standard-display-table nil make-vector 261 vector] 5 "\ Display characters in the range L to H literally."]) (defalias 'standard-display-default #[(l h) " X…3ÂYƒÃWƒ ƒ, ÅIˆ‚, „'ÆÇÅ\" ÅIˆT‰‚‡" [l h 32 127 standard-display-table nil make-vector 261] 4 "\ Display characters in the range L to H using the default notation."]) (defalias 'standard-display-ascii #[(c s) "„ ÁÂÃ\" ÅÆÇÃ\"\"I‡" [standard-display-table make-vector 261 nil c apply vector append s] 7 "\ Display character C using string S."]) (defalias 'standard-display-g1 #[(c sc) "„ ÁÂÃ\" ÅÆÇÈ !ÊQ!!I‡" [standard-display-table make-vector 261 nil c vector create-glyph "" char-to-string sc ""] 7 "\ Display character C as character SC in the g1 character set."]) (defalias 'standard-display-graphic #[(c gc) "„ ÁÂÃ\" ÅÆÇÈ !ÊQ!!I‡" [standard-display-table make-vector 261 nil c vector create-glyph "(0" char-to-string gc "(B"] 7 "\ Display character C as character GC in graphics character set."]) (defalias 'standard-display-underline #[(c uc) "„ ÁÂÃ\" ÅÆÇÈ !ÊQ!!I‡" [standard-display-table make-vector 261 nil c vector create-glyph "" char-to-string uc ""] 7 "\ Display character C as character UC plus underlining."]) (defalias (quote create-glyph) #[(string) "GÁUƒ ÂÃ!ˆÄ C\"‰GS‡" [glyph-table 65536 error "No free glyph codes remain" vconcat string] 4]) (defalias 'standard-display-european #[(arg) "À !ÂW„! „&à !ƒ& GÅYƒ& ÆHÇšƒ&ÈÆÉ\"‡ÊÆÉ\"‡" [prefix-numeric-value arg 0 vectorp standard-display-table 161 160 [160] standard-display-default 255 standard-display-8bit] 3 "\ 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." "P"]) (provide (quote disp-table)) emacs-19.22/lisp/dissociate.elc100666 13437 1 2774 5427115011 15034 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 2 00:37:28 1993 ;;; from file /home/fsf/rms/e19/lisp/dissociate.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (defalias 'dissociated-press #[(&optional arg) "ƒ\nÁ!‚ ÂpÄÅ!ÇVƒÈ‚É\nÇVƒ*‚,[ ÇVƒ8Ì‚9ÍÇÐ!ˆÑ ˆŠbˆÒÓ ÔZ!ˆ`dU†mdbˆÕÖ!…m×Ø!ˆÙÚ!ˆdÛ)…܉Š qˆ`\nÈ=ƒ§ ßà!\\\\‰dVƒ  ßà!Ú\\\\bˆ‚±\n ßà!\\!ˆ`)`!â #ˆŠ!bˆÜˆi#VƒÒä ˆ,Š qˆmƒáebˆ‚`\n [!ˆ`{%ßdS!Tbˆ%ÜÛ#„`!Úbˆ%!Û#ˆ)))æÇ!ˆ‚F.‡" [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 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 "\ 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." "P"]) emacs-19.22/lisp/doctor.elc100666 74777 1 104014 5424635036 14257 0ustar ericdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sun Jul 25 21:57:50 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/doctor.el ;;; emacs version 19.17.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias doctor-cadr #[(x) "A@‡" [x] 1] doctor-caddr #[(x) "AA@‡" [x] 1] doctor-cddr #[(x) "AA‡" [x] 1] // (lambda (x) x)] 3) (defalias '$ '(macro . #[(what) "ÀÁ\nDD‡" [doctor-$ quote what] 3 "\ quoted arg form of doctor-$"])) (defalias 'doctor-$ #[(what) "J‰@à A\nC\" Lˆ\n+‡" [what vv first append ww] 4 "\ Return the car of a list, rotating the list each time"]) (byte-code "ÀÁ!„ „à Ä ÅÆ#ˆÄ ÇÈ#ˆÂ‡" [boundp doctor-mode-map nil make-sparse-keymap define-key "\n" doctor-read-print " " doctor-ret-or-read] 4) (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 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias make-doctor-variables #[nil "ÀÁ!ˆÂÀÃ!ˆÄÅÆ\"ÀÇ!ˆÈÀÉ!ˆÈ ÀÊ!ˆÈ\nÀË!ˆÈ ÀÌ!ˆÍ ÀÎ!ˆÏÀÐ!ˆÑÀÒ!ˆÓÀÔ!ˆÕÀÖ!ˆ×ÀØ!ˆÙÀÚ!ˆÛÀÜ!ˆÝÀÞ!ˆßÀà!ˆá Àâ!ˆã\"Àä!ˆå$Àæ!ˆç&Àè!ˆé(Àê!ˆë*Àì!ˆí,Àî!ˆï.Àð!ˆñ0Àò!ˆó2Àô!ˆõ4Àö!ˆ÷6Àø!ˆù:Àû!ˆü=Àþ!ˆÿ>À@!ˆ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 ((feelings about) (aprehensions toward) (thoughts on) (emotions toward)) feelings-about random ((vivid) (emotionally stimulating) (exciting) (boring) (interesting) (recent) (random) (unusual) (shocking) (embarrassing)) random-adjective 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] doctor-meaning #[(x) "ÁN‡" [x doctor-meaning] 2]] 3) (defalias 'doctor-put-meaning '(macro . #[(symb val) "ÀÁ\nDà F‡" [put quote symb (quote doctor-meaning) val] 4 "\ Store the base meaning of a word on the property list."])) (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Â#ˆÀ Â#ˆÀ Â#ˆÀ Â#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#ˆÀÂ#‡" [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) (defalias 'doctor #[nil "ÀÁ!ˆÂ ‡" [switch-to-buffer "*doctor*" doctor-mode] 2 "\ Switch to *doctor* buffer and start giving psychotherapy." nil]) (defalias 'doctor-ret-or-read #[(arg) "hÀUƒ Á ‡Â !‡" [10 doctor-read-print newline arg] 2 "\ Insert a newline if preceding character is not a newline. Otherwise call the Doctor to parse preceding sentence." "*p"]) (defalias 'doctor-read-print #[nil "À Âcˆ TÄ !ˆÂcˆ ‰)‡" [doctor-readin sent "\n" lincount doctor-doc bak] 2 "\ top level loop" nil]) (defalias 'doctor-readin #[nil "ÀÂÃ!ˆm„Ä Å C\"‚ )‡" [nil sentence backward-sentence 1 append doctor-read-token] 3 "\ Read a sentence. Return it as a list of words."]) (defalias 'doctor-read-token #[nil "À`Ávˆ`{—!ÂÃ!ˆ‡" [intern 1 re-search-forward "\\Sw*"] 3 "\ read one word from buffer"]) (defalias (quote doctor-doc) #[(sent) "Ášƒ\nÂÃ!‡ ƒÂÅ!‡Æ„!@Ç>ƒ'ÂÈÉ!!‡@Ê=ƒBË! >ƒ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]) (defalias 'doctor-correct-spelling #[(sent) "… ÁÂÃÄ\"\"‡" [sent apply append mapcar #[(word) " >ƒ ÂNÃN‡C‡" [word typos doctor-correction doctor-expansion] 2]] 5 "\ Correct the spelling and expand each word in sentence."]) (defalias 'doctor-shorten #[(sent) "À‰Á\nƒ.\n@ >‰ƒ' GÆVƒ' Ç !ÀÈ‚\nA‰„\n +‡" [nil (because but however besides anyway until while that except why how) temp retval foo sent 3 doctor-fixup t] 4 "\ Make a sentence manageably short using a few hacks."]) (defalias (quote doctor-define) #[(sent found) "À \nÃÄ$ˆÅ!…/Ç!?…/…/È !…/Êȉ !#…/ˇ" [doctor-svo sent found 1 nil doctor-nounp subj doctor-pronounp doctor-meaning object put t] 5]) (defalias 'doctor-defq #[(sent) "Àƒ @ >ƒ @À‰‚ A‰„) ‡" [nil found (means applies mean refers refer related similar defined associated linked like same) temp sent] 3 "\ Set global var FOUND to first keyword found in sentence SENT."]) (defalias (quote doctor-def) #[(x) "ÀÁ ÄÅ !Æǯ!ˆÈ‡" [doctor-type the word x means doctor-meaning to me nil] 8]) (defalias 'doctor-forget #[nil "À‰ !A!‰‡" [reverse history] 3 "\ Delete the last element of the history list."]) (defalias 'doctor-query #[(x) "ÀÁ\n!ÃPÀ „[„%Ç È !DZˆÉ ‰ƒƒ „ Ê@!ƒ=@‚%Ë@!ƒR̉\nÍ\"@\"‚%A‰‚' +‡" [nil doctor-make-string x " what ? " retval prompt a 10 read-string doctor-readin doctor-nounp doctor-verbp doctor-build " "] 5 "\ Prompt for a line of input from the minibuffer until a noun or verb is seen. Put dialogue in buffer."]) (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 "\ 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-nounp #[(x) "À !† !† Ú†Ä !†Å !?‡" [doctor-pronounp x doctor-verbp not doctor-prepp doctor-modifierp] 2 "\ Returns t if the symbol argument is a noun."]) (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 "\ Returns t if the symbol argument is a pronoun."]) (byte-code "ÀÁÂ\"ˆÃÄÅ\"‡" [mapcar #[(x) "À ÂÃ#‡" [put x doctor-sentence-type verb] 4] (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]] 3) (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 "\ Form the plural of the word argument."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"‡" [defalias doctor-setprep #[(sent key) "À \n>ÅÆ !!ƒ ÇÈ !!‰ƒ ‚CÉ‚CÊÆ !!ƒBÇÈ !!‰ƒ>Ë‰Æ !Ì\" \"‚CÉ‚CÉ*‡" [nil key sent foo val doctor-prepp doctor-cadr doctor-getnoun doctor-cddr something doctor-articlep doctor-build " "] 5] 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] doctor-modifierp #[(x) "À !† !†à !‡" [doctor-adjectivep x doctor-adverbp doctor-othermodifierp] 2] doctor-adjectivep #[(x) "§† Á!† Â!† Ã!† Ä!† Å!‡" [x doctor-nmbrp doctor-articlep doctor-colorp doctor-sizep doctor-possessivepronounp] 2] doctor-adverbp #[(xx) "À !ÂÃOʇ" [doctor-make-string xx -2 nil "ly"] 3] doctor-articlep #[(x) "Á>‡" [x (the a an)] 2] 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] doctor-colorp #[(x) "Á>‡" [x (beige black blue brown crimson gray grey green orange pink purple red tan tawny violet white yellow)] 2] doctor-sizep #[(x) "Á>‡" [x (big large tall fat wide thick small petite short thin skinny)] 2] doctor-possessivepronounp #[(x) "Á>‡" [x (my your his her our their)] 2] 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] 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] doctor-remember #[(thing) "„ C‰‡Â C\"‰‡" [history thing append] 3] doctor-type #[(x) "À !Âà !!‡" [doctor-fix-2 x doctor-txtype doctor-assm] 3] 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] 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] doctor-vowelp #[(x) "Á>‡" [x (97 101 105 111 117)] 2]] 3) (defalias 'doctor-replace #[(sent rlist) "ÀÁÂà \"\"‡" [apply append mapcar #[(x) " ž† ‰DA‡" [x rlist] 2] sent] 5 "\ Replace any element of SENT that is the car of a replacement element pair in RLIST."]) (defalias (quote doctor-wherego) #[(sent) "„ÁÂ!‡Ã@!„#ÄÅÆ!ÇUƒÈA!‚!A!‡@ Ã@!‡" [sent doctor-$ whereoutp doctor-meaning doctor-wherego random 2 0 reverse found] 3]) (defalias 'doctor-svo #[(sent key type mem) "À \n #‰„ ÅÇ @!„! Aƒ! A‚ @É A!\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 "\ 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-possess #[(sent key) "G >GZÂZ‰ÄWƒÅ‚ 8Ç!„,È!ÉÊO˘ƒ1‚2ʼn *‡" [sent key 1 i 0 your prev doctor-possessivepronounp doctor-make-string -1 nil "s" owner] 4 "\ Set possessive in SENT for keyword KEY. Hack on previous word, setting global variable OWNER to correct result."]) (defalias 'doctor-txtype #[(ans) "ÀÂÄÅ\"ˆÇc‡" [t *print-upcase* nil *print-space* mapcar doctor-type-symbol ans "\n"] 3 "\ Output to buffer a list of symbols or strings as a sentence."]) (defalias 'doctor-type-symbol #[(word) "À !‰˜ƒ à ƒÅ !ƒÇcˆÈÉ \"„(„. cˆ‚3Ê ±ˆ ƒCi VƒC ˆÈÍ \"Ή‡" [doctor-make-string word "i" "I" *print-upcase* capitalize *print-space* " " string-match "^[.,;:?! ]" 32 auto-fill-function fill-column "[.?!]$" t] 4 "\ Output a symbol to the buffer with some fancy case and spacing hacks."]) (defalias 'doctor-build #[(str1 str2) "„ ‡ „ ‡:„ :„ ÂÃ!à !P!‡Ä‡" [str1 str2 intern doctor-make-string nil] 4 "\ Make a symbol out of the concatenation of the two non-list arguments."]) (defalias (quote doctor-make-string) #[(obj) ";ƒ‡9ƒÁ!‡§ƒÂ!‡Ã‡" [obj symbol-name int-to-string ""] 2]) (defalias 'doctor-concat #[(x y) "À ƒ :„ C‚ \nƒ\n:„\nC‚\n\"‡" [append x y] 3 "\ Like append, but force atomic arguments to be lists."]) (defalias (quote doctor-assm) #[(proto) "„Á‡:„C‡@:„@ÂA!B‡ÃÂÄ@!!ÂA!\"‡" [proto nil doctor-assm doctor-concat eval] 4]) (defalias 'doctor-go #[(destination) "ÀÁ !P! ‡" [intern "doctor-" doctor-make-string destination] 4 "\ Call a `doctor-*' function."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆÀõö\"ˆÀ÷ø\"ˆÀùú\"ˆÀûü\"ˆÀýþ\"ˆÀÿ@\"ˆÀAB\"ˆÀCD\"ˆÀEF\"ˆÀGH\"‡" [defalias doctor-desire1 #[nil "ÀÁÂ!!‡" [doctor-go doctor-$ whereoutp] 3] doctor-huh #[nil "GÁWƒ ÂÃÄ!!‡ÂÃÅ!!‡" [sent 9 doctor-type doctor-$ huhlst longhuhlst] 3] doctor-rthing #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ thlst] 3] doctor-remem #[nil "„Á ‡ÂÃÄ!!‡" [history doctor-huh doctor-type doctor-$ remlst] 3] doctor-howdy #[nil "„ ÁÂ!ˆÃ‰‡ÁÄ!ˆÁÅ!‡" [howdyflag doctor-type (($ hello) what brings you to see me \?) t (($ ibelieve) we\'ve introduced ourselves already \.) (($ please) ($ describe) ($ things) \.)] 2] doctor-when #[nil " >GÂWƒ à ‡ >AÄ !ÅÆ!‡" [found sent 3 doctor-short doctor-fixup doctor-type (($ whatwhen) (// sent) \?)] 2] doctor-conj #[nil " >GÂWƒ à ‡ >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] doctor-short #[nil "@ SUƒ‰AT¡ˆ‚¡ˆ  ˆAÃVƒ0 „,ÅÆ!ˆÇ‰‡ÅÈ!‡ ÊË!šƒ=ÅÌ!‡ ÊÍ!šƒ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] doctor-alcohol #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ drnk] 3] 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] doctor-drug #[nil "ÀÁÂ!!ˆÃÄÅE!‡" [doctor-type doctor-$ drugs doctor-remember you used found] 4] doctor-toke #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ toklst] 3] doctor-state #[nil "ÀÁÂ!!ˆÃÄÅE!‡" [doctor-type doctor-$ states doctor-remember you were found] 4] doctor-mood #[nil "ÀÁÂ!!ˆÃÄÅE!‡" [doctor-type doctor-$ moods doctor-remember you felt found] 4] doctor-fear #[nil "À \n\"ÄÅÆ!!ˆÇÈÉÊË ¯!‡" [doctor-setprep sent found feared doctor-type doctor-$ fears doctor-remember you were afraid of] 6] 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] doctor-symptoms #[nil "ÀÁ!‡" [doctor-type (($ maybe) you should consult a doctor of medicine\, i am a psychiatrist \.)] 2] doctor-hates #[nil "À \nÃÄ$ˆÅ ‡" [doctor-svo sent found 1 t doctor-hates1] 5] doctor-hates1 #[nil "ÀÁ!‡" [doctor-type (($ whysay) (list subj verb obj))] 2] doctor-loves #[nil "À \nÃÄ$ˆÅ ‡" [doctor-svo sent found 1 t doctor-qloves] 5] doctor-qloves #[nil "ÀÁ!‡" [doctor-type (($ bother) (list subj verb obj) \?)] 2] 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] doctor-mach #[nil "À !ÂÃÄ!!‡" [doctor-plural found doctor-type doctor-$ machlst] 3] doctor-sexnoun #[nil "À ‡" [doctor-sexverb] 1] doctor-sexverb #[nil "À >„ >„à >ƒÄ ‡ÅÆÇ!!‡" [me sent myself i doctor-foul doctor-type doctor-$ sexlst] 3] doctor-death #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ deathlst] 3] doctor-foul #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ foullst] 3] doctor-family #[nil "À \n\"ˆÃÄÅ!!‡" [doctor-possess sent found doctor-type doctor-$ famlst] 3] doctor-rms #[nil "ƒ\nÁÂÃ!!‡ÄÁÅ!‡" [rms-flag doctor-type doctor-$ stallmanlst t (do you know Stallman \?)] 3] doctor-school #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ schoollst] 3] doctor-eliza #[nil "ƒ\nÁÂÃ!!‡ÄÁÅ!‡" [eliza-flag doctor-type doctor-$ elizalst t ((// found) \? hah ! ($ please) ($ continue) \.)] 3] doctor-sports #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ sportslst] 3] doctor-math #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ mathlst] 3] doctor-zippy #[nil "ƒ\nÁÂÃ!!‡ÄÁÅ!‡" [zippy-flag doctor-type doctor-$ zippylst t (yow! are we interactive yet \?)] 3] doctor-chat #[nil "ÀÁÂ!!‡" [doctor-type doctor-$ chatlst] 3] doctor-strangelove #[nil "ÀcˆÁ ‡" ["Mein fuhrer!!\n" doctor-read-print] 1 nil nil]] 3) emacs-19.22/lisp/dunnet.elc100666 21623 1 217321 5444012411 14057 0ustar mibdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Sep 10 01:47:52 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/dunnet.el ;;; emacs version 19.19.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"))) (error "This file was compiled for Emacs 19")) (defvar dun-log-file "/usr/local/dunnet.score" "\ Name of file to store score information for dunnet.") (require (quote cl)) (defalias 'dun-mode #[nil "À ˆÁ\n!ˆÃʼn‡" [text-mode use-local-map dungeon-mode-map dungeon-mode major-mode "Dungeon" mode-name] 2 "\ Major mode for running dunnet." nil]) (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 "\ Function called when return is pressed in interactive mode to parse line." "*p"]) (defalias (quote dun-messages) #[nil "ƒÁ ‡\nÃ=… U„Æ !ˆ Ç ˆÈÉ!‡" [dun-dead text-mode dungeon-mode dungeon room dun-current-room dun-describe-room dun-fix-screen dun-mprinc ">"] 2]) (defalias 'dunnet #[nil "ÀÁ!ˆÂ ˆÃÅÇ ‡" [switch-to-buffer "*dungeon*" dun-mode nil dun-dead 0 room dun-messages] 2 "\ Switch to *dungeon* buffer and start game." nil]) (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\"ˆÀ{|\"ˆÀ}~\"ˆÀ€\"ˆÀ‚\"ˆÀƒ„\"ˆÀ…†\"ˆÀ‡ˆ\"ˆÀ‰Š\"ˆÀ‹Œ\"ˆÀŽ\"ˆÀ\"ˆÀ‘’\"ˆÀ“”\"ˆÀ•–\"ˆÀ—˜\"ˆ™š›œžŸ ™\"¡ž Wƒb¡ž‰IˆžT‰ž‚K‰P‰–œ™ž™¢Wƒª¡ž£\\ž¤\\HIˆ¡ž¥\\œž¤\\HIˆžT‰ž‚t+À¦§\"ˆ¨©ª«›¬›­®¯!„×›¯° ¯±¯²³#ˆ®´!„úµ ´¶™·O¸˜ƒ4›¹º¹™¹ªZ‰¹Wƒ0´¹»Iˆ‚)‚]›¹º¹™¹ªZ‰¹Wƒ\\´A@¹»Iˆ‚>)±´²¼#ˆ±´½¼#ˆ›¾›¿™À›Á›™ÙěśƙǙțɛe›ÊËÌÍÎÏЛÑÒÓÔÕ›Ö×ØÙÚÛÜ›Ý×Þ›ßàáâãäå›æ›çèéêë™ì™íªî·ïðñòóôõö÷øùúûüýþÿ›‰ƒ»@› \n@!P   !AE!ˆ)A‰„*›CC›‰‰CC›‰CE›‰C›D›‰D›‰‰‰‰‰‰C›C›‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰D›‰‰‰‰C›‰‰C›‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰C›‰ C›!C›\"C›#$E%C&C›‰‰‰‰'C›‰C›C›C›(C›‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰¯¡)›*C*C›‰‰‰‰‰+C,C›‰‰-C›.C/.D›‰‰‰‰‰‰‰‰‰0C›‰‰‰‰12D34D›‰‰‰‰‰C›‰‰‰‰‰‰‰‰‰‰‰‰‰,5D6C7C›‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰8C›‰‰9C›:;D<C=C>C›‰?C›‰,C›‰‰‰‰‰‰‰@C›‰‰‰‰‰¯oABCDEFGHIJKLMNOPQ›‰‰RC›‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰SC›‰‰‰‰‰‰‰¯3T·U›VᛉWƒ“W@XV‹A@!—C\"VWA‰W„l*YZ›[™[V›‰\\ƒå\\@   ![E!ˆ[ª\\[\\A‰\\„¶+À]^\"ˆÀ_`\"ˆÀab\"ˆÀcd\"ˆÀef\"ˆÀgh\"ˆÀij\"ˆÀkl\"ˆÀmn\"ˆÀop\"ˆÀqr\"ˆÀst\"ˆÀuv\"ˆÀwx\"ˆÀÜy\"ˆÀz{\"ˆÀ|}\"ˆÀ~\"ˆÀ€\"ˆÀ‚ƒ\"ˆÀ„…\"ˆÀ†‡\"ˆÀˆ‰\"ˆÀŠ‹\"ˆÀŒ\"ˆÀŽ\"ˆÀ‘\"ˆÀ’“\"ˆÀ”•\"ˆ–×!ˆ–—!˜\\™q)™X™)8—C\"#ˆ–š!›\\œ\nœ!ÀžŸ\"ˆÀ ¡\"ˆÀ¢£\"ˆÀ¤¥\"ˆÀ¦§\"ˆÀ¨©\"ˆÀª«\"ˆÀ¬­\"ˆÀ®¯\"ˆÀ°±\"ˆÀ²³\"ˆÀ´µ\"ˆÀ¶·\"ˆÀ¸¹\"ˆÀº»\"ˆÀ¼½\"ˆÀ¾¿\"ˆÀÀÁ\"ˆÀÂÃ\"ˆÀÄÅ\"ˆÀÆÇ\"ˆÀÈÉ\"ˆÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"ˆÀÐÑ\"‡" [defalias dun-describe-room #[(room) "À !\n„ „ÅÆ!‡ÅÀ !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--71800 obj-special dun-special-object dun-objects obj-bus dun-inbus dun-perm-objects obj-jar dun-jar "The jar contains:" x --dolist-temp--71801 " " "You are on the bus."] 5] 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] dun-die #[(murderer) "ÀÁ!ˆ\nƒ ÃÄ!ˆÅÆ\n\"ˆÇÈ!ˆÉ‰\n‡" [dun-mprinc "\n" murderer dun-mprincl "You are dead." dun-do-logfile dun-die dun-score nil t dun-dead] 3] dun-quit #[(args) "ÀÁ!‡" [dun-die nil] 2] dun-inven #[(args) "ÀÁ!ˆÀÂ!ˆ ĉƒc@‰ƒZÇ 8A@!ˆ  UƒZ\nƒZÇË!ˆ\nÄ ‰ ƒY @ ÀÎ!ˆÇ 8A@!ˆ A‰ „=*A‰„*ć" [dun-mprinc "You currently have:" "\n" dun-inventory nil curobj --dolist-temp--71802 dun-mprincl dun-objects obj-jar dun-jar "The jar contains:" x --dolist-temp--71803 " "] 5] dun-shake #[(obj) "À !‰…s ƒ(ÅÆ!ˆÅ 8A@—!ˆÅÈ!ˆÅÉ!‚s \n 8„B \n 8„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] dun-drop #[(obj) "ƒÁÂ!‡Ã‰Æ!‰…K ‰„$ÁÉ!‚KÊ !ˆË  Î  8 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] dun-drop-check #[(objnum) " Uƒ3\n Uƒ3 8ƒ3ÆÇ!ˆÈ \"ˆÈ \"ˆÊ  Ë 8 C\"#ˆ 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] dun-examine #[(obj) "À !‰ =ƒÅ[!‚¦ =ƒ, 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] dun-take #[(obj) "ƒÁÂ!‡Ã !‰„ÁÅ!‡ ƘƒlÇÇ \n8Ç ‰ ƒ` @‰ ÍYƒW U„WÏÐ 8A@!ˆÐÒ!ˆÓ !ˆ A‰ „.*?…jÁÔ!)‡ÇÖ !ž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--71804 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] dun-take-object #[(objnum) " ƒE\n ƒEÄÆÇ!ˆÄ ĉ ƒ9 @‰U„0Ê C\" A‰ „* Ê C\"‰)‡  8„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--71805 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] dun-inven-weight #[nil "À À‰ƒ @ 8\\ A‰„ *À‰ƒ<@ 8\\A‰„(* )‡" [nil total 0 dun-jar x --dolist-temp--71806 dun-object-lbs dun-inventory --dolist-temp--71807] 4] dun-try-take #[(obj) "ÀÁ!‡" [dun-mprinc "You cannot take that."] 2] dun-dig #[(args) "ƒÁÂ!‡Ã „ÁÅ!‡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] dun-climb #[(obj) "À !‰ U„+ 8„+ 8„+ „+ÉÊ!‚W UƒA 8„AÉÌ!‚W  U„T U„TÉÍ!‚WÉÎ!)‡" [nil objnum dun-objnum-from-args obj obj-special dun-current-room dun-room-objects dun-room-silents dun-inventory dun-mprincl "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] dun-eat #[(obj) "À !‰…= „ÅÆ!‚= 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] dun-put #[(args) "ƒÁÂ!‡Ã‰‰‰È !‰„\"ÁÊ!‚«Ë@!‰ žA‰„9ÁÍ!‚«„GÁÏ!‚«ÈA!ÈA!‰„_ÁÐ!‚«Ë@! ž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] dun-put-objs #[(obj1 obj2) " Uƒ \n„  Uƒ  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] dun-type #[(args) " U„\nÂÃ!‡ „ÂÅ!‡Æ ‡" [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] dun-n #[(args) "À !‡" [dun-move north] 2] dun-s #[(args) "À !‡" [dun-move south] 2] dun-e #[(args) "À !‡" [dun-move east] 2] dun-w #[(args) "À !‡" [dun-move west] 2] dun-ne #[(args) "À !‡" [dun-move northeast] 2] dun-se #[(args) "À !‡" [dun-move southeast] 2] dun-nw #[(args) "À !‡" [dun-move northwest] 2] dun-sw #[(args) "À !‡" [dun-move southwest] 2] dun-up #[(args) "À !‡" [dun-move up] 2] dun-down #[(args) "À !‡" [dun-move down] 2] dun-in #[(args) "À !‡" [dun-move in] 2] dun-out #[(args) "À !‡" [dun-move out] 2] 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] 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] 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] dun-long #[(args) "À‰‡" ["long" dun-mode] 2] dun-turn #[(obj) "À‰à !‰…u\n 8„$\n 8„$ÈÉ!‚u\n\nU„1ÈË!‚uÌ A!‰ƒ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] dun-sauna-heat #[nil "ÁUƒ\nÂÃ!ˆÄUƒÂÅ!ˆÆUƒÂÇ!ˆÈUƒžÂÉ!ˆ\n „;\n  8ƒpÂÎ!ˆ\n ƒXÏ\n!ˆÐ C\" ‚pÒ \n\"ˆÓ  Ð  8C\"#ˆ „ƒ  8ƒžÂÕ!ˆ ƒ—Ï!ˆ‚žÒ \"ˆÖ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] dun-press #[(obj) "À !‰…e 8„! 8„!ÇÈ!‚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] dun-swim #[(args) " \nD„ ÃÄ!‡ „ÃÇ!ˆÈÉ!‡ 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] 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] 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] 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] dun-piss #[(args) " U„\nÂÃ!‡ „ÂÅ!‡ÂÆ!ˆÇÈ \nË\n 8 C\"#‡" [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] 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] dun-break #[(obj) "À\n „ÄÅ!‚›Æ!‰…› ƒ'ÄÈ!ˆÉÊ!‚›   8„A   8„AÄÎ!‚› Uƒ‚ÄÐ!ˆÑ Ó 8 \"#ˆ ƒ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] 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] dun-superb #[(args) "À‰‡" [dun-superb dun-mode] 2] dun-reg-score #[nil "À 8À‰ƒ#@ 8\\A‰„* 8ƒ/ )‡" [nil total 0 treasure-room dun-room-objects x --dolist-temp--71808 dun-object-pts obj-URINE] 4] dun-endgame-score #[nil "À 8À‰ƒ#@ 8\\A‰„* )‡" [nil total 0 endgame-treasure-room dun-room-objects x --dolist-temp--71809 dun-object-pts] 4] 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] dun-endgame-question #[nil "„ÁÂ!ˆÁÃ!ˆÄ‰‡Æ‰‰ ÊÆËG! ÁÂ!ˆÁ 8@‰ !ˆ 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] dun-power #[(args) " U„\nÂÃ!‡ „Å ‡Æ ‡" [dun-current-room pc-area dun-mprincl "That operation is not applicable here." dun-floppy dun-dos-no-disk dun-dos-interface] 2] dun-feed #[(args) "À !‰…O Uƒ- 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] 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] 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] 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] dun-replace #[(list n number) " ›\n ‡" [n list number] 2] dun-firstword #[(list) "@??…ƒÁ@!\nƒA‰„ @‡" [list intern dun-ignore] 3] dun-firstwordl #[(list) "@??…ƒÁ@!\nƒA‰„ ‡" [list intern dun-ignore] 3] 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] 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] dun-read-line #[nil "ÀÂÃ!Ä !ˆ )‡" [nil line read-string "" dun-mprinc] 2] dun-minsert #[(string) ";ƒc‡Á!c‡" [string prin1-to-string] 2] dun-mprinc #[(string) ";ƒc‡Á!c‡" [string prin1-to-string] 2] dun-fix-screen #[nil "À ÁZ[yˆÂà `\"ˆÄ ‡" [window-height 2 set-window-start selected-window end-of-buffer] 3 nil nil] dun-minsertl #[(string) "À !ˆÀÂ!‡" [dun-minsert string "\n"] 2] dun-mprincl #[(string) "À !ˆÀÂ!‡" [dun-mprinc string "\n"] 2] dun-objnum-from-args #[(obj) "À !‰„ ‚Å !žA‰)‡" [nil objnum dun-firstword obj obj-special intern dun-objnames] 3] dun-objnum-from-args-std #[(obj) "À !‰ =ƒÅÆ!ˆ À=ƒÅÇ!ˆ =?…\" )‡" [nil result dun-objnum-from-args obj obj-special dun-mprincl "You must supply an object." "I don't know what that is."] 2] dun-space-to-hyphen #[(string) "ÀÂà \"‰ƒ Å OÆ TÀOQÇ !‚ )‡" [nil space string-match "[ /]" string 0 "-" dun-space-to-hyphen] 5] 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] dun-members #[(string string-list) "ÀÀ\nÀ‰ƒ @‰ ˜ƒÆ A‰„ * )‡" [nil found string-list x --dolist-temp--71810 string t] 3] 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] 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] dun-remove-obj-from-room #[(room objnum) "ÀÀ\n 8À‰ƒ% @‰U„Ç C\" A‰„*\n ›  )‡" [nil newroom room dun-room-objects x --dolist-temp--71811 objnum append] 4] dun-remove-obj-from-inven #[(objnum) "ÀÀ\nÀ‰ƒ\" @‰ U„Æ C\" A‰„ * ‰)‡" [nil new-inven dun-inventory x --dolist-temp--71812 objnum append] 4] 0 "abcdefghijklmnopqrstuvwxyz" nil upper lower i make-vector 256 dun-translate-table 26 97 13 65 dun-rot13 #[nil "À‰Áed{‰G\n Wƒ# \n \nHHIˆ\nT‰‚Æ ˆ c+‡" [nil 0 i len str dun-translate-table erase-buffer] 6] (27) dun-visited 1 dun-current-room dun-exitf dun-badcd boundp dungeon-mode-map make-sparse-keymap define-key " " dun-parse dungeon-batch-map make-keymap emacs-version 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-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) (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--71813 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--71814 append (("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--71815 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"] dun-doassign #[(line esign) "„,ÁÃÄ!ˆÅ „ÃÇ!ˆ\nȘƒ'ÉÊ  \"‚*ÍÎ!)‡Á‰‰‰‰ Ô OÕÖ \"‰„‰  T ×\\Oؘƒv  ×\\ÁOÕØ\" Ù\\\\‚²ÕÚ \"‰„² G‚²T‰ GU„²ÕÖ ÁO\"‰ƒ²Û\\\\‰‚  TOÜ\"-‡" [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] 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] dun-unix-interface #[nil "À ˆ …ÂÄ ÆÇ#ˆÈÉ!‡" [dun-login dun-logged-in unix dungeon-mode define-key dungeon-mode-map " " dun-unix-parse dun-mprinc "$ "] 4] 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] dun-ls #[(args) "@ƒ Á‰  Æ!Ç=„ÈÁ!ˆ \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] 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] 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] dun-ls-rooms #[nil "ÀÁ!ˆ\nɃ! @ÆÇ!ˆÀ 8!ˆ A‰„ *Ç" [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--71816 dun-mprinc "drwxr-xr-x 3 root staff 512 Jan 1 1970 " dun-room-shorts] 4] 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--71817 0 255 dun-mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 " dun-objfiles] 4] dun-ls-inven #[nil "ÀÁ!ˆ\nɃ& @‰@Æ=„ÀÇ!ˆÀ @!ˆ A‰„ *ÀÈ!ˆ „4ÊË!ˆ É ƒV @ÀÎ!ˆÊ 8!ˆ 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--71818 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--71819 "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 " dun-objfiles] 4] dun-echo #[(args) "À‰À À‰ƒb @\n„[ ÆÇOȘ„)É !ˆÉÊ!ˆ‚[Ë ÇÀO!Ì !„=ÉÊ!ˆ‚[  ƒQÉ !ˆÉÎ!ˆÏ‚[ÐÉ D!ˆÉÊ!ˆ A‰„*ÉÑ!*‡" [nil var nomore args x --dolist-temp--71820 0 1 "$" dun-mprinc " " intern boundp dun-restricted ": Permission denied" t eval "\n"] 5] dun-ftp #[(args) "À‰‰‰‰@„ÇÈ!‚ÌÉ@!‰Ê„(ÇË!‚Ì Ì=ƒ4ÇÍ!‚Ì„?ÇÏ!‚ÌÇÐ!ˆÑÒ!ˆÓ ‰Ô˜ƒaƒ[ÇÖ!‚ÌÇ×!‚Ì Ø˜ƒzƒsÇÙ!ˆ‚ŽÇÚ!ˆ‚Žƒ†ÑÛ!ˆ‚ŠÑÜ!ˆÇ !ˆÑÝ!ˆÓ  ؘ„¬ƒ¦ÇÞ!‚ÌÇß!‚̃¸Çà!ˆ‚¼Çá!ˆâ ˆãä \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] dun-ftp-commands #[nil "ÀÀ „ ÃÄ!ˆÅ ÆÀÇ\n#È=ƒÉÊ!ˆ‚ˉ )‡" [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] #[(args) "@„ ÁÂ!‡Ã@!‰Ä=ƒÅÆ!‡Ç=ƒ\"ÈÆ!‡ÁÉ!‡" [args dun-mprincl "Usage: type [binary | ascii]" intern binary dun-bin nil ascii dun-fascii "Unknown type."] 3] dun-bin #[(args) "ÀÁ!ˆÂ‰‡" [dun-mprincl "Type set to binary." binary dun-ftptype] 2] dun-fascii #[(args) "ÀÁ!ˆÂ‰‡" [dun-mprincl "Type set to ascii." ascii dun-ftptype] 2] dun-ftpquit #[(args) "À‰‡" [t dun-exitf] 2] dun-send #[(args) "@„ ÁÂ!‡@ÉÃÆÇ!žƒ=Ç!žÉ ˆÊË!ˆÊ !ˆÊÍ!ˆÁ!ˆÁÎ!‚ÙɃÐ@˜ƒÃ „dÁÓ!ˆÔ‚ÃÊË!ˆÊ !ˆÊÍ!ˆÊ 8A@—!ˆÁÖ!ˆ ×=„©8„¢ÛÜ8C\"#ˆÝ !ˆ‚½Ý !ˆÛÜ8 C\"#ˆÔÁÎ!ˆ Þ\\A‰„H* ?…ÙÁÓ!*‡" [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--71821 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] dun-ftphelp #[(args) "ÀÁ!‡" [dun-mprincl "Possible commands are:\nsend quit type ascii binary help"] 2] 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] dun-pwd #[(args) "À !‡" [dun-mprincl dun-cdpath] 2] 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] 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] 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   Ò‚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--71822 "." ".." 0 "/rooms" -2 -4 -3 "/" -10 "/usr" "toukmond" "/usr/toukmond" dun-nosuchdir "rooms" "usr" dun-visited x --dolist-temp--71823 dun-room-shorts "/rooms/"] 4] dun-nosuchdir #[nil "ÀÁ!ˆÂ‰‡" [dun-mprincl "No such directory." t dun-badcd] 2] dun-cat #[(args) "À‰ @‰„ÄÅ!‚ÆÇ \"ƒÄÈ!‚ ÊVƒ6 ˘ƒ6Ä  8@!‚ÆÍ \"‰ƒ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] dun-zippy #[(args) "ÀÁ !‡" [dun-mprincl yow] 2] dun-rlogin-endgame #[nil "ÀÁ!ÂU„ ÃÄ!‡ÃÅ!ˆÈ Ê   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] random 18 60 tloc 899 100 tcomb dun-combination dun-dos-parse #[(args) "ÀyˆÁ`Ã\\Áˆ\n`U„4Á\n`{—Å !ˆÆÁ #È=ƒ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"] dun-dos-interface #[nil "À ˆÁà ÅÆ#ˆÇ ‡" [dun-dos-boot-msg dos dungeon-mode define-key dungeon-mode-map " " dun-dos-parse dun-dos-prompt] 4] 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] dun-dos-invd #[(args) "ÀÁ!ˆÂÃ!‡" [sleep-for 1 dun-mprincl "Invalid drive specification"] 2] 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] dun-dos-prompt #[nil "ÀÁ!‡" [dun-mprinc "A> "] 2] 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] dun-dos-spawn #[(args) "ÀÁ!ˆÂÃ!‡" [sleep-for 1 dun-mprincl "Cannot spawn subshell"] 2] 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] dun-dos-no-disk #[nil "ÀÁ!ˆÂÃ!‡" [sleep-for 3 dun-mprincl "Boot sector not found"] 2] dun-dos-show-combination #[nil "ÀÁ!ˆÂÃ!ˆÂ !ˆÂÅ!‡" [sleep-for 2 dun-mprinc "\nThe combination is " dun-combination ".\n"] 2] dun-dos-nil (lambda (args)) 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] dun-make-save-buffer #[nil "ÀÁÂ!!ˆÃ ‡" [switch-to-buffer get-buffer-create "*save-dungeon*" erase-buffer] 3] 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] dun-save-val #[(varname) "À !Ä !ÅÆ!ˆÅ !ˆÅÇ!ˆ <„ 9ƒ$ÅÈ!ˆ ;ƒ-ÅÉ!ˆÅ !ˆ ;ƒ:ÅÉ!ˆÊË!)‡" [nil value intern varname eval dun-minsert "(setq " " " "'" "\"" dun-minsertl ")"] 2] 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] 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] dun-batch-mprinc #[(arg) ";ƒ Á!‡ÁÂ!!‡" [arg send-string-to-terminal prin1-to-string] 3] dun-batch-mprincl #[(arg) ";ƒ Á!ˆÁÂ!‡ÁÃ!!ˆÁÂ!‡" [arg send-string-to-terminal "\n" prin1-to-string] 3] dun-batch-parse #[(dun-ignore dun-verblist line) "À ÂP!Ä  @ A$‡" [dun-listify-string line " " line-list dun-doverb dun-ignore dun-verblist] 5] dun-batch-parse2 #[(dun-ignore dun-verblist line) "À ÂP!Ä  @ A$‡" [dun-listify-string2 line " " line-list dun-doverb dun-ignore dun-verblist] 5] dun-batch-read-line #[nil "ÀÁ #‡" [read-from-minibuffer "" nil dungeon-batch-map] 4] dun-batch-loop #[nil "À ?…; Å=ƒ 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] 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] dun-batch-unix-interface #[nil "À ˆ …P Â=ƒJÄÅ!ˆÆ —ÈÉ\n#Ë=ƒ É ÍÎ\"‰ ƒ<Ï \"ˆ‚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]] 162) (defun dungeon-nil (arg) "\ noop" (interactive "*p")) (byte-code "ÀÁÂ\"ˆ ƒ/ÄÅMˆÆÇMˆÈÉMˆÊËMˆÌÍMˆÎÏMˆÐÑMˆÄÒ!ˆÓÕ ˆÀ‡" [defalias dun-batch-dungeon #[nil "ÀÁ!ˆÂÄÅ!ˆÆ ‡" [load "dun-batch" (27) dun-visited dun-mprinc "\n" dun-batch-loop] 2] 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] 3) emacs-19.22/lisp/ebuff-menu.elc100666 13437 1 15156 5416164326 14767 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:52:06 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/ebuff-menu.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ Äć" [require electric boundp electric-buffer-menu-mode-map nil] 2) (defalias 'electric-buffer-list #[(arg) "À‰ˈ\n…2 qˆÄ Æ ˆebˆÇÈÀÉ# bˆ À‰“ˆƒ,Ê ‚1ËÌÉ!!)*‡" [nil buffer select ((byte-code "À‹ˆÁÂÃ!!ÅŽ qˆÆ ˆÇÈ )Á‡" [((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ˆ`Ê  ‰ bˆÎÇÅÏÐ  B%+‡" [message "<<< Press Space to bury the buffer list >>>" read-event unread-command-events 32 nil throw electric-buffer-menu-select 2 -1 0 goal-column last first 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 "\ 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}" "P"]) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#‡" [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 Electric-buffer-menu-mode mode-class special] 4) (defalias 'Electric-buffer-menu-mode #[nil "À ˆÁ\n!ˆÃÅÇÈ!ˆÉÊ Ê Í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 "\ 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."]) (byte-code "ÀÁÂÃ#ˆ „NÅ Å ÈA@Á\"ˆÉÊ#ˆÈA@Á\"ˆÉËÌ#ˆÉÍÎ#ˆÉÏ!Ñ#ˆÉÒÓ#ˆÉÔÕ#ˆÉÖ×#ˆÉØ×#ˆÉÙ×#ˆÉÚÛ#ˆÉÜÝ#ˆÉÞß#ˆÉàá#ˆÉâá#ˆÉãä#ˆÉåæ#ˆÉçè#ˆÉéê#ˆë,ëíXƒÌÉÏ,!î#ˆÉÊÏ,!Pî#ˆ,T‰,‚¨)Éïð#ˆÉñð#ˆÉòó#ˆÉôõ#ˆÉö÷#ˆÉøù#ˆÉú÷#ˆÉûù#ˆÉüý#ˆÉþÿ#ˆÉ@A#ˆÉBC#ˆÉDE#ˆÉFG#ˆÉHI#ˆ*JKL\"‡" [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 " " 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 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]] 6) (defalias 'Electric-buffer-menu-select #[nil "ÀÁ`\"‡" [throw electric-buffer-menu-select] 3 "\ 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." nil]) (defalias 'Electric-buffer-menu-quit #[nil "ÀÁÂ\"‡" [throw electric-buffer-menu-select nil] 3 "\ Leave Electric Buffer Menu, restoring previous window configuration. Does not execute select, save, or delete commands." nil]) (defalias (quote 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]) (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 "\ View buffer on current line in Electric Buffer Menu. Returns to Electric Buffer Menu when done." nil]) emacs-19.22/lisp/echistory.elc100666 13437 1 7571 5416164336 14732 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:52:14 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/echistory.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require electric chistory] 2) (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 "\ Edit current history line in minibuffer and execute result. With prefix arg NOCONFIRM, execute current line as-is without editing." "P"]) (byte-code "ÀÁ!„ „ÿà Ä ÅÆ#ˆÄ Çà #ˆÄ ÈÆ#ˆÄ ÉÊ#ˆÄ ËÌ#ˆÄ ÍÌ#ˆÄ ÎÏ#ˆÄ ÐÑ#ˆÄ ÒÓ#ˆÄ ÔÕ#ˆÄ Ö×#ˆÄ ØÙ#ˆÄ ÚÛ#ˆÄ ÜÝ#ˆÄ Þß#ˆÄ àá#ˆÄ âÂ#ˆÄ ãá#ˆÄ äá#ˆÄ åæ#ˆÄ ç(!é#ˆÄ êë#ˆÄ ìí#ˆÄ îï#ˆÄ ðñ#ˆÄ òñ#ˆÄ óô#ˆÄ õñ#ˆÄ öô#ˆÄ ÷ø#ˆÄ ùú#ˆÄ ûï#ˆÄ üñ#ˆÄ ýô#ˆÄ þø#ˆÄ ÿú#ˆÄ @A#ˆÄ BC#ˆÂ‡" [boundp electric-history-map nil 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] " " recenter "" scroll-other-window] 4) (defvar electric-command-history-hook nil "\ If non-nil, its value is called by `electric-command-history'.") (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ƒÅ ˆÆÇ!ˆÈÉÊ\"‡Ë ÍÉÎÏ#)‡" [((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 "\ \\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." nil]) (defalias (quote Electric-history-undefined) #[nil "À ˆÁÂÃ!!ˆÄÅ!‡" [ding message substitute-command-keys "Type \\[Help-for-help] for help, ? for commands, C-c to quit, Space to execute" sit-for 4] 3 nil nil]) (defalias 'Electric-history-quit #[nil "ÀÁ!…ÂÃ!ˆÄÅÆ\"‡" [boundp electric-history-in-progress message "" throw electric-history-quit nil] 3 "\ Quit Electric Command History, restoring previous window configuration." nil]) emacs-19.22/lisp/edebug.elc100666 13437 1 136567 5474621145 14224 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:59:16 1993 ;;; from file /home/fsf/rms/e19/lisp/edebug.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (defvar edebug-all-defuns nil "\ *If non-nil, all defuns and defmacros evaluated will use edebug. eval-defun without prefix arg and eval-region will use edebug-defun. If nil, eval-region evaluates normally, but eval-defun with prefix arg uses edebug-defun. eval-region is called by eval-defun, eval-last-sexp, and eval-print-last-sexp. You may wish to make this variable local to each Emacs Lisp buffer by calling (make-local-variable 'edebug-all-defuns) in your emacs-lisp-mode-hook. You can use the function edebug-all-defuns to toggle its value.") (defvar edebug-eval-macro-args nil "\ *If non-nil, edebug will assume that all macro call arguments for macros that have no edebug-form-hook may be evaluated, otherwise it will not. To specify exceptions for macros that have some arguments evaluated and some not, you should specify an edebug-form-hook") (defvar edebug-stop-before-symbols nil "\ *Non-nil causes edebug to stop before symbols as well as after. In any case, it is possible to stop before a symbol with a breakpoint or interrupt.") (defvar edebug-save-windows t "\ *If non-nil, save and restore window configuration on edebug calls. It takes some time to save and restore, so if your program does not care what happens to the window configurations, it is better to set this variable to nil.") (defvar edebug-save-point t "\ *If non-nil, save and restore the point and mark in source code buffers.") (defvar edebug-save-buffer-points nil "\ *If non-nil, save and restore the points of all buffers, displayed or not. Saving and restoring buffer points 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 all the points is an expensive operation since it visits each buffer twice for each edebug call, so it is best to avoid it if you can.") (defvar edebug-initial-mode (quote step) "\ *Global initial mode for edebug, if non-nil. This is used when edebug is first entered for each recursive-edit level. Possible values are nil (meaning keep using edebug-mode), step, go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast.") (defvar edebug-trace nil "\ *Non-nil if edebug should show 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-entry and edebug-print-trace-exit.") (defalias 'edebug-which-function #[nil "ŠÀ ˆÁ ˆÂÃ!ˆÄp!Å>„ÆÇ!ˆÄp!)‡" [end-of-defun beginning-of-defun down-list 1 read (defun defmacro) error "Not in defun or defmacro"] 2 "\ Return the symbol of the function we are in"]) (defalias 'edebug-last-sexp #[nil "ÀŠÁÂ!ˆ`)`{!@‡" [read-from-string forward-sexp -1] 3 "\ Return the last sexp before point in current buffer. Assumes Emacs Lisp syntax is active."]) (defalias 'edebug-window-list #[nil "À ‰Cà !‰ =„ \nBà !‰‚ \nŸ+‡" [selected-window first-window window-list next-window next] 3 "\ Return a list of windows, in order of next-window."]) (defalias 'edebug-get-buffer-points #[nil "ŠÀÁ \")‡" [mapcar #[(buf) "qˆ`B‡" [buf] 2] buffer-list] 3 "\ Return a list of buffer point pairs, for all buffers."]) (defalias 'edebug-set-buffer-points #[nil "ÀÁ\n\"‡" [mapcar #[(buf-point) "À @!… @qˆ Ab‡" [buffer-name buf-point] 2] edebug-buffer-points] 3 "\ Restore the buffer-points given by edebug-get-buffer-points."]) (defalias 'edebug-two-window-p #[nil "À ?…Á ‰Á !!=‡" [one-window-p selected-window next-window] 4 "\ Return t if there are two windows."]) (defalias 'edebug-macrop #[(object) "9ƒÁ!ƒK‰‚<…&@Â=…&ÃA!…&‡" [object fboundp macro edebug-functionp] 3 "\ Return the macro named by OBJECT, or nil if it is not a macro."]) (defalias 'edebug-functionp #[(object) "9ƒÁ!ƒK‰‚Â!„1Ã!„1<…2@Ä=…2A@<…2‡" [object fboundp subrp byte-code-function-p lambda] 3 "\ Returns the function named by OBJECT, or nil if it is not a function."]) (defalias 'edebug-sort-alist #[(alist function) "À Â\"‡" [sort alist #[(e1 e2) " @\n@\"‡" [function e1 e2] 3]] 3 "\ Return the ALIST sorted with comparison function FUNCTION. This uses 'sort so the sorting is destructive."]) (put (quote edebug-save-restriction) (quote edebug-form-hook) (quote (&rest form))) (defalias 'edebug-save-restriction '(macro . #[(&rest body) "ÀÁÂÃÄ \"ÆEE‡" [let ((edebug:s-r-beg (point-min-marker)) (edebug:s-r-end (point-max-marker))) unwind-protect append (progn) body (save-excursion (set-buffer (marker-buffer edebug:s-r-beg)) (narrow-to-region edebug:s-r-beg edebug:s-r-end))] 6 "\ 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."])) (defalias 'edebug-all-defuns #[nil "?Áƒ ÂÄ\"‡" [edebug-all-defuns message "Edebugging is %s." "on" "off"] 3 "\ Toggle edebugging of all defuns and defmacros, not including those evaluated in the minibuffer, or during load." nil]) (byte-code "ÀÁ!„ ÁÂKMˆÀ‡" [fboundp edebug-emacs-eval-defun eval-defun] 2) (defalias 'eval-defun #[(edebug-debug) "? ?=?ÂÃ!)‡" [edebug-debug edebug-all-defuns edebug-emacs-eval-defun nil] 2 "\ Edebug replacement for eval-defun. Print value in the minibuffer. Evaluate the top-level form that point is in or before. Note: eval-defun normally evaluates any top-level form, not just defuns. Here are the differences from the standard eval-defun. If the prefix argument is the same as edebug-all-defuns (nil or non-nil), evaluate normally; otherwise edebug-defun is called to wrap edebug calls around evaluatable expressions in the defun or defmacro body. Also, the value printed by edebug-defun is not just the function name." "P"]) (byte-code "ÀÁ!„ ÁÂKMˆÀ‡" [fboundp edebug-emacs-eval-region eval-region] 2) (defalias 'eval-region #[(edebug-e-r-start edebug-e-r-end &optional edebug-e-r-output) "†Á`pp ēÄ \n bˆÌ ˆ`Wƒž ƒIÎ Ï=ƒIŠÐuˆÑ Ò>)ƒIÓ ˆÔÐ!ˆ‚Î Ï=ƒdŠÐuˆÑ Õ>)ƒdÖ× ØÙ #ˆÑ ŠqˆÚ !p)ƒ B\nÜ=ƒŒÝ !ˆ‚Þ !ˆ`]Ì ˆ`^bˆ‚ „ªqˆ bˆ.ć" [edebug-e-r-output symbolp make-marker edebug-e-r-end nil edebug-e-r-val edebug-e-r-end-marker edebug-e-r-inside-buf edebug-e-r-buf edebug-e-r-pnt standard-output edebug-e-r-start edebug-skip-whitespace edebug-all-defuns edebug-next-token-class lparen 1 edebug-read-sexp (defun defmacro) edebug-defun forward-sexp (defun defmacro) put edebug-which-function edebug point-marker eval values t prin1 print] 7 "\ Edebug replacement for eval-defun. Like eval-region, but call edebug-defun for defuns or defmacros. Also, this eval-region does not narrow to the region and if an error occurs, point is left at the error." "r"]) (defalias 'edebug-eval-current-buffer #[(&optional edebug-e-c-b-output) "Àed #‡" [eval-region edebug-e-c-b-output] 4 "\ Call eval-region on the whole buffer." nil]) (defalias 'edebug-eval-buffer #[(&optional buffer edebug-e-c-b-output) "ŠqˆÁed\n#)‡" [buffer eval-region edebug-e-c-b-output] 4 "\ Call eval-region on the whole buffer." "bEval buffer: "]) (byte-code "ÀÁ!ƒÀÂ!„ÂÁKMˆÁÃMˆÀÄ!ƒ*ÀÅ!„*ÅÄKMˆÄÆMˆÀ‡" [fboundp eval-current-buffer edebug-emacs-eval-current-buffer edebug-eval-current-buffer eval-buffer edebug-emacs-eval-buffer edebug-eval-buffer] 2) (defalias 'edebug-defun #[nil "À‰‰‰‰ÁÀ‰`À \n   ÎÏЈ . ‡" [nil 0 t parse-sexp-ignore-comments tmp-point starting-point edebug-func-mark edebug-offset-list edebug-offset-index defun-interactive def-docstring def-args def-name def-kind err (byte-code "À ˆÁ ˆÂÃ!ˆÄ Æ ‰È=„$É=„$ÊË\"ˆÆ ‰ 9„3ÊÍ \"ˆÆ ‰<„BÊÏ\"ˆ`Ñ Ò=ƒSÆ `Ñ Ô=ƒpÃuˆÆ Õ=ƒpÕÖ BÃuˆ`bˆ ØÙÚ DÚDÚÛÜÝÞ!\"DF¯MˆÉ=ƒ£ ß KBMˆ bˆá â ãä%Ÿ!E#ˆæç \"‡" [end-of-defun beginning-of-defun down-list 1 point-marker edebug-func-mark edebug-read-sexp def-kind defun defmacro edebug-syntax-error "%s is not a defun or defmacro." def-name "Bad defun name: %s" def-args "Bad defun arg list: %s" tmp-point edebug-next-token-class string def-docstring lparen interactive edebug-interactive defun-interactive lambda edebug-enter quote append (progn) edebug-sexp-list t macro starting-point put edebug nil vconcat edebug-offset-list message "edebug: %s"] 14) ((invalid-read-syntax (byte-code "ŠbˆÁÂ!ˆ)ÃÄ A\"‡" [starting-point set-mark-command nil message "Syntax error: %s" err] 3)))] 11 "\ Evaluate defun or defmacro, like eval-defun, but with edebug calls. Print its name in the minibuffer and leave point after any error it finds, with mark at the original point." nil]) (defalias 'edebug-sexp-list #[(debuggable) "À Ã=„ ƒÅ ‚Æ B‚ Ÿ)‡" [nil sexp-list edebug-next-token-class rparen debuggable edebug-form edebug-read-sexp] 2 "\ Return an edebug form built from the sexp list following point in the current buffer. If DEBUGGABLE then wrap edebug calls around each sexp. The sexp list does not start with a left paren; we are already in the list. Leave point at (before) the trailing right paren."]) (defalias (quote edebug-increment-offset) #[nil "T` Z\nB‰‡" [edebug-offset-index edebug-func-mark edebug-offset-list] 2]) (defalias 'edebug-make-edebug-form #[(index form) "À \nà DFÅ ˆ‡" [edebug index edebug-offset-index quote form edebug-increment-offset] 5 "\ Return the edebug form for the current function at offset INDEX given FORM. Looks like: (edebug def-name INDEX edebug-offset-index 'FORM). Also increment the offset index."]) (defalias 'edebug-form #[nil "ÂÂÅ ˆÆ ˆÇ ‰È=ƒÉ Ê \"‚> Ë=ƒ<Ì ‰Í>„8 §„8É \"‚> ‚>Ì +‡" [edebug-offset-index index nil form class edebug-skip-whitespace edebug-increment-offset edebug-next-token-class lparen edebug-make-edebug-form edebug-list symbol edebug-read-sexp (nil t)] 4 "\ Return the debug form for the following form. Add the point offset to the edebug-offset-list for the function and move point to immediately after the form."]) (defalias 'edebug-list #[nil "`À‰ÄuˆÅ ‰Æ=ƒÇ ‚3\nÈ=ƒ$É ‚3\nÊ=ƒ/À‚3ËÌ!ˆ …Õ ‰Í>ƒCÎ ‚Ô Ï>ƒNÐ ‚Ô Ñ=ƒYÒ ‚Ô Ó=ƒdÔ ‚Ô Õ>ƒpÖÀ!‚Ô ×=ƒˆÅ È=ƒ‚É ‚„Ç C‚ÔØ !ƒÅ 9ƒ¾ ÙN‰…ºÛ=ƒ©ÖÛ!‚ºÜ=ƒ¶ÖÀ!‚ºÝ!)†ÔÖ!‚Ô ß=ƒÑËà!‚ÔÖÛ!BÅ Ê=ƒâÄuˆ‚æËá!ˆ+‡" [nil head class beginning 1 edebug-next-token-class symbol edebug-read-sexp lparen edebug-anonymous rparen edebug-syntax-error "Head of list must be a symbol or lambda expression." (let let*) edebug-let (setq setq-default) edebug-setq cond edebug-cond condition-case edebug-condition-case (quote defun defvar defconst defmacro) edebug-sexp-list function edebug-macrop edebug-form-hook form t 0 edebug-form-parser edebug-eval-macro-args interactive "interactive not expected here." "Too many arguments."] 4 "\ Return an edebug form built from the list form that follows point. Insert debug calls as appropriate to the form. Start with point at the left paren. Leave point after the right paren."]) (defalias 'edebug-form-parser #[(args) "Á‰‰‰‰‰‰  ƒ)Ê ‰Ë=„)Ì͈‚ ƒB „B „B @Î>„BÏÐ!ˆÊ Ë=„X\nƒTÏÑ!ˆ‚XÏÒ!ˆŸ.‡" [args nil &or &rest &optional class form-list form arg arglist edebug-next-token-class rparen no-match (byte-code "@A\nƒ„\n Ã>ƒ\" LˆÄÅÆ\"ˆ‚£ Ç=ƒ/È ‚£ É=ƒ<Ê ‚£ <ƒu @Ë=ƒ`` A@‰Ê ‰=„\\Í ˆ)‚£Ï=ƒ£ÐuˆÑ !Ðuˆ‚£ 9ƒž`Ò !…ƒ K ƒšÊ ‰!„šÍ ˆ*‚£ÄÅÆ\"ˆÆBƇ" [arglist arg &rest (&optional &rest &or) throw no-match nil form edebug-form sexp edebug-read-sexp quote pnt edebug-form-parser-error class lparen 1 edebug-form-parser fboundp pred &optional form-list] 4) (&optional &rest) edebug-syntax-error "Not enough arguments." "Unrecognized argument." "Too many arguments."] 8 "\ Parse the macro arguments that follow based on ARGS. ARGS describes the types of the arguments of a list form. Each of the ARGS is processed left to right, in the same order as the arguments of the list form. See the edebug documentation for more details. The ARGS may be one of the following: symbolp - an unevaluated symbol integerp - an unevaluated number stringp - an unevaluated string vectorp - an unevaluated vector atom - an unevaluated number, string, symbol, or vector sexp - an unevaluated sexp (atom or list); may not be empty form - an evaluated sexp; may not be empty foo - any other symbol should be the name of a function; this function is called on the argument as a predicate and an error is signaled if the predicate fails. &optional - one following arg in the list may or may not appear. &rest - all following args are repeated zero or more times as a group. This is an extension of the normal meaning of &rest. &or - each of the following args are alternatives, processed left to right until one succeeds. There is no way to group more than one list element as one alternative. (...) - a sublist, of the same format as the top level, processed recursively. Special case: if the car of the list is quote, the argument must match the quoted sexp (see example below of 'for macro). "]) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#ˆÃÇÅÈ#ˆÃÉÅÊ#ˆÃËÅÃÌÅÍ##ˆÃÎÅÃÏÅÐ##ˆÃÑÅÒ#‡" [defalias edebug-form-parser-error #[nil "bˆ ƒ ÂÃÄ\"‡ ƒÄÂÃÄ\"‡ÆÇ #‡" [pnt &or throw no-match nil &optional edebug-syntax-error "%s is not %s" form arg] 4] put for edebug-form-hook (symbolp (quote from) form (quote to) form (quote do) &rest form) case (form &rest (sexp form)) do ((&rest &or symbolp (symbolp &optional form &optional form)) (form &rest form) &rest body) defvar defconst (symbolp &optional form &optional stringp) defun defmacro (symbolp (&rest symbolp) &optional stringp &optional ((quote interactive) &or stringp form) &rest form) anonymous (&optional (quote macro) (quote lambda) (&rest symbolp) &rest form)] 7) (defalias 'edebug-anonymous #[nil "ÀuˆÁ ‰Ã=ƒÄ ‚,\nÅ=ƒ)Á Ã=„\"ÆÇ!ˆÅÄ B‚,ÆÈ!)Àuˆ‡" [1 edebug-read-sexp head lambda edebug-lambda macro edebug-syntax-error "lambda expected." "Anonymous lambda or macro expected."] 3 "\ Return the edebug form for an anonymous lambda or macro. Point starts before the left paren and ends after it."]) (defalias 'edebug-lambda #[nil "ÀÁ DÃÄ!\"‡" [append lambda edebug-read-sexp edebug-sexp-list t] 4 "\ Return the edebug form for the lambda form that follows. Point starts after the lambda symbol and is moved to before the right paren."]) (byte-code "ÀÁÂÀÃÂÄ##‡" [put let edebug-form-hook let* ((&rest &or (symbolp &optional form) symbolp) &rest form)] 7) (defalias 'edebug-let #[nil "À‰‰Ä Å=„Æ ‰ƒÇÈ!‚V\n‚VÉuˆÄ ‰Ê=„Q Å=„5Æ ‚KÉuˆË Ä Ê=„HÇÌ!ˆ‚KÉuˆ B‚!Éuˆ ŸÍÎ!+B‡" [nil class token var-value-list edebug-next-token-class lparen edebug-read-sexp edebug-syntax-error "Bad var list in let." 1 rparen edebug-var-value "Right paren expected in let." edebug-sexp-list t] 3 "\ Return the edebug form of the let or let* form. Leave point before the right paren."]) (defalias 'edebug-var-value #[nil "À Á Â=?… à D‡" [edebug-read-sexp edebug-next-token-class rparen edebug-form] 3 "\ Return the edebug form of the var and optional value that follow point. Leave point after the value, if there is one."]) (byte-code "ÀÁÂÀÃÂÄ##‡" [put setq edebug-form-hook setq-default (&rest symbolp form)] 7) (defalias 'edebug-setq #[nil "À Ã=„Ä Å \"‚ )‡" [nil var-value-list edebug-next-token-class rparen append edebug-var-value] 3 "\ Return the edebug form of the setq or setq-default var-value list."]) (put (quote interactive) (quote edebug-form-hook) (quote (&optional &or stringp form))) (defalias 'edebug-interactive #[nil "À Á=?…)À Â=ƒà ‚)ÄÅDÅÇ DEÀ Á=„)ÈÉ!ˆC‡" [edebug-next-token-class rparen string edebug-read-sexp edebug-interactive-entry quote def-name edebug-form edebug-syntax-error "Only first expression used in interactive form."] 4 "\ Return the edebug form of the interactive form."]) (put (quote cond) (quote edebug-form-hook) (quote (&rest (form &rest form)))) (defalias 'edebug-cond #[nil "À‰à ‰Ä=„G Å=„\"Æ ‰…ÈÉ!)‚AÊuˆË à Ä=?…2ÌÍ!Bà Ä=„>ÈÎ!ˆÊuˆ\nB‚\nŸ*‡" [nil class value-value-list edebug-next-token-class rparen lparen edebug-read-sexp thing edebug-syntax-error "Condition expected in cond" 1 edebug-form edebug-sexp-list t "Right paren expected in cond"] 4 "\ Return the edebug form of the cond form."]) (put (quote condition-case) (quote edebug-form-hook) (quote (symbolp form &rest (symbolp &optional form)))) (defalias 'edebug-condition-case #[nil "À ‰9„ÃÄ \"ˆ )Å À‰È ‰É=„LÊ=„0ÃË!‚DÌuˆÂ È É=?…@ÍÎ!BÌuˆB‚Ÿ*BB‡" [nil token edebug-read-sexp edebug-syntax-error "Variable or nil required for condition-case; found: %s" edebug-form class symb-sexp-list edebug-next-token-class rparen lparen "Bad handler in condition-case." 1 edebug-sexp-list t] 6 "\ Return the edebug form of the condition-case form."]) (defalias 'edebug-syntax-error #[(msg &rest args) "ÀÁÂà #\"‡" [signal invalid-read-syntax apply format msg args] 6 "\ Signal an invalid-read-syntax with MSG and ARGS. This is caught by edebug-defun."]) (defalias 'edebug-skip-whitespace #[nil "ÀÁwˆgÂU…ÃÁwˆÀÁwˆ‚‡" [" \n " nil 59 "^\n "] 2 "\ Leave point before the next token, skipping white space and comments."]) (defalias 'edebug-read-sexp #[nil "À ˆgÃU„gÄUƒÅp!‚&ŠÅp!`)Æ`Ç\"^bˆ )‡" [nil token edebug-skip-whitespace 91 63 read scan-sexps 1] 4 "\ 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."]) (defconst edebug-syntax-table (byte-code "ÀÁÂ\"‰ÄÅIˆ ÆÇIˆ ÈÉIˆ ÊËIˆ ÌÍIˆ ÎÏIˆ ÐÑIˆ )‡" [make-vector 256 symbol table 40 lparen 41 rparen 39 quote 34 string 63 char 91 vector 46 dot] 4) "\ Lookup table for the token class of each character.") (defalias 'edebug-next-token-class #[nil "À ˆ gH‡" [edebug-skip-whitespace edebug-syntax-table] 2 "\ Move to the next token and return its class. We only care about lparen, rparen, dot, quote, string, char, vector, or symbol."]) (defvar edebug-active nil "\ Non-nil when edebug is active") (byte-code "À ž„ ÀÂD BÀ‡" [edebug-active minor-mode-alist " *Debugging*"] 2) (defvar edebug-backtrace nil "\ Stack of active functions evaluated via edebug. Should be nil at the top level.") (defvar edebug-offset-indices nil "\ Stack of offset indices of visited edebug sexps. Should be nil at the top level.") (defvar edebug-entered nil "\ Non-nil if edebug has already been entered at this recursive edit level.") (defalias 'edebug-enter #[(edebug-func edebug-args edebug-body) "„\n ƒ\n à >?…  >?… ÇN‰@ Ê !  B  Î\\ Ð\\ƒn GSÒÕÖ $ˆØ!ÚÖ $ˆ*‚rØ!. ‡" [edebug-entered edebug-initial-mode edebug-mode t edebug-func pre-command-hook post-command-hook edebug edebug-data edebug-func-mark marker-buffer edebug-buffer edebug-backtrace max-lisp-eval-depth 6 max-specpdl-size 10 edebug-trace nil edebug-result edebug-stack-depth edebug-print-trace-entry "*edebug-trace*" edebug-args eval edebug-body edebug-print-trace-exit] 6 "\ 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-defun is entered. Return the result of BODY."]) (defalias 'edebug-interactive-entry #[(edebug-func edebug-args) "„\n ƒ\n à ÅN‰@È! Ê !,‡" [edebug-entered edebug-initial-mode edebug-mode t edebug-func edebug edebug-data edebug-func-mark marker-buffer edebug-buffer eval edebug-args] 3 "\ Evaluating FUNCs non-string argument of interactive form ARGS."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias edebug-print-trace-entry #[(edebug-stream edebug-function edebug-args edebug-stack-depth) "À Âà Å\"$‡" [edebug-trace-display edebug-stream "%sEnter: %s\n" make-string edebug-stack-depth 32 edebug-function] 6] edebug-print-trace-exit #[(edebug-stream edebug-function edebug-result edebug-stack-depth) "À Âà Å\"$‡" [edebug-trace-display edebug-stream "%sExit: %s\n" make-string edebug-stack-depth 32 edebug-function] 6]] 3) (defalias 'edebug #[(edebug-before-index edebug-after-index edebug-exp) "Á\\\nÃ\\ BÇ Ê=ƒ&Ë „&Ì !‚6Î Ï #ˆÎÑÌ !#-‡" [max-lisp-eval-depth 5 max-specpdl-size 7 edebug-before-index edebug-offset-indices executing-macro nil edebug-outside-executing-macro edebug-mode Go-nonstop edebug-input-pending-p eval edebug-exp edebug-debugger enter edebug-after-index exit] 5 "\ Debug current function given BEFORE and AFTER positions around EXP. BEFORE and AFTER are indexes into the position offset vector in the functions 'edebug property. edebug is called from functions compiled with edebug-defun."]) (defalias 'edebug-debugger #[(edebug-offset-index edebug-arg-mode edebug-exp) "A@\n ž‰… A@‰?†Å !)‰ƒ1 AA@ƒ1Ç \"AAB¡ˆÉ>„J\n„T Ì=ƒT 9ƒTÎ „TƒWÏ ˆ +‡" [edebug-data edebug-breakpoints edebug-offset-index edebug-break-data edebug-break-condition eval edebug-break delq edebug-mode (go continue Continue-fast) edebug-stop-before-symbols edebug-arg-mode enter edebug-exp edebug-input-pending-p edebug-display] 5 "\ Determine if edebug display should be updated."]) (defvar edebug-window-start 0 "\ Remember where each buffers' window starts between edebug calls. This is to avoid spurious recentering.") (byte-code "ÀÁÂ\"ˆÃÁ!‡" [set-default edebug-window-start 0 make-variable-buffer-local] 3) (defalias 'edebug-display #[nil "ÀÁ\n AA@ H\\ …Æ Á‰Ç p`ÈÀ!Á‰‰‰ …$Ê    Á‰‰‰‰   \n á\"!„nÁ#äå&\"ˆ)'ƒwè é\"!ˆÇ ê\n!ˆë!ˆ,ƒ—`ÈÀ!í î /0ñŽed~ˆbˆò3!3ô ƒÁõ6Àß ˆ÷ ˆ8ù=ƒÕ:;û ˆ‚8ä=ƒü ˆ:@ý=ƒîþÿ!ˆ‚þ@:@AN:A@#ˆ‚BƒþC!ˆ‚þD!ˆBƒI6E>„*À‚n6F=ƒ>GH!ˆ‚nGI!ˆ‚n6J=ƒ]GH!ˆ‚n6K=ƒnGI!ˆLŽ„…6õ=„…8ä=ƒõ6÷ ˆM ˆ),ƒ®\"qˆbˆN ƒ®N Á“ˆ+'ƒ»O!ˆqˆbˆN …ÒN Á“.‡" [t nil edebug-func-mark edebug-data edebug-offset-index edebug-save-buffer-points edebug-get-buffer-points selected-window mark edebug-eval-list edebug-eval-result-list overlay-arrow-position overlay-arrow-string cursor-in-echo-area edebug-outside-point-max edebug-outside-point-min edebug-outside-c-i-e-a edebug-outside-o-a-s edebug-outside-o-a-p edebug-eval-buffer edebug-outside-edebug-mark edebug-outside-edebug-point edebug-outside-windows edebug-outside-mark edebug-outside-point edebug-outside-buffer edebug-outside-window edebug-inside-window edebug-window edebug-buffer-points edebug-point edebug-stop edebug-active buffer-name edebug-buffer debug-on-error error "Buffer defining %s not found" edebug-func edebug-save-windows edebug-current-window-configuration edebug-pop-to-buffer edebug-eval-display select-window edebug-save-point point-min-marker point-max-marker edebug:s-r-end edebug:s-r-beg ((byte-code "ŠÀ !qˆ \n}ˆ)À‡" [marker-buffer edebug:s-r-beg edebug:s-r-end] 2)) edebug-adjust-window edebug-window-start edebug-input-pending-p step edebug-mode edebug-overlay-arrow edebug-arg-mode exit edebug-exp edebug-previous-result beep quit message "Quit" "%s: %s" error-message edebug-break "Break" "" (continue Continue-fast) continue edebug-sit-for 1 0 trace Trace-fast ((byte-code "ƒÁ ˆÂ !‡" [edebug-save-buffer-points edebug-set-buffer-points select-window edebug-outside-window] 2)) edebug-recursive-edit mark-marker edebug-set-window-configuration] 23 "\ Setup windows for edebug, determine mode, maybe enter recursive-edit."]) (defvar edebug-depth 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.") (defalias 'edebug-recursive-edit #[nil "Š qˆÂ ) TÄ Å‰‰Æ  \n   \n      \n Ü=ƒ^Þ>„^ßà!ˆÛ ˆáâ!ƒk\" ãäŽå .‡" [buffer-read-only edebug-outside-buffer match-data edebug-depth recursion-depth nil current-local-map standard-output standard-input last-command-char last-command this-command last-input-char debug-on-error edebug-outside-last-input-char edebug-outside-this-command edebug-outside-last-command edebug-outside-last-command-char edebug-outside-standard-input edebug-outside-standard-output edebug-outside-map edebug-inside-windows edebug-backtrace-buffer edebug-entered edebug-recursion-depth edebug-outside-match-data edebug-buffer-read-only edebug-mode go edebug-arg-mode (exit error) message "Break" boundp edebug-outside-debug-on-error t ((byte-code "ƒÁ!ˆ\nƒÁ\n!ˆÃ Å!ˆÇ!ƒMqˆ Ê>ƒ-Ë ˆ  Î!ˆÐ!ˆÒ!=ƒIÓ Ð !ˆÁ‡" [edebug-backtrace-buffer kill-buffer edebug-eval-buffer selected-window edebug-inside-window store-match-data edebug-outside-match-data buffer-name edebug-buffer edebug-mode (go Go-nonstop) edebug-overlay-arrow edebug-buffer-read-only buffer-read-only use-local-map edebug-outside-map select-window edebug-window window-buffer window-start edebug-window-start] 3)) recursive-edit] 19 "\ Start up a recursive edit inside of edebug."]) (defalias 'edebug-adjust-window #[(old-start) "À „4Á \"ˆÀ „4Ä `Á Š Wƒ%Ç‚*È É¥[yˆÊyˆ`)\"ˆ*Ä ‡" [pos-visible-in-window-p set-window-start selected-window old-start window-start pnt start -1 window-height 2 0] 4 "\ Adjust window to fit as much as possible following point. The display should prefer to start at OLD-START if point is not visible. Return the new window-start."]) (defconst edebug-arrow-alist (quote ((Continue-fast . ">") (Trace-fast . ">") (continue . ">") (trace . "->") (step . "=>") (go . "<>") (Go-nonstop . ".."))) "\ Association list of arrows for each edebug mode. If you come up with arrows that make more sense, let me know.") (defalias 'edebug-overlay-arrow #[nil "ÀŠÂyˆ`) žAÆ ‰ p“)‡" [nil pos 0 edebug-mode edebug-arrow-alist overlay-arrow-string make-marker overlay-arrow-position] 4 "\ Set up the overlay arrow at beginning-of-line in current buffer. The arrow string is derived from edebug-arrow-alist and edebug-mode."]) (put (quote edebug-outside-excursion) (quote edebug-form-hook) (quote (&rest form))) (defalias 'edebug-outside-excursion '(macro . #[(&rest body) "ÀÁÂÃÄÅÆÇÈÉ\n\"EËÌFEF‡" [save-excursion (if edebug-save-windows (progn (setq edebug-inside-windows (edebug-current-window-configuration)) (edebug-set-window-configuration edebug-outside-windows))) (set-buffer edebug-buffer) let ((edebug-inside-map (current-local-map)) (last-command-char edebug-outside-last-command-char) (last-command edebug-outside-last-command) (this-command edebug-outside-this-command) (last-input-char edebug-outside-last-input-char) (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) (standard-output edebug-outside-standard-output) (standard-input edebug-outside-standard-input) (executing-macro edebug-outside-executing-macro)) unwind-protect save-restriction (narrow-to-region edebug-outside-point-min edebug-outside-point-max) append (save-excursion (if edebug-save-point (progn (goto-char edebug-outside-edebug-point) (if (mark-marker) (set-marker (mark-marker) edebug-outside-edebug-mark)))) (use-local-map edebug-outside-map) (store-match-data edebug-outside-match-data) (select-window edebug-outside-window) (set-buffer edebug-outside-buffer) (goto-char edebug-outside-point)) body (use-local-map edebug-inside-map) (if edebug-save-windows (edebug-set-window-configuration edebug-inside-windows))] 11 "\ Evaluate an expression list in the outside context. Return the result of the last expression."])) (defalias 'edebug-toggle-save-windows #[nil "?‰ƒ Á ‰ÄŃƂÇ\"‡" [edebug-save-windows edebug-current-window-configuration edebug-outside-windows edebug-inside-windows message "Window saving is %s." "on" "off"] 3 "\ Toggle the edebug-save-windows variable. Each time you toggle it, the inside and outside window configurations become the same as the current configuration." nil]) (defalias 'edebug-where #[nil "„ÁÂ!ˆÃ !ˆ b‡" [edebug-active error "edebug is not active" edebug-pop-to-buffer edebug-buffer edebug-point] 2 "\ Show the debug windows and where we stopped in the program." nil]) (defalias 'edebug-view-outside #[nil "„ÁÂ!ˆÃ Å!ˆbˆÈÉÊË!\"‡" [edebug-active error "edebug is not active" edebug-current-window-configuration edebug-inside-windows edebug-set-window-configuration edebug-outside-windows edebug-outside-point message "Window configuration outside of edebug. Return with %s" substitute-command-keys "\\\\[edebug-where]"] 4 "\ Change to the outside window configuration." nil]) (defalias 'edebug-bounce-point #[nil "„ÁÂ!ˆŠÃ‹)‡" [edebug-active error "edebug is not active" ((byte-code "À !ˆ\nbˆÃÄ!ˆÀ !‡" [edebug-pop-to-buffer edebug-outside-buffer edebug-outside-point edebug-sit-for 1 edebug-buffer] 2))] 2 "\ Bounce the point in the outside current buffer." nil]) (defvar edebug-epoch-running (byte-code "ÀÁ!… ‡" [boundp epoch::version] 2) "\ non-nil if epoch is running. Windows are handled a little differently under epoch.") (defalias 'edebug-current-window-configuration #[nil "ƒÁ ‡Â ‡" [edebug-epoch-running edebug-current-screen-configuration current-window-configuration] 1 "\ Return the current window or frame configuration."]) (defalias 'edebug-set-window-configuration #[(conf) "ƒÁ\n!‡Ã\n!‡" [edebug-epoch-running edebug-set-screen-configuration conf set-window-configuration] 2 "\ Set the window or frame configuration to CONF."]) (defalias (quote edebug-get-buffer-window) #[(buffer) "ƒÁ\n!‡Ã\n!‡" [edebug-epoch-running epoch::get-buffer-window buffer get-buffer-window] 2]) (defalias 'edebug-pop-to-buffer #[(buffer) "À !‰ƒÃ\n!ˆ‚9 ƒ ÅÆÇ \"@†È !ˆÉ ƒ(Ê ˆÃË !ˆÌÍ \"ˆÎÍ Ï\"ˆ) q‡" [edebug-get-buffer-window buffer edebug-window select-window edebug-epoch-running select-screen symbol-buffer-value allowed-screens epoch::current-screen one-window-p split-window next-window set-window-buffer selected-window set-window-hscroll 0] 5 "\ Like pop-to-buffer, but select a frame that buffer was shown in."]) (defalias 'edebug-current-screen-configuration #[nil "ÀÁ! p Æ \"BÇÈ \"É !ˆ qˆ+‡" [epoch::screen-list unmapped epoch::get-screen current-buffer current-screen screen-list delq mapcar #[(screen) "Á!ˆÂ B‡" [screen epoch::select-screen current-window-configuration] 3] epoch::select-screen] 4 "\ Return an object recording the current configuration of Epoch screen-list. The object is a list of pairs of the form (SCREEN . CONFIGURATION) where SCREEN has window-configuration CONFIGURATION. The current screen is the head of the list."]) (defalias 'edebug-set-screen-configuration #[(sc) "ÀÁ\n\"ˆÃ\n@@!…Ä\n@@!‡" [mapcar #[(screen-conf) "À @!… @!ˆÃ A!‡" [epoch::screen-p screen-conf epoch::select-screen set-window-configuration] 2] sc epoch::screen-p epoch::select-screen] 3 "\ Set the window-configuration for all the screens in SC. Set the current screen to be the head of SC."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias edebug-sit-for #[(arg) "ƒÁ ˆÂ !‡" [edebug-epoch-running epoch::dispatch-events sit-for arg] 2] edebug-input-pending-p #[nil "ƒÁ ˆÂ ‡" [edebug-epoch-running epoch::dispatch-events input-pending-p] 1]] 3) (defalias 'edebug-find-stop-point #[nil "À ‰ÂN† ÃÄ \"‰@ A@ AA@ŠÉÊ!ƒ(ËÌxˆ`)Z ÌÌGÐÐWƒX HVƒXT‰‚>Wƒr HXƒr B‚vÑÒ \".‡" [edebug-which-function def-name edebug error "%s must first be evaluated with edebug-defun" edebug-data edebug-func-mark edebug-breakpoints offset-vector looking-at "[ ]" " " nil offset len i 0 message "Point is not on an expression in %s."] 4 "\ Return (function . index) of the nearest edebug stop point."]) (defalias 'edebug-next-breakpoint #[nil "À ‰…Š @ A\nÄN‰@ A@ AA@É\n„.ËÌ!‚ˆ‰ ƒH @@ XƒH A‰ „6 ƒS @‚V@\n\n@H\\bˆË\nAA@ƒp΂qÏ\nA@ƒ„ÐÑÒ\nA@!\"‚…ÏP!).)‡" [edebug-find-stop-point edebug-stop-point def-name index edebug edebug-data edebug-func-mark edebug-breakpoints offset-vector nil breakpoint message "No breakpoints in this function." breaks "Temporary " "" format "Condition: %s" prin1-to-string] 7 "\ Move point to the next breakpoint, or first if none past point." nil]) (defalias 'edebug-modify-breakpoint #[(flag &optional condition temporary) "À ‰…p @ A\nÄN‰@ A@ AA@É\n ž\nË\n\" ƒLÍ EBÐ\"ÑÒ\n\"ˆ‚]\nƒYÑÓ\n\"ˆ‚]ÑÔ!ˆ  AAB¡ˆ H\\b.)‡" [edebug-find-stop-point edebug-stop-point def-name index edebug edebug-data edebug-func-mark edebug-breakpoints offset-vector nil present delq flag edebug-sort-alist condition temporary < message "Breakpoint set in %s." "Breakpoint unset in %s." "No breakpoint here."] 5 "\ 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-set-breakpoint #[(arg) "ÀÁ #‡" [edebug-modify-breakpoint t nil arg] 4 "\ Set the breakpoint of nearest sexp. With prefix argument, make it a temporary breakpoint." "P"]) (defalias 'edebug-unset-breakpoint #[nil "ÀÁ!‡" [edebug-modify-breakpoint nil] 2 "\ Clear the breakpoint of nearest sexp." nil]) (defalias 'edebug-set-conditional-breakpoint #[(arg condition) "ÀÁ\n #‡" [edebug-modify-breakpoint t condition arg] 4 "\ Set a conditional breakpoint at nearest sexp. The condition is evaluated in the outside context. With prefix argument, make it a temporary breakpoint." "P\nxCondition: "]) (defalias 'edebug-set-mode #[(mode shortmsg msg) " Wƒp =…Å!ˆÇ ‡Å!‡" [mode edebug-mode 0 edebug-depth edebug-buffer message shortmsg exit-recursive-edit msg] 2 "\ Set the edebug mode to MODE. Display SHORTMSG, or MSG if not within edebug." nil]) (defalias 'edebug-step-through #[nil "ÀÁÂÃ#‡" [edebug-set-mode step "" "edebug will stop before next eval."] 4 "\ Proceed to next debug step." nil]) (defalias 'edebug-go #[(arg) "ƒÁÂ!ˆÃÄÅÆ#‡" [arg edebug-set-breakpoint t edebug-set-mode go "Go..." "edebug will go until break."] 4 "\ Go, evaluating until break. With ARG set temporary break at stop point and go." "P"]) (defalias 'edebug-Go-nonstop #[nil "ÀÁÂÃ#‡" [edebug-set-mode Go-nonstop "Go-Nonstop..." "edebug will not stop at breaks."] 4 "\ Go, evaluating without debugging." nil]) (defalias 'edebug-forward-sexp #[(arg) "ÀÁ‡" [err (byte-code "À !ˆÄÀ!)‡" [t parse-sexp-ignore-comments forward-sexp arg edebug-go] 2) ((error (edebug-step-out)))] 3 "\ 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." "p"]) (defalias 'edebug-step-out #[nil "ÀÁ‡" [err (byte-code "ÀÂÃ!ˆŠÂÃ!ˆ)ÄÀ!)‡" [t parse-sexp-ignore-comments up-list 1 edebug-go] 2) ((error (byte-code "`ÁÂ!ˆ`Uƒà ‚ÄÅ!)‡" [start-point down-list -1 edebug-step-through edebug-go t] 2)))] 3 "\ 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." nil]) (defalias 'edebug-goto-here #[nil "ÀÁ!‡" [edebug-go t] 2 "\ Proceed to this stop point." nil]) (defalias 'edebug-trace #[nil "ÀÁÂÃ#‡" [edebug-set-mode trace "Tracing..." "edebug will trace with pause."] 4 "\ Begin trace mode." nil]) (defalias 'edebug-Trace-fast #[nil "ÀÁÂÃ#‡" [edebug-set-mode Trace-fast "Trace fast..." "edebug will trace without pause."] 4 "\ Trace with no wait at each step." nil]) (defalias 'edebug-continue #[nil "ÀÁÂÃ#‡" [edebug-set-mode continue "Continue..." "edebug will pause at breakpoints."] 4 "\ Begin continue mode." nil]) (defalias 'edebug-Continue-fast #[nil "ÀÁÂÃ#‡" [edebug-set-mode Continue-fast "Continue fast..." "edebug will stop and go at breakpoints."] 4 "\ Trace with no wait at each step." nil]) (defalias 'edebug-step-in #[nil "Á=„\nÂÃ!ˆ @‰ÆNÈ!ƒ+ŠÉ!qˆbˆÊ ˆ)‚6<„6ÂË \"ˆ*Ì ‡" [edebug-arg-mode enter error "You must be in front of a function or macro call" edebug-exp func edebug func-marker markerp marker-buffer edebug-defun "You must first evaluate %s in a buffer" exit-recursive-edit] 4 "\ Step into the function about to be called. Do this before the arguments are evaluated since otherwise it will be too late. One side effect of using edebug-step-in is that the next time the function is called, edebug will be called there as well." nil]) (defalias 'edebug-stop #[nil "ÀÁ!‡" [message "Stop"] 2 "\ Useful for exiting from trace loop." nil]) (defconst edebug-initial-mode-alist (quote ((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.") (defalias 'edebug-set-initial-mode #[nil "À \nà =… \n ÅN† ÇÈÉ ÊË \"@ Í#$!Ï! žA‰ƒU ÅN„E =„UÑ Å#ˆÒÓ #‚XÔÕ!-‡" [edebug-which-function this-function edebug-mode-map current-local-map keymap edebug-initial-mode old-mode read-key-sequence format "Change initial edebug mode for %s from %s (%s) to (enter key): " where-is-internal rassq edebug-initial-mode-alist firstonly key key-binding mode put message "Initial mode for %s is now: %s" error "Key must map to one of the mode changing commands"] 10 "\ 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." nil]) (defvar edebug-previous-result nil "\ Last result returned from an expression.") (defalias 'edebug-previous-result #[nil "ÀÁÄÅÆ!\"*‡" [t 20 print-length print-escape-newlines message "Result: %s" prin1-to-string edebug-previous-result] 4 "\ Return the previous result." nil]) (defalias 'edebug-eval #[(expr) "„ÁÂ!ˆŠ ƒÄ Æ!ˆqˆÉ \n   ߎŒ !}ˆŠ\"ƒd#bˆä ƒdä %擈ç(!ˆé*!ˆë,!ˆ-qˆ.bˆï0!.‡" [edebug-active error "edebug is not active" edebug-save-windows edebug-current-window-configuration edebug-inside-windows edebug-set-window-configuration edebug-outside-windows edebug-buffer current-local-map edebug-outside-last-command-char edebug-outside-last-command edebug-outside-this-command edebug-outside-last-input-char edebug-outside-o-a-p edebug-outside-o-a-s edebug-outside-c-i-e-a edebug-outside-standard-output edebug-outside-standard-input edebug-outside-executing-macro executing-macro standard-input standard-output cursor-in-echo-area overlay-arrow-string overlay-arrow-position last-input-char this-command last-command last-command-char edebug-inside-map ((byte-code "À !ˆ\nƒ à !ˆÀ‡" [use-local-map edebug-inside-map edebug-save-windows edebug-set-window-configuration edebug-inside-windows] 2)) edebug-outside-point-min edebug-outside-point-max edebug-save-point edebug-outside-edebug-point mark-marker edebug-outside-edebug-mark nil use-local-map edebug-outside-map store-match-data edebug-outside-match-data select-window edebug-outside-window edebug-outside-buffer edebug-outside-point eval expr] 11 "\ Evaluate EXPR in the outside environment."]) (defalias 'edebug-eval-expression #[(expr) "ÀÁ\n!!‡" [prin1 edebug-eval expr] 3 "\ Prompt and evaluate an expression in the outside environment. Print result in minibuffer." "xEval: "]) (defalias 'edebug-eval-last-sexp #[nil "ÀÁ !!‡" [prin1 edebug-eval edebug-last-sexp] 3 "\ Evaluate sexp before point in the outside environment; print value in minibuffer." nil]) (defalias 'edebug-eval-print-last-sexp #[nil "pÁÂÃÄ!)‡" [standard-output print err (byte-code "ÀÁ !‡" [edebug-eval edebug-last-sexp] 2) ((error (byte-code "ÀÁ\n@ÃN\nA@#‡" [format "%s: %s" err error-message] 4)))] 4 "\ Evaluate sexp before point in the outside environment; print value into current buffer." nil]) (defvar edebug-mode (quote step) "\ Current edebug mode set by user.") (byte-code "ÀÁ!„ „¾Ã !Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÅ ÎÏ#ˆÅ ÐÑ#ˆÅ ÒÓ#ˆÅ ÔÕ#ˆÅ Ö×#ˆÅ ØÙ#ˆÅ ÚÛ#ˆÅ ÜÝ#ˆÅ Þß#ˆÅ àá#ˆÅ âã#ˆÅ äå#ˆÅ æç#ˆÅ èé#ˆÅ êë#ˆÅ ìí#ˆÅ îï#ˆÅ ðñ#ˆÅ òó#ˆÅ ôõ#ˆÅ ö÷#ˆÅ øù#ˆÅ úû#ˆÅ üý#ˆÅ þÿ#ˆÂ‡" [boundp edebug-mode-map nil copy-keymap emacs-lisp-mode-map define-key " " edebug-step-through "g" edebug-go "G" edebug-Go-nonstop "t" edebug-trace "T" edebug-Trace-fast "c" edebug-continue "C" edebug-Continue-fast "f" edebug-forward-sexp "h" edebug-goto-here "r" edebug-previous-result "i" edebug-step-in "o" edebug-step-out "q" top-level "a" abort-recursive-edit "S" edebug-stop "b" edebug-set-breakpoint "u" edebug-unset-breakpoint "B" edebug-next-breakpoint "x" edebug-set-conditional-breakpoint "e" edebug-eval-expression "" edebug-eval-last-sexp "E" edebug-visit-eval-list "w" edebug-where "v" edebug-view-outside "p" edebug-bounce-point "W" edebug-toggle-save-windows "?" edebug-help "d" edebug-backtrace "-" negative-argument] 4) (defvar global-edebug-prefix "X" "\ Prefix key for global edebug commands, available from any buffer.") (defvar global-edebug-map nil "\ Global map of edebug commands, available from any buffer.") (byte-code "„^Á  !ˆÄ \"ˆÅÆÇ#ˆÅÈÉ#ˆÅÊË#ˆÅÌÍ#ˆÅÎÏ#ˆÅÐÑ#ˆÅÒÓ#ˆÅÔÕ#ˆÅÖ×#ˆÅØÙ#ˆÅÚÛ#ˆÅÜÝ#ˆÅÞß#ˆàáâ\"‡" [global-edebug-map make-sparse-keymap global-unset-key global-edebug-prefix global-set-key define-key "d" edebug-defun " " edebug-step-through "g" edebug-go "G" edebug-Go-nonstop "t" edebug-trace "T" edebug-Trace-fast "c" edebug-continue "C" edebug-Continue-fast "b" edebug-set-breakpoint "x" edebug-set-conditional-breakpoint "u" edebug-unset-breakpoint "w" edebug-where "q" top-level defalias edebug-help #[nil "ÀÁ!‡" [describe-function edebug-mode] 2 nil nil]] 4) (defalias 'edebug-mode #[nil "À !‡" [use-local-map edebug-mode-map] 2 "\ Mode for Emacs Lisp buffers while in edebug. Under construction. There are both buffer local and global key bindings to several functions. E.g. edebug-step-through is bound to \\[edebug-step-through] in the debug buffer and \\\\[edebug-step-through] in any buffer. edebug buffer commands: \\{edebug-mode-map} Global commands prefixed by global-edbug-prefix: \\{global-edebug-map} Options: edebug-all-defuns edebug-eval-macro-args edebug-stop-before-symbols edebug-save-windows edebug-save-point edebug-save-buffer-points edebug-initial-mode edebug-trace "]) (defvar edebug-eval-list nil "\ List of expressions to evaluate.") (defalias 'edebug-eval-result-list #[nil "ÀÁ\n\"‡" [mapcar #[(expr) "ÀÁ‡" [err (eval expr) ((error (byte-code "ÀÁ\n@ÃN\nA@#‡" [format "%s: %s" err error-message] 4)))] 3] edebug-eval-list] 3 "\ Return a list of evaluations of edebug-eval-list"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias edebug-eval-display-list #[(edebug-eval-result-list) " ÂÃÄÅ ÆZÇ\"\" \nË !ˆÌ ˆ\n…BÍ\n@!ˆÎ ˆÍ@!ˆÎ ˆÐ!ˆ\nA\nA‚+‡" [edebug-eval-list edebug-eval-buffer format ";%s\n" make-string window-width 2 45 edebug-display-line standard-output edebug-eval-list-temp edebug-pop-to-buffer erase-buffer prin1 terpri edebug-eval-result-list princ] 7] edebug-create-eval-buffer #[nil "…Á!?…ÂÃ!‰qˆÄ ‡" [edebug-eval-buffer buffer-name get-buffer-create "*edebug*" edebug-eval-mode] 2]] 3) (defalias 'edebug-eval-display #[(edebug-eval-result-list) "…Á ˆÂ !ˆÄ!‡" [edebug-eval-result-list edebug-create-eval-buffer edebug-pop-to-buffer edebug-eval-buffer edebug-eval-display-list] 2 "\ Display expressions and evaluations in EVAL-LIST. It modifies the context by popping up the eval display."]) (defalias 'edebug-eval-redisplay #[nil "À ˆÁ\n!ˆŠ ƒÄ Æ!ˆqˆÉ \n   ߎŒ !}ˆŠ\"ƒc#bˆä ƒcä %擈ç(!ˆé*!ˆë,!ˆ-qˆ.bˆïð !.‡" [edebug-create-eval-buffer edebug-pop-to-buffer edebug-eval-buffer edebug-save-windows edebug-current-window-configuration edebug-inside-windows edebug-set-window-configuration edebug-outside-windows edebug-buffer current-local-map edebug-outside-last-command-char edebug-outside-last-command edebug-outside-this-command edebug-outside-last-input-char edebug-outside-o-a-p edebug-outside-o-a-s edebug-outside-c-i-e-a edebug-outside-standard-output edebug-outside-standard-input edebug-outside-executing-macro executing-macro standard-input standard-output cursor-in-echo-area overlay-arrow-string overlay-arrow-position last-input-char this-command last-command last-command-char edebug-inside-map ((byte-code "À !ˆ\nƒ à !ˆÀ‡" [use-local-map edebug-inside-map edebug-save-windows edebug-set-window-configuration edebug-inside-windows] 2)) edebug-outside-point-min edebug-outside-point-max edebug-save-point edebug-outside-edebug-point mark-marker edebug-outside-edebug-mark nil use-local-map edebug-outside-map store-match-data edebug-outside-match-data select-window edebug-outside-window edebug-outside-buffer edebug-outside-point edebug-eval-display-list edebug-eval-result-list] 11 "\ Redisplay eval list in outside environment. May only be called from within edebug-recursive-edit."]) (defalias (quote edebug-visit-eval-list) #[nil "À ˆÁ\n!‡" [edebug-eval-redisplay edebug-pop-to-buffer edebug-eval-buffer] 2 nil nil]) (defalias 'edebug-update-eval-list #[nil "`ÀebˆÃ ˆm„ÄÅ!ˆÆ BÇÈÀÉ#ƒ<ÅyˆÊÀwˆgËU„m„ÄÅ!ˆÆ B‚ Ÿ Í ˆ\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 "\ Replace the evaluation list with the sexps now in the eval buffer." nil]) (defalias 'edebug-delete-eval-item #[nil "ÀÁÂÃ#ƒ Äyˆ`ÅÁÂÃ#ˆÆyˆ`|ˆÇ ‡" [re-search-backward "^;" nil nofail 1 re-search-forward 0 edebug-update-eval-list] 5 "\ Delete the item under point and redisplay." nil]) (defvar edebug-eval-mode-map nil "\ Keymap for edebug-eval-mode. Superset of lisp-interaction-mode.") (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) (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 "\ Mode for data display buffer while in edebug. Under construction. ... ignore the following... There are both buffer local and global key bindings to several functions. E.g. edebug-step-through is bound to \\[edebug-step-through] in the debug buffer and \\\\[edebug-step-through] in any buffer. Eval list buffer commands: \\{edebug-eval-mode-map} Global commands prefixed by global-edbug-prefix: \\{global-edebug-map} "]) (byte-code "ÀÀ‡" [edebug-debug debugger] 1) (defalias 'edebug-debug #[(&rest debugger-args) "ƒ*Á \n=ƒ* @ @ A@ʼnÅ \n  Í .‡ÎÏ \"‡" [edebug-backtrace recursion-depth edebug-recursion-depth edebug-offset-indices debugger-args nil debug-on-error edebug-outside-debug-on-eror edebug-break edebug-break-data edebug-exp edebug-arg-mode edebug-offset-index edebug-display apply debug] 7 "\ Replacement for debug. If an error or quit occurred and we are running an edebugged function, show where we last were. Otherwise call debug normally."]) (defalias 'edebug-backtrace #[nil "p „ ÂÄÅ!)Æ !ˆÇ ˆpÈÉÊ   ÈÐ ˆebˆ`ÑÒ!ˆÓyˆ`|ˆÓyˆ` ÑÔÊÈ#ƒeÕÖ!ƒTŠ bˆ×yˆ` )Óyˆ `|ˆÓyˆ` ‚:,Æ!)‡" [old-buf edebug-backtrace-buffer fundamental-mode default-major-mode generate-new-buffer "*Backtrace*" edebug-pop-to-buffer erase-buffer t 50 nil last-ok-point print-length print-escape-newlines standard-output truncate-lines backtrace re-search-forward "^ edebug(" 1 "^ edebug" looking-at "-enter" -1] 4 "\ Display a non-working backtrace. Better than nothing..." nil]) (defalias 'edebug-trace-display #[(buf-name fmt &rest args) "À Á\n!ÄÆ !ˆŠÀ  qˆdbˆÇÈ \n#cˆË `\"ˆÌÍ !ZyˆÎ `\"ˆÏ !ˆ)Ð!+‡" [selected-window get-buffer-create buf-name buffer nil buf-window edebug-pop-to-buffer apply format fmt args set-window-point 1 window-height set-window-start bury-buffer select-window] 4 "\ 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."]) (provide (quote edebug)) emacs-19.22/lisp/edmacro.elc100666 13437 1 36115 5451135377 14351 0ustar jimbdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:41:18 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/edmacro.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂ ÄÅ#‡" [require cl define-key ctl-x-map " " edit-kbd-macro] 4) (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.") (byte-code "ÀÁ!„ „à Ä ÅÆ#ˆÄ ÇÈ#ˆÂ‡" [boundp edmacro-mode-map nil make-sparse-keymap define-key "" edmacro-finish-edit "" edmacro-insert-key] 4) (defalias 'edit-kbd-macro #[(keys &optional prefix finish-hook store-hook) "…:Á!ƒÂ!‚à Âs Ç=„,ȃF „:ÊË!„:Ì ˆ †@ÍÉ‚s Î=ƒVÏÐ!‰K‚s Ñ=ƒdÒ É‚s 9ƒo K‚s ÃÁ !„~ÓÔ \"ˆÕÖ!ˆpØ !ÚÛ\"Ú?\"ßà!!Õâ!ˆã!!ˆä ˆå&!ˆÃ'è)ê+ìí!Lˆìî!/Lˆìð!Lˆñ ˆòó±ˆôõ±ˆ„ö ƒí÷ !‚îøõ±ˆù †ø Ã\"‰ƒƒúÚ‰A@Û\"õ±ˆ‚ÿûcˆ)ücˆŠõ±ˆ)ýþ!ˆ =ƒ1ÿÃ!ˆ@A!.‡" [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 "Not a keyboard macro: %s" 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 "Key: " "Key: none\n" "\nMacro:\n\n" recenter (4) set-buffer-modified-p run-hooks edmacro-format-hook] 5 "\ 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." "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP"]) (defalias 'edit-last-kbd-macro #[(&optional prefix) "ÀÁ\n\"‡" [edit-kbd-macro call-last-kbd-macro prefix] 3 "\ Edit the most recently defined keyboard macro." "P"]) (defalias 'edit-named-kbd-macro #[(&optional prefix) "ÀÁ\n\"‡" [edit-kbd-macro execute-extended-command prefix] 3 "\ Edit a keyboard macro which has been given a name by `name-last-kbd-macro'." "P"]) (defalias 'read-kbd-macro #[(start &optional end) ";ƒ\nÁ\n\"‡Á\n{!‰‡" [start edmacro-parse-keys end last-kbd-macro] 3 "\ 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." "r"]) (defalias 'format-kbd-macro #[(&optional macro verbose) "ƒ 9ƒ KÁ†\n \"‡" [macro edmacro-format-keys last-kbd-macro verbose] 3 "\ 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 (quote edmacro-finish-edit) #[nil "Á=„\nÂÃ!ˆÄÅ!ˆÆ‰‰e \nbˆÆ ÌÍ!„úÌÎ!ƒsƒ6ÂÐ!ˆÑ”Ñ•{‰Óš„oÔÕ\"?…PÖ!\n×\n!ƒoØ\nK!„oÙÚÛ\nÜ#!„oÝ ˆ)‚úÌÞ!ƒãƒ‚Âß!ˆàєѕ{!‰!Óš„ßÔ!Õ\"ƒŸâ‚ß! B ã!!‰$ƒÞå$!ƒÞØ$!„Þ×$!ƒÍØ$K!„ÞÙÚæç!Ñ\"Ü#!„ÞÝ ˆ))‚úÌè!ƒðé•bˆ‚m„Âê!ƒÑyˆ‚!`)p+d{ì -./0 1\n„6 „60„6Óš„6Âò!ˆ-ƒó/!ƒF/qˆôõ!ˆà!6ô÷!ˆ0ƒb06!ˆ‚\nø=ƒx6GéV…s68Æ\n\nƒ“6GéUƒù\n!ˆ‚“\n6MˆƒÄ\nƒú\nÆ\";Æ!;:ƒÀ;@!ü!!ˆ;A‰;‚©*‚ ƒ6GéUƒõ =Æ!=:ƒñ=@!ü!!ˆ=A‰=‚Ú*‚ >Æ!>:ƒ>@!ÿ!\n†6\"ˆ>A‰>‚þ*)@+!ˆó/!ƒ3A/!ˆ1…;1 .\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 "" equalp "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 G44800 global-unset-key G44801 G44802 global-set-key kill-buffer switch-to-buffer] 7 nil nil]) (defalias 'edmacro-insert-key #[(key) "nƒ À Â\"ñ‡À !ı‡" [edmacro-format-keys key t "\n" " "] 3 "\ Insert the written name of a key in the buffer." "kKey to insert: "]) (defalias 'edmacro-mode #[nil "ÀÁ!‡" [error "This mode can be enabled only by `edit-kbd-macro'"] 2 "\ \\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." nil]) (byte-code "ÀÁÂÃ#ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"‡" [put edmacro-mode mode-class special defalias edmacro-format-keys #[(macro &optional verbose) "À !ÂÃ Ä Å D\"ÇÉ›\n ƒ!Ì‚\"ÍÏÑÓ Ô\"ÖØÛ=‰ƒCÏ ;ƒ~Ø GWƒ}HßYƒsHàÛá\"ßZ\\IˆÛ\\‰‚Q*ØHâ=„fØH¨ƒßØH\n>ƒßãäØÛ#!å>ƒßÛH\nA>ƒ½T‚©H>?…ÛæäØ#çQä\")†ØHè=ƒ;ãé!ê=ƒ;ÛHè=ƒT‚óH>?…7+Ö,+S‰+ØYƒ,,íP,‚,*ä\")†ØHè=…ãî!ê=…ÛHï=ƒ^THð>ƒpT‚^H>?…ŽíäÛ#çQä\")1òóÛ4Ï5Ï6Ï74:ƒÈ4@5ø5\"‰6ƒ¿67B74A‰4‚£7Ÿ,#9äØ9#:Ï;Ï<Ï=>Ï5Ï6ÿ@ÏA>:ƒ>@5ø5:\"‰6¨?… 6‰A?‰@ƒ>A‰>‚óA-†¦øB\"‰;…¦;<äØ<#=øB=\"‰;…¦CÏ5Ï6ÿDÏEC:ƒ—C@5ø5;\"‰6¨„Š6ƒŠ<9=:6EωD‚‹ÿƒ—CA‰C‚\\Dƒ£Ï;Ï‚¥E-F:ØHG9GHÏIHWƒ*H‰I¨ƒ*IJVƒ*IWƒ*IKU„*ãLI!!M=ƒ*GNZV„ IÛ\\H=ƒ IN\\H=„*Û\\‰‚¼+OÏPF;ƒ;ÏFFM=ƒè1„èOÛVƒèG¨ƒèGJVƒèGXƒèGKU„èOQVƒ~QOäØO#°PRSP\"ƒ£NOPØNOPRTP\"„èRUP\"„ÃPƒÏVLPç#PƒáWXFO#FO9‚SFY=ƒBO9VƒBOHZ>ƒBä9O#°P[\\P!!ƒB[\\P!!ƒ/PFW]P\"POT9‚SV^;†O:ç#P1ƒ_1PPPRçP\"„µÛ9_`a‰b9c_d9_\\&„™`T`_9\\_‚p`ÛVƒ´We`P#P9`_9*ä9\"ƒÖš„ÑfPPPFƒF;„éF9ƒghPGi¥ZÛ]j\"kF;ƒ F‚lF!RØ‚aPGN\\\\mVƒ@„@nPÛ‚RÖš„RçPTPPPG\\.\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 -8388563 -8388560 -8388559 -8388558 -8388557 -8388556 -8388555 -8388554 -8388553 -8388552 -8388551) 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 G44803 128 lsh 23 end-macro key-binding subseq (digit-argument negative-argument) "M-" " " 21 [21] universal-argument G44805 G44806 "C-u " [21] 45 (48 49 50 51 52 53 54 55 56 57) prefix apply max G44809 map b G44810 lookup-key bind-len key fkey tlen tkey G44811 t G44812 G44813 function-key-map G44814 G44815 G44816 bind first G44817 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) "¨ƒÛÁÃÅÇÅ Ê T‰\nGWƒN\n H:ƒN@ ÌÍÎ \"\"ÏU„F ÐÑ\"P A‚ .ÌÍÎÒ\"S\"‰ÔXƒ¹Ï=ƒmÕ‚ØÖ=ƒxׂØØ=ƒƒÙ‚ØÚ=ƒŽÛ‚ØÜ=ƒ™Ý‚ØÔ=ƒ¤Þ‚ØÐßàXƒ±á‚²â\\\"‚ØãUƒÄä‚Ø%XƒÓæ!‚ØÐç\")P‡9ƒåÐè\"‡éê\"‡" [ch "ACHMsS" G44829 -1 G44830 nil pf (18 22 20 23 19 21) G44831 bit "" G44832 logand lsh 1 0 format "%c-" 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 mismatch :end1 :start2 :end2 "%d*%s" "\n" make-string 3 8 9 ";; " symbol-name 72 "\n "] 11] edmacro-fix-menu-commands #[(macro) "À !ƒIÂÉ GWƒH H‰:ƒA A@A@Æšƒ<ÇÈ Â #ÉÊ @\"È T\"# T‚AËÌÍ\"ˆ T‰‚ * ‡" [vectorp macro 0 nil ev i (menu-bar) vconcat subseq vector menu-bar error "Macros with mouse clicks are not %s" "supported by this command"] 7] edmacro-parse-keys #[(string &optional need-vector) "ÀÁ GWƒAÇÈ #ƒAÁ”Á•OÀÉ\n  Á•ÇÍ \"ƒDÎ ÁÉ•O!\n É•TÀO ÇÏ \"ƒmÐÑÒ!Ó=ƒYÔ‚aÕÓ!@†aÖ ×ØOÙ# ‚ÇÚ \"ƒ˜ ɔɕO Û”Û•OP ÇÜ \"„˜Ý !C ‚ Þš„§Çß \"ƒ±Çà #‚ Á‰!\"#Çä \"ƒâ!åÉ ÁHæžA\"\\!\"×\\\" ×ÀO ‚»Çç \"ƒÿ!åÉè\"\\!\"T\" ÉÀO é ê\"‰+ƒ+A )Çì \"ƒ] -î/À0À1ò3/T‰/-GWƒV-/H03ƒEÁ‚N1ô_0õ\\\\1À3‚(ö1! -!ÁUƒk  ‚!åÉ÷\"Uƒ¹ ;ƒ¹Çø \"ƒ¹ 9î:À;À<:T‰:9GWƒ°9:H‰;!\\>$" vconcat key-binding [-8388488] execute-extended-command [-8388488] where-is-internal [-8388488] 2 -2 " " "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" 3 "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" intern "REM" "^;;" "$" bits prefix orig-word "^[ACHMsS]-." lsh ((65 . 18) (67 . 22) (72 . 20) (77 . 23) (115 . 19) (83 . 21)) "^\\^.$" 22 assoc (("NUL" . "") ("RET" . " ") ("LFD" . "\n") ("TAB" . " ") ("ESC" . "") ("SPC" . " ") ("DEL" . "")) found "^\\\\[0-7]+$" G44836 -1 G44837 ch n t G44838 8 -48 vector 23 "^-?[0-9]+$" G44839 G44840 x G44841 error "%s must prefix a single character, not %s" logand "[@-_.a-z?]" "?" 127 31 G44842 4 24 40 41 subseq need-vector G44843 G44844 G44845 lognot ch2 G44846 G44847 G44848 128] 8]] 4) (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 "(global-set-key %S '%s)\n"] 5 "\ 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." "CInsert kbd macro (name): \nP"]) (provide (quote edmacro)) emacs-19.22/lisp/ehelp.elc100666 13437 1 14417 5431130743 14023 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 8 03:57:22 1993 ;;; from file /home/fsf/rms/e19/lisp/ehelp.el ;;; emacs version 19.17.7. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote electric)) (defvar electric-help-map nil "\ Keymap defining commands available in `electric-help-mode'.") (byte-code "ÀÁÂÃ#ˆ „pÅ ÇA@Á\"ˆÈÉ\n!Ë!#ˆÈÉ !Í#ˆÈÎÍ#ˆÈÏÐ#ˆÈÑÒ#ˆÈÓÔ#ˆÈÕÔ#ˆÈÖ×#ˆÈØÙ#ˆÈÚÙ#ˆÈÛÜ#ˆ)À‡" [put electric-help-undefined suppress-keymap t electric-help-map make-keymap map fillarray define-key char-to-string meta-prefix-char copy-keymap help-char electric-help-help "?" " " scroll-up "" scroll-down "." beginning-of-buffer "<" ">" end-of-buffer "q" electric-help-exit "Q" "r" electric-help-retain] 5) (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] 2 "\ `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 'with-electric-help #[(thunk &optional buffer noerase) "À †Â!ÃÄ!Å Æ ÊŽŠ ƒ\"ËÌ !bˆÄ Î !ˆ)Š qˆÏ ˆÆ„<Ò ˆ)  „Z qˆÕÆ!ˆebˆ ƒZÖÌ !ˆ) qˆ×Ø!ˆÙ ¢Ú=ƒrÅ ‰‚vĉ-‡" [get-buffer-create buffer "*Help*" one-window-p t current-window-configuration nil 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] 3)) window-start selected-window pop-up-windows pop-to-buffer electric-help-mode buffer-read-only 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] 3 "\ Arguments are THUNK &optional BUFFER NOERASE. BUFFER defaults to \"*Help*\" THUNK is a function of no arguments which is called to initialize the contents of BUFFER. BUFFER will be erased before THUNK is called unless NOERASE is non-nil. THUNK will be called with `standard-output' bound to the buffer specified by BUFFER 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. 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 (quote electric-help-command-loop) #[nil "ÀÁ‡" [exit (byte-code "Àd!ƒÁÂ!ˆÃ C‰ÅšƒÆÇÈÉ\"ˆÆ‰‰‰ÊË!Ì=…<ÊÍ!Î=…<ÊÏ!Ð=…<ÊÑ!Ð=×ÈØÉ#-‡" [pos-visible-in-window-p message "<<< Press Space to bury the help buffer >>>" read-event unread-command-events (32) nil throw exit t key-binding " " scroll-up "" scroll-down "Q" electric-help-exit "q" standard neither both down up Electric-command-loop #[nil "Àe!Àd!‰ƒ$ ƒ$ ƒÄ‚k †kÆÇ!‰‚k\nƒ> ƒ0È‚k †kÆÊ!‰ ‚k ƒX ƒJË‚k †kÆÍ!‰ ‚k ƒ`΂k†kÆÐ!‰*‡" [pos-visible-in-window-p max min standard "Press Q to exit " neither substitute-command-keys "Press \\[scroll-up] to exit " "Press SPC to scroll, Q to exit " up "Press \\[scroll-up] to scroll; \\[electric-help-exit] to exit " "Press DEL to scroll back, Q to exit " down "Press \\[scroll-down] to scroll back, \\[scroll-up] to exit " "Press SPC to scroll, DEL to scroll back, Q to exit " both "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit "] 4]] 6)] 2]) (defalias 'electric-help-exit #[nil "ÀÁÂ\"‡" [throw exit t] 3 "\ >>>Doc" nil]) (defalias 'electric-help-retain #[nil "ÀÁÂ\"‡" [throw exit (retain)] 3 "\ 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.)" nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆ×Ø!„@Ù„†Ú!ÝÞÇ#ˆÝßÉ#ˆÝàË#ˆÝáÍ#ˆÝâÏ#ˆÝãÑ#ˆÝäÓ#ˆåMˆ)æç!‡" [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] electric-help-help #[nil "ÀÁ!Â=ƒÀÃ!Ä=ƒÀÅ!Æ=ƒÇÈ!ˆ‚*ÇÉ!ˆÇÊËÌ!\"ˆÍÎ!‡" [key-binding "Q" electric-help-exit " " scroll-up "" scroll-down message "SPC scrolls forward, DEL scrolls back, Q exits and burys help buffer" "Help..." "%s" substitute-command-keys "\\[scroll-up] scrolls forward, \\[scroll-down] scrolls back, \\[electric-help-exit] exits." sit-for 2] 4 nil nil] electric-helpify #[(fun) "À‹… ÃÄ Å#)‡" ["*Help*" name ((byte-code "ÀK !Å ! ƒÇ !„ÈÉŽÊËÌÍ!!\"ˆ ƒ1Š qˆÏÐ!ˆ)ÀÑMˆÒ!ˆÂ !…ZÇ !!…Z ?†Z  !=?†ZÅ !?,‡" [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] electric-describe-key #[nil "ÀÁ!‡" [electric-helpify describe-key] 2 nil nil] electric-describe-mode #[nil "ÀÁ!‡" [electric-helpify describe-mode] 2 nil nil] electric-view-lossage #[nil "ÀÁ!‡" [electric-helpify view-lossage] 2 nil nil] electric-describe-function #[nil "ÀÁ!‡" [electric-helpify describe-function] 2 nil nil] electric-describe-variable #[nil "ÀÁ!‡" [electric-helpify describe-variable] 2 nil nil] electric-describe-bindings #[nil "ÀÁ!‡" [electric-helpify describe-bindings] 2 nil nil] electric-describe-syntax #[nil "ÀÁ!‡" [electric-helpify describe-syntax] 2 nil nil] electric-command-apropos #[nil "ÀÁ!‡" [electric-helpify command-apropos] 2 nil nil] boundp ehelp-map nil copy-keymap help-map map substitute-key-definition describe-key describe-mode view-lossage describe-function describe-variable describe-bindings describe-syntax ehelp-command provide ehelp] 4) emacs-19.22/lisp/electric.elc100666 13437 1 4520 5416164662 14504 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:55:46 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/electric.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!‡" [defalias Electric-command-loop #[(return-tag &optional prompt inhibit-quit loop-function loop-state) "„Á‰Å;ƒ‚ !‰‰GSHÇ !‰  „5\nË=ƒZ  ΠGÏU„H„XÑ ˆÒÓ!ˆÔÂ\"ˆ‚Z  ƒj×ØÙˆ‚mÑ ˆƒ\n \"ˆ‚\n" [prompt "->" nil err cmd 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 Å„Ç=ƒ.Å „+Ê ˆËÌ!ˆÍÅ\"ˆ‚.Ê ˆÅ‡" [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] Electric-pop-up-window #[(buffer &optional max-height) "À !† Ä !ÆÇ!Ç Ê Ê „&ÍÎ \"‚›Š qˆÏed\" ƒ> T^‚A T]Ò‹^ )Ó ! =ƒ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 electric] 3) emacs-19.22/lisp/emacsbug.elc100666 13437 1 1605 5416164663 14502 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:55:47 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/emacsbug.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu" "\ Address of site maintaining mailing list for GNU Emacs bugs.") (defalias 'report-emacs-bug #[(topic) "ÀÁ\n #ˆdbˆÄŠƱˆÇÈÉ!!‡" [mail nil bug-gnu-emacs topic "\nIn " emacs-version "\n\n" message substitute-command-keys "Type \\[mail-send] to send bug report."] 4 "\ Report a bug in GNU Emacs. Prompts for bug subject. Leaves you in a mail buffer." "sBug Subject: "]) (provide (quote emacsbug)) emacs-19.22/lisp/emerge.elc100666 13437 1 176427 5432646445 14240 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 13 04:13:22 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/emerge.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (defalias 'emerge-eval-in-buffer '(macro . #[(buffer &rest forms) "ÀÁÂÃÄÅDD\"ÈEE‡" [let ((StartBuffer (current-buffer))) unwind-protect append progn set-buffer buffer forms (set-buffer StartBuffer)] 7 "\ 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-defvar-local '(macro . #[(var value doc) "ÀÁ\n FÅÆ\nDDÇÆ\nDÈÉFF‡" [progn defvar var value doc make-variable-buffer-local quote put (quote preserved) t] 7 "\ 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."])) (byte-code "À ž„ Ä \"‡" [((emerge-mode " Emerge") (emerge-fast-mode " F") (emerge-edit-mode " E") (emerge-auto-advance " A") (emerge-skip-prefers " S")) emerge-minor-modes-list emerge-mode minor-mode-alist append] 3) (defun emerge-mode nil "\ 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.") (defalias 'emerge-version #[nil "tƒ\nÀÁ \"‡\n‡" [message "Emerge version %s" emerge-version] 3 "\ Return string describing the version of Emerge. When called interactively, displays the version." nil]) (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 (byte-code "À à İ)‡" ["\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)" x "^" "\\([acd]\\)" "$"] 5) "\ *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-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.") (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.") (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 "\ 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-count-matches-string #[(string regexp) "À‰à \n#ƒ TÀ•‚ *‡" [0 count i string-match regexp string] 4 "\ Return the number of matches in STRING for REGEXP."]) (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.") (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 (byte-code "ÀÁ!‰ƒ GÅVƒ ‚Ɖ‰GSHÇUƒ& ÅÈO ÉP*‡" [getenv "TMPDIR" nil d env 0 "/tmp" 47 -1 "/emerge"] 4) "\ *Prefix to put on Emerge temporary file names. Do not start with `~/' or `~user-name/'.") (defvar emerge-temp-file-mode 384 "\ *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'.") (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-command-prefix "" "\ *Command prefix for Emerge commands in `edit' mode. Must be set before Emerge is loaded.") (defalias (quote emerge-setup-fixed-keymaps) #[nil "À  !ˆÃ ÄÅ#ˆÃ ÆÇ#ˆÃ ÈÉ#ˆÃ ÊË#ˆÃ ÌÍ#ˆÃ ÎÏ#ˆÃ ÐÑ#ˆÃ ÒÓ#ˆÃ ÔÕ#ˆÃ Ö×#ˆÃ ØÙ#ˆÃ ÚÛ#ˆÃ ÜÝ#ˆÃ Þß#ˆÃ àÙ#ˆÃ áâ#ˆÃ ãä#ˆÃ åÙ#ˆÃ æç#ˆÃ èé#ˆÃ êÙ#ˆÃ ëì#ˆÃ íî#ˆÃ ïð#ˆÃ ñò#ˆÃ óô#ˆÃ õö#ˆÃ ÷ø#ˆÃ ùú#ˆÃ ûÙ#ˆÃ üý#ˆÃ þÿ#ˆÃ @A#ˆÃ BC#ˆÃ DE#ˆÃ FG#ˆÃ HI#ˆÃ JK#ˆÃ LM#ˆÃ NO#ˆÁ MˆP !QÃQRÁ#ˆQQMˆSTUQV $ˆSWXQV $‡" [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] 5]) (defvar emerge-mode nil "\ Indicator for emerge-mode.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-mode put preserved t] 4) (defvar emerge-fast-mode nil "\ Indicator for emerge-mode fast submode.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-fast-mode put preserved t] 4) (defvar emerge-edit-mode nil "\ Indicator for emerge-mode edit submode.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-edit-mode put preserved t] 4) (defvar emerge-A-buffer nil "\ The buffer in which the A variant is stored.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-A-buffer put preserved t] 4) (defvar emerge-B-buffer nil "\ The buffer in which the B variant is stored.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-B-buffer put preserved t] 4) (defvar emerge-merge-buffer nil "\ The buffer in which the merged file is manipulated.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-merge-buffer put preserved t] 4) (defvar emerge-ancestor-buffer nil "\ The buffer in which the ancestor variant is stored, or nil if there is none.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-ancestor-buffer put preserved t] 4) (defconst emerge-saved-variables (quote ((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 (quote (nil t nil)) "\ Values to be assigned to emerge-saved-variables during a merge.") (defvar emerge-A-buffer-values nil "\ Remembers emerge-saved-variables for emerge-A-buffer.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-A-buffer-values put preserved t] 4) (defvar emerge-B-buffer-values nil "\ Remembers emerge-saved-variables for emerge-B-buffer.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-B-buffer-values put preserved t] 4) (defvar 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") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-difference-list put preserved t] 4) (defvar emerge-current-difference -1 "\ The difference that is currently selected.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-current-difference put preserved t] 4) (defvar emerge-number-of-differences nil "\ Number of differences found.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-number-of-differences put preserved t] 4) (defvar 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.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-edit-keymap put preserved t] 4) (defvar emerge-old-keymap nil "\ The original local keymap for the merge buffer.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-old-keymap put preserved t] 4) (defvar emerge-auto-advance nil "\ *If non-nil, emerge-select-A and emerge-select-B automatically advance to the next difference.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-auto-advance put preserved t] 4) (defvar emerge-skip-prefers nil "\ *If non-nil, differences for which there is a preference are automatically skipped.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-skip-prefers put preserved t] 4) (defvar 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.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local emerge-quit-hook put preserved t] 4) (defvar emerge-output-description nil "\ Describes output destination of emerge, for `emerge-file-names'.") (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÆÇ\"ˆÅÈÉ\"ˆÅÊË\"ˆÅÌÍ\"ˆÅÎÏ\"ˆÅÐÑ\"ˆÅÒÓ\"ˆÅÔÕ\"ˆÅÖ×\"ˆÅØÙ\"‡" [make-variable-buffer-local emerge-output-description put preserved t defalias emerge-files-internal #[(file-A file-B &optional startup-hooks quit-hooks output-file) "À !„ Âà \"ˆÀ !„Âà \"ˆÅ !Å !È ! È !\n ƒ5È ! p ÎŽqˆ~ˆÏ !‰ƒZÑÒÓ DEB‚]Õ ˆ+p ÖŽqˆ~ˆÏ !‰ƒƒÑÒÓ DEB‚†Õ ˆ+×   &*‡" [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] emerge-setup #[(buffer-A file-A buffer-B file-B startup-hooks quit-hooks output-file) "À !À\n! …À !ÄÅÆ\"pÉŽ\nqˆË!* pÍŽ qˆÎ\n!ˆÏÑÒ!ˆÓ\nÏ  ƒWÚ P‚]ÛÜ !PÞ!ˆß ˆà \n\"‰!G\"ã$%&ç ˆè ˆ*é\n Ó$ˆpêŽ qˆëìí\"ˆÓ‰,‡" [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] emerge-make-diff-list #[(file-A file-B) "ÀÁ!pÄŽ\nqˆÅ ˆÆÇÈ \nË !Ë !%Î\"ˆ*Ï!ˆÑÕ\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] emerge-extract-diffs #[(diff-buffer) "ÀpÃŽ qˆebˆÅÀÇ#ƒ®Èɔɕ{!\n˔˕ ‰ ƒ4È  {!‚6\n*ϔϕ{Èєѕ{!Ó”Ó• ‰ ƒ_È  {!‚a*Õ˜ƒ{T\nT‰\n‚œÖ˜ƒ’TT‰‚œTT×\nØ% B-‚ * Ÿ)‡" [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] 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] emerge-files-with-ancestor-internal #[(file-A file-B file-ancestor &optional startup-hooks quit-hooks output-file) "À !„ Âà \"ˆÀ !„Âà \"ˆÀ !„!Âà \"ˆÆ !Æ !Æ ! Ê ! Ê ! Ê ! ƒJÊ!pÑŽ qˆ~ˆÒ !‰ƒoÔÕÖ DEB‚rØ ˆ+pÙŽqˆ~ˆÒ !‰ƒ˜ÔÕÖ DEB‚›Ø ˆ+pÚŽqˆ~ˆÒ !‰ƒÁÔÕÖ DEB‚ÄØ ˆ+Û   & +‡" [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] emerge-setup-with-ancestor #[(buffer-A file-A buffer-B file-B buffer-ancestor file-ancestor &optional startup-hooks quit-hooks output-file) "À !À\n!À ! …À !ÅÆÇ\"p ÊŽ qˆÌ!* p ÎŽ qˆÏ !ˆÐÒÓ!ˆÔ   ƒ\\Ü P‚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] emerge-make-diff3-list #[(file-A file-B file-ancestor) "ÀÁ!pÄŽ\nqˆÅ ˆÆÇÈ \nË !Ë !Ë!&Ï\"ˆ*Ð!ˆÒÖ\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] emerge-extract-diffs3 #[(diff-buffer) "ÀpÃŽ qˆÅÆÀÇ#ƒjÈyˆÈ”È•{‰ ʘ„fÀ‰‰   ` ÎÏ!  bˆÎÐ! Ñ @ A@ @ A@ Ϙƒ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] 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]] 4) (defalias 'emerge-files #[(arg file-A file-B file-out &optional startup-hooks quit-hooks) "À \n ƒÅÆÇ DEB‚ %‡" [emerge-files-internal file-A file-B startup-hooks file-out lambda nil emerge-files-exit quit-hooks] 8 "\ Run Emerge on two files." (byte-code "À\nÃÄ À‰$‰ÃÆÀ $\n…ÃÈ ‰$F)‡" [nil f current-prefix-arg emerge-read-file-name "File A to merge" emerge-last-dir-A "File B to merge" emerge-last-dir-B "Output file" emerge-last-dir-output] 8)]) (defalias 'emerge-files-with-ancestor #[(arg file-A file-B file-ancestor file-out &optional startup-hooks quit-hooks) "À \n ƒÆÇÈ 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 "\ Run Emerge on two files, giving another file as the ancestor." (byte-code "À\nÃÄ À‰$‰ÃÆÀ $ÃÈ À $\n…$ÃÊ ‰$¯)‡" [nil f current-prefix-arg emerge-read-file-name "File A to merge" emerge-last-dir-A "File B to merge" emerge-last-dir-B "Ancestor file" emerge-last-dir-ancestor "Output file" emerge-last-dir-output] 9)]) (defalias (quote emerge-files-exit) #[(file-out) "?…Á\n!‡" [emerge-prefix-argument emerge-write-and-delete file-out] 2]) (defalias 'emerge-buffers #[(buffer-A buffer-B &optional startup-hooks quit-hooks) "ÀÁ!ÀÂ!pÆŽqˆÈed ÉÊ%ˆ*pËŽ qˆÈed ÉÊ%ˆ*ÍÎ! Î ! ÏÉÐ DÐ 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 "\ Run Emerge on two buffers." "bBuffer A to merge: \nbBuffer B to merge: "]) (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 ËÌ%ˆ*ÑÒ !Ò! Ò! ÓËÔDÔ DÔ D¯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 "\ Run Emerge on two buffers, giving another buffer as the ancestor." "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: "]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"‡" [defalias emerge-files-command #[nil "@A@Á8Å›Æ ÇÈÇÉ\nDEC$+‡" [command-line-args-left 2 file-out file-b file-a 3 emerge-files-internal nil lambda emerge-command-exit] 8] emerge-files-with-ancestor-command #[nil "À‰‰‰ @Ƙƒ&Ç 8È 8 A@É 8Ê ›‚9 @ A@Ç 8È 8É ›Ë \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] emerge-command-exit #[(file-out) "À !ˆÂ ƒ Ä‚Å!‡" [emerge-write-and-delete file-out kill-emacs emerge-prefix-argument 1 0] 2] emerge-files-remote #[(file-a file-b file-out) " ÅÆÅÇÈ DEEC%ˆÊËÅ\"‡" [file-out emerge-file-out emerge-files-internal file-a file-b nil lambda emerge-remote-exit quote exit-func throw client-wait] 10] emerge-files-with-ancestor-remote #[(file-a file-b file-anc file-out) " ÆÇÆÈÉ\nDEEC&ˆËÌÆ\"‡" [file-out emerge-file-out emerge-files-with-ancestor-internal file-a file-b file-anc nil lambda emerge-remote-exit quote exit-func throw client-wait] 11] emerge-remote-exit #[(file-out exit-func) "À !ˆÂ !ˆ ƒÆ‚Ç!‡" [emerge-write-and-delete file-out kill-buffer emerge-merge-buffer exit-func emerge-prefix-argument 1 0] 2]] 3) (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 "\ Emerge two RCS revisions of a file." (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))]) (defalias 'emerge-revisions-with-ancestor #[(arg file revision-A revision-B ancestor &optional startup-hooks quit-hooks) "\n Æ\n  ƒ)Ê ÌÊÍÎÏ#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 "\ Emerge two RCS revisions of a file, with another revision as ancestor." (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))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias emerge-revisions-internal #[(file revision-A revision-B &optional startup-hooks quit-hooks output-file) "ÀÁ #!ÀÁ #!ÆÇ!ÆÈ! \n  p ÎŽ qˆÏ ˆÐÁÑ $Ó\"ˆÔed\nÕÖ%ˆ×Õ!ˆ*p ØŽ qˆÏ ˆÐÁÑ $Ó\"ˆÔed ÕÖ%ˆ×Õ!ˆ*Ù \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] emerge-revision-with-ancestor-internal #[(file revision-A revision-B ancestor &optional startup-hooks quit-hooks output-file) "ÀÁ #!ÀÁ #!ÀÁ #!ÇÈ!ÇÉ!ÇÊ!   pÒŽqˆÓ ˆÔÁÕ $×\"ˆØed ÙÚ%ˆÛÙ!ˆ*pÜŽqˆÓ ˆÔÁÕ $×\"ˆØed ÙÚ%ˆÛÙ!ˆ*pÝŽqˆÓ ˆÔÁÕ $×\"ˆØed ÙÚ%ˆÛÙ!ˆ*Þ   ßÙà Dà Dà 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]] 3) (defalias 'emerge-execute-line #[nil "À‰‰‰ÁmƒÇÈ!ˆÉyˆÊË!ƒ É•bˆl„°ÊÌ!ƒ©Í”Í•{—ΔΕ{É•bˆјƒTƒMÇÒ!ˆ‚¥Ó˜ƒi ƒcÇÔ!ˆ‚¥Õ˜„wÖ˜ƒ… ƒÇ×!ˆ‚¥ؘ„“Ù˜ƒ¡ ƒ›ÇÚ!ˆ‚¥ÇÛ!ˆ*‚ ÇÜ!ˆ‚ ƒ¹ „Á „ÁÇÝ!ˆ„Î „ÎÇÞ!ˆÍyˆƒü ƒü ƒüßà #ˆá ?? ÀâÀãpDäFC&‚Jƒ\" ƒ\"ßà #ˆå ?? ÀâÀãpDæFC&‚J ƒ1'ƒ1ßè!‚J†7 )ßê!ˆë) \"ˆßì) #)-‡" [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 "\ 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." nil]) (defvar emerge-merge-directories-filename-regexp "[^.]" "\ Regexp describing files to be processed by `emerge-merge-directories'.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias emerge-merge-directories #[(a-dir b-dir ancestor-dir output-dir) "nƒl„ ÀÁ!ˆ\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)))] emerge-setup-windows #[(buffer-A buffer-B merge-buffer &optional pos) "À Á =ƒ ÂÃ!ˆÄ ˆÅ!ˆÇ ˆÈ ˆÉ ˆÅ\n!ˆ ƒ*ebˆÂÃ!ˆÅ !ˆ ƒ;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] emerge-set-keys #[nil "„Á ˆÂ ‰ƒÄ !‚Å ÇÀ#ˆÉÊË#ˆÉÌÍ#ˆÉÊËÎ $ˆÉÌÍÎ $ˆÏ!ˆÑÓ‰‡" [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 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]] 3) (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 "\ 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-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 "\ Restores characteristics saved by `emerge-remember-buffer-characteristics'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias emerge-convert-diffs-to-markers #[(A-buffer B-buffer merge-buffer lineno-list) "ÀpÃŽ qˆe*‰SpÇŽ qˆŒ~ˆÈÉ \"+\npËŽ qˆe* pÎŽ qˆŒ~ˆÈÉ \"+ƒö@ÀÀÀÀÀÀØHÉHÛHÝHßH pᎠqˆâ\n\\!ˆã â\n\\!ˆã *päŽ qˆâ\\!ˆã â\\!ˆã *å æ!Z'“å æ!Z'“è & B. A‰„Eéè Ÿ\"‰*.‡" [nil marker-list StartBuffer ((set-buffer StartBuffer)) A-buffer A-point-min offset ((set-buffer StartBuffer)) count-lines 1 A-hidden-lines ((set-buffer StartBuffer)) B-buffer B-point-min ((set-buffer StartBuffer)) B-hidden-lines 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)) goto-line point-marker ((set-buffer StartBuffer)) make-marker marker-position merge-buffer vector apply emerge-difference-list] 9] 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] 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] emerge-write-and-delete #[(file-out) "À ˆÁ\n!„ Ã\n!ˆÁ !„à !ˆ ƒ%Á !„%à !ˆ….Ç!‡" [delete-other-windows buffer-modified-p emerge-A-buffer kill-buffer emerge-B-buffer emerge-ancestor-buffer file-out write-file] 2]] 3) (defalias 'emerge-recenter #[(&optional arg) "ƒ\nÁ\n #ˆ ÆY…Ÿ W…Ÿ \n \nË ! Ë\n! Ë! H ƒZÑ !ˆÒÆ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 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 "\ 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." "P"]) (defalias (quote emerge-operate-on-windows) #[(operation arg) "\n Æ !Æ !Æ ! ƒ$Ê!ˆËÌ͈ƒ3Ê!ˆËÎψ …BÊ !ˆ!.‡" [emerge-merge-buffer merge-buffer emerge-A-buffer buffer-A emerge-B-buffer buffer-B get-buffer-window window-A window-B merge-window select-window nil (funcall operation arg) ((error)) (funcall operation arg) ((error)) operation arg] 3]) (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 "\ 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." "P"]) (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 "\ 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." "P"]) (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 "\ 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." "P"]) (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 "\ 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." "P"]) (defalias 'emerge-scroll-reset #[nil "ÀÁÂ\"‡" [emerge-operate-on-windows #[(x) "ÀÁ Â\"‡" [set-window-hscroll selected-window 0] 3] nil] 3 "\ Reset horizontal scrolling in Emerge. This resets the horizontal scrolling of all three merge buffers to the left margin, if they are in windows." nil]) (defalias (quote emerge-position-region) #[(beg end pos) "À !ˆ`\nXƒ À T[!ˆ`X„JÄÅ \n\"ˆÆ !ƒJÇ À!ˆ`Vƒ8T‚%\nbˆÉÊÅ !SZTË¥!ˆ) b‡" [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]) (defalias 'emerge-next-difference #[nil " Wƒ+T ƒ#\n Wƒ# \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 "\ Advance to the next difference." nil]) (defalias 'emerge-previous-difference #[nil "ÁVƒ+S ƒ#\nÁVƒ# \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 "\ Go to the previous difference." nil]) (defalias 'emerge-jump-to-difference #[(difference-number) "À\nS‰ÃYƒ\n TWƒÅ\n!‚ÆÇ!)‡" [nil buffer-read-only difference-number -1 emerge-number-of-differences emerge-unselect-and-select-difference error "Bad difference number"] 3 "\ Go to the N-th difference." "p"]) (defalias 'emerge-abort #[nil "ÀÁ!‡" [emerge-quit t] 2 "\ Abort the Emerge session." nil]) (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 "\ 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." "P"]) (defalias (quote emerge-really-quit) #[(arg) "ÀÂÃ!ˆÄ ˆÅÆ\"ˆÀÈ !ˆÀ\nÀ À À ÀÏÐ!ˆÓÔ!)‡" [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]) (defalias 'emerge-select-A #[(&optional force) "ÀÁÄ \n ‰$*‡" [#[nil "À \n $ˆ … Æ ‡" [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 "\ 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." "P"]) (defalias (quote emerge-select-A-edit) #[(merge-begin merge-end A-begin A-end) "pÁŽ\nqˆ |ˆ 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]) (defalias 'emerge-select-B #[(&optional force) "ÀÁÄ \n $*‡" [#[nil "À \n $ˆ … Æ ‡" [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 "\ 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." "P"]) (defalias (quote emerge-select-B-edit) #[(merge-begin merge-end B-begin B-end) "pÁŽ\nqˆ |ˆ 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]) (defalias 'emerge-default-A #[nil "À\n‰Ã] Wƒ? H‰ÉHÊ=ƒ+Ë Ì\"ˆÍ ˆÉÎIˆ) T‰ϦÃUƒÐÑ \"ˆ‚Ë !ˆ+ÐÒ!‡" [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 A set"] 4 "\ 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." nil]) (defalias 'emerge-default-B #[nil "À\n‰Ã] Wƒ? H‰ÉHÊ=ƒ+Ë Ì\"ˆÍ ˆÉÎIˆ) T‰ϦÃUƒÐÑ \"ˆ‚Ë !ˆ+ÐÒ!‡" [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 B set"] 4 "\ 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." nil]) (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" set-buffer-modified-p buffer-modified-p] 2 "\ Set fast mode, for Emerge. In this mode ordinary Emacs commands are disabled, and Emerge commands need not be prefixed with \\\\[emerge-basic-keymap]." nil]) (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" set-buffer-modified-p buffer-modified-p] 2 "\ Set edit mode, for Emerge. In this mode ordinary Emacs commands are available, and Emerge commands must be prefixed with \\\\[emerge-basic-keymap]." nil]) (defalias 'emerge-auto-advance #[(arg) "„ ?‚Â!ÃVÄ ƒÆ‚Ç!ˆÈÉ !‡" [arg emerge-auto-advance prefix-numeric-value 0 message emerge-skip-prefers "Auto-advance set" "Auto-advance cleared" set-buffer-modified-p buffer-modified-p] 2 "\ 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." "P"]) (defalias 'emerge-skip-prefers #[(arg) "„ ?‚Â!ÃVÄ ƒÅ‚Æ!ˆÇÈ !‡" [arg emerge-skip-prefers prefix-numeric-value 0 message "Skip-prefers set" "Skip-prefers cleared" set-buffer-modified-p buffer-modified-p] 2 "\ 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." "P"]) (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 "\ Put the A variant of this difference in the kill ring." nil]) (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 "\ Put the B variant of this difference in the kill ring." nil]) (defalias 'emerge-insert-A #[(arg) "À ˆ \nH‰ÄHT ÆHS`É\nË #ˆ „,Î!‚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 "\ Insert the A variant of this difference at the point. Leaves point after text, mark before. With prefix argument, puts point before, mark after." "P"]) (defalias 'emerge-insert-B #[(arg) "À ˆ \nH‰ÄHT ÆHS`É\nË #ˆ „,Î!‚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 "\ Insert the B variant of this difference at the point. Leaves point after text, mark before. With prefix argument, puts point before, mark after." "P"]) (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 "\ Leaves the point before this difference and the mark after it. With prefix argument, puts mark before, point after." "P"]) (defalias 'emerge-file-names #[nil "À ˆÁÃpÅŽqˆƒ ÈÉ!ˆÈ!ˆ‚)ÈÊ!ˆÈË !ˆÈÌ!ˆ*pÍŽqˆƒGÈÏ!ˆÈ!ˆ‚PÈÐ!ˆÈË !ˆÈÌ!ˆ*ƒpÒŽqˆƒsÈÓ!ˆÈ!ˆ‚|ÈÔ!ˆÈË !ˆÈÌ!ˆ*È!‘)‡" [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] 3 "\ Show the names of the buffers or files being operated on by Emerge. Use C-u l to reset the windows afterward." nil]) (defalias 'emerge-join-differences #[(arg) "\nƒ S ÃW„ SYƒÅÆ!ˆÇ!ˆ SÃÈ É\"\n‰ WƒÂ\n ‰ WƒB  H‚· VƒR  TH‚·  H  TH ÏÃH ÐHÑH ÒHÓH ÔHÕH ÕH‰=ƒ’‚³Ø=„ Ù=ƒ²Ø=„®Ù=ƒ²Ø‚³Ú*&*Iˆ T‰ ‚+\n * Û ˆÜ!ˆÝ )‡" [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 "\ Join the selected difference with the following one. With a prefix argument, join with the preceding one." "P"]) (defalias 'emerge-split-difference #[nil " ˆpÄŽ qˆÆ *pÇŽqˆÆ *Æ  H\n  ‰ \nÎHW„; \nÏHVƒ?ÐÑ!ˆ \nÒHW„S \nÓHVƒWÐÔ!ˆ \nÕHW„k \nÖHVƒoÐ×!ˆØ!ˆTÎÚÛ\"‰Wƒù‰ Wƒ› H‚î TVƒ¬ SH‚î UƒÏÞ\nÎH \nÒH \nÕH \nßH&‚îÞà !\nÏHà !\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 "\ Split the current difference where the points are in the three windows." nil]) (defalias 'emerge-trim-difference #[nil "À ˆÁ\n!ˆ \nHÅ ÆH!Å ÈH! Å ÊH! Å ÌH! Å ÎH!Å Ð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ˆ Æâ Iˆ bˆÈyˆ Èâ Iˆ*pãŽqˆ bˆÆyˆ Êâ Iˆ bˆÈyˆ Ìâ Iˆ*bˆÆyˆ Îâ IˆbˆÈyˆ Ðâ Iˆä\n!ˆå . ‡" [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 "\ 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.)" nil]) (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 "\ 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." "P"]) (defalias 'emerge-find-difference-merge #[(arg) "À `ÂÃ$‡" [emerge-find-difference1 arg 4 5] 5 "\ 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." "P"]) (defalias 'emerge-find-difference-A #[(arg) "À pÃŽ qˆ`*ÅÆ$‡" [emerge-find-difference1 arg StartBuffer ((set-buffer StartBuffer)) emerge-A-buffer 0 1] 5 "\ 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." "P"]) (defalias 'emerge-find-difference-B #[(arg) "À pÃŽ qˆ`*ÅÆ$‡" [emerge-find-difference1 arg StartBuffer ((set-buffer StartBuffer)) emerge-B-buffer 2 3] 5 "\ 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." "P"]) (defalias (quote 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 Æ H!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]) (defalias 'emerge-line-numbers #[nil "ÁY… \nW‰… HÆÇÈ\" p\nËŽ qˆÆÁÍ\"*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 "\ Display the current line numbers. This function displays the line numbers of the points in the A, B, and merge buffers." nil]) (defalias (quote 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]) (defalias 'emerge-set-combine-versions-template #[(start end &optional localize) "ƒÁÂ!ˆ {ÅÂÆ žƒÇ‚È!‡" [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 "\ Copy region into `emerge-combine-versions-template'. This controls how `emerge-combine-versions' will combine the two versions. With prefix argument, `emerge-combine-versions' is made local to this merge buffer. Localization is permanent for any particular merge buffer." "r\nP"]) (defalias 'emerge-combine-versions #[(&optional force) "À \n\"‡" [emerge-combine-versions-internal emerge-combine-versions-template force] 3 "\ 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." "P"]) (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 "\ 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." "cRegister containing template: \nP"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias emerge-combine-versions-internal #[(template force) "À ‰‰$)‡" [#[nil "À \n &ˆ…È ‡" [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] emerge-combine-versions-edit #[(merge-begin merge-end A-begin A-end B-begin B-end) "pÁŽ\nqˆ |ˆ 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]] 3) (defalias 'emerge-set-merge-mode #[(mode) " ˆÁ ˆ\nƒ  ‡Ã ‡" [mode emerge-refresh-mode-line emerge-fast-mode emerge-edit-mode] 1 "\ 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." (list (intern (completing-read "New major mode for merge buffer: " obarray (quote commandp) t nil)))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"‡" [defalias emerge-one-line-window #[nil "ÀÂà ÄZ!)‡" [1 window-min-height shrink-window window-height 2] 3 nil nil] 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] emerge-place-flags-in-buffer #[(buffer difference before-index after-index) "ƒpÂŽqˆÃ #*‡Ã #‡" [buffer StartBuffer ((set-buffer StartBuffer)) emerge-place-flags-in-buffer1 difference before-index after-index] 4] emerge-place-flags-in-buffer1 #[(difference before-index after-index) "À\n H HÀ‰bˆÇ!ˆ`‰SÀ“ˆ SÀ‰‰ \n ‰ ÍYƒb\n H‰ H‰ Uƒb ‰SÀ“ˆ H‰\n UƒY\nS\n S‰ ‚*.\n HHÐ!‰bˆcˆ‰TÀ“ˆ TÀ‰‰  \n‰ W…Æ\n H‰ H‰\n U…Æ\n‰TÀ“ˆ H‰ Uƒ½ T  T‰ ‚.‡" [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] emerge-unselect-difference #[(n) " Hà \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] 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] emerge-unselect-and-select-difference #[(n &optional suppress-display) "ÁYƒ\nWƒÃ!ˆ ÁYƒH \nWƒHÅ !ˆ H‰ÈH‰ Ê=ƒ:ÈËIˆ‚G Ì=ƒGÈÍIˆ* ?…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] emerge-select-version #[(force a-version b-version neither-version) "À ˆÁ H‰Æ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] emerge-read-file-name #[(prompt alternative-default-dir default-file A-file) "ƒ& ƒ&\nƒ&\nà !˜„&ÄÅÆÈ !#\n‰È !PÉ$‡\nƒ=ÄÅÆ\n#…8\n\nÉ$‡ÄËP…G\nÌÉ$‡" [emerge-default-last-directories A-file alternative-default-dir file-name-directory read-file-name format "%s (default %s): " prompt file-name-nondirectory confirm default-file ": " nil] 6] 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 set-buffer-modified-p buffer-modified-p] 6] 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] emerge-unique-buffer-name #[(prefix suffix) "À \nP!„ \nP‡ÃÀÅÆ \n$!ƒ T‚ÅÆ \n$)‡" [get-buffer prefix suffix 2 n format "%s<%d>%s"] 6] emerge-validate-difference #[nil "ÁY… \nW?…ÃÄ!‡" [emerge-current-difference 0 emerge-number-of-differences error "No difference selected"] 2] emerge-save-variables #[(vars) "ÀÁ\n\"‡" [mapcar #[(v) "9ƒJ‡@ ‡" [v] 1] vars] 3] emerge-restore-variables #[(vars values) "…&@ @‰9ƒ \nLˆ‚ A@\n!ˆ*A A‚‡" [vars values value var] 3] 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]] 3) (defalias 'emerge-query-write-file #[nil "ÀÁ!‡" [emerge-query-and-call write-file] 2 "\ 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." nil]) (defalias 'emerge-query-save-buffer #[nil "ÀÁ!‡" [emerge-query-and-call save-buffer] 2 "\ 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." nil]) (defalias 'emerge-query-and-call #[(command) "ÀÁ!ƒ.\nÃYƒ\n WƒÅ\n!ˆÆ!ˆ\nÃY…-\n W…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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] emerge-copy-modes #[(buffer) "pÁŽ\nqˆ * ‡" [StartBuffer ((set-buffer StartBuffer)) buffer major-mode] 1]] 3) (defalias 'emerge-force-define-key #[(keymap key definition) "À \n\"‰¨ƒÄ \nÅ OÆ#ˆ)Ä \n#‡" [lookup-key keymap key v define-key 0 nil definition] 6 "\ Like `define-key', but forcibly creates prefix characters as needed. If some prefix of KEY has a non-prefix definition, it is redefined."]) (defalias (quote emerge-define-key-if-possible) #[(keymap key definition) "À \n\"‰¨ƒÀ \nÄ O\"?…)Å \n#‚) ?…)Å \n#)‡" [lookup-key keymap key present 0 define-key definition] 6]) (defalias 'emerge-show-file-name #[nil "À ‰„ ÂË)‡" [buffer-file-name name "Buffer has no file name." ((byte-code "ÀÁ !ˆÂ ˆ cˆÄ ?…;ÅÄ „)Ç SÈ Vƒ)ÉÊ!ˆ‚Ë ‰ Í=?…: C‰*‡" [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 "\ 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." nil]) (defalias 'emerge-make-auto-save-file-name #[nil "ƒ*Á!ÂÃ!ÂRÅ !ƒ ‚(ÆÇ!ÈÃ!ÉÊÁ!!°)‡ËÆÇ!ÌÍÎ !ÏÐÑ!°!‡" [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 "\ 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'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias emerge-hash-string-into-string #[(s) "ÀÁ‰‰‰‰%Á\n GWƒ+ \nŦ \nŦHÆ_ \nH\\ǦIˆ\nT‰‚ ÈÉ Ê#*‡" [vector 0 i bins s 5 35 65536 mapconcat #[(b) "Á¦Â\\‰ÃYƒTÄ!‡" [b 93 33 47 char-to-string] 3] ""] 7] emerge-unslashify-name #[(s) "ÀÂà #ƒ- À‰”O À”À•OŘƒÆ‚Ç À•ÈOQÀ•T‚) ‡" [0 limit string-match "[/\\]" s "/" "\\!" "\\\\" nil] 5]] 3) (defvar emerge-metachars "[ \n!\"#$&'()*;<=>?[\\^`{|~]" "\ Characters that must be quoted with \\ when used in a shell command line. More precisely, a [...] regexp to match any one such character.") (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias emerge-protect-metachars #[(s) "À #ƒ À‰”OÅ À”ÆOQÀ•T‚) ‡" [0 limit string-match emerge-metachars s "\\" nil] 5] provide emerge] 3) emacs-19.22/lisp/env.elc100666 74777 1 2121 5416165127 13511 0ustar ericdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 22:58:31 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/env.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'setenv #[(variable &optional value) "ÀÁ\n\"ƒ ÃÄ\n\"‡ÅÆ\nÁP!PÇ \n  …dÀ  @\"ƒN Ç=ƒ>Í @\"‚G \nÁ Q ˆÇ‰ ‚ A‰ „\nÁ QB‚+‡" [string-match "=" variable error "Environment variable name `%s' contains `='" "\\`" regexp-quote nil process-environment scan case-fold-search pattern value delq] 5 "\ 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. This function works by modifying `process-environment'." "sSet environment variable: \nsSet %s to value: "]) (provide (quote env)) emacs-19.22/lisp/etags.elc100666 12062 1 66114 5475264607 13663 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:27:18 1993 ;;; from file /home/fsf/rms/e19/lisp/etags.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (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 nil "\ *Non-nil means always add a new tags table to the current list. This eliminates the need to ask the user whether to add a new tags table to the current list (as opposed to starting a new list).") (defvar tags-table-list-pointer nil "\ Pointer into `tags-table-list' where the current state of searching is. Might instead point into a list of included tags tables. Use `visit-tags-table-buffer' to cycle through tags tables in this list.") (defvar tags-table-list-started-at nil "\ Pointer into `tags-table-list', where the current search started.") (defvar tags-table-parent-pointer-list nil "\ Saved state of the tags table that included this one. Each element is (POINTER . STARTED-AT), giving the values of `tags-table-list-pointer' and `tags-table-list-started-at' from before we moved into the current table.") (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.") (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.") (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].") (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.") (defvar tags-table-format-hooks (quote (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-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.") (defalias (quote 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]) (defalias 'visit-tags-table #[(file &optional local) "ŠÂÃ!„ÄÅÆÇE\"ˆ *ƒÉÁ!L‡ÊÁ\"‡" [file tags-file-name visit-tags-table-buffer same signal file-error "Visiting tags table" "file does not exist" local make-local-variable set-default] 5 "\ 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." (list (read-file-name "Visit tags table: (default TAGS) " default-directory (expand-file-name "TAGS" default-directory) t) current-prefix-arg)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias tags-next-table #[(&optional no-includes) "„ÁÂ!ƒà ƒ BB  ‚K A‰„( =ƒKƒI@@@AAÈÉ!ˆ‚KÊ …VË @!‰ ‡" [no-includes visit-tags-table-buffer same tags-included-tables tags-table-list-pointer tags-table-list-started-at tags-table-parent-pointer-list tags-table-list tags-next-table t nil tags-expand-table-name tags-file-name] 3] tags-expand-table-name #[(file) "À ! !ƒÀà \"‡ ‡" [expand-file-name file file-directory-p "TAGS"] 3] tags-table-list-member #[(file &optional list) "„  !ƒ Â@!˜„A‰„‡" [list tags-table-list tags-expand-table-name file] 4] tags-table-including #[(this-file tables core-only &optional recursing) "À „w\nƒwÃ\n@!Å !„ „pÇ !ƒpÈÉ!ˆ\n„. \n \nƒ;\n‚pÍ ƒpÐŽ„NÀÒ  Ó$‰ƒoBB  Ö*)\nA‚ )‡" [nil found tables tags-expand-table-name tags-file-name get-file-buffer core-only file-exists-p visit-tags-table-buffer same tags-table-files tags-table-files-function this-file tags-included-tables tags-table-parent-pointer-list old ((byte-code "„ Ÿ\n¤Ç" [recursing tags-table-parent-pointer-list old nil] 2)) recursing tags-table-including t tags-table-list-pointer tags-table-list-started-at included visit-tags-table-buffer-cont] 6]] 3) (defalias 'visit-tags-table-buffer #[(&optional cont) "‰Â=ƒ „ÄÅÆÇP!!ˆÈ‚¶ ƒ>É ƒ¶Ê ! Ì !†2Í !)„¶É „\"‚¶ÃÎ žA†µƒQ †µŠÐÓ#)†fŠÐÈ#)@†µ ƒxÔ !„x †µÈ ‰ƒ¥Ê@!‰ ƒ¥Ì !„¥Í !„¥A‰„ƒ@*†µÖ×ØÚÓ$!Ê ! Ó=…Ã??…ÉÌ !ƒÈÌ !qˆ†ÜÞ ßp!„êàá!„õ…ü ‚üâÓ‰\"ˆÞ )‚\"ã !qˆ ˜„  ‰$ƒ$ ˆ)Þ ƒ³åp!ˆ „¯Ô !‰&„¦'‰(ƒSÔ (@\"‰&„S(A‰(„>(ƒo'>„g'B'(@‚¥ƒŠ)„êëìP!ƒŠ B‚¡íî!ˆ'>„'B' C&)&/&)Ó‚É  ðÃ!ˆ =ƒÃÈ)Äñ\")‡" [cont visit-tags-table-buffer-cont same tags-file-name error substitute-command-keys "No tags table in use! " "Use \\[visit-tags-table] to select one." nil tags-next-table tags-expand-table-name file get-file-buffer file-exists-p buffer-local-variables default-tags-table-function tags-table-including buffer-file-name tags-table-list t tags-table-list-member list expand-file-name read-file-name "Visit tags table: (default TAGS) " default-directory "TAGS" tags-table-list-pointer win verify-tags-table-function initialize-new-tags-table verify-visited-file-modtime yes-or-no-p "Tags file has changed, read new contents? " revert-buffer find-file-noselect tail bury-buffer elt tags-table-set-list sets tags-add-tables y-or-n-p "Add to current list" " of tags tables? " message "Starting a new list of tags tables" tags-table-list-started-at kill-local-variable "File %s is not a valid tags table"] 7 "\ Select the buffer containing the current 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 'file-of-tag #[nil " ‡" [file-of-tag-function] 1 "\ 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 'tags-table-files #[nil "† ‰‡" [tags-table-files tags-table-files-function] 2 "\ 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-included-tables #[nil "† ‰‡" [tags-included-tables tags-included-tables-function] 2 "\ Return a list of tags tables included by the current table. Assumes the tags table is the current buffer."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias tags-completion-table #[nil "†ÁÂÇ" [tags-completion-table nil (byte-code "ÀÁ\n\"ˆÃ Šƒ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] 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] 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] 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]] 3) (defvar last-tag nil "\ Last tag found by \\[find-tag].") (defalias (quote 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]) (defalias 'find-tag-noselect #[(tagname &optional next-p regexp-p) "\nÃ=ƒ2 „ÅÆ!‚š @ AÈ!qÉ!bˆʉ“ˆËÁ!ˆ)‚š\nƒ=ÌÍ!ˆ‚DÌ ˆÈÐ ŠÑ\nƒT‚Vƒ`‚bƒl‚nƒx‚zƒƒÙ‚„Ú\n?&qˆ`Ê“* B‰@!ËÁ!ˆ)‡" [find-tag-hook local-find-tag-hook next-p - tags-location-stack error "No previous tag locations" marker marker-buffer marker-position nil run-hooks visit-tags-table-buffer same tagname last-tag make-marker find-tag-in-order regexp-p find-tag-regexp-search-function find-tag-search-function find-tag-regexp-tag-order find-tag-tag-order find-tag-regexp-next-line-after-failure-p find-tag-next-line-after-failure-p "matching" "containing"] 8 "\ 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'." (find-tag-interactive "Find tag: ")]) (defalias 'find-tag #[(tagname &optional next-p regexp-p) "ÀÁ\n #!‡" [switch-to-buffer find-tag-noselect tagname next-p regexp-p] 5 "\ 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'." (find-tag-interactive "Find tag: ")]) (defalias 'find-tag-other-window #[(tagname &optional next-p regexp-p) "ÀÁ ! #‰qˆ`ÈÁ É!ˆÈÁ \"ˆ\"+‡" [window-point selected-window find-tag-noselect tagname next-p regexp-p tagbuf tagpoint set-window-point switch-to-buffer-other-window] 6 "\ 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'." (find-tag-interactive "Find tag other window: ")]) (defalias 'find-tag-other-frame #[(tagname &optional next-p) "À \")‡" [t pop-up-frames find-tag-other-window tagname next-p] 3 "\ 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'." (find-tag-interactive "Find tag other frame: ")]) (defalias 'find-tag-regexp #[(regexp &optional next-p other-window) "ƒÁ‚  Å#‡" [other-window find-tag-other-window find-tag regexp next-p t] 4 "\ 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'." (find-tag-interactive "Find tag regexp: " t)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"‡" [defalias find-tag-in-order #[(pattern search-forward-func order next-line-after-failure-p matching first-search) "À‰‰Á\nÀŠ „ÊË!ˆÌ͈Îyˆ`BÐÑ ! Ô!qˆ~ˆÕ ˆ !ˆÖ×!ˆp.‡" [nil t order 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ÁÂ!ƒf ƒÄ ƒƒebˆÄƒ_ \nÄÂ#ƒT@\n!ƒIŠËyˆ`) >„IÌÍÄ\"ˆƒ&Ïyˆ‚&Aebˆ‚!‚ÑÒ ƒpÓ‚qÔ\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 make-local-variable tags-file-name] 6] 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-exact-match-p tag-word-match-p tag-any-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] etags-verify-tags-table #[nil "ÀfÁ=‡" [1 12] 2] etags-file-of-tag #[nil "ŠÀÁ!ˆÂuˆ`ÃÄwˆ`{)‡" [search-backward " \n" 2 "^," nil] 3] 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] etags-snarf-tag #[nil "À‰ÃÄ!ˆ`SŠÅyˆ`){ÃÆŠÇyˆ`)È#ˆÃÉ!ˆÊ`ËÀwˆ`{!Çyˆ\n *B‡" [nil startpos tag-text search-forward "" 0 "" 1 t "," string-to-int "0-9"] 4] etags-goto-tag-location #[(tag-info) "AÁ Ä=ƒÅ‚ÆÇ@!P \n‰ „#e  „H \nZbˆo„HÌ \n\\Ä# \nÍ_\n‚# „^ÌÂÄ#„^ÎÏ#ˆ, Ä=ƒnÑÒ!ƒnÓuˆÔyˆÂ‡" [tag-info 1000 nil selective-display t "\\(^\\| \\)" "^" regexp-quote pat found offset startpos re-search-forward 3 error "`%s' not found in %s; time to rerun etags" buffer-file-name looking-at " " 1 0] 7] etags-list-tags #[(file) "ÀbˆÁ ÄQÅÆ#??…1Àyˆm„0ÇÈ!„0É`ÊÅwˆ`{!ˆË ˆÀyˆ‚Ƈ" [1 search-forward " \n" file "," nil t looking-at " " princ "^" terpri] 4] etags-tags-apropos #[(string) "ÀbˆÁ\nÃÄ#…!ÅyˆÆ`ÇÃwˆ`{!ˆÈ ˆÀyˆ‚‡" [1 re-search-forward string nil t 0 princ "^" terpri] 4] etags-tags-table-files #[nil "À‰ebˆÃÄÀÅ#ƒ&`ÆÀwˆÇÈ!„É `{!\nB‚\nŸ*‡" [nil beg files search-forward " \n" t "^,\n" looking-at ",include$" expand-file-name] 4] etags-tags-included-tables #[nil "À‰ebˆÃÄÀÅ#ƒ&`ÆÀwˆÇÈ!ƒÉ `{!\nB‚\nŸ*‡" [nil beg files search-forward " \n" t "^,\n" looking-at ",include$" expand-file-name] 4] 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] tag-exact-match-p #[(tag) "ÀÁ !ÄQ!†(ÀÅ!…(ÀÆ!…(ŠÇ GT!ˆÀÈ!…'ÀÉ!)‡" [looking-at "[^]*" regexp-quote tag "" "\\Sw.*" "\\S_.*" backward-char "\\Sw" "\\S_"] 4] tag-word-match-p #[(tag) "ÀÁ!…ŠÂ GT!ˆÀÄ!)‡" [looking-at "\\b.*" backward-char tag "\\b"] 2] tag-any-match-p #[(tag) "ÀÁ!‡" [looking-at ".*"] 2] tag-re-match-p #[(re) "ŠÀyˆ`ÂÊĈ`)Å#…Æ Å#*‡" [0 bol search-forward "" nil t re-search-backward re] 4]] 3) (defalias 'next-file #[(&optional initialize novisit) "ƒÁ=ƒŠÂ ˆÃ )‚Å! „DŠÂÆ!ƒ0ÂÁ!ƒ0à ‚Cƒ?ÈÉ!ƒ?ÊÉ!ˆËÌ!ˆ)Í @!?‰ƒT„_Ï @\"qˆ‚tÐÉ!qˆÑ ˆÒ ˆ @ÓÔ\"ˆ A)‡" [initialize t visit-tags-table-buffer tags-table-files next-file-list eval same novisit get-buffer " *next-file*" kill-buffer error "All files processed." get-file-buffer new find-file-noselect get-buffer-create kill-all-local-variables erase-buffer insert-file-contents nil] 4 "\ 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." "P"]) (defvar tags-loop-operate nil "\ Form for `tags-loop-continue' to eval to change one file.") (defvar tags-loop-scan (quote (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.") (defalias 'tags-loop-continue #[(&optional first-time) "À‰ „Œ~ˆÄ !)„?Æ Ç\" „- „7 Vƒ7ljƒ7ÊË\n†5 \"ˆÀebˆ‚\nƒU` Î ˆÏ\n!qˆ~ˆ bˆ)Ðp!ˆÄ!„ …o?…oÊÒ \"*‡" [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 "\ 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 execute to operate on an interesting file If the latter returns non-nil, we exit; otherwise we scan the next file." nil]) (defalias 'tags-search #[(regexp &optional file-list-form) "Ášƒ\n@Ã=ƒ „ÅÆ!‡ÃÆÇFÆņ$Ç!‡" [regexp "" tags-loop-scan re-search-forward tags-loop-operate tags-loop-continue nil t file-list-form] 4 "\ 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'." "sTags search (regexp): "]) (defalias 'tags-query-replace #[(from to &optional delimited file-list-form) "ÀÁ ÄÅFÆEDÈ  ʼn\n¯ Ì †Å!‡" [prog1 if re-search-forward from nil t (goto-char (match-beginning 0)) tags-loop-scan perform-replace to delimited tags-loop-operate tags-loop-continue file-list-form] 6 "\ 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'." "sTags query replace (regexp): \nsTags query replace %s by: \nP"]) (defalias 'list-tags #[(file) "ÀÁÂ!ˆÁ !ˆÄ ˆŠÅÆÉ?!ƒ,Æ\n !ƒÅ‚†5ËÌ \"+‘‡" ["*Tags List*" princ "Tags in file " file terpri t nil gotany first-time visit-tags-table-buffer list-tags-function error "File %s not in current tags tables"] 4 "\ Display list of tags in file FILE. FILE should not contain a directory specification." (list (completing-read "List tags in file: " (save-excursion (visit-tags-table-buffer) (mapcar (quote list) (mapcar (quote file-name-nondirectory) (tags-table-files)))) nil t nil))]) (defalias 'tags-apropos #[(regexp) "ÀÁÂ!ˆÃ !ˆÅ ˆŠÆÈ?!…$É\n !ˆ‚*‘‡" ["*Tags List*" princ "Tags matching regexp " prin1 regexp terpri t first-time visit-tags-table-buffer nil tags-apropos-function] 3 "\ Display list of all tags in tags table REGEXP matches." "sTags apropos (regexp): "]) (defalias 'select-tags-table #[nil "ÀÁ!ˆÂÄ ˆÅ \n ƒ2Ì  Í p\"ˆÎcˆÏ @p\"ˆÐcˆ\nƒ^\n@ =„UÍ\n@p\"ˆÎcˆÏ\n@@p\"ˆÐcˆ\nA‰\n„7ƒ{ „lÌ  αˆÏp\"ˆÐcˆÒÓÔ ÕÖ\"B\"\"‰\nƒ®\n@αˆÏ\n@p\"ˆÐcˆÒ\n@\n\"‰\n„×bˆØÙ!ˆ ƒ¾ bˆÚÛ ×Å#ˆ*ÜÂ!ˆÅÝß  á âã#ˆá äå#ˆá æç#ˆá èå#ˆá éç#ˆá êë#ˆì !)‡" [pop-to-buffer "*Tags Table List*" nil buffer-read-only erase-buffer t selective-display selective-display-ellipses tags-table-set-list desired-point set-list tags-table-list point-marker princ " " prin1 "\n" tags-file-name delete apply nconc mapcar copy-sequence 1 insert-before-markers "Type `t' to select a tags table or set of tags tables:\n\n" set-window-start selected-window set-buffer-modified-p "Select Tags Table" mode-name make-sparse-keymap map define-key "t" select-tags-table-select " " next-line "" previous-line "n" "p" "q" select-tags-table-quit use-local-map] 9 "\ 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-file-list'; see the doc of that variable if you want to add names to the list." nil]) (defalias 'select-tags-table-select #[nil "ÀÁ!ˆÂp!Ä !ˆÅ ˆÆÇ \")‡" [search-forward " " read name visit-tags-table select-tags-table-quit message "Tags table now %s"] 3 "\ Select the tags table named on this line." nil]) (defalias 'select-tags-table-quit #[nil "Àp!ˆÁ †  ‡" [kill-buffer one-window-p delete-window] 2 "\ Kill the buffer and delete the selected window." nil]) (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 "\ 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)." nil]) (provide (quote etags)) emacs-19.22/lisp/faces.elc100666 12120 1 53644 5475264700 13671 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:28:15 1993 ;;; from file /home/fsf/rms/e19/lisp/faces.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#ˆÀÆÇ\"‡" [defalias internal-facep #[(x) "À !… GÂU… ÃHÄ=‡" [vectorp x 8 0 face] 2] put byte-optimizer byte-compile-inline-expand internal-check-face (macro . #[(face) "ÀÁ DDÄ ÅÆÇÈ EEEE‡" [while not internal-facep face setq signal (quote wrong-type-argument) list (quote internal-facep)] 9])] 4) (defalias 'face-name #[(face) "À !ÂH‡" [internal-get-face face 1] 2 "\ Return the name of face FACE."]) (put (quote face-name) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'face-id #[(face) "À !ÂH‡" [internal-get-face face 2] 2 "\ Return the internal ID number of face FACE."]) (put (quote face-id) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'face-font #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 3] 3 "\ 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."]) (put (quote face-font) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'face-foreground #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 4] 3 "\ 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."]) (put (quote face-foreground) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'face-background #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 5] 3 "\ 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."]) (put (quote face-background) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'face-underline-p #[(face &optional frame) "À \n\"ÃH‡" [internal-get-face face frame 7] 3 "\ 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."]) (put (quote face-underline-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'set-face-font #[(face font &optional frame) ";ƒ Á\n #Ä\nÀÅ %‡" [font x-resolve-font-name face frame internal-set-face-1 3] 6 "\ 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." (internal-face-interactive "font")]) (put (quote set-face-font) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'set-face-foreground #[(face color &optional frame) "À Â Ä %‡" [internal-set-face-1 face foreground color 4 frame] 6 "\ 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." (internal-face-interactive "foreground")]) (put (quote set-face-foreground) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'set-face-background #[(face color &optional frame) "À Â Ä %‡" [internal-set-face-1 face background color 5 frame] 6 "\ 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." (internal-face-interactive "background")]) (put (quote set-face-background) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'set-face-underline-p #[(face underline-p &optional frame) "À Â Ä %‡" [internal-set-face-1 face underline underline-p 7 frame] 6 "\ 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." (internal-face-interactive "underline-p" "underlined")]) (put (quote set-face-underline-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (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.") (defalias 'face-list #[nil "ÀÁ\n\"‡" [mapcar car global-face-data] 3 "\ Returns a list of all defined face names."]) (defalias 'internal-find-face #[(name &optional frame) "Á=ƒ\n9„\nÄ !ÅH)\n9ƒ0\nÁ=ƒ%‚-dž,È !žA‡\n Ê !…H GËU…H ÌHÃ=)„WÍÎÏ\nD\"‰‚1\n‡" [frame t name face internal-get-face 1 global-face-data frame-face-alist selected-frame x vectorp 8 0 signal wrong-type-argument internal-facep] 5 "\ 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-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] 5 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias internal-set-face-1 #[(face name value index frame) "À\n„Oà ‰ƒ*ÅÇ!ÈH) \n @%ˆ A‰„ Ç9ƒ6‚AÇ!ÈH)À\" \nIˆ\n)‚r\nÀ=„hÌÇ!ÍH) \n\n$ˆÇ\n\" \nI)‡" [t inhibit-quit frame frame-list frames internal-set-face-1 face internal-get-face 1 name value index set-face-attribute-internal 2] 7] read-face-name #[(prompt) "ÀÀGÂUƒà ÅÆÇ \"ÀÈ$‰‚É !)‡" [nil face 0 completing-read prompt mapcar #[(x) "À !C‡" [symbol-name x] 2] face-list t intern] 6] internal-face-interactive #[(what &optional bool) "ÀÁ\nP!Ä\nÅQÇÈP! Ê !…(  Ë \"†( ÌË \"  ƒ?ÎÏÐ !Ñ Ò°!‚LÓÔÐ !ÕR \" ך?…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]] 3) (defalias 'make-face #[(name) "À !†`ÂÃÄ\"‰ÆÅIˆ Ç IˆÈ  Ê Ì  Î !ˆ Ï Iˆ ƒJÐ @ Ñ !BÒ @!B\"ˆ A‰ „0 BB+Õ=ƒ^Ö !ˆ )‡" [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 make-face-x-resource-internal] 6 "\ 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." "SMake face: "]) (defalias (quote make-face-x-resource-internal) #[(face &optional frame set-anyway) "„%Á ‰ƒ!à Å !ÆH)\n@#ˆ\nA‰„ )‚èÅ Å !ÆH)\"È Å !ÆH)! Ê ËPÌ\"†W…W ÍÅ \"ÎH*Ê ÐPÑ\"†s…s ÍÅ \"ÒH*Ê ÔPÕ\"†… ÍÅ \"ÖH*Ê ØPÙ\"†«…« ÍÅ \"ÚH*ƒ·ÍÜ݈ƒÁÍÞ߈ƒËÍàሄՃç \"ã ä\"Ú%ˆ+- ‡" [frame frame-list frames make-face-x-resource-internal face internal-get-face 1 set-anyway symbol-name name x-get-resource ".attributeFont" "Face.AttributeFont" nil 3 fn ".attributeForeground" "Face.AttributeForeground" 4 fg ".attributeBackground" "Face.AttributeBackground" 5 bg ".attributeUnderline" "Face.AttributeUnderline" 7 ulp (byte-code " \n ;ƒÄ \n#Åà Æ\n%ˆ+ć" [face fn frame font x-resolve-font-name internal-set-face-1 3] 6) ((error (message "font `%s' not found for face `%s'" fn name))) (byte-code " \nÄÅ Æ\n%ˆ+ć" [face fg frame color internal-set-face-1 foreground 4] 6) ((error (message "color `%s' not allocated for face `%s'" fg name))) (byte-code " \nÄÅ Æ\n%ˆ+ć" [face bg frame color internal-set-face-1 background 5] 6) ((error (message "color `%s' not allocated for face `%s'" bg name))) underline-p internal-set-face-1 underline] 7]) (defalias 'copy-face #[(old-face new-name &optional frame new-frame) "„  \"ÄÆ\"†È! „DÊ ‰ ƒ9Ì  @#ˆ A‰ „'Ì Ä#ˆ)‚Ó   \"ÎH* ;ƒhÐ #Ñ ÏÎ %ˆ+   \"ÒH* Ñ ÔÒ %ˆ+   \"ÕH* Ñ ÖÕ %ˆ+   \"×H* Ñ Ù× %ˆ+ *‡" [new-frame frame internal-get-face old-face t inhibit-quit internal-find-face new-name make-face new-face frame-list frames copy-face face 3 font x-resolve-font-name internal-set-face-1 4 color foreground 5 background 7 underline-p underline] 7 "\ Define a face just like OLD-FACE, with name NEW-NAME. If NEW-NAME already exists as a face, it is modified to be like OLD-FACE. If the optional argument FRAME is given, this applies only to that frame. Otherwise it applies to each frame separately. If the optional fourth argument NEW-FRAME is given, copy the information from face OLD-FACE on frame FRAME to face NEW-NAME on frame NEW-FRAME."]) (defalias 'face-equal #[(face1 face2 &optional frame) "À \n\"À \n\" \nÀ \n\"ÅH* \nÀ \n\"ÅH*š…U \nÀ \n\"ÆH* \nÀ \n\"ÆH*š…U \nÀ \n\"ÇH* \nÀ \n\"ÇH*š‡" [internal-get-face face1 frame face2 face 4 5 3] 4 "\ True if the faces FACE1 and FACE2 display in the same way."]) (defalias 'face-differs-from-default-p #[(face &optional frame) "ÀÁ\n\"À \n\" \nÀ \n\"ÄH* \nÀ \n\"ÄH*š„3 \nÀ \n\"ÄH*?…œ \nÀ \n\"ÅH* \nÀ \n\"ÅH*š„\\ \nÀ \n\"ÅH*?…œ \nÀ \n\"ÆH* \nÀ \n\"ÆH*š„… \nÀ \n\"ÆH*?…œ \nÀ \n\"ÇH* \nÀ \n\"ÇH*š)?‡" [internal-get-face default frame face 4 5 3 7] 4 "\ 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."]) (defalias 'invert-face #[(face &optional frame) "À \n\"‰\nÀ \n\"ÃH* \nÀ \n\"ÄH*‰„& ƒL \nÈ ÉÃ\n%ˆ+ \nÈ ÊÄ\n%ˆ+‚” Ë\nÀ \n\"ÄH*†aÌÍ\n!žA\nÈ ÉÃ\n%ˆ+ Ë\nÀ \n\"ÃH*†…ÎÍ\n!žA\nÈ ÊÄ\n%ˆ+* ‡" [internal-get-face face frame 4 5 bg fg color internal-set-face-1 foreground background default background-color frame-parameters foreground-color] 7 "\ 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." (list (read-face-name "Invert face: "))]) (defalias 'internal-try-face-font #[(face font &optional frame) "ÀÁ‡" [nil (byte-code " \n ;ƒà \n#ÄÁ Å\n%+‡" [face font frame x-resolve-font-name internal-set-face-1 3] 6) ((error))] 3 "\ Like set-face-font, but returns nil on failure instead of an error."]) (byte-code "ÀÀÀÀÅƉÇÈÉÊÈËÌ͉‰ÎÌƉàá°âã° QQ.À‡" [nil x-font-regexp x-font-regexp-head x-font-regexp-weight x-font-regexp-slant "[-?]" "[^-]+" "\\(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 - "\\`\\*?[-?*]" "[-?*]\\*?\\'" "\\`[-?*]" "\\([-*?]\\|\\'\\)"] 27) (defalias 'x-resolve-font-name #[(pattern &optional face frame) "9„Á!ÂH) Ä=ƒÅƒ>Ç #‰„9ƒ3ÉÊ\"ˆ‚9ÉË\"ˆ@)‡ÌÍÎ !žA‡" [face internal-get-face 1 frame t nil pattern x-list-fonts fonts error "No fonts matching pattern are the same size as `%s'" "No fonts match `%s'" font frame-parameters selected-frame] 5 "\ 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, try to return a font which is also the same size as FACE on FRAME."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias x-frob-font-weight #[(font which) "À \n\"„À \n\"„À \n\"…\"\nÅÆ”O\nÆ•ÈOQ‡" [string-match x-font-regexp font x-font-regexp-head x-font-regexp-weight 0 1 which nil] 5] x-frob-font-slant #[(font which) "À \n\"„À \n\"ƒ\nÄÅ”O\nÅ•ÇOQ‡À\n\"ƒ2\nÄÉ”O\nÉ•ÇOQ‡Ç‡" [string-match x-font-regexp font x-font-regexp-head 0 2 which nil x-font-regexp-slant 1] 5]] 3) (defalias 'x-make-font-bold #[(font) "À Â\"‡" [x-frob-font-weight font "bold"] 3 "\ Given an X font specification, make a bold version of it. If that can't be done, return nil."]) (defalias 'x-make-font-demibold #[(font) "À Â\"‡" [x-frob-font-weight font "demibold"] 3 "\ Given an X font specification, make a demibold version of it. If that can't be done, return nil."]) (defalias 'x-make-font-unbold #[(font) "À Â\"‡" [x-frob-font-weight font "medium"] 3 "\ Given an X font specification, make a non-bold version of it. If that can't be done, return nil."]) (defalias 'x-make-font-italic #[(font) "À Â\"‡" [x-frob-font-slant font "i"] 3 "\ Given an X font specification, make an italic version of it. If that can't be done, return nil."]) (defalias 'x-make-font-oblique #[(font) "À Â\"‡" [x-frob-font-slant font "o"] 3 "\ Given an X font specification, make an oblique version of it. If that can't be done, return nil."]) (defalias 'x-make-font-unitalic #[(font) "À Â\"‡" [x-frob-font-slant font "r"] 3 "\ Given an X font specification, make a non-italic version of it. If that can't be done, return nil."]) (defalias 'make-face-bold #[(face &optional frame noerror) "Á=ƒH\nÁÃ\n\"ÄH*<ƒH\nÅ\nÁÃ\n\"ÄH*>ƒ*Æ‚+ÇÁ;ƒ>É\n#Ê\nÈÄ%+‡\nÃ\n\"ÄH*ˉ  „…Î Ð\nÁ#ˆƒÐ\n@#ˆA‰„o)‚ÍÃ\n\"‰Ã\n\"ÄH*†£\nÁÃ\n\"ÄH*‰<ƒ­Ë†ÆÒÃ\n\"ÄH*†ÆÈÓ!žAÔ\n\"ˆ \nËÃ\n\"ÄH*š?†ê?…êÕÖ\"+‡" [frame t face internal-get-face 3 italic (bold italic) (bold) font x-resolve-font-name internal-set-face-1 nil f2 ofont frame-list frames make-face-bold noerror default frame-parameters make-face-bold-internal error "No bold version of %S"] 7 "\ Make the font of the given face be bold, if possible. If NOERROR is non-nil, return nil on failure." (list (read-face-name "Make which face bold: "))]) (defalias (quote make-face-bold-internal) #[(face frame) "À !‰ƒà \n #†Æ !‰…à \n #‡" [x-make-font-bold font f2 internal-try-face-font face frame x-make-font-demibold] 4]) (defalias 'make-face-italic #[(face &optional frame noerror) "Á=ƒH\nÁÃ\n\"ÄH*<ƒH\nÅ\nÁÃ\n\"ÄH*>ƒ*Æ‚+ÇÁ;ƒ>É\n#Ê\nÈÄ%+‡\nÃ\n\"ÄH*ˉ  „…Î Ð\nÁ#ˆƒÐ\n@#ˆA‰„o)‚ÍÃ\n\"‰Ã\n\"ÄH*†£\nÁÃ\n\"ÄH*‰<ƒ­Ë†ÆÒÃ\n\"ÄH*†ÆÈÓ!žAÔ\n\"ˆ \nËÃ\n\"ÄH*š?†ê?…êÕÖ\"+‡" [frame t face internal-get-face 3 bold (bold italic) (italic) font x-resolve-font-name internal-set-face-1 nil f2 ofont frame-list frames make-face-italic noerror default frame-parameters make-face-italic-internal error "No italic version of %S"] 7 "\ Make the font of the given face be italic, if possible. If NOERROR is non-nil, return nil on failure." (list (read-face-name "Make which face italic: "))]) (defalias (quote make-face-italic-internal) #[(face frame) "À !‰ƒà \n #†Æ !‰…à \n #‡" [x-make-font-italic font f2 internal-try-face-font face frame x-make-font-oblique] 4]) (defalias 'make-face-bold-italic #[(face &optional frame noerror) "Á=ƒ4\nÁÃ\n\"ÄH*<ƒ4\nÅÁ;ƒ*Ç\n#È\nÆÄ%+‡\nÃ\n\"ÄH*É\n„nË  Í\nÁ#ˆ ƒjÍ\n @#ˆ A‰ „X)‚¶Ã\n\"‰Ã\n\"ÄH*†Œ\nÁÃ\n\"ÄH*‰<ƒ–Ɇ¯ÏÃ\n\"ÄH*†¯ÆÐ!žAÑ\n\"ˆ\n\nÉÃ\n\"ÄH*š?†Ó?…ÓÒÓ\"*‡" [frame t face internal-get-face 3 (bold italic) font x-resolve-font-name internal-set-face-1 nil ofont frame-list frames make-face-bold-italic noerror default frame-parameters make-face-bold-italic-internal error "No bold italic version of %S"] 7 "\ Make the font of the given face be bold and italic, if possible. If NOERROR is non-nil, return nil on failure." (list (read-face-name "Make which face bold-italic: "))]) (defalias (quote make-face-bold-italic-internal) #[(face frame) "À‰à !‰ƒ* \nš„*Å\n!‰ƒ*\n š„*Æ #†›É !‰ƒP \nš„PÅ\n!‰ƒP\n š„PÆ #†›Ã !‰ƒv \nš„vÊ\n!‰ƒv\n š„vÆ #†›É !‰…› \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]) (defalias 'make-face-unbold #[(face &optional frame noerror) "Á=ƒD\nÁÃ\n\"ÄH*<ƒD\nÅ\nÁÃ\n\"ÄH*>…'ÆÁ;ƒ:È\n#É\nÇÄ%+‡\nÃ\n\"ÄH*ʉ  „Í Ï\nÁ#ˆƒ}Ï\n@#ˆA‰„k)‚ÕÃ\n\"‰Ã\n\"ÄH*†Ÿ\nÁÃ\n\"ÄH*‰ <ƒ©Ê  †ÂÑÃ\n\"ÄH*†ÂÇÒ!žA Ó !‰ƒÕÔ\n#ˆ \nÊÃ\n\"ÄH*š?†ò?…òÕÖ \"+‡" [frame t face internal-get-face 3 italic (italic) font x-resolve-font-name internal-set-face-1 nil font1 ofont frame-list frames make-face-unbold noerror default frame-parameters x-make-font-unbold internal-try-face-font error "No unbold version of %S"] 7 "\ Make the font of the given face be non-bold, if possible. If NOERROR is non-nil, return nil on failure." (list (read-face-name "Make which face non-bold: "))]) (defalias 'make-face-unitalic #[(face &optional frame noerror) "Á=ƒD\nÁÃ\n\"ÄH*<ƒD\nÅ\nÁÃ\n\"ÄH*>…'ÆÁ;ƒ:È\n#É\nÇÄ%+‡\nÃ\n\"ÄH*ʉ  „Í Ï\nÁ#ˆƒ}Ï\n@#ˆA‰„k)‚ÕÃ\n\"‰Ã\n\"ÄH*†Ÿ\nÁÃ\n\"ÄH*‰ <ƒ©Ê  †ÂÑÃ\n\"ÄH*†ÂÇÒ!žA Ó !‰ƒÕÔ\n#ˆ \nÊÃ\n\"ÄH*š?†ò?…òÕÖ \"+‡" [frame t face internal-get-face 3 bold (bold) font x-resolve-font-name internal-set-face-1 nil font1 ofont frame-list frames make-face-unitalic noerror default frame-parameters x-make-font-unitalic internal-try-face-font error "No unitalic version of %S"] 7 "\ Make the font of the given face be non-italic, if possible. If NOERROR is non-nil, return nil on failure." (list (read-face-name "Make which face non-italic: "))]) (defvar list-faces-sample-text "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" "\ *Text string to display as the sample text for `list-faces-display'.") (defalias 'list-faces-display #[nil "ÀÁ Â\"ÃÄ Ã‰ ÊŠ qˆÌ  ƒM @ A ÎÏÐ!\"cˆ`cˆÓcˆÔ`SÈ$ˆ)‚eb)‘ˆÕÖÊ!Ì\"‰ƒc× !‚fØ @=†Á ‰ …Ù @ @$ˆ A‰ „xÃ)-‡" [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 get-buffer-window get-buffer window-frame frame-list copy-face] 7 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊ !Ë=ƒ Á ˆÌÍ!‡" [defalias face-initialize #[nil "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÇ\nË\n!ÌH) Î ‰…RÐ@!Ñ=ƒHÒ@!ˆA‰„8Ó)‡" [make-face default modeline highlight bold italic bold-italic region secondary-selection underline face internal-get-face 2 region-face frame-list frames framep x x-initialize-frame-faces nil] 3] x-initialize-frame-faces #[(frame) "ÀÁ\n\"„ÃÁ\nÄ#„ÅÁ\nÄ#„ÆÁ\n\"ˆÀÇ\n\"„6ÈÇ\nÄ#„6ÃÇ\nÄ#ˆÆÇ\n\"ˆÀÉ\n\"„hÊÉ\nÄ#„hÃÉ\nÄ#„hÅÉ\nÄ#ƒ]ÈÉ\nÄ#„hÈÉ\nÄ#ˆÆÉ\n\"ˆÀË\n\"„ˆÌ ƒ{Í ÎUƒƒÏË\n\"ˆ‚ˆÐÑÒˆÀÓ\n\"„£Í ÎUƒžÏÓ\n\"ˆ‚£ÐÔÕˆÀÖ\n\"„¯ÏÖ\n\"ˆÀ×\n\"„É×Ä\nÚ×Û\n%ˆ+ÀÜ\n\"†åÌ ƒÜÍ ÎUƒáÏÜ\n\"‡ÐÝÞ‡" [face-differs-from-default-p bold frame make-face-bold t make-face-unbold internal-x-complain-about-font italic make-face-italic bold-italic make-face-bold-italic highlight x-display-color-p x-display-planes 1 invert-face nil (byte-code "ÀÁ‡" [nil (byte-code "ÀÁ\nÅ Æ Ç\n%ˆ+À‡" [highlight "darkseagreen2" frame color face internal-set-face-1 background 5] 6) ((error (byte-code "ÀÁ\nÅ Æ Ç\n%ˆ+À‡" [highlight "green" frame color face internal-set-face-1 background 5] 6)))] 3) ((error (byte-code "ÀÁ\n\"‡" [invert-face highlight frame] 3))) region (byte-code "ÀÁ\nÅ Æ Ç\n%ˆ+À‡" [region "gray" frame color face internal-set-face-1 background 5] 6) ((error (byte-code "ÀÁ\n\"‡" [invert-face region frame] 3))) modeline underline underline-p face internal-set-face-1 7 secondary-selection (byte-code "ÀÁ‡" [nil (byte-code "ÀÁ\nÅ Æ Ç\n%+‡" [secondary-selection "paleturquoise" frame color face internal-set-face-1 background 5] 6) ((error (byte-code "ÀÁ\nÅ Æ Ç\n%+‡" [secondary-selection "green" frame color face internal-set-face-1 background 5] 6)))] 3) ((error (byte-code "ÀÁ\n\"‡" [invert-face secondary-selection frame] 3)))] 6] internal-x-complain-about-font (lambda (face frame)) x-create-frame-with-faces #[(&optional parameters) "„Á\n!‡Á\n!Ä!‰Ç \"ˆÈ\nž†-È ž†-ÊËÌÍ\"ÎBAƒ`Ï !Ñ ÒÓžABÓÒžABÔÓžABÕÓžABÖÓžAB¯\"ˆ)ƒ‡@×@A!¡ˆÊØÙˆÚ@A Û#ˆA‰„eÜ !ˆ +‡" [global-face-data x-create-frame parameters frame copy-alist faces rest set-frame-face-alist reverse default-frame-alist nil x-get-resource "reverseVideo" "ReverseVideo" ("on" "true") frame-parameters params modify-frame-parameters foreground-color background-color mouse-color cursor-color border-color copy-sequence (byte-code "@AÁÄ \n\"ÅH*<ƒbÆ@AÁÄ \n\"ÅH*>Ç@AÁÄ \n\"ÅH*>‰ƒFƒFÈ@@\n\"ˆ‚aƒUÉ@@\n\"ˆ‚aƒaÊ@@\n\"ˆ*Á‡" [rest nil frame face internal-get-face 3 bold italic make-face-bold-italic make-face-bold make-face-italic] 6) ((error)) make-face-x-resource-internal t x-initialize-frame-faces] 10] framep selected-frame x provide faces] 3) emacs-19.22/lisp/files.elc100666 12062 1 140233 5475265121 13665 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:30:40 1993 ;;; from file /home/fsf/rms/e19/lisp/files.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defconst delete-auto-save-files t "\ *Non-nil means delete a buffer's auto-save file when the buffer is saved.") (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.") (defconst make-backup-files (byte-code "Á=?‡" [system-type vax-vms] 2) "\ *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'.") (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 (quote backup-inhibited) (quote 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 (quote (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 (quote 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-truename nil "\ The truename of the file visited in the current buffer. This variable is automatically local in all buffers, when non-nil.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local buffer-file-truename put permanent-local t] 4) (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.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local buffer-file-number put permanent-local t] 4) (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.") (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 trim-versions-without-asking nil "\ *If t, deletes excess backup versions silently. If nil, asks 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.") (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.") (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'.") (put (quote write-file-hooks) (quote 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'.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local local-write-file-hooks put permanent-local t] 4) (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 (quote 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.") (byte-code "ÀÁ!„ ÂÁÃ\"ˆÀÄ!„ÂÄÃ\"ˆÂÅÆ\"‡" [fboundp lock-buffer defalias ignore unlock-buffer ange-ftp-completion-hook-function #[(op &rest args) "Á>ƒ Âà #‡Å \")‡" [op (file-name-completion file-name-all-completions) apply ange-ftp-hook-function args nil file-name-handler-alist] 4]] 3) (defalias 'pwd #[nil "ÀÁ\n\"‡" [message "Directory %s" default-directory] 3 "\ Show the current default directory." nil]) (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.") (defalias 'parse-colon-path #[(cd-path) "…7Á‰ÂÁÇPÈÇ #‰ƒ5 U?…+ÉÊ O!!C¤ Ë\\‚ ,‡" [cd-path nil 0 cd-colon cd-start cd-list cd-prefix ":" string-match substitute-in-file-name file-name-as-directory 1] 6 "\ Explode a colon-separated list of paths into a string list."]) (defalias 'cd-absolute #[(dir) "ÀÁ\n!! Ä=„Å\n!Æ\n!„ÇÈ\n\"‡É\n!ƒ&\n‰\n‡ÇË\n\"‡" [abbreviate-file-name expand-file-name dir system-type vax-vms file-name-as-directory file-directory-p error "%s is not a directory" file-executable-p default-directory "Cannot cd to %s: Permission denied"] 3 "\ Change current directory to given absolute file name DIR."]) (defalias 'cd #[(dir) "À !ƒ Âà !!‡ „ÅÆÇ!!‰†É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 "\ 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." "FChange default directory: "]) (defalias 'load-file #[(file) "ÀÁ\n!ÉÄ$‡" [load expand-file-name file nil t] 5 "\ Load the Lisp file named FILE." "fLoad file: "]) (defalias 'load-library #[(library) "À !‡" [load library] 2 "\ Load the library named LIBRARY. This is an interface to the function `load'." "sLoad library: "]) (defalias 'file-local-copy #[(file) "À !‰… \nà \")‡" [find-file-name-handler file handler file-local-copy] 4 "\ 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-truename #[(filename) "Á˜„ÂÃOÁ˜ƒ\"ÄÅ\"ƒ\"Æ!‰ǘƒ\"ÈÉ!‰\nƒ3\nË\"‚ Ì!͉Ñ!˜„TÒË!!Ó!ÔšƒgÑÌÑ!!!‚ŸÓ!ÕšƒvÑ!‚ŸÓ!PÖ!‰ƒž×!ƒ”Ë!‚ŸËP!‚Ÿ+)‡" [filename "~" 0 1 string-match "~[^/]*" expand-file-name "" "/" find-file-name-handler handler file-truename file-name-directory nil dirfile target dir directory-file-name file-name-as-directory file-name-nondirectory ".." "." file-symlink-p file-name-absolute-p] 5 "\ 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."]) (defalias 'file-chase-links #[(filename) "ÀÁ\nÆ !‰ƒC ÇUƒÈÉ\n\"ˆÊË \"ƒ6 ÌÀOÍÎÏÐÎÏ !!!!!!‚Ñ Ï !\" S‚ +‡" [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 "\ Chase links in FILENAME until a name that is not a link. Does not examine containing directories for links, unlike `file-truename'."]) (defalias 'switch-to-buffer-other-window #[(buffer) "À À\")‡" [t pop-up-windows pop-to-buffer buffer] 3 "\ Select buffer BUFFER in another window." "BSwitch to buffer in other window: "]) (defalias 'switch-to-buffer-other-frame #[(buffer) "À À\")‡" [t pop-up-frames pop-to-buffer buffer] 3 "\ Switch to buffer BUFFER in another frame." "BSwitch to buffer in other frame: "]) (defalias 'find-file #[(filename) "ÀÁ\n!!‡" [switch-to-buffer find-file-noselect filename] 3 "\ Edit file FILENAME. Switch to a buffer visiting file FILENAME, creating one if none already exists." "FFind file: "]) (defalias 'find-file-other-window #[(filename) "ÀÁ\n!!‡" [switch-to-buffer-other-window find-file-noselect filename] 3 "\ Edit file FILENAME, in another window. May create a new window, or reuse an existing one. See the function `display-buffer'." "FFind file in other window: "]) (defalias 'find-file-other-frame #[(filename) "ÀÁ\n!!‡" [switch-to-buffer-other-frame find-file-noselect filename] 3 "\ Edit file FILENAME, in another frame. May create a new frame, or reuse an existing one. See the function `display-buffer'." "FFind file in other frame: "]) (defalias 'find-file-read-only #[(filename) "À !ˆÂp‡" [find-file filename t buffer-read-only] 2 "\ Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." "fFind file read-only: "]) (defalias 'find-file-read-only-other-window #[(filename) "À !ˆÂp‡" [find-file-other-window filename t buffer-read-only] 2 "\ 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." "fFind file read-only other window: "]) (defalias 'find-file-read-only-other-frame #[(filename) "À !ˆÂp‡" [find-file-other-frame filename t buffer-read-only] 2 "\ 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." "fFind file read-only other frame: "]) (defalias 'find-alternate-file #[(filename) "À ƒÁÂÃÄ \"!„ÅÆ!ˆp Ä \n   ÏÐ!ˆÑÑÑ ÒŽÓ ˆÔ!ˆ)p=†IÖ!-‡" [buffer-modified-p yes-or-no-p format "Buffer %s is modified; kill anyway? " buffer-name error "Aborted" buffer-file-name buffer-file-number buffer-file-truename oname otrue onum ofile obuf rename-buffer " **lose**" 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 kill-buffer] 5 "\ 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." (byte-code "Á‰‰ƒÅ !Æ !ÇÈ\nÁ‰ %+C‡" [buffer-file-name nil file-dir file-name file file-name-nondirectory file-name-directory read-file-name "Find alternate file: "] 7)]) (defalias 'create-file-buffer #[(filename) "À !‰؃ Ä\n!)‡" [file-name-nondirectory filename lastname "" generate-new-buffer] 3 "\ 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 'generate-new-buffer #[(name) "ÀÁ\n!!‡" [get-buffer-create generate-new-buffer-name name] 3 "\ Create and return a buffer with a name based on NAME. Choose the buffer's name using `generate-new-buffer-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'.") (defalias 'abbreviate-file-name #[(filename) "À \n\"ƒÃÄ\nÅ•SÆO!!ƒ\nÅ•SÆO‰ƒAÀ@@\n\"ƒ8@A\nÅ•ÆOPA‰„# „TÊ ËÌÍÎ!!ÏQ) À \n\"ƒzÎ ‰GSHÐ=ƒlÑ‚mÒ\nÓ”Ó•O\nÅ•ÆOR\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 "~" "\\(/\\|$\\)" 47 "/" "" 1] 7 "\ 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."]) (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.") (defalias 'find-file-noselect #[(filename &optional nowarn) "ÀÁ\n!!Ã\n!ƒ ƒÅ\n!‡ÆÇ\n\"‡È\n! ÀÊ\n!! ÌÍ !› †gÏÐ „dƒdŠ@qˆƒ[ ˜ƒ[@)A‚9* †¶…¶ÏÐ „³ƒ³Š@qˆšƒª×!ƒªÌÍ!›šƒª@)A‚z*Ï „؃؄ØÚÛ\nÓ! $ˆ‚ð „ðƒð„ðÚÜ\nÓ!#ˆ„úƒ†  ƒF„´ß !„´×\n!„\"Æà\n\"ˆ‚´áâã !ƒ/ä‚0åæ\n!\"!ƒ´Š qˆçè‰\"ˆ)‚´Šé\n!‰ qˆê ˆÏëìˆÀ !-î=ƒŠÏ/ðñò\n!\"ƒ}ò\n!ó‰”O//4)„Šƒ—Á!‰ò\n!56!„«÷ø!ˆè8ù?\"ˆ) .‡" [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 nil buffer-list list found buffer-file-name buffer-file-truename same-truename buffer-file-number file-exists-p same-number nowarn message "%s and %s are the same file (%s)" "%s and %s are the same file" find-file-existing-other-name find-file-visit-truename verify-visited-file-modtime "File %s no longer exists!" yes-or-no-p format buffer-modified-p "File %s changed on disk. Discard your edits? " "File %s changed on disk. Read the new version? " file-name-nondirectory revert-buffer t create-file-buffer erase-buffer (insert-file-contents filename t) ((file-error (byte-code "À\n‰ƒ @ ƒÄ‚ A‰„)ć" [t error find-file-not-found-hooks hooks nil] 2))) 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 "\ 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 'after-find-file #[(&optional error warn noauto) "À !? „™ÄƒÇ !ƒÈÉ‚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 mapcar funcall find-file-hooks] 6 "\ 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. Finishes by calling the functions in `find-file-hooks'."]) (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 "\ 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." nil]) (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) ("\\.mss\\'" . scribe-mode) ("\\.pl\\'" . prolog-mode) ("\\.cc\\'" . c++-mode) ("\\.hh\\'" . c++-mode) ("\\.C\\'" . c++-mode) ("\\.H\\'" . c++-mode) ("\\.s\\'" . asm-mode) ("ChangeLog\\'" . change-log-mode) ("ChangeLog.[0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) ("\\.[12345678]\\'" . nroff-mode) ("\\.TeX\\'" . TeX-mode) ("\\.sty\\'" . LaTeX-mode) ("\\.bbl\\'" . LaTeX-mode) ("\\.bib\\'" . bibtex-mode) ("\\.article\\'" . text-mode) ("\\.letter\\'" . text-mode) ("\\.texinfo\\'" . texinfo-mode) ("\\.texi\\'" . texinfo-mode) ("\\.lsp\\'" . lisp-mode) ("\\.awk\\'" . awk-mode) ("\\.prolog\\'" . prolog-mode) ("\\.tar\\'" . tar-mode) ("^/tmp/Re" . text-mode) ("/Message[0-9]*\\'" . text-mode) ("^/tmp/fol/" . text-mode) ("\\.y\\'" . c-mode) ("\\.lex\\'" . c-mode) ("\\.oak\\'" . scheme-mode) ("\\.scm.[0-9]*\\'" . scheme-mode) ("\\.sgm\\'" . sgml-mode) ("\\.sgml\\'" . sgml-mode) ("\\.dtd\\'" . sgml-mode) ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode) ("\\.ml\\'" . lisp-mode)))) "\ Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION). Visiting a file whose name matches REGEXP causes FUNCTION to be called.") (defconst inhibit-local-variables-regexps (quote ("\\.tar$")) "\ List of regexps; if one matches a file name, don't look for local vars.") (defalias 'set-auto-mode #[nil "À‰‰ŠebˆÄÀwˆ ƒ¯‰ƒ-È@ \"„-A‰„)„¯ÊËŠÌÍ!…=Έ`)Ï#ƒ¯ÐÀwˆ`ÊËŠÀˆ`)Ï#ƒ¯ÑuˆÐÀxˆ` bˆŠÊÒ\nÏ#)ƒ£ÏÊÔ\nÏ#)ƒ­ÐÀwˆ`ÊÕ\nÏ#ƒÖuˆ‚’\nbˆÐÀxˆ× `{—ØP! ˆ‚o× \n{—ØP! ˆÏ ?…ý …ý ÀÞ=ß!„óƒóÈ@@\"ƒë@AA‚Ð)…ü +,‡" [nil done end beg " \n" enable-local-variables inhibit-local-variables-regexps temp string-match buffer-file-name search-forward "-*-" looking-at "^#!" 2 t " " -3 ":" case-fold-search "mode:" ";" -1 intern "-mode" auto-mode-alist mode name alist system-type vax-vms file-name-sans-versions] 5 "\ Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, or compares the filename against the entries in auto-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 (quote hack-local-variables-prop-line) #[nil "ŠebˆÀÁwˆÁŠÁˆ`)ÄÅ\nÆ#ƒ}ÇÈ!ƒ-ÉÊ˔˕{!BC‚}ŠÄÅ\nÆ#ƒ=`ÌZ‚AÍÎ!ˆ)`\nWƒzÇÏ!„RÍÐ!ˆÑ•bˆÊ˔˕{—!Œ`\n}ˆÒp!)‰B BÕÁwˆ*‚B Ÿ …¶Æ=„’…¶×‹…¶ …¶ @@ @A‰É=„­Ø\"ˆ* A‰„–Á+‡" [" \n " nil end result search-forward "-*-" t looking-at "[ ]*\\([^ \n :;]+\\)\\([ ]*-\\*-\\)" mode intern 1 3 error "-*- not terminated before end of line" "[ ]*\\([^ \n:]+\\)[ ]*:[ ]*" "malformed -*- line" 0 read val key " ;" enable-local-variables ((byte-code "Àp!ˆÁÂÃÄ !\"!‡" [switch-to-buffer 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]) (defalias 'hack-local-variables #[nil "À ˆŠdbˆÁÂdÃZe]Ä#ˆÅÇÈÉÅ#…*\nÅ=†*\n…*Ë‹)…Åɉ‰‰   ÒÉwˆl„Q`Ɉ`{Ó”bˆn„a`Óyˆ`{ƒqGÔ!ƒ~Ô!ÕP…ƒ×Ø!ˆ‚’Ùyˆƒ©Ú!ƒ¥uˆ‚©ÛÜ!ˆÒÉwˆ` ÝÉwˆlƒ¼ÛÞ!ˆÒÉxˆ `{à!!É\"—㘃ÝÉ‚ äÉwˆÙuˆàp!\"åÉxˆÒÉwˆƒýÚ!‚þl„Ûæ!ˆç!\"\"ˆ+‚~.)‡" [hack-local-variables-prop-line search-backward "\n " 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] 6 "\ Parse and put into effect this buffer's local variables spec."]) (defconst ignored-local-variables (quote (enable-local-eval)) "\ Variables to be ignored in a file's local variable spec.") (defalias (quote hack-one-local-variable) #[(var val) "Á=ƒÂà !—ÅP! ‡>ƒLJÈ=„(ÉÊÃ!\"ƒXË Ì˜„T Î=„@ ƒTÏ‹ƒTÈ=ƒLŠÈ !)‡Ð!ˆ L‡ÑÒ!‡Ð!ˆ L‡" [var mode intern symbol-name val "-mode" ignored-local-variables nil eval string-match "-hooks?$\\|-functions?$" user-login-name "root" 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]) (defalias 'set-visited-file-name #[(filename) "ƒÁ˜?…Â! š„ ƒ Ä!ˆÅ ˆƒMÆ !‰Á˜ƒ5ÈÉ!ˆ\nË=ƒA—Ì ! ÎÏ\"ˆ)ÐÒ ˆƒpÓÔ !!ƒf×Ø !8‚vÐÐÚÛ!ˆÚÜ!ˆÚÝ!ˆÚÞ!ˆ !„”àÞ!ˆÏ!\"!„­ ƒ±#ƒ±äÏ!ˆ‚±å !\"ƒÊ!ƒÊæ\"!ƒÊç\"!Ï#ˆ) …ÒèÏ!‡" [filename "" expand-file-name buffer-file-name lock-buffer unlock-buffer file-name-nondirectory new-name error "Empty file name" system-type vax-vms file-name-directory default-directory rename-buffer t nil buffer-backed-up clear-visited-file-modtime abbreviate-file-name file-truename buffer-file-truename find-file-visit-truename 10 file-attributes buffer-file-number kill-local-variable write-file-hooks local-write-file-hooks revert-buffer-function backup-inhibited 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 "\ 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." "FSet visited file name: "]) (defalias 'write-file #[(filename) "ƒ Á˜„ Â!ƒ ƒÄ!Å !PÆ!ˆÇÈ!ˆÉ ‡" [filename "" file-directory-p buffer-file-name file-name-as-directory file-name-nondirectory set-visited-file-name set-buffer-modified-p t save-buffer] 3 "\ 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." (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))))]) (defalias 'backup-buffer #[nil "…I ?…I\n?…Ià !…IÅ !ÆœÇHÈ>…I ɉ‰‰\n   Ï!Ð!‰ @  A ÉÑÒ-‡" [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 "… Â=„ Ã=… †ÄÅÆ\"!ÃÉʈ ƒ:ƒ:ÃÌ͈A‰„.)‡" [targets trim-versions-without-asking t nil y-or-n-p format "Delete excess backup versions of %s? " real-file-name delete-old-versions (byte-code "„1 „1\nƒà !ÅV„1ƒ9Ç !É8†-Ê8Ë U?)ƒ9ÌÍΈ‚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 2 user-uid 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 "\ 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 'file-name-sans-versions #[(name &optional keep-backup-version) "À !‰ƒ\nà #‚K ÅÇ=ƒ1ÈÉ \"†JÈÊ \"ƒ,Ë”†J G‚J ƒ: G‚JÈÌ \"†JÈÍ \"†J GO)‡" [find-file-name-handler name handler file-name-sans-versions keep-backup-version 0 system-type vax-vms string-match ";[---+]?[0-9]*\\'" "\\.[^]>:]*\\(\\.[---+]?[0-9]*\\)\\'" 1 "\\.~[0-9]+~\\'" "~\\'"] 6 "\ 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 'make-backup-file-name #[(file) "ÁP‡" [file "~"] 2 "\ Create the non-numeric backup file name for FILE. This is a separate function so you can redefine it for customization."]) (defalias 'backup-file-name-p #[(file) "ÀÁ\n\"‡" [string-match "~$" file] 3 "\ 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-extract-version #[(fn) "ÀÁ\n #ƒÄ” UƒÅ\n ÆO!‡Ä‡" [string-match "[0-9]+~$" fn bv-length 0 string-to-int -1] 4 "\ 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 'find-backup-file-name #[(fn) "Á=ƒ  !C‡Ä !ÅP‰GÈ È\nË È ËÈÏЈ „6 !C‚i ÅÑ T!ÒRËV…hÕ\\\\ËY…hÖ×\n›S›È¡ˆ)\"B.‡" [version-control never make-backup-file-name fn file-name-nondirectory ".~" base-versions bv-length nil possibilities versions 0 high-water-mark deserve-versions-p number-to-delete (byte-code "À  !\"ÅÆÇ \"È\" ÊËÌ # †! Ì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 "\ 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."]) (defalias 'file-nlinks #[(filename) "À !A@‡" [file-attributes filename] 2 "\ Return number of names file FILENAME has."]) (defalias (quote file-relative-name-1) #[(directory) "Á˜ƒ\n‡ÃÄÅ!P\n\"ƒ\nÆ•ÇO‡ÈÉÆÊO!!‡" [directory "/" filename string-match "^" regexp-quote 0 nil file-relative-name-1 file-name-directory -1] 5]) (defalias 'file-relative-name #[(filename &optional directory) "À !ÂÀ † !!Å !‡" [expand-file-name filename file-name-as-directory directory default-directory file-relative-name-1] 3 "\ Convert FILENAME to be relative to DIRECTORY (default: default-directory)."]) (defalias 'save-buffer #[(&optional args) "À Á ÂV … Å=?‰ƒ È>ƒ É\nƒ0ƒ0ËÌÍ \"ˆÎ ˆ…B Ï>…Bɉ\n+‡" [buffer-modified-p buffer-size 50000 make-backup-files args 0 large modp (16 64) nil buffer-backed-up message "Saving file %s..." buffer-file-name basic-save-buffer (4 64)] 5 "\ 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 `trim-versions-without-asking' is nil, system will query user before trimming versions. Otherwise it does it silently." "p"]) (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 "\ 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 'basic-save-buffer #[nil "À ƒºÁ ‰Ç=ƒ?É!˜„?Â\nÉ!Ë—! Í !\nÎ !ˆ)Ï\n!ˆ)„MÐÑÒÓ!Â\"!ˆÔp!„jÕ!ƒjÖ×ØÙ!\"!„jÚÛ!ˆŒ~ˆdÜVƒ™dSfÝU„™ß=„‘ƒ™à×áÍ \"!ƒ™ŠdbˆÝcˆ)â#$%#Â&‰'ƒ½'@ ‰&„½'A‰'„ª&„’è!„é!*ë*!„ßÚì*\"ˆ‚Õ!„ïÚí*\"ˆ‚Ö×îÙ!\"!ƒß‚Úï!ˆ)0„ ñ 2ƒré!‰‰‰‰345678*ù4ß55ƒM×ú*4#7Õ7!54T4‚1ûŽü ˆýed7Â8%ˆß3)þ!ÿ7ß#ˆ.‚’ ƒ‰ „‰þ!@A\"ˆýedÂß%ˆ*ÝB!8C ƒªÂDEˆ)F !ˆGH!+‡IJ!‡" [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 set-visited-file-name expand-file-name read-file-name "File to save in: " verify-visited-file-modtime file-exists-p yes-or-no-p format "%s has changed since visited or saved. Save anyway? " file-name-nondirectory error "Save not confirmed" 1 10 require-final-newline t y-or-n-p "Buffer %s does not end in newline. Add one? " append write-contents-hooks local-write-file-hooks write-file-hooks done hooks file-writable-p file-name-directory dir file-directory-p "%s is not a directory" "Directory %s write-protected" "File %s is write-protected; try to save anyway? " "Attempt to save to a file which you aren't allowed to write" buffer-backed-up backup-buffer file-precious-flag succeed i nogood temp tempname realname 0 "%s#tmp#%d" ((byte-code "„Á\n!ˆÁ‡" [succeed delete-file tempname] 2)) clear-visited-file-modtime write-region file-modes rename-file set-file-modes 511 file-attributes buffer-file-number (set-file-modes buffer-file-name setmodes) ((error)) delete-auto-save-file-if-necessary run-hooks after-save-hook message "(No changes need to be saved)"] 8 "\ Save the current buffer in its visited file, if it has been modified." nil]) (defalias 'save-some-buffers #[(&optional arg exiting) "À‹‡" [((byte-code "ÀÁÂà ÄÅÆÇEC%ÈU…ÉÊ!‡" [map-y-or-n-p #[(buffer) "À !…8 !„ …8 qˆ …8Å ÆV…8ƒ%ȇ !ƒ2ÉÊ !\"‡ÉËÌ !\"‡" [buffer-modified-p 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" 0 message "(No files need saving)"] 8))] 1 "\ 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." "P"]) (defalias 'not-modified #[(&optional arg) "À ƒ ‚\nÃ!ˆÄ !‡" [message arg "Modification-flag set" "Modification-flag cleared" set-buffer-modified-p] 2 "\ Mark current buffer as unmodified, not needing to be saved. With prefix arg, mark buffer as modified, so \\[save-buffer] will save." "P"]) (defalias 'toggle-read-only #[(&optional arg) "„ ?‚Â!ÃVÄÅ !‡" [arg buffer-read-only prefix-numeric-value 0 set-buffer-modified-p buffer-modified-p] 2 "\ Change whether this buffer is visiting its file read-only. With arg, set read-only iff arg is positive." "P"]) (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 "\ 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)." "fInsert file: "]) (defalias 'append-to-file #[(start end filename) "À \n Ä$‡" [write-region start end filename t] 5 "\ 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." "r\nFAppend to file: "]) (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 "\ Return most recent backup file for FILENAME or nil if no backups exist."]) (defalias 'rename-uniquely #[nil "ÀÁ !Á\n!Ä\n!ˆÅ !ˆÆÇ !*‡" [generate-new-buffer buffer-name new-buf name kill-buffer rename-buffer set-buffer-modified-p buffer-modified-p] 2 "\ 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." nil]) (defalias 'make-directory #[(dir &optional parents) "À !‰ƒ\nà #‚N „Å !‚NÆÇ !!È Ê !„8  B ÆË !!‚# …MÅ @!ˆ A‰ „=È*)‡" [find-file-name-handler dir handler make-directory parents make-directory-internal directory-file-name expand-file-name nil create-list file-exists-p file-name-directory] 5 "\ 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." (list (read-file-name "Make directory: " default-directory default-directory nil nil) t)]) (put (quote revert-buffer-function) (quote permanent-local) t) (defvar revert-buffer-function nil "\ Function to use to revert this buffer, or nil to do the default.") (put (quote revert-buffer-insert-file-contents-function) (quote 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.") (defalias 'revert-buffer #[(&optional ignore-auto noconfirm) "ƒ  \n\"‡` ?…\"Ä …\" …\"Æ !…\"ÇÈ!‰ ƒ, ‚.\n‰ „:ÌÍ!‚§\n„HÎÏÐ \"!…§ „VÑp!„VÒÕ=„`ÒÒÕƒv  \"ˆ‚šØ !„ƒÌÙ \"ˆÒ\n „ŽÚ ˆÛ ˆ)Ü  ?\"ˆ* d^bˆÝÒ‰Õ#ˆÕ+‡" [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? " verify-visited-file-modtime nil buffer-backed-up buffer-undo-list t buffer-read-only revert-buffer-insert-file-contents-function file-exists-p "File %s no longer exists!" unlock-buffer erase-buffer insert-file-contents after-find-file] 5 "\ 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." (list (not prefix-arg))]) (defalias 'recover-file #[(file) "À ! !ƒÃÄ \"ˆ Æ )È \"„&ÃÉ\"‚JÊ‹ƒGËÌ Í\"!ˆÎÐ ˆÑÎ\"ˆ)ÒΉÍ#‚JÃÓ!)‡" [expand-file-name file auto-save-file-name-p error "%s is an auto-save file" buffer-file-name make-auto-save-file-name file-name file-newer-than-file-p "Auto-save file %s not current" ((byte-code "Á=„%Âà !ˆÅÆÇ ÇÈ !ƒÊ‚Ë  &‘ˆÍÎÏ \"!‡" [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 "\ Visit file FILE, but get contents from its last auto-save file." (byte-code "Á‰‰ƒÅ !Æ !ÇÈ\nÁ‰ %+C‡" [buffer-file-name nil file-dir file-name prompt-file file-name-nondirectory file-name-directory read-file-name "Recover file: "] 7)]) (defalias 'kill-some-buffers #[nil "À ‰…= @Ã\n!‰Ř„4 ÆHÇU„4ÈÉÊ Ë\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 "\ For each buffer, ask whether to kill it." nil]) (defalias 'auto-save-mode #[(arg) "„ ?‚Â=„<„¨…2ÃV…2 ƒ0 ƒ0„0 ‚2Ç tƒDÈÉ ƒAÊ‚BË\"ˆ ‡" [arg buffer-auto-save-file-name t 0 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 "\ Toggle auto-saving of contents of current buffer. With prefix argument ARG, turn auto-saving on if positive, else off." "P"]) (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 "\ 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 'make-auto-save-file-name #[nil "ƒÁ!ÂÃ!ÂR‡ÄÅÆÇ ÈÉ!#!‡" [buffer-file-name file-name-directory "#" file-name-nondirectory expand-file-name format "#%s#%s#" buffer-name make-temp-name ""] 6 "\ 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 'auto-save-file-name-p #[(filename) "ÀÁ\n\"‡" [string-match "^#.*#$" filename] 3 "\ Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. You can redefine this for customization."]) (defconst list-directory-brief-switches (byte-code "Á=ƒ‡Ç" [system-type vax-vms "" "-CF"] 2) "\ *Switches for list-directory to pass to `ls' for brief listing,") (defconst list-directory-verbose-switches (byte-code "Á=ƒ‡Ç" [system-type vax-vms "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" "-l"] 2) "\ *Switches for list-directory to pass to `ls' for verbose listing,") (defalias 'list-directory #[(dirname &optional verbose) "ƒ ‚ \n „ Æ !ÇÈ !ˆÊË!ˆÊ !ˆÌ ˆŠÇqˆÍ !?Ï ‰?$*‘)‡" [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-directory-p wildcard insert-directory] 6 "\ 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'." (byte-code " ƒ  ÄÅÅ$ )D‡" [current-prefix-arg pfx read-file-name "List directory (verbose): " "List directory (brief): " nil default-directory] 5)]) (defvar insert-directory-program "ls" "\ Absolute or relative name of the `ls' program used by `insert-directory'.") (defalias 'insert-directory #[(file switches &optional wildcard full-directory-p) "À !‰ƒ\nà %‚gÈ=ƒ\"É p#‚g ƒPÊ !ƒ2Ë !‚7ËÌ !! ÎÐÑÐÒÔ ÕÖ !°&)‚gÎÐÑÐ ƒd× !ØP‚e &)‡" [find-file-name-handler file handler insert-directory switches wildcard full-directory-p system-type vax-vms vms-read-directory file-name-absolute-p file-name-directory expand-file-name default-directory call-process shell-file-name nil t "-c" insert-directory-program " -d " " " file-name-nondirectory file-name-as-directory "."] 13 "\ Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. Optional third arg WILDCARD means treat FILE as shell wildcard. 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 'save-buffers-kill-emacs #[(&optional arg) "À Â\"ˆÂÃÄÅ \">ƒÆÇ!…`ÈÉ!ƒ^É Ê ‰ ƒQÍ @!Î>ƒHÏ @!Ï @\"ˆ)ƒH  A‰ „& ?†ZÆÑ!*…`Ò ‡" [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? " kill-emacs] 5 "\ Offer to save each buffer, then kill this Emacs process. With prefix arg, silently save all file-visiting buffers, then kill." "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.22/lisp/fill.elc100666 13437 1 12642 5471142025 13652 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 13 06:25:08 1993 ;;; from file /home/fsf/rms/e19/lisp/fill.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (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. Nil means that any change in indentation starts a new paragraph.") (defalias 'set-fill-prefix #[nil "ŠÀyˆ`)`{‰šƒÃ ƒÄÅ \"‡ÄÆ!‡" [0 fill-prefix "" nil message "fill-prefix: \"%s\"" "fill-prefix cancelled"] 4 "\ 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." nil]) (defconst adaptive-fill-mode t "\ *Non-nil means determine a paragraph's fill prefix from its text.") (defconst adaptive-fill-regexp "[ ]*\\([>*] +\\)?" "\ *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.") (defalias 'fill-region-as-paragraph #[(from to &optional justify-flag) "ƒÁ=„`B\n ƒW\nƒ\nĘƒWŠ ^bˆlƒ,ÇyˆÇyˆ` ]WƒI`É\n!ˆ`{)‚V ^bˆlƒVÇyˆ)Œ }ˆebˆËÌwˆ`d}ˆ`dbˆ\n…{\nÄš?…{Í\n!‰ƒ¹\nGYƒÐÑ!ˆebˆÇyˆm„©Ò!ƒ£`Ó•|ˆÇyˆ‚“ebˆÒ!ƒ·\nGuˆ`) bˆÉÔÌÁ#ƒËÕcˆ‚½Ö d×Õ$ˆ bˆØÌwˆÖ`dÙÕ$ˆÉÚÌÁ#ƒÓ”ŠÛÌxˆhÜ>)ƒúÝ‚ûÇ\\Ó•|ˆ‚àdbˆÞ ˆßcˆebˆÓÌ !m?…!` âT!ˆm„îã xˆ` Ý\\VƒUhÕ=ƒUgÕ=„U`ÝZfä=ƒUåuˆã xˆ‚,!ÓUƒgŠæ xˆn)‚k!iYƒ Á'â!!ˆm„œ'„Žo„œŠèuˆÒé!)ƒœæÌwˆãÌwˆÌ'‚v)‚£èuˆ\nƒî!ÓUƒî`eZ\nGWƒîe`{\nÓ`eZO˜ƒîÁ'm„í'„ßo„íŠèuˆÒé!)ƒíæÌwˆãÌwˆÌ'‚Ç)æÌxˆ×cˆÞ ˆm„ \nƒ \nÄš„ \ncˆi!*ƒm„èyˆë ˆÇyˆ‚,‡" [buffer-undo-list t fill-prefix adaptive-fill-mode "" from to 1 start re-search-forward adaptive-fill-regexp "\n" nil regexp-quote fpre fill-column error "fill-prefix too long for specified width" looking-at 0 "[.?!][])}\"']*$" 32 subst-char-in-region 10 " " 9 " *" " ]})\"'" (46 63 33) 2 delete-horizontal-space " " linebeg prefixcol move-to-column "^ \n" 46 -2 " " first -1 "\\. " justify-flag justify-current-line] 6 "\ Fill region as one paragraph: break lines to fit fill-column. Prefix arg means justify too. From program, pass args FROM, TO and JUSTIFY-FLAG." "r\nP"]) (defalias 'fill-paragraph #[(arg) "`ŠÁ ˆn„ÂÃ!ˆ`Ä ˆ`bˆÇ #,‡" [before forward-paragraph newline 1 backward-paragraph beg end fill-region-as-paragraph arg] 4 "\ Fill paragraph at or after point. Prefix arg means justify as well." "P"]) (defalias 'fill-region #[(from to &optional justify-flag) "Œ }ˆebˆm?…0`ÂÃ!ˆ`ÂÆ!ˆ` Yƒ)Ç` #ˆ‚, bˆ*‚)‡" [from to forward-paragraph 1 end initial -1 fill-region-as-paragraph justify-flag] 4 "\ Fill each of the paragraphs in the region. Prefix arg (non-nil third arg, if called from program) means justify as well." "r\nP"]) (defalias 'justify-current-line #[nil "ŠŒÀ‰‰Äyˆ GuˆÆÀwˆi`Àˆ\n`}ˆ\nbˆÇÈÀÉ#ƒDÄ”ŠÊÀxˆhË>)ƒ;Ì‚<Í\\Ä•|ˆ‚!\nbˆÇÎÀÉ#ƒXÏuˆÐcˆ‚GdbˆiZ ZÒÓÀÉ#ƒ¨ ÄVƒ¨ÔÕ!Õ\\‰ÄVƒ™ÒÓÀÉ#„ŒdbˆÒÓ!ˆÓÀxˆS‰‚x)ÓcˆÓÀxˆ S‰‚k-À‡" [nil indent beg ncols 0 fill-prefix " " re-search-forward " *" t " ])\"'" (46 63 33) 2 1 "[.?!][])\"']*\n" -1 32 fill-column search-backward " " random 3 nmove] 5 "\ Add spaces to line point is in, so it ends at `fill-column'." nil]) (defalias 'fill-nonuniform-paragraphs #[(min max &optional justifyp mailp) "À $)‡" [t fill-individual-varying-indent fill-individual-paragraphs min max justifyp mailp] 5 "\ 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-FLAG and MAIL-FLAG: JUSTIFY-FLAG to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines." "r\nP"]) (defalias 'fill-individual-paragraphs #[(min max &optional justifyp mailp) "ŒŠbˆÁyˆ\nƒ-ÃÄ!„ÃÅ!ƒ-ÃÄ!ƒ'ÆÇÈÉ#ˆ‚ Êyˆ‚ ` }ˆÌÈwˆm?…ÂÁyˆ`ȉ ƒSà !„d`ŠÐÈwˆ`){Ñ! Êyˆm„ªƒÃ!„ªŠÃ !…ˆGuˆÃ!)?‚§Ã !ƒªŠGuˆÃ!†¥Ã!)?„GnÖ`#ˆ„¾ØÙ!ˆ,‚2*‡" [min 0 mailp looking-at "[ ]*[^ \n]*:" "[ ]*$" search-forward "\n\n" nil move 1 max " \n" fill-prefix-regexp fill-prefix start " " regexp-quote fill-individual-varying-indent paragraph-separate paragraph-start had-newline fill-region-as-paragraph justifyp delete-char -1] 4 "\ 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-FLAG and MAIL-FLAG: JUSTIFY-FLAG to justify paragraphs (prefix arg), MAIL-FLAG for a mail message, i. e. don't fill header lines." "r\nP"]) emacs-19.22/lisp/find-dired.elc100666 13437 1 11104 5416165563 14734 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:03:12 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/find-dired.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defconst find-dired-version (substring "$Revision: 1.13 $" 11 -2) "\ $Id: find-dired.el,v 1.13 1993/05/28 00:58:08 roland Exp $") (require (quote dired)) (defvar find-ls-option (byte-code "Á=ƒ‡Ç" [system-type berkeley-unix "-ls" "-exec ls -ldi {} \\;"] 2) "\ *Option to `find' to produce an `ls -l'-type listing.") (defvar find-grep-options (byte-code "Á=ƒ‡Ç" [system-type berkeley-unix "-s" "-l"] 2) "\ *Option to grep to be as silent as possible. On Berkeley systems, this is `-s', for others it seems impossible to suppress all output, so `-l' is used to print nothing more than the file name.") (defvar find-args nil "\ Last arguments given to `find' by \\[find-dired].") (defalias 'find-dired #[(dir args) "ÀÁ\n!!Ã\n!„ÄÅ\n\"ˆÆÇÈ!!ˆ~ˆÉ ˆÊ Ì ˆ\n Ðјƒ5Ñ‚:ÒÓQQÕ\nÖ\"ˆ×Ø!ƒPØ ˆ‚[ÙÚ! Û 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 "-gilsb" fboundp dired-simple-subdir-alist make-local-variable dired-subdir-alist point-min-marker " " ":\n" "\n" set-process-filter start-process-shell-command "find" find-dired-filter set-process-sentinel get-buffer-process find-dired-sentinel (": %s") mode-line-process] 5 "\ Run `find' and go into dired-mode on a buffer of the output. The command run (after changing into DIR) is find . \\( ARGS \\) -ls" (list (read-file-name "Run find in directory: " nil "" t) (if (featurep (quote gmhist)) (read-with-history-in (quote find-args-history) "Run find (with args): ") (read-string "Run find (with args): " find-args)))]) (defalias 'find-name-dired #[(dir pattern) "À  ÄQ\"‡" [find-dired dir "-name '" pattern "'"] 5 "\ 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" "DFind-name (directory): \nsFind-name (filename wildcard): "]) (defalias (quote lookfor-dired) (quote find-grep-dired)) (defalias 'find-grep-dired #[(dir args) "À Â Ä Æ°\"‡" [find-dired dir "! -type d -exec grep " find-grep-options " " args " {} \\; "] 7 "\ 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." "DFind-grep (directory): \nsFind-grep (grep args): "]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„ÆÇMˆÈÉ!‡" [defalias find-dired-filter #[(proc string) "À !Ã\n!ƒSŠ\nqˆŒ~ˆŠÄd bˆcˆ bˆÈÉ!„*ÊyˆÈÉ!ƒ9ËcˆÊyˆ‚* ÌZbˆÍÎÄÏ#…O``ÐZ|ˆ‚>-‚VÑ !)‡" [process-buffer proc buf buffer-name nil end buffer-read-only string looking-at "^" 1 " " 3 search-forward " ./" t 2 delete-process] 4] find-dired-sentinel #[(proc state) "À !Ã\n!…AŠ\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 set-buffer-modified-p buffer-modified-p message "find-dired %s finished."] 4] fboundp start-process-shell-command #[(name buffer &rest args) "Á=ƒÂà $‡Ã ÈÉÊËÌ#P%‡" [system-type vax-vms apply start-process name buffer args shell-file-name "-c" "exec " mapconcat identity " "] 10 "Start a program in a subprocess. Return the process object for it.\nArgs are NAME BUFFER COMMAND &rest COMMAND-ARGS.\nNAME is name for process. It is modified if necessary to make it unique.\nBUFFER 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\nThird arg is command name, the name of a shell command.\nRemaining arguments are the arguments for the command.\nWildcards and redirection are handle as usual in the shell."] provide find-dired] 3) emacs-19.22/lisp/find-gc.elc100666 13437 1 4667 5416165572 14236 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:03:21 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/find-gc.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÃÀÅÆ\"ˆÀÇÈ\"ˆÉ\nÀËÌ\"ˆÍÀÏÐ\"‡" [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] "/usr/gnu/src/dist/src" emacs-source-directory find-unsafe-funcs #[(target) "CCÂ!‡" [target unsafe-list trace-unsafe] 2] 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] (Fsignal Fthrow wrong_type_argument) noreturn-list 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] ("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 trace-use-tree #[nil "ÀÁÀ \"\" ʼn‰…G@A‰ƒ=@ ž‰ƒ@@AB¡ˆ‚A‰„Å+‡" [mapcar list car subrs-called subrs-used nil found p2 ptr] 6]] 3) emacs-19.22/lisp/finder-inf.elc100666 13437 1 42557 5474621160 14762 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:59:27 1993 ;;; from file /home/fsf/rms/e19/lisp/finder-inf.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÂÃ!‡" [(("abbrev.el" "abbrev mode commands for Emacs" (abbrev)) ("abbrevlist.el" "list one abbrev table alphabetically ordered." (abbrev)) ("ada.el" "Ada editing support package in GNUlisp. v1.0" (languages)) ("add-log.el" "change log maintenance commands for Emacs" (maint)) ("advice.el" "advice mechanism for Emacs Lisp functions" (extensions lisp tools)) ("allout.el" nil nil) ("ange-ftp.el" "transparent FTP support for GNU Emacs" (comm)) ("appt.el" "appointment notification functions." (calendar)) ("apropos.el" "faster apropos commands." (help)) ("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)) ("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" "backquoting for Emacs Lisp macros" (extensions)) ("bib-mode.el" "bib-mode, major mode for editing bib files." (bib)) ("bibtex.el" "BibTeX mode for GNU Emacs" (tex bib)) ("blackbox.el" "blackbox game in Emacs Lisp" (games)) ("bookmark.el" "set bookmarks, jump to them later." (bookmarks placeholders)) ("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)) ("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)) ("calendar.el" "Calendar functions." (calendar)) ("case-table.el" "code to extend the character set and support case tables." (i18n)) ("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.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 nil) ("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)) ("cplus-md1.el" "major mode for editing C++ (and C) code" (languages)) ("cust-print.el" "handles print-level and print-circle." (extensions)) ("dabbrev.el" "dynamic abbreviation package for GNU Emacs." (abbrev)) ("debug.el" "debuggers and related commands for Emacs" (lisp tools maint)) ("default.el" nil nil) ("delsel.el" "delete selection if you insert" nil) ("desktop.el" "save partial status of Emacs when killed" nil) ("diary-ins.el" "calendar functions for adding diary entries." (diary calendar)) ("diary.el" "diary functions." (calendar)) ("diff.el" "Run `diff' in compilation-mode." (unix tools)) ("dired-aux.el" "all of dired except what people usually use" nil) ("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)) ("doctor.el" "psychological help for frustrated users." (games)) ("dunnet.el" "Text adventure for Emacs" (games)) ("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)) ("edmacro.el" "keyboard macro editor" (abbrev)) ("edt.el" "EDT emulation in Emacs" (emulations)) ("ehelp.el" "bindings for electric-help mode" (help extensions)) ("electric.el" "window maker and Command loop for `electric' modes." (extensions)) ("emacsbug.el" "command to report Emacs bugs to appropriate mailing list." (maint)) ("emerge.el" "merge diffs under Emacs control" (unix tools)) ("env.el" "functions to manipulate environment variables." (processes unix)) ("etags.el" "etags facility for Emacs" (tools)) ("faces.el" "Lisp interface to the c \"face\" structure" nil) ("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-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)) ("font-lock.el" nil (languages faces)) ("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.el" nil (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)) ("gosmacs.el" "rebindings to imitate Gosmacs." (emulations)) ("grow-vers.el" "increment Emacs version number" (internal)) ("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)) ("hilit19.el" nil (faces)) ("hippie-exp.el" "expand text trying various ways to find its expansion." (extensions)) ("holidays.el" "holiday functions for the calendar package" (holidays calendar)) ("icon.el" "mode for editing Icon code" (languages)) ("inc-vers.el" "load this to increment the recorded Emacs version number." (internal)) ("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-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" "this is the GNU EMACS interface to GNU ISPELL version 4." (wp)) ("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-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)) ("medit.el" "front-end to the MEDIT package for editing MDL" (languages)) ("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-e.el" "GNU Emacs interface to the MH mail system" (mail)) ("mhspool.el" "MH folder access using NNTP for GNU Emacs" (mail news)) ("mim-mode.el" "Mim (MDL in MDL) mode." (languages)) ("mim-syntax.el" "syntax checker for Mim (MDL)." (languages)) ("misc.el" "basic editing commands for Emacs" nil) ("mlconvert.el" "convert buffer of Mocklisp code to real lisp." (emulations)) ("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)) ("netunam.el" "HP-UX RFA Commands" (comm)) ("nnspool.el" "spool access using NNTP for GNU Emacs" (news)) ("nntp.el" "NNTP (RFC977) Interface for GNU Emacs" (news)) ("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" nil) ("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 (languages)) ("paths.el" "define pathnames for use by various Emacs commands." (internal)) ("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)) ("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" (tools mail lisp extensions)) ("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) ("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)) ("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)) ("site-load.el" nil nil) ("solar.el" "calendar functions for solar events." (calendar)) ("sort.el" "commands to sort text in an Emacs buffer." (unix)) ("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) ("tar-mode.el" "simple editing of tar files from GNU emacs" (unix)) ("tcp.el" nil nil) ("telnet.el" "run a telnet session from within an Emacs buffer" nil) ("term-nasty.el" "Damned Things from terminfo.el" 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) ("tpu-doc.el" "Documentation for TPU-edt" (emulations)) ("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) ("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)) ("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) ("ws-mode.el" "WordStar emulation mode for GNU Emacs" (emulations)) ("x-menu.el" "menu support for X " nil) ("xscheme.el" "run Scheme under Emacs" (languages lisp)) ("yow.el" "quote random zippyisms" (games))) finder-package-info provide finder-inf] 2) emacs-19.22/lisp/finder.elc100666 13437 1 14050 5474621206 14174 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 03:59:49 1993 ;;; from file /home/fsf/rms/e19/lisp/finder.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÄÅ!„ÆÄÇ!„ÈÉ ÊËÌ#ˆÊÍÎ#ˆÊÏÐ#ˆÊÑÒ#‡" [require lisp-mnt finder-inf picture boundp finder-known-keywords ((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") (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") (games . "games, jokes and amusements") (hardware . "support for interfacing with exotic hardware") (help . "support for on-line help systems") (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") (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 define-key " " finder-select "?" finder-summary "q" finder-exit "f" finder-list-keywords] 4) (defvar finder-package-info nil "\ Assoc list mapping file names to description & keyword lists.") (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 "\ 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-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 "\ Display descriptions of the keywords in the Finder buffer." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias finder-list-matches #[(key) "À ˆÃ !Æ Ç±ˆ`ÉÊ \"ˆ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] finder-find-library #[(file) "À !ƒ ‡\nɃ@ „@ÆÇ ÈP @\"!ƒ)Ç @\"‚9ÆÇ @\"!ƒ9Ç @\" A‰„ *‡" [file-name-absolute-p file load-path nil found dirs file-exists-p expand-file-name ".el"] 5] 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] finder-current-item #[nil "ƒ`WƒÁÂ!‡ŠÃyˆÄ )‡" [finder-headmark error "No keyword or filename on this line" 0 current-word] 2] finder-select #[nil "À Âà \"ƒÄ !‚Å !)‡" [finder-current-item key string-match "\\.el$" finder-commentary finder-list-matches] 3 nil nil]] 3) (defalias 'finder-by-keyword #[nil "À ˆÁ ‡" [finder-mode finder-list-keywords] 1 "\ Find packages matching a given keyword." nil]) (defalias 'finder-mode #[nil "ÀÁ!ˆÂÄ ˆÅ!ˆÇ!ˆÉ\nË ÍÎ!ˆÂ‰‡" [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 "\ Major mode for browsing package documentation. \\ \\[finder-select] more help for the item on the current line \\[finder-exit] exit Finder mode and fill the Finder buffer. " nil]) (defalias 'finder-summary #[nil "ÀÁÂ!!‡" [message substitute-command-keys "\\\\[finder-select] = select, \\[finder-list-keywords] = back to finder, \\[finder-exit] = quit, \\[finder-summary] = help"] 3 "\ Summarize basic Finder commands." nil]) (defalias 'finder-exit #[nil "À ˆÁÂ!‡" [delete-window kill-buffer "*Finder*"] 2 "\ Exit Finder mode and kill the buffer" nil]) (provide (quote finder)) emacs-19.22/lisp/float-sup.elc100666 13437 1 2144 5416165627 14626 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:03:51 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/float-sup.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„\nÂÃ!ˆÀ‡" [fboundp atan error "Floating point was disabled at compile time"] 2) (defconst pi (byte-code "ÀÁ!Â_‡" [atan 1 4] 2) "\ The value of Pi (3.1415926...)") (defconst e (exp 1) "\ The value of e (2.7182818...)") (defconst degrees-to-radians (/ pi 180.0) "\ Degrees to radian conversion constant") (defconst radians-to-degrees (/ 180.0 pi) "\ Radian to degree conversion constant") (defalias 'degrees-to-radians '(macro . #[(x) "À Â¥ E‡" [* pi 180.0 x] 3 "\ Convert ARG from degrees to radians."])) (defalias 'radians-to-degrees '(macro . #[(x) "ÀÁ\n¥ E‡" [* 180.0 pi x] 3 "\ Convert ARG from radians to degrees."])) (provide (quote lisp-float-type)) emacs-19.22/lisp/float.elc100666 13437 1 17336 5416165664 14053 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:04:20 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/float.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (defconst maxbit (1- mantissa-bits) "\ Number of highest bit") (defconst mantissa-maxval (byte-code "ÀÁ\n\"S‡" [ash 1 maxbit] 3) "\ Maximum permissible value of mantissa") (defconst mantissa-minval (ash 1 maxbit) "\ Minimum permissible value of mantissa") (defconst floating-point-regexp "^[ ]*\\(-?\\)\\([0-9]*\\)\\(\\.\\([0-9]*\\)\\|\\)\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ ]*$" "\ 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 (byte-code "ÀÁ\nS\"‡" [ash 1 maxbit] 3) "\ Masks all bits except the highest-order magnitude bit") (byte-code "ÀÂÄÆÈ T \"‰\nËIˆ\nÌÍIˆ\nÎÏIˆ\nÐÑIˆ\nÒÓIˆ\nÔÕIˆ\n SH\n HØÙÚ\"ˆØÛÜ\"ˆØÝÞ\"ˆØßà\"ˆØáâ\"ˆØãä\"ˆØåæ\"ˆØçè\"ˆ)Ì¥*ëË*\"S,í,!.ëË*Ì¥\"/Øðñ\"ˆØòó\"‡" [(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 defalias fashl #[(fnum) "À @Â\" ASB‡" [ash fnum 1] 3] fashr #[(fnum) "À @Â\" ATB‡" [ash fnum -1] 3] normalize #[(fnum) "@ÁVƒÂ@ \"ÁUƒ3Ä!‚@ÁWƒ0Â@ \"ÁUƒ3Ä!‚‡" [fnum 0 logand second-bit-mask fashl high-bit-mask _f0] 3] abs #[(n) "ÁYƒ‡[‡" [n 0] 2] fabs #[(fnum) "À @‰ÃYƒ\n‚\n[) AB!‡" [normalize fnum n 0] 4] xor #[(a b) "„ …… ?‡" [a b] 1] same-sign #[(a b) "ÀÁ\n@!Á @!\"?‡" [xor natnump a b] 4] extract-match #[(str i) "ÀÁ‡" [nil (byte-code " ” •O‡" [str i] 3) ((error ""))] 3] mantissa-bits halfword-bits ash masklo lognot maskhi round-limit hihalf #[(n) "ÀÁ\n \" [\"‡" [ash logand n maskhi halfword-bits] 4] lohalf #[(n) "À \n\"‡" [logand n masklo] 3]] 5) (defalias 'f+ #[(a1 a2) "À \n\"à \n\"Æ \n\"ƒÇ !Ç !È @É @ A AZ\"\\ AB!*‡" [fmax a1 a2 fmin f2 f1 same-sign fashr normalize ash] 6 "\ Returns the sum of two floating point numbers."]) (defalias 'f- #[(a1 &optional a2) "ƒ Á\nÃ!\"‡Ä\n@[\nAB!‡" [a2 f+ a1 f- normalize] 4 "\ Returns the difference of two floating point numbers."]) (defalias 'f* #[(a1 a2) "À !@À !@Å \"?ÇÈ\n!È !_!ÈÇ\n!È !_!ȉ\n!Ç !_!\\\\ Ç\n!Ç !_lj\n!È !_!ÇÈ\n!Ç !_!Ç !\\\\\\\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 "\ Returns the product of two floating point numbers."]) (defalias 'f/ #[(a1 a2) "@ÁUƒÂÃÄ E\"‡SÁÇ !@Ç!@È \"? \n   Î !ƒc \nZÁWƒEÏ Ð\" ‚TÏ Ð\"T  \nZ Ï Ð\"  S ‚*Ñ ƒo [‚q Ç !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 "\ Returns the quotient of two floating point numbers."]) (defalias 'f% #[(a1 a2) "À ÂÃÄ \"! \"\"‡" [f- a1 f* ftrunc f/ a2] 7 "\ Returns the remainder of first floating point number divided by second."]) (defalias 'f= #[(a1 a2) " š‡" [a1 a2] 2 "\ Returns t if two floating point numbers are equal, 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 "\ Returns t if first floating point number is greater than second, nil otherwise."]) (defalias 'f>= #[(a1 a2) "À \n\"† à \n\"‡" [f> a1 a2 f=] 3 "\ Returns t if first floating point number is greater than or equal to second, nil otherwise."]) (defalias 'f< #[(a1 a2) "À \n\"?‡" [f>= a1 a2] 3 "\ Returns t if first floating point number is less than second, nil otherwise."]) (defalias 'f<= #[(a1 a2) "À \n\"?‡" [f> a1 a2] 3 "\ 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 "\ Returns t if first floating point number is not equal to second, nil otherwise."]) (defalias 'fmin #[(a1 a2) "À \n\"ƒ ‡\n‡" [f< a1 a2] 3 "\ Returns the minimum of two floating point numbers."]) (defalias 'fmax #[(a1 a2) "À \n\"ƒ ‡\n‡" [f> a1 a2] 3 "\ Returns the maximum of two floating point numbers."]) (defalias 'fzerop #[(fnum) "@ÁU‡" [fnum 0] 2 "\ Returns t if the floating point number is zero, nil otherwise."]) (defalias 'floatp #[(fnum) ":…@¨…A¨‡" [fnum] 1 "\ Returns t if the arg is a floating point number, nil otherwise."]) (defalias 'f #[(int) "À ÂB!‡" [normalize int 0] 3 "\ Convert the integer argument to floating point, like a C cast operator."]) (defalias 'int-to-hex-string #[(int) "ÀÁ‰ÆXƒ# Ç ÈÉ\n \"Ë\"H!P Ì\\‰‚ +‡" [-20 "0x" "0123456789ABCDEF" hex-chars str shiftval 0 char-to-string logand lsh int 15 4] 8 "\ Convert the integer argument to a C-style hexadecimal string."]) (defalias 'ftrunc #[(fnum) "À A!ƒ ‡ A\n[XƒÇ @ AÆÀ !ƒ+lj \" [\"‚5lj [ \" [\"[ B!*‡" [natnump fnum maxbit (0 . 1) exp mant normalize ash] 5 "\ Truncate the fractional part of a floating point number."]) (defalias 'fint #[(fnum) "À !‰@\nA‰ Yƒ‚% [Xƒ!‚%È \"+‡" [ftrunc fnum tf tint texp mantissa-bits mantissa-maxval mantissa-minval ash] 4 "\ Convert the floating point number to integer, with truncation, like a C cast operator."]) (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 ƒ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 "\ Convert the floating point number to a decimal string. Optional second argument non-nil means use scientific notation."]) (defalias 'string-to-float #[(str) "À \nÃ#ƒÄÆÇ\nÈ\" Ç\nÊ\"   P Ç\nÍ\"ΚÃÄ GZ GWƒO HÓUƒOT‰‚5 Z ÄO‰ GVƒx HÔY ÃO ‚  GZ\\ÕÖ !ƒÍ‚Ã\\ƒš×‚›Í_!.Ç\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 "\ 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."]) (provide (quote float)) emacs-19.22/lisp/flow-ctrl.elc100666 12120 1 3077 5416165670 14475 0ustar rmsdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:04:23 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/flow-ctrl.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'enable-flow-control #[nil "ÀÁÂÃÄ 8#ˆÅÆÇ\"Ç G\n‰ \nWƒ2   œIˆ T‰ ‚ ÆWƒI ‰Iˆ T‰ ‚4* ) ÌÍIˆ ÍÌIˆ ÎÏIˆ ÏÎIˆÐÑÒÓ!ÔQ!ˆÕÃ!‡" [set-input-mode nil t 2 current-input-mode make-string 128 0 the-table keyboard-translate-table j i 28 19 30 17 message "XON/XOFF adjustment for " getenv "TERM" ": use C-\\ for C-s and use C-^ for C-q." sleep-for] 6 "\ Enable use of flow control; let user type C-s as C-\\ and C-q as C-^." nil]) (defalias (quote enable-flow-control-memstr=) #[(e s) "„Á‡\n@˜ƒÇÄ\nA\"‡" [s nil e t enable-flow-control-memstr=] 3]) (defalias 'enable-flow-control-on #[(&rest losing-terminal-types) "ÀÁ!ÂÅÆ \"‰ƒ Ç O‚È  \"…!Ê *‡" [getenv "TERM" nil hyphend term string-match "[-_][^-_]+$" 0 enable-flow-control-memstr= losing-terminal-types enable-flow-control] 3 "\ 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."]) (provide (quote flow-ctrl)) emacs-19.22/lisp/font-lock.elc100666 12241 1 31264 5473274410 15155 0ustar rolanddaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 19 20:55:20 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/font-lock.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ ÂÃÁ\"ˆÁÄÅÉÁÊ%ˆ+Ň" [internal-find-face underline copy-face default t nil frame underline-p face internal-set-face-1 7] 6) (defvar font-lock-comment-face (quote italic) "\ Face to use for comments.") (defvar font-lock-doc-string-face (quote italic) "\ Face to use for documentation strings.") (defvar font-lock-string-face (quote underline) "\ Face to use for string constants.") (defvar font-lock-function-name-face (quote bold-italic) "\ Face to use for function names.") (defvar font-lock-keyword-face (quote bold) "\ Face to use for keywords.") (defvar font-lock-type-face (quote italic) "\ Face to use for data types.") (make-variable-buffer-local (quote font-lock-keywords)) (defvar font-lock-keywords nil "\ *The keywords to highlight. If this is a list, then elements may be of the forms: \"string\" ; A regexp to highlight in the ; `font-lock-keyword-face'. (\"string\" . N) ; Highlight subexpression N of the regexp. (\"string\" . face-name) ; Use the named face (\"string\" N face-name) ; Both of the above (\"string\" N face-name t) ; This allows highlighting to override ; already-highlighted regions. (\"string\" N face-name keep) ; This allows highlighting to occur ; even if some parts of what STRING matches ; are already highlighted--but does not alter ; the existing highlighting of those parts. These regular expressions should not match text which spans lines. While \\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating when you edit the buffer does not, since it considers text one line at a time. Be careful composing regexps for this list; the wrong pattern can dramatically slow things down!") (defvar font-lock-keywords-case-fold-search nil "\ *Non-nil means the patterns in `font-lock-keywords' are case-insensitive.") (defvar font-lock-verbose t "\ *Non-nil means `font-lock-fontify-buffer' should print status messages.") (defvar font-lock-mode-hook nil "\ Function or functions to run on entry to Font Lock mode.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÄÁ!ˆÄÃ!‡" [boundp font-lock-cache-position nil font-lock-cache-state make-variable-buffer-local] 2) (defalias 'font-lock-fontify-region #[(start end) "ŠbˆÁyˆ\nd^ɉ‰‰Ä  \n`` =ƒ.  ‚JÍ ˆ`WƒCÎ`Á# ‚1  ` Î`É % Ï 8ƒ‰`ÑÒ\nÓ#ƒtÏÎ`É %8„^Ô`Õ$ˆÎ`É % )× 8„—Ø 8ƒÓ`у©ÚÛ!P‚ªÜ\nÓ#ƒ¾ÏÎ`É %8„šÔ`Õ$ˆÎ`É % )`\nWƒ†` ‰ƒ†ÑƒñßP‚òÒ\nà#ƒ†á`â#ˆÎ`É %‰ ƒ†`#× 8„Ø 8ƒIÁ”‰bˆŒe\n}ˆÃäåˆ)Ô`Õ$ˆÎ#`É % )‚Ï 8ƒÁ”ÑÒ\nÓ#ƒjÏÎ#`É %8„TÔ`Õ$ˆÎ#`É % ))ÂӃ’á\næ#ˆç !.‡" [start 0 end nil buffer-modified-p modified prevstate prev startline state buffer-read-only font-lock-cache-position font-lock-cache-state beginning-of-defun parse-partial-sexp 3 beg re-search-forward "\\s\"" move put-text-property face font-lock-string-face 4 7 comment-end "\\s>\\|" regexp-quote "\\s>" font-lock-comment-face comment-start-skip "\\s\"\\|" t remove-text-properties (face nil) here (byte-code "ÀÁ!ˆÂÃx‡" [forward-comment 1 " " nil] 2) ((error (goto-char end))) (face nil) set-buffer-modified-p] 8 "\ Put proper face on each string and comment between START and END."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÅÈÉ#ˆÀÊË\"ˆÌÍ!„#Î Íž„1ÐÑ\"ÌÒ!„:ÎÇÒÓÔ#‡" [defalias font-lock-unfontify-region #[(beg end) "À ÁÄ Ç#ˆÈ !*‡" [buffer-modified-p nil buffer-read-only modified remove-text-properties beg end (face nil) set-buffer-modified-p] 4] font-lock-after-change-function #[(beg end old-len) "ŠÀ ÂŽ bˆ ƒ VƒÅbˆÅˆ` bˆÇyˆ`È T\"ˆÉ \"+‡" [match-data match-data ((store-match-data match-data)) beg font-lock-cache-position nil end 0 font-lock-fontify-region font-lock-hack-keywords] 3] font-lock-any-properties-p #[(start end) "À Â\"†à Â\"‰… W)‡" [get-text-property start face next-single-property-change next end] 4] put byte-optimizer byte-compile-inline-expand font-lock-hack-keywords #[(start end &optional loudly) "bˆ \nÃÄŠĉ‰‰‰‰‰ \n   ƒH@ Abˆ :ƒ‰ @  A:ƒc A@\nÒÓ 8! Ô 8‚— A9ƒzÃ\nÄÒ A! ‚— A\nÄ ‚—  Ã\nÄ Ö Ø#ƒ1\n”\n•„¶ÙÚ\n\"ˆ„ÝÛÉ\"†ÙÜÉ\"‰…ØW)*„—Þ>„$ŠbˆŒ}ˆm„ Ü`É\"‰ƒdVƒdÛ`É\"„ß`É $ˆbˆ)‚ð*‚—ßÉ $ˆ‚— ƒ(áâã äT‰å\"#ˆ‚(æ !. ‡" [start font-lock-keywords-case-fold-search font-lock-keywords 0 nil buffer-modified-p allow-overlap-p e s face match str first modified buffer-read-only count rest case-fold-search eval 2 3 font-lock-keyword-face re-search-forward end t error "expression did not match subexpression %d" get-text-property next-single-property-change next (t nil) put-text-property loudly message "Fontifying %s... (regexps...%s)" buffer-name make-string 46 set-buffer-modified-p] 13] boundp font-lock-mode nil minor-mode-alist append ((font-lock-mode " Font")) font-lock-fontified permanent-local t] 4) (defalias 'font-lock-mode #[(&optional arg) "„ ?‚Â!ÃVÅ ÆšƒÇÉ>„%ÊË\"ˆÌÈ! …-ÍLˆÌÁ! Lˆ ƒKÎ ˆÏÐ!ˆ„XÒ ˆ‚XƒXÇÓed\"ˆÔ )‡" [arg font-lock-mode prefix-numeric-value 0 on-p buffer-name " *Compiler Input*" nil after-change-function (nil font-lock-after-change-function) error "after-change-function is %s" make-local-variable font-lock-after-change-function font-lock-set-defaults run-hooks font-lock-mode-hook font-lock-fontified font-lock-fontify-buffer font-lock-unfontify-region force-mode-line-update] 3 "\ Toggle Font Lock mode. With arg, turn Font Lock mode on if and only if arg is positive. When Font Lock mode is enabled, text is fontified as you type it: - comments are displayed in `font-lock-comment-face'; (That is a variable whose value should be a face name.) - strings are displayed in `font-lock-string-face'; - documentation strings are displayed in `font-lock-doc-string-face'; - function and variable names in their defining forms are displayed in `font-lock-function-name-face'; - and certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. When you turn Font Lock mode on/off, the buffer is fontified/defontified. To fontify a buffer without having newly typed text become fontified, you can use \\[font-lock-fontify-buffer]." "P"]) (defalias 'font-lock-fontify-buffer #[nil " †t ƒÃÄÅ \"ˆ\n„Æ ˆÇed\"ˆ ƒ(ÃÈÅ \"ˆŠÉed\"ˆ ƒ8ÃÊÅ \"ˆËed #ˆ)ÌÍ!ÎLˆ …NÃÏÅ \"*‡" [font-lock-mode font-lock-verbose was-on message "Fontifying %s..." buffer-name font-lock-set-defaults font-lock-unfontify-region "Fontifying %s... (syntactically...)" font-lock-fontify-region "Fontifying %s... (regexps...)" font-lock-hack-keywords make-local-variable font-lock-fontified t "Fontifying %s... done."] 4 "\ Fontify the current buffer the way `font-lock-mode' would: - comments are displayed in `font-lock-comment-face'; - strings are displayed in `font-lock-string-face'; - documentation strings are displayed in `font-lock-doc-string-face'; - function and variable names in their defining forms are displayed in `font-lock-function-name-face'; - and certain other expressions are displayed in other faces according to the value of the variable `font-lock-keywords'. This can take a while for large buffers." nil]) (defalias 'font-lock-set-defaults #[nil "Á=ƒ\n\n‚UÃ=ƒ\n‚UÄ=ƒ ‚UÆ=ƒ( ‚UÇ=ƒ3‚UÉ=ƒ>\n‚UË=ƒI ‚UÍ=ƒT‚Uω‡" [major-mode lisp-mode lisp-font-lock-keywords emacs-lisp-mode c-mode c-font-lock-keywords c++-c-mode c++-mode c++-font-lock-keywords perl-mode perl-font-lock-keywords tex-mode tex-font-lock-keywords texinfo-mode texi-font-lock-keywords nil font-lock-keywords] 2 "\ Set `font-lock-keywords' to something appropriate for this mode."]) (defconst lisp-font-lock-keywords-1 (quote (("^(def[-a-z]+\\s +\\([^ \n)]+\\)" 1 font-lock-function-name-face) ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1))) "\ For consideration as a value of `lisp-font-lock-keywords'. This does fairly subdued highlighting.") (defconst lisp-font-lock-keywords-2 (append lisp-font-lock-keywords-1 (quote (("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \n]" . 1) ("(\\(while\\|do\\|let*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \n]" . 1) ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \n]" . 1) ("(\\(save-restriction\\|save-window-restriction\\)[ \n]" . 1) ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \n]" . 1) ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t) ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" 1 font-lock-keyword-face t)))) "\ For consideration as a value of `lisp-font-lock-keywords'. This does a lot more highlighting.") (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 "\ Additional expressions to highlight in Lisp modes.") (defconst c-font-lock-keywords-1 nil "\ For consideration as a value of `c-font-lock-keywords'. This does fairly subdued highlighting.") (defconst c-font-lock-keywords-2 nil "\ For consideration as a value of `c-font-lock-keywords'. This does a lot more highlighting.") (byte-code "ÀÁÂÃPÄÉÊËÌÍÎÏ ÐÑ ÐÑ ÐÒÑ Ó° ÔÕEÖ× ØRÙÕEÚÛ¯\nÝÞßQàBÞßQàBÞáß°àBâãäåæ#çQèBéê¯\"+,Ô‡" ["auto\\|extern\\|register\\|static\\|volatile" "unsigned\\|short\\|long" "int\\|char\\|float\\|double\\|void\\|struct\\|" "union\\|enum\\|typedef" "[a-zA-Z0-9_:~*]+" ctoken types prefixes storage ("^#[ ]*[a-z]+" . font-lock-comment-face) ("^#[ ]*\\(define\\|undef\\)[ ]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 font-lock-function-name-face) ("^#[ ]*\\(if\\)[ ]+\\([^\n]+\\)" 2 font-lock-function-name-face keep) ("^#[ ]*\\(endif\\|else\\)[ ]+\\([^\n]+\\)" 2 font-lock-function-name-face keep) ("^#[ ]*\\(ifn?def\\)[ ]+\\([^ \n]+\\)" 2 font-lock-function-name-face t) ("^#[ ]*include[ ]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) "^\\(" "[ ]+\\)?" "\\(" "\\([*&]+[ ]*\\)?" "\\)[ ]*(" 5 font-lock-function-name-face "^\\(typedef[ ]+struct\\|struct\\|static[ ]+struct\\)" "[ ]+\\(" "\\)[ ]*\\({\\|$\\)" 2 ("case[ ]+\\(\\(\\sw\\|\\s_\\)+\\):" . 1) ("\\<\\(default\\):" . 1) c-font-lock-keywords-1 append "\\<\\(" "\\)\\>" font-lock-type-face "[ ]+" "[ ]\\(" mapconcat identity ("for" "while" "do" "return" "goto" "case" "break" "switch" "if" "then" "else if" "else" "return" "default" "continue" "default") "\\|" "\\)[ \n(){};,]" 1 "\\(\\(\\sw\\|\\s_\\)+\\):" ("}[ *]*\\(\\(\\sw\\|\\s_\\)+\\)[ ]*[,;]" 1 font-lock-function-name-face) c-font-lock-keywords-2] 19) (defvar c-font-lock-keywords c-font-lock-keywords-1 "\ Additional expressions to highlight in C mode.") (defvar c++-font-lock-keywords c-font-lock-keywords "\ Additional expressions to highlight in C++ mode.") (defvar perl-font-lock-keywords (byte-code "ÀÁÂÃÄ#ÅQÆBÁÂÇÄ#ÈÉʯ‡" ["[ \n {]*\\(" mapconcat identity ("if" "until" "while" "elsif" "else" "unless" "for" "foreach" "continue" "exit" "die" "last" "goto" "next" "redo" "return" "local" "exec") "\\|" "\\)[ \n ;(]" 1 ("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" "#define" "#undef") ("^[ \n ]*sub[ ]+\\([^ {]+\\)[ ]*[{]" 1 font-lock-function-name-face) ("[ \n {]*\\(eval\\)[ \n (;]" 1 font-lock-function-name-face) ("\\(--- .* ---\\|=== .* ===\\)" . font-lock-doc-string-face)] 5) "\ Additional expressions to highlight in Perl mode.") (defvar tex-font-lock-keywords (list (quote ("\\(\\\\\\w+\\)" 1 font-lock-keyword-face t)) (quote ("{\\\\em\\([^}]+\\)}" 1 font-lock-comment-face t)) (quote ("{\\\\bf\\([^}]+\\)}" 1 font-lock-keyword-face t)) (quote ("^[ \n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face t)) (quote ("\\\\\\(begin\\|end\\){\\([a-zA-Z0-9\\*]+\\)}" 2 font-lock-function-name-face t)) (quote ("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t))) "\ Additional expressions to highlight in TeX mode.") (defvar texi-font-lock-keywords (list "@\\(@\\|[^} \n{]+\\)" (quote ("^\\(@c\\|@comment\\)[ ].*$" . font-lock-comment-face)) (quote ("^\\(*.*\\)[ ]*$" 1 font-lock-function-name-face t)) (quote ("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face t)) (quote ("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face t)) (quote ("@\\(samp\\|code\\|var\\){\\([^}]+\\)" 2 font-lock-function-name-face t)) (quote ("@\\(xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-keyword-face t)) (quote ("@end *\\([a-zA-Z0-9]+\\)[ ]*$" 1 font-lock-function-name-face t)) (quote ("@item \\(.*\\)$" 1 font-lock-function-name-face t)) (quote ("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t))) "\ Additional expressions to highlight in TeXinfo mode.") (provide (quote font-lock)) emacs-19.22/lisp/forms-d2.elc100666 13437 13 3505 5416165673 14106 0ustar jimbuser;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:04:26 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/forms-d2.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÂÃ!‡" ["forms-d2.dat" forms-file forms-enumerate (arch-newsgroup arch-volume arch-issue arch-article arch-shortname arch-parts arch-from arch-longname arch-keywords arch-date arch-remarks) forms-number-of-fields] 2) (defalias 'arch-tocol #[(target &optional fill) "„Á\niWƒÃÄ\n\"P‡Ä\niZ\"‡" [fill 32 target "\n" make-string] 4 "\ 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."]) (defalias 'arch-rj #[(target field &optional fill) "À \n 8GZ \"‡" [arch-tocol target field forms-fields fill] 4 "\ 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."]) (defalias 'forms-new-record-filter #[(the-record) "  Iˆ Ä Iˆ‡" [the-record arch-from user-full-name arch-date current-time-string] 3 "\ Form a new record with some defaults."]) (byte-code "À  ÄÅÇÉÊË ÉÍÎÄÐÒÓÒÔÄÖدۇ" ["====== 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 "Submitted by: " arch-from "\n" (arch-tocol 79 45) "Keywords: " arch-keywords "Parts: " arch-parts "\n\n====== Remarks ======\n\n" arch-remarks forms-format-list nil] 30) emacs-19.22/lisp/forms-pass.elc100666 13437 13 1407 5416165676 14551 0ustar jimbuser;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:04:30 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/forms-pass.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ‰!„\nÃÄÆÈ Ê\nËÌÍÎÏÐÑÒÓÔÒÕÖÒ×ÈدÀ‡" [file-exists-p "/var/yp/src/passwd" forms-file "/etc/passwd" t forms-read-only ":" forms-field-sep 7 forms-number-of-fields "====== Visiting " " ======\n\n" "User : " 1 " Uid: " 3 " Gid: " 4 "\n\n" "Name : " 5 "Home : " 6 "Shell: " "\n" forms-format-list] 19) emacs-19.22/lisp/forms.elc100666 13437 13 52202 5473274440 13615 0ustar jimbuser;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 19 20:55:44 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/forms.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [provide forms forms-mode] 2) (defconst forms-version (substring "$Revision: 2.3 $" 11 -2) "\ The version number of forms-mode (as string). The complete RCS id is: $Id: forms.el,v 2.3 1993/10/21 00:43:51 rms Exp $") (defvar forms-mode-hooks nil "\ Hook functions to be run upon entering Forms mode.") (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.") (defvar forms-field-sep " " "\ 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 " " "\ 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-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 (quote 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 (quote default) "\ The face (a symbol) that is used to display read-only text on the screen.") (defvar forms-rw-face (quote region) "\ The face (a symbol) that is used to display read-write text on the screen.") (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.") (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 (quote 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.") (defalias 'forms-mode #[(&optional primary) "„ „ ˆÃÄ!ˆÃÅ!ˆÃÆ!ˆÃÇ!ˆÃÈ!ˆÃÉ!ˆÃÊ!ˆÃË!ˆÃÌ!ˆÃÍ!ˆÃÎ!ˆÏ ÏÐÑ!ƒKÃÒ!ˆÃÓ!ˆÔ ˆ „XÕÖ×P!ˆ „bÕÖØP!ˆ §ƒm ÙV„sÕÖÚP!ˆ;„ÕÖÛP!ˆ ƒ© ;ƒ£ GÜ=ƒ£ ˜ƒ©ÕÖÝP!ˆ‚©ÕÖÞP!ˆÐß!„²Ï à ˆÃá!ˆÃâ!ˆÃã!ˆÃä!ˆå ˆÃæ!ˆç ˆ ƒáÐ !„áÕÖèP!ˆƒóÐ!„óÕÖéP!ˆÃê!ˆÃë!ˆÏ,íÏ!ˆÏ.ï ˆÐÑ!ƒ.Ãð!ˆÃñ!ˆƒ&01‚.01Ãò!ˆÃó!ˆÃô!ˆÃõ!ˆÃö!ˆ7„Jø ˆù !2Ï:Š2qˆûp!ˆ.:üed\")3:ƒný)þ?@AÃB!ˆÈCDCBD ˆE ˆFÏ!ˆ4ÜWƒŸÜ4G4!ˆHI!ˆJ ˆý‰‡" [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-new-record-filter forms-modified-record-filter nil fboundp make-face forms-ro-face forms-rw-face eval-current-buffer error "Forms control file error: " "'forms-file' has not been set" "'forms-number-of-fields' has not been set" 0 "'forms-number-of-fields' must be a number > 0" "'forms-field-sep' is not a string" 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 buffer-file-name auto-save-mode 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 find-file-noselect ro bury-buffer count-lines t forms-mode major-mode "Forms" mode-name minor-mode-alist " View" forms--set-keymaps forms--change-commands set-buffer-modified-p forms-jump-record run-hooks forms-mode-hooks forms--help] 3 "\ 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-s forms-search s \\C-c \\C-x forms-exit x " nil]) (defalias (quote forms--process-format-list) #[nil "„\nÁÂÃP!ˆ<„ÁÂÄP!ˆÅÇ\"ÉÇÉ\n   Ç ƒ\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]) (defvar forms--iif-start nil "\ Record start of modification command.") (defvar forms--iif-properties nil "\ Original properties of the character being overridden.") (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 "\ `insert-in-front-hooks' 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 "\ `post-command-hook' function for read-only segments."]) (defalias 'forms--make-format #[nil "À‰ ƒ$ÄÅÆÇÈÆÉÊ \"\" @§?…ÌÍ$ÎF‚/ÆÏÈÆÉÐ \"\"\"Ò\nÓ\"Ò Ó\"*ÖÑ!‡" [0 forms--dyntext forms--marker forms-use-text-properties lambda (arg) append (let ((inhibit-read-only t))) 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))))) ((remove-text-properties (1- (point)) (point) (quote (rear-nonsticky)))) (setq forms--iif-start nil) (lambda (arg)) forms--make-format-elt forms--format make-vector nil forms--markers forms--dyntexts forms--debug] 9 "\ Generate `forms--format' using the information in `forms-format-list'."]) (defalias 'forms--make-format-elt-using-text-properties #[(el) ";ƒÁÂÃÄDÅEÆÇTCÉ#FC‡§ƒ5ÊËÌ͉TÎFÄÏÐSEDѯC‡<…UÁÒÃÄÌÓ‰TFDÕEÆÖTC×#FC‡" [el set-text-properties (point) progn insert (point) append (list (quote face) forms--ro-face (quote read-only)) forms--marker ((quote insert-in-front-hooks) (quote (forms--iif-hook)) (quote rear-nonsticky) (quote (face read-only insert-in-front-hooks))) 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) (list (quote face) forms--ro-face (quote read-only)) ((quote insert-in-front-hooks) (quote (forms--iif-hook)) (quote rear-nonsticky) (quote (read-only face insert-in-front-hooks)))] 8 "\ Helper routine to generate format function."]) (defalias 'forms--make-format-elt #[(el) ";ƒ\nÁDC‡§ƒ Âà ÅFÁÆÇSEDD T‡<…3ÁÂÈ FDC T ‡" [el insert aset forms--markers forms--marker (point-marker) elt arg forms--dyntexts forms--dyntext] 5 "\ Helper routine to generate format function."]) (defalias 'forms--make-parser #[nil "ƒÁ‚\"‰ÃÇÂÈÉÊÈËÌÈ ÂC\"\"\"\"E+ÏÎ!‡" [forms-use-text-properties forms--parser-using-text-properties nil 0 forms--dyntext forms--seen-text forms--field lambda append (let (here) (goto-char (point-min))) apply mapcar forms--make-parser-elt forms-format-list forms--parser forms--debug] 11 "\ Generate `forms--parser' from the information in `forms-format-list'."]) (defalias 'forms--parser-using-text-properties #[nil "ÀÁ‰‰ GW…P H‰bˆÆ Ç\"ƒ' HÁIˆ‚IÊ Ç\"‰ƒ> H \n{Iˆ‚I H d{Iˆ T‰‚+‡" [0 nil there here i forms--markers get-text-property read-only forms--recordv forms--elements next-single-property-change] 5 "\ Extract field info from forms when using text properties."]) (defalias 'forms--make-parser-elt #[(el) ";ƒA ƒ)ÂÃÄÅÆCÇ#DÈÉEEÊË SÌÍÎÏGEEFE‚;ÃÄÐÑ!DDÈÒEEÓGDDÔÖ‡§ƒT ƒPÈ× #‡Ö‡„d …šÊË SØFC‡<…š ƒƒÙÚÛÜÝEDDÞÊË SßFFC‚ÙÛÜÝEDCàáFCTÔÖ‡" [el forms--field (setq here (point)) if not append (search-forward) (nil t nil) error "Parse error: cannot find \"%s\"" aset forms--recordv buffer-substring 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 (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 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 "\ Helper routine to generate forms parser function."]) (defalias 'forms--set-keymaps #[nil "À ƒ \n‚\n !‡" [use-local-map forms-read-only forms-mode-ro-map forms-mode-edit-map] 2 "\ Set the keymaps used in this mode."]) (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 " " forms-jump-record "" forms-next-record "" forms-prev-record "" forms-search "" forms-exit "<" forms-first-record ">" forms-last-record "?" describe-mode "" forms-mode-ro-map suppress-keymap "" "q" "l" "n" "p" "s" "x" " " forms--mode-commands1 forms-mode-edit-map] 4 "\ Fill the Forms mode keymaps."]) (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 "\ Helper routine to define keys."]) (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 make-local-variable local-write-file-hooks add-hook #[(nil) "À ˆŠ qˆÂ ˆ)Ç" [forms--checkmod forms--file-buffer save-buffer t] 1] revert-buffer-function forms-revert-buffer t] 5 "\ Localize some commands 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 "\ Initial help for Forms mode."]) (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 "\ Translate in SUBJ all chars ARG into char REP. ARG and REP should be single-char strings."]) (defalias 'forms--exit #[(query &optional save) "À !à ˆ ƒÅ !ƒŠ qˆÆ ˆ)Š qˆÇ ˆÈp!ˆ)É\n!ƒ8 …>Ê ˆËÌ!‚>Ç ˆÈp!)‡" [buffer-name forms--file-buffer buf forms--checkmod save buffer-modified-p save-buffer delete-auto-save-file-if-necessary kill-buffer get-buffer beep message "Problem saving buffers?"] 2 "\ Internal exit from forms mode function."]) (defalias 'forms--get-record #[nil "n„Àyˆ`ˆ `{ bˆ)‡" [0 here nil] 2 "\ Fetch the current record from the file buffer."]) (defalias 'forms--show-record #[(the-record) "ÀÁÀ\nGƒÈ Ê#ˆ \nP Ë\n #‰ƒ@ O Í C\" \\)‚,ÀƒWÑÓedÀ#ˆ)Ô ˆGU„‡Ö ˆ×Ø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 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 "\ Format THE-RECORD and display it in the current buffer."]) (defalias 'forms--parse-form #[nil "À !  ˆ)ƒ(ÂÇ \"!ÉÀ\"A)‚,É À\")‡" [nil forms--recordv vconcat forms--the-record-list forms--dynamic-text forms--parser forms-modified-record-filter [nil] the-fields append] 3 "\ Parse contents of form into list of strings."]) (defalias 'forms--update #[nil "ƒ ÁÂ!ˆÃ ‡ÄÆ ÈÉ\n# ƒ%Ì Í #ˆÎÍ \"ƒ5ÁÏ!ˆÃ ‚PŠ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 forms-multi-line forms--trans "\n" string-match "Multi-line fields in this record - update refused!" forms--file-buffer 0] 4 "\ Update current record with contents of form. As a side effect: sets `forms--the-record-list'."]) (defalias 'forms--checkmod #[nil "ÀÁ!…`à ˆÄÁ!ˆ\nb)‡" [buffer-modified-p nil here forms--update set-buffer-modified-p] 2 "\ Check if this form has been modified, and call forms--update if so."]) (defalias 'forms-find-file #[(fn) "À !ˆ\n† ÃÄ!‡" [find-file-read-only fn forms--mode-setup forms-mode t] 2 "\ Visit a file in Forms mode." "fForms file: "]) (defalias 'forms-find-file-other-window #[(fn) "À !ˆÂ ˆ †ÄÅ!‡" [find-file-other-window fn eval-current-buffer forms--mode-setup forms-mode t] 2 "\ Visit a file in Forms mode in other window." "fFbrowse file in other window: "]) (defalias 'forms-exit #[(query) "À Â\"‡" [forms--exit query t] 3 "\ Normal exit from Forms mode. Modified buffers are saved." "P"]) (defalias 'forms-exit-no-save #[(query) "À Â\"‡" [forms--exit query nil] 3 "\ Exit from Forms mode without saving buffers." "P"]) (defalias 'forms-next-record #[(arg) "À  !\\Ä\"‡" [forms-jump-record forms--current-record prefix-numeric-value arg t] 4 "\ Advance to the ARGth following record." "P"]) (defalias 'forms-prev-record #[(arg) "À  !ZÄ\"‡" [forms-jump-record forms--current-record prefix-numeric-value arg t] 4 "\ Advance to the ARGth previous record." "P"]) (defalias 'forms-jump-record #[(arg &optional relative) " V„ ÂXƒà ˆ ?…sÅÆ #‡Ç ˆZ \nËŠ qˆÂyˆ ƒ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 "\ Jump to a random record." "NRecord number: "]) (defalias 'forms-first-record #[nil "ÀÁ!‡" [forms-jump-record 1] 2 "\ Jump to first record." nil]) (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 "\ Jump to last record. As a side effect: re-calculates the number of records in the data file." nil]) (defalias 'forms-toggle-read-only #[(arg) "ƒ Á!ÂX‚ ƒ7 Š qˆ)ƒ*ÇÈÉ\n\"ˆË ˆ‚,Ì š?…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 "\ 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." "P"]) (defalias 'forms-insert-record #[(arg) "ƒÁÂ!ˆ ƒ T‚ ʼnÉ ˆ\nƒ=Ë TÂ\" \n ! Î Å\"A)‚DÏ Â\"ÐÑ#ŠqˆÔ!ˆÕÖ!ˆcˆ×yˆ)+TÙ !‡" [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 "\ 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." "P"]) (defalias 'forms-delete-record #[(arg) "ƒÁÂ!ˆÃ ˆ „ÅÆ!ƒJŠ qˆÊ!ˆŠËyˆ`)ŠÌˆ`T)|ˆ) S  VƒD Î!ˆ)ÏÂ!‡" [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 nil forms--total-records forms-jump-record message] 2 "\ Deletes a record. With a prefix argument: don't ask." "P"]) (defalias 'forms-search #[(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 "\ Search REGEXP in file buffer." (list (read-string (concat "Search for" (if forms--search-regexp (concat " (" forms--search-regexp ")")) ": ")))]) (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 "\ Reverts current form to un-modified." "P"]) (defalias 'forms-next-field #[(arg) "À`ÁÀÀUƒÇ‚\n\\ÈÉ?…%\nÀHb,‡" [0 nil cnt there here i arg 1 done (byte-code " GW…- H‰ƒ&\n X„& S‰ÅXƒ&\nbˆÆÇÈ\"ˆT‰‚‡" [i forms--markers there here cnt 0 throw done t] 4) forms--markers] 4 "\ Jump to ARG-th next field." "p"]) (defalias 'forms-prev-field #[(arg) "G`ÁÂÂUƒÈ‚ \\ÉÊ?…(‰GSHb,‡" [forms--markers nil 0 cnt there here i arg 1 done (byte-code "ÁV…+S\nH‰ƒ Y„ S‰ÁXƒ bˆÆÇÈ\"ˆ‚‡" [i 0 forms--markers there here cnt throw done t] 3)] 4 "\ Jump to ARG-th previous field." "p"]) (defalias 'forms-enumerate #[(the-fields) "À\nƒ T\n¢\n£ Lˆ)‚ )‡" [0 the-index the-fields el] 2 "\ 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 ...)))"]) (defvar forms--debug nil "\ *Enables forms-mode debugging if not nil.") (defalias 'forms--debug #[(&rest args) "…gÁ ƒQ ¢ £ ;ƒ\n P‚M\nÅ !ÆQÇ !ƒ:È ! \nÅ !ÊQ)‚?\nËÊQÌ !ƒM\nÅ K!Ê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 "\ Internal debugging routine."]) emacs-19.22/lisp/gud.elc100666 13437 1 56731 5453474616 13530 0ustar jimbdaemon;ELC ;;; compiled by jonathan@kauai on Sun Oct 3 03:04:42 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/gud.el ;;; emacs version 19.19.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint etags] 2) (defvar gud-key-prefix "" "\ Prefix of all GUD commands valid in C buffers.") (byte-code "À ÂPÃ\"ˆÀÄÅ\"‡" [global-set-key gud-key-prefix " " gud-refresh " " gud-break] 3) (defalias 'gud-overload-functions #[(gud-overload-alist) "ÀÁ\n\"‡" [mapcar #[(p) "@AKM‡" [p] 2] gud-overload-alist] 3 "\ Overload functions defined in GUD-OVERLOAD-ALIST. This association list has elements of the form (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias gud-massage-args #[(file args) "ÀÁ!‡" [error "GUD not properly entered."] 2] gud-marker-filter #[(str) "ÀÁ!‡" [error "GUD not properly entered."] 2] gud-find-file #[(f) "ÀÁ!‡" [error "GUD not properly entered."] 2]] 3) (defalias 'gud-def '(macro . #[(func cmd key &optional doc) "ÀÁ\nà † ÅÆÇÉ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 "\ 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)."])) (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÅÆÇ\"ˆÀÈ!„&ÉÅÊË\"ˆÅÌÍ\"‡" [boundp gud-last-frame nil gud-last-last-frame gud-gdb-history defalias gud-gdb-massage-args #[(file args) "À \nBB‡" ["-fullname" file args] 3] gud-gdb-marker-acc "" gud-gdb-marker-filter #[(string) "À ÂŽ PÅÇÈ \"ƒ7 ɔɕOÊ Ë”Ë•O!B  ͉”OP Í•ÎO‚ ÇÏ \"ƒQ ͉”OP Í”ÎO‚Y PÅ+‡" [match-data match-data ((store-match-data match-data)) gud-gdb-marker-acc string "" output string-match "^\\([^:\n]*\\):\\([0-9]*\\):.*\n" 1 string-to-int 2 gud-last-frame 0 nil "^.*\\'"] 5] gud-gdb-find-file #[(f) "À !‡" [find-file-noselect f] 2]] 3) (defalias 'gdb #[(command-line) "ÀÁ!ˆÂ !ˆÄÅMˆÆÇ ÈÄ#ˆÉ\nËPÄ\"ˆÌÍMˆÆÇ ÎÌ#ˆÉ\nÏPÌ\"ˆÐÑMˆÆÇ ÒÐ#ˆÉ\nÓPÐ\"ˆÔÕMˆÆÇ ÖÔ#ˆÉ\n×PÔ\"ˆØÙMˆÆÇ ÚØ#ˆÉ\nÛPØ\"ˆÜÝMˆÆÇ ÞÜ#ˆÉ\nßPÜ\"ˆàáMˆÆÇ âà#ˆÉ\nãPà\"ˆäåMˆÆÇ æä#ˆÉ\nçPä\"ˆèéMˆÆÇ êè#ˆÉ\nëPè\"ˆìíMˆÆÇ îì#ˆÉ\nïPì\"ˆðñMˆÆÇ òð#ˆÉ\nóPð\"ˆô5ö÷!‡" [gud-overload-functions ((gud-massage-args . gud-gdb-massage-args) (gud-marker-filter . gud-gdb-marker-filter) (gud-find-file . gud-gdb-find-file)) gud-common-init command-line gud-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 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 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"] "" "" "^(.*gdb[+]?) *" comint-prompt-regexp run-hooks gdb-mode-hook] 4 "\ 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." (list (read-from-minibuffer "Run gdb (like this): " (if (consp gud-gdb-history) (car gud-gdb-history) "gdb ") nil nil (quote (gud-gdb-history . 1))))]) (byte-code "ÀÁ!„‡" [boundp gud-sdb-history nil] 2) (defvar gud-sdb-needs-tags (byte-code "ÀÁ!?‡" [file-exists-p "/var"] 2) "\ If nil, we're on a System V Release 4 and don't need the tags hack.") (byte-code "ÀÁ!„ÂÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"‡" [boundp gud-sdb-lastfile nil defalias gud-sdb-massage-args #[(file args) " B‡" [file args] 2] gud-sdb-marker-filter #[(string) "ÀÁ\n\"ƒ\nÔÕOÄ\nŔŕO!B‚LÀÇ\n\"ƒ-\nÔÕO‚LƒIÀÉ\n\"ƒIÄ\nʔʕO!B‚LË\n‡" [string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" string 2 string-to-int 3 gud-last-frame "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n" gud-sdb-lastfile "^\\([0-9]+\\):" 1 nil] 5] gud-sdb-find-file #[(f) "ƒÁ\n!‡Ã\n!‡" [gud-sdb-needs-tags find-tag-noselect f find-file-noselect] 2]] 3) (defalias 'sdb #[(command-line) "ƒÁÂ!ƒÃ\n!„ÄÅ!ˆÆÇ!ˆÈ !ˆÊËMˆÌÍ ÎÊ#ˆÏÑPÊ\"ˆÒÓMˆÌÍ ÔÒ#ˆÏÕPÒ\"ˆÖ×MˆÌÍ ØÖ#ˆÏÙPÖ\"ˆÚÛMˆÌÍ ÜÚ#ˆÏÝPÚ\"ˆÞßMˆÌÍ àÞ#ˆÏáPÞ\"ˆâãMˆÌÍ äâ#ˆÏåPâ\"ˆæçMˆÌÍ èæ#ˆÏéPæ\"ˆêëMˆÌÍ ìê#ˆÏíPê\"ˆî/ðñ!‡" [gud-sdb-needs-tags boundp tags-file-name file-exists-p error "The sdb support requires a valid tags table to work." gud-overload-functions ((gud-massage-args . gud-sdb-massage-args) (gud-marker-filter . gud-sdb-marker-filter) (gud-find-file . gud-sdb-find-file)) gud-common-init command-line gud-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 run-hooks sdb-mode-hook] 4 "\ 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." (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 "ÀÁ!„ÂÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"‡" [boundp gud-dbx-history nil defalias gud-dbx-massage-args #[(file args) " B‡" [file args] 2] gud-dbx-marker-filter #[(string) "ÀÁ\n\"„ÀÃ\n\"ƒ\nĔĕOÅ\nƔƕO!B\n‡" [string-match "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" string "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" 2 string-to-int 1 gud-last-frame] 5] gud-dbx-find-file #[(f) "À !‡" [find-file-noselect f] 2]] 3) (defalias 'dbx #[(command-line) "ÀÁ!ˆÂ !ˆÄÅMˆÆÇ ÈÄ#ˆÉ\nËPÄ\"ˆÌÍMˆÆÇ ÎÌ#ˆÉ\nÏPÌ\"ˆÐÑMˆÆÇ ÒÐ#ˆÉ\nÓPÐ\"ˆÔÕMˆÆÇ ÖÔ#ˆÉ\n×PÔ\"ˆØÙMˆÆÇ ÚØ#ˆÉ\nÛPØ\"ˆÜÝMˆÆÇ ÞÜ#ˆÉ\nßPÜ\"ˆàáMˆÆÇ âà#ˆÉ\nãPà\"ˆäåMˆÆÇ æä#ˆÉ\nçPä\"ˆèéMˆÆÇ êè#ˆÉ\nëPè\"ˆì-îï!‡" [gud-overload-functions ((gud-massage-args . gud-dbx-massage-args) (gud-marker-filter . gud-dbx-marker-filter) (gud-find-file . gud-dbx-find-file)) gud-common-init command-line gud-break #[(arg) "ÀÁ\n\"‡" [gud-call "file \"%d%f\"\nstop at %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 "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-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-print #[(arg) "ÀÁ\n\"‡" [gud-call "print %e" arg] 3 "Evaluate C expression at point." "p"] "" "" "^[^)]*dbx) *" comint-prompt-regexp run-hooks dbx-mode-hook] 4 "\ 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." (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 "ÀÁ!„‡" [boundp gud-xdb-history nil] 2) (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.") (defalias (quote gud-xdb-massage-args) #[(file args) "Á‰ƒ @Ä\nBB A‰„ \nBŸ*¤‡" [gud-xdb-directories nil result directories "-d" file args] 4]) (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 "\ Transform a relative pathname to a full pathname in xdb mode"]) (byte-code "ÀÁ!„ÂÃÄÅ\"ˆÃÆÇ\"‡" [boundp gud-xdb-accumulation "" defalias gud-xdb-marker-filter #[(string) "À \"„ÂÅ \"ƒ PÇ‚! P ƒTÂÈ \"„3ÂÉ \"ƒTÊ Ë”Ë•O!Ì Í”Í•O!ƒSB* †YÇ)‡" [nil result string-match comint-prompt-regexp string ".*\n" gud-xdb-accumulation "" "\\([^\n :]+\\): [^:]+: \\([0-9]+\\):" "[^: ]+:[ ]+\\([^:]+\\): [^:]+: \\([0-9]+\\):" string-to-int 2 gud-xdb-file-name 1 file line gud-last-frame] 5] gud-xdb-find-file #[(f) "À !‰… Ã\n!)‡" [gud-xdb-file-name f realf find-file-noselect] 3]] 3) (defalias 'xdb #[(command-line) "ÀÁ!ˆÂ !ˆÄÅMˆÆÇ ÈÄ#ˆÉ\nËPÄ\"ˆÌÍMˆÆÇ ÎÌ#ˆÉ\nÏPÌ\"ˆÐÑMˆÆÇ ÒÐ#ˆÉ\nÓPÐ\"ˆÔÕMˆÆÇ ÖÔ#ˆÉ\n×PÔ\"ˆØÙMˆÆÇ ÚØ#ˆÉ\nÛPØ\"ˆÜÝMˆÆÇ ÞÜ#ˆÉ\nßPÜ\"ˆàáMˆÆÇ âà#ˆÉ\nãPà\"ˆäåMˆÆÇ æä#ˆÉ\nçPä\"ˆèéMˆÆÇ êè#ˆÉ\nëPè\"ˆìíMˆÆÇ îì#ˆÉ\nïPì\"ˆð1òó!ˆô3õö!‡" [gud-overload-functions ((gud-massage-args . gud-xdb-massage-args) (gud-marker-filter . gud-xdb-marker-filter) (gud-find-file . gud-xdb-find-file)) gud-common-init command-line gud-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 make-local-variable gud-xdb-accumulation "" run-hooks xdb-mode-hook] 4 "\ 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." (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 "ÀÁ!„ÂÃÄÅ\"ˆÀÆ!„ÇÃÈÉ\"ˆÃÊË\"‡" [boundp gud-perldb-history nil defalias gud-perldb-massage-args #[(file args) "À  BBB‡" ["-d" file "-emacs" args] 4] gud-perldb-marker-acc "" gud-perldb-marker-filter #[(string) "À ÂŽ PÅÇÈ \"ƒ7 ɔɕOÊ Ë”Ë•O!B  ͉”OP Í•ÎO‚ ÇÏ \"ƒQ ͉”OP Í”ÎO‚Y PÅ+‡" [match-data match-data ((store-match-data match-data)) gud-perldb-marker-acc string "" output string-match "^\\([^:\n]*\\):\\([0-9]*\\):.*\n" 1 string-to-int 2 gud-last-frame 0 nil "^.*\\'"] 5] gud-perldb-find-file #[(f) "À !‡" [find-file-noselect f] 2]] 3) (defalias 'perldb #[(command-line) "ÀÁ!ˆÂ !ˆÄÅMˆÆÇ ÈÄ#ˆÉ\nËPÄ\"ˆÌÍMˆÆÇ ÎÌ#ˆÉ\nÏPÌ\"ˆÐÑMˆÆÇ ÒÐ#ˆÉ\nÓPÐ\"ˆÔÕMˆÆÇ ÖÔ#ˆÉ\n×PÔ\"ˆØÙMˆÆÇ ÚØ#ˆÉ\nÛPØ\"ˆÜÝMˆÆÇ ÞÜ#ˆÉ\nßPÜ\"ˆà!âã!‡" [gud-overload-functions ((gud-massage-args . gud-perldb-massage-args) (gud-marker-filter . gud-perldb-marker-filter) (gud-find-file . gud-perldb-find-file)) gud-common-init command-line 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 run-hooks perldb-mode-hook] 4 "\ 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." (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 "ÀÁ!„‡" [boundp gud-delete-prompt-marker nil] 2) (defalias 'gud-mode #[nil "À ˆÁÃÅÇÈ !!ˆÊË!ˆÌ ÊÍ!ˆÊÎ!ˆÏ ÐÑ!‡" [comint-mode gud-mode major-mode "Debugger" mode-name (": %s") mode-line-process use-local-map copy-keymap comint-mode-map make-local-variable gud-last-frame nil comint-prompt-regexp gud-delete-prompt-marker make-marker run-hooks gud-mode-hook] 3 "\ 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." nil]) (byte-code "ÀÁ!„ÂÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"ˆÃÊË\"ˆÃÌÍ\"‡" [boundp gud-comint-buffer nil defalias gud-chop-words #[(string) "À‰ G‰ WƒK HÇ>ƒB O BT‰ Wƒ: HÈ>ƒ: T‰‚& T‰‚ T‰‚ WƒX ÂO B Ÿ,‡" [0 string nil words len beg i (9 32) (9 32)] 5] gud-common-init #[(command-line) "À !‰@\nA‰ƒ @ÅHÆUƒ A‰„ @)È\nA\" Ê! Ì ! ÎÏ ÐQ!ˆÑ !n„LÓ ˆÔÕ±ˆÖ×Ø P ÙÚ  \"%ˆ.Û ˆÜÝp!Þ\"ˆßÝp!à\"ˆá ‡" [gud-chop-words command-line words program w 0 45 file-word delq args expand-file-name file file-name-nondirectory filepart switch-to-buffer "*gud-" "*" file-name-directory default-directory newline "Current directory is " "\n" apply make-comint "gud-" nil gud-massage-args gud-mode set-process-filter get-buffer-process gud-filter set-process-sentinel gud-sentinel gud-set-buffer] 9] gud-set-buffer #[nil "Á=… p‰‡" [major-mode gud-mode gud-comint-buffer] 2] gud-filter #[(proc string) "ÀŠÂ !qˆÄ‰ŠÇ !bˆÈ !ƒ%` |ˆ ĉ“ˆÊË !!ˆ`Ç !U`Ç !W ƒK „KÎp!ƒKÏ ˆ)…UÇ !b,‡" [t inhibit-quit process-buffer proc nil output-after-point moving process-mark marker-buffer gud-delete-prompt-marker insert-before-markers gud-marker-filter string gud-last-frame get-buffer-window gud-display-frame] 3] gud-sentinel #[(proc msg) "ÀÁ\n!!„ÃÅ\nÃ\"‡Æ\n!Ç>…SÃÈÉÆ\n!!P\np ÌŽÁ\n!qˆÍÎ !ˆmƒAÏѱˆ‚OŠ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)) set-buffer-modified-p buffer-modified-p 10 mode-name " " msg delete-process] 4]] 3) (defalias 'gud-display-frame #[nil "…Á ˆÂ@A\"ˆĉ‡" [gud-last-frame gud-set-buffer gud-display-line gud-last-last-frame nil] 3 "\ Find and obey the last filename-and-line marker from the debugger. Obeying it means displaying in another window the specified file and line." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias gud-display-line #[(true-file line) "À !Ã\n!ÅŠ\nqˆŒ~ˆÇ!ˆ`É\n „&Ì   `p“ˆ)eW„;dVƒA~ˆbˆ)Í  \"+‡" [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] gud-format-command #[(str arg) "p=?Âà \"ƒ( ŔŕOÆ ƒÇ ‚@! ɔɕOQÂÊ \"ƒK ŔŕOË ƒ?Ç ‚B@! ɔɕOQÂÌ \"ƒw ŔŕO ƒlŠÍyˆŒ~ˆÎÅ`\"T*‚oA ɔɕOQÂÏ \"ƒŽ ŔŕOРɔɕOQÂÑ \"ƒ¥ ŔŕOÒ É”É•OQÂÓ \"ƒÇ ŔŕOƒ¾Õ!‚¿Ö ɔɕOQ) ‡" [gud-comint-buffer insource string-match "\\(.*\\)%f\\(.*\\)" str 1 file-name-nondirectory buffer-file-name gud-last-frame 2 "\\(.*\\)%d\\(.*\\)" file-name-directory "\\(.*\\)%l\\(.*\\)" 0 count-lines "\\(.*\\)%e\\(.*\\)" find-c-expr "\\(.*\\)%a\\(.*\\)" gud-read-address "\\(.*\\)%p\\(.*\\)" arg int-to-string ""] 5]] 3) (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 "\ Return a string containing the core-address found in the buffer at point."]) (defalias (quote gud-call) #[(fmt &optional arg) "À \n\"ÄÅ \"ˆÆÇ!ˆÈ !)‡" [gud-format-command fmt arg msg message "Command: %s" sit-for 0 gud-basic-call] 3]) (defalias 'gud-basic-call #[(command) "À ˆ ÂPà !Š qˆÆ !bˆÇyˆÈ !ƒ$\n`Ë“ˆ)Ì \"*‡" [gud-set-buffer command "\n" get-buffer-process gud-comint-buffer proc process-mark 0 looking-at comint-prompt-regexp gud-delete-prompt-marker nil process-send-string] 3 "\ Invoke the debugger COMMAND displaying source in other window." nil]) (defalias 'gud-refresh #[(&optional arg) "À !ˆ\n„\n Ä ‡" [recenter arg gud-last-frame gud-last-last-frame gud-display-frame] 2 "\ Fix up a possibly garbled display, and redraw the arrow." "P"]) (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 "\ Returns the C expr that surrounds point." nil]) (defalias 'expr-cur #[nil "`À‰Ä ˆ`Å ˆ` Yƒ  bˆÅ ˆ`\nbˆ\n +B‡" [nil end begin p expr-backward-sexp expr-forward-sexp] 3 "\ 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-backward-sexp #[nil "ÀÁ‡" [nil (backward-sexp) ((error t))] 3 "\ Version of `backward-sexp' that catches errors."]) (defalias 'expr-forward-sexp #[nil "ÀÁ‡" [nil (forward-sexp) ((error t))] 3 "\ Version of `forward-sexp' that catches errors."]) (defalias 'expr-prev #[nil "À‰à ˆ`Ä ˆ`\nbˆ\n *B‡" [nil end begin expr-backward-sexp expr-forward-sexp] 2 "\ 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-next #[nil "À‰à ˆÃ ˆ`Ä ˆ`‰ *B‡" [nil end begin expr-forward-sexp expr-backward-sexp] 3 "\ 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-compound-sep #[(span-start span-end) "ÀÁ WƒL fz‰ÀU„D\nÆUƒD f‰ÆUƒ(Æ‚D\nÇUƒ@ È\\fÉUƒ@Æ È\\‚D Ê È\\‰‚ *‡" [32 nil syntax result span-start span-end 46 45 1 62 63] 3 "\ Returns '.' for '->' & '.', returns ' ' for white space, returns '?' for other punctuation."]) (defalias 'expr-compound #[(first second) "A @ÂÆ \"@ @Uƒ‚jA AUƒ%‚j ÇUƒ/È‚j ÉUƒi ÊZf f ËUƒGÈ‚j ÌUƒQÈ‚j ÍUƒ[È‚j ÎUƒeÈ‚j‚jÂ+‡" [first second nil syntax span-end span-start expr-compound-sep 46 t 32 1 41 93 40 91] 3 "\ 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"]) (provide (quote gud)) emacs-19.22/lisp/fortran.elc100666 13437 1 66006 5473274506 14416 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 19 20:56:22 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/fortran.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (byte-code "À‡" ["version 1.30.3" fortran-mode-version nil] 1) (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.") (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 and MAP blocks.") (defvar fortran-continuation-indent 5 "\ *Extra indentation applied to Fortran continuation lines.") (defvar fortran-comment-indent-style (quote 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.") (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 "\ *From a Fortran ENDIF statement, blink the matching IF 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 50 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 50 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-do-auto-fill' to break lines before delimiters.") (byte-code "„UÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÈ#ˆÂÊÈ#ˆÂËÈ#ˆÂÌÈ#ˆÂÍÎ#ˆÂÏÎ#ˆÂÐÑ#ˆÂÒÄ#ˆÂÓÄ#ˆÂÔÕ#ˆÁ‡" [fortran-mode-syntax-table make-syntax-table modify-syntax-entry 59 "w" 13 " " 43 "." 45 61 42 47 39 "\"" 34 92 "/" 46 95 10 ">"] 4) (defvar fortran-mode-map nil "\ Keymap used in Fortran mode.") (byte-code "„—Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáà#ˆÂâà#ˆÂãà#ˆÂäà#ˆÂåà#ˆÂæà#ˆÂçà#ˆÂèà#ˆÂéà#ˆêë!„ ì++„M-.ïëì\"ˆð+ñòì$ˆð+óôì$ˆð+õöì$ˆð+÷øì$ˆð+ùúì$ˆð+ûüì$ˆð+ýþì$ˆð+ÿ@ì$ˆð+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ì$ˆð+{|ì$ˆð+}~ì$ˆð+€ì$ˆð+‚ì$ˆð+ƒ„ì$ˆð+…†ì$ˆð+‡ˆì$ˆð+‰Šì$ˆð+‹Œì$ˆð+Žì$ˆð+ì$ˆð+‘’ì$ˆð+“”ì$ˆð+•–ì$ˆð+—˜ì$ˆð+™šì$ˆð+›œì$ˆð+žì$ˆð+Ÿ ì$ˆð+¡¢ì$ˆð+£¤ì$ˆ.-)ì‡" [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 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) (defalias 'fortran-mode #[nil "À ˆ ƒ Âà #ˆÆÉ\n!ˆËÌ!ˆÍ ËÎ!ˆÏËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆ×ËØ!ˆÆËÙ!ˆÍËÚ!ˆÍËÛ!ˆÆÜÞ!ˆà!â#Ëä!ˆËå!ˆËæ!ˆËç!ˆËè!ˆËé!ˆê)ë ìí!‡" [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 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 "\ 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 and map 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 From a Fortran ENDIF statement, blink the matching IF 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-do-auto-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." nil]) (defalias (quote fortran-comment-hook) #[nil "ŠÀÁxˆiÂ\\ ])‡" [" " nil 1 comment-column] 2]) (defalias 'fortran-indent-comment #[nil "ÀyˆÁ\n!ƒ à ‡Ä ƒ+ ƒ(À”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 "\ 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." nil]) (defalias 'fortran-comment-region #[(beg-region end-region arg) "À Á ‰ Å“ˆbˆÇyˆ„/ cˆÊyÇUƒ^` Wƒ^ cˆ‚Ë ! Í !ƒA`Ç•|ˆÊyÇUƒ]` Wƒ]Í !ƒ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 "\ 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." "*r\nP"]) (defalias 'fortran-abbrev-start #[nil "À\ncˆÃ ‰Ä=„ =ƒÆ ‚ C‰)‡" [nil c last-command-char read-event 63 help-char fortran-abbrev-help unread-command-events] 2 "\ Typing ;\\[help-command] or ;? lists all the Fortran abbrevs. Any other key combination is executed normally." nil]) (defalias 'fortran-abbrev-help #[nil "ÀÁ!ˆÂà !ˆÀÄ!‡" [message "Listing abbrev table..." display-buffer fortran-prepare-abbrev-list-buffer "Listing abbrev table...done"] 2 "\ List the currently defined abbrevs in Fortran mode." nil]) (defalias (quote 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]) (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 "\ Inserts a column ruler momentarily above current line, till next keystroke. The ruler is defined by the value of `fortran-column-ruler'. The key typed is executed unless it is SPC." nil]) (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 "\ Makes the window 72 columns wide. See also `fortran-window-create-momentarily'." nil]) (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 "\ Momentarily makes the window 72 columns wide. Optional ARG non-nil and non-unity disables the momentary feature. See also `fortran-window-create'." "p"]) (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 "\ Break line at point and insert continuation marker and alignment." nil]) (defalias 'fortran-numerical-continuation-char #[nil "ŠÀyˆÁÂ!ƒ`Ã\\fÄZŦÆ\\‚Æ)‡" [-1 looking-at " [1-9]" 1 48 9 49] 2 "\ 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 'delete-horizontal-regexp #[(chars) "Áxˆ`Áwˆ`|‡" [chars nil] 3 "\ 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 ." "*s"]) (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 "\ Self insert, but if part of a Fortran line number indent it automatically. Auto-indent does not happen if a numeric arg is used." "P"]) (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 "\ Moves point to the beginning of the current Fortran subprogram." nil]) (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 "\ Moves point to the end of the current Fortran subprogram." nil]) (defalias 'mark-fortran-subprogram #[nil "À ˆÁ`!ˆÂ ‡" [end-of-fortran-subprogram push-mark beginning-of-fortran-subprogram] 2 "\ Put mark at end of Fortran subprogram, point at beginning. The marks are pushed." nil]) (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 "\ 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." nil]) (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 "\ 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." nil]) (defalias 'fortran-blink-matching-if #[nil "ÀÁ Â`ŠÈyˆÉÂwˆÊË!)…ºŠÈU„Ì Í=„ÊÎ!„ÉÂwˆÊÏ!ƒqŠÊÐ!„gÂÀyÈUƒaÊÒ!„XÊÓ!ƒaÊÔ!‰ƒE)ƒmÀZ)‚ÊË!ƒÀ\\‰‚ÈU„Õ‚¥`Wƒ£ÖÈyˆ`ˆ`{P‚¥`) ƒ±Ã× \"‚º bˆØÀ!ˆ b-‡" [1 window-start nil message endif-point matching-if top-of-window count 0 " 0-9" looking-at "end[ ]*if\\b" fortran-previous-statement first-statement "^[ 0-9]*end\\b[ ]*[^ =(a-z]" "if[ ]*(" ".*)[ ]*then\\b[ ]*[^ (=a-z0-9]" then-test " [^ 0\n]" " [1-9]" ".*then\\b[ ]*[^ (=a-z0-9]" "No matching if." "Matches " "%s" sit-for] 6 "\ From a Fortran ENDIF statement, blink the matching IF statement."]) (defalias 'fortran-indent-line #[nil "À ŠÂyˆ à UƒÄÅ`Æ\\Ç#ƒ$È „$É !ˆ‚6ÂyˆÊ !„6Ì ƒ6Í ˆ)i WƒAÎ !ˆƒZŠÐˆi)VƒZŠÐˆÒ ˆ)…aÓ )‡" [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-do-auto-fill fortran-blink-matching-if] 4 "\ Indents current Fortran line based on its contents and on previous lines." 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 "\ Reindent the current Fortran line, insert a newline and indent the newline. An abbrev before point is expanded if `abbrev-mode' is non-nil." nil]) (defalias 'fortran-indent-subprogram #[nil "ŠÀ ˆÁÂ!ˆÃ`Ä Å#ˆ)ÁÆ!‡" [mark-fortran-subprogram message "Indenting subprogram..." indent-region mark nil "Indenting subprogram...done."] 4 "\ Properly indents the Fortran subprogram which contains point." nil]) (defalias 'calculate-fortran-indent #[nil "À‰Á\nƒ ‚ ŠÉ ‰ƒ\" ‚Ê`eUƒ. ‚2Ê ËÀwˆÌÍ!ƒqÌÎ!„gÀÐyÑUƒaÌÒ!„XÌÓ!ƒaÌÔ!‰ƒE)ƒÊ\\‚ÊÌÖ!ƒ\\‚ÊÌ×!ƒ‘\\‚ÊÌØ!ƒ¡\\‚ÊÌÙ!ƒ±\\‚ÊÌÛ!ƒÁ\\‚ÊÌÝ!ƒÊ )ŠÑyˆÌÞ!„ØÌ!ƒÿ á=ƒí\"\\‚ú ã=ƒú \"\\Ñ‚ØÌäå&!P!„ÌÒ!„ÌÓ!ƒ '\\‚ØÌè!ƒ.ÑÑ‚Ø„Ø)ƒMÌê!ƒMë ƒMZ‚ØËÀwˆÌì!ƒaZ‚ØÌÖ!ƒqZ‚ØÌ×!ƒZ‚ØÌí!ƒ‘Z‚ØÌî!ƒ¦ë ƒ¦Z‚ØÌï!ƒ¶Z‚ØÌð!ƒÆZ‚ØÌÝ!ƒØ U„Øñò \"ˆ) ],‡" [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" "\\(otherwise\\|else[ ]*where\\)\\b" "where[ ]*(.*)[ ]*\n" "do\\b" fortran-do-indent "\\(structure\\|union\\|map\\)\\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\\)\\b[ ]*[^ =(a-z]" message "Warning: `end' not in column %d. Probably an unclosed block."] 5 "\ Calculates the Fortran indent column based on previous lines."]) (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 "\ 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-indent-to-column #[(col) "ŠÀyˆÁ\n!ƒ2 …ö ;ƒ ÀH‚ À•bˆÆÇÈ !P!ˆÉ \niZ\")‚öÁË!ƒR ƒDÀ•bˆ‚ÓÍÎ!ˆÏcˆcˆ‚ÓÁÑ!ƒs ƒmÍÒ!ˆÓcˆÉÔ Õ\"ˆ‚ÓÒuˆ‚ÓÖ ˆm„ÓÁ×!!ƒ¬ ƒ£ ƒ’‚”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 "\ 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-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 "\ Return t if current line's line number is correctly indented. Do not call if there is no line number."]) (defalias 'fortran-check-for-matching-do #[nil "ÀÁŠÄyˆÅÆ!…4ÇÀwˆÈÀwˆ`ÉÀwˆ`{ÄyˆÊË Ì Í°ÀÁ#…4ÅÎ 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*"] 6 "\ When called from a numbered statement, returns t if matching DO is found. Otherwise return a nil."]) (defalias 'fortran-find-comment-start-skip #[nil "À‰ŠÃ ŠÀˆ`)Å#)…=ƔƕÇÆ”!ƒ*Š bˆÈ )‚=\nbˆÃ ŠÀˆ`)Å#ˆÆ•bˆÅ*‡" [nil save-match-end save-match-beginning re-search-forward comment-start-skip t 0 fortran-is-in-string-p fortran-find-comment-start-skip] 4 "\ Move to past `comment-start-skip' found on current line. Return t if `comment-start-skip' found, nil if not." nil]) (defalias 'fortran-is-in-string-p #[(where) "Šbˆnƒ Á‚ÙŠÂyˆÃ !)ƒÁ‚ÙÅ…%Ç!ÈÁ‰ \n   Î ˆÏ ˆ ƒÔà !„\\l„\\Ð 8„nƒnÑh!šƒnÒyÂV„gmƒ8Á‰ ‚:nƒvÓÁwˆiÔUƒ‚Òuˆ‚”iÔWƒ”Ñg!šƒ”ÒuˆŠÁˆ`)  ^\nƒ¹ŠÖ  È#ƒ¸`\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 "\ Return non-nil if POS (a buffer position) is inside a Fortran string, nil else."]) (defalias 'fortran-auto-fill-mode #[(arg) "„ ?‚Â!ÃV…ĉÅÆ !ˆ‡" [arg auto-fill-function prefix-numeric-value 0 fortran-indent-line set-buffer-modified-p buffer-modified-p] 3 "\ 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." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias fortran-do-auto-fill #[nil "`ŠÁyˆ`)ŠÃˆ`)‰\nÅ \\^Š\nbˆÇ!?…FÉ\n!ˆË`!ƒEŠÌÍ\nÎ#ˆƒ?`‚A`T)‚FÃ)‰†ŠÉ\nT!ˆÑÃxˆ`TXƒqÉ\nT!ˆÒÓ Î#„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] fortran-break-line #[nil "`ŠÀyˆ`)ŠÁˆ`)ÁŠƒ,Ç ƒ,È É#ˆ` {` |ˆ)ŠÊyˆËÌ!†:ËÍ!)ƒQÊyˆÎ ˆÏÐ!ˆÑ ˆÒ ˆ‚TÓ ˆ\n…iŠ bˆÁˆÑ ˆÔ 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-indentation delete-char 2 delete-horizontal-space fortran-do-auto-fill fortran-split-line fortran-comment-hook] 4]] 3) (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 "\ 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."]) (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.22/lisp/frame.elc100666 13437 1 31174 5472116742 14027 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Nov 16 04:31:13 1993 ;;; from file /home/fsf/rms/e19/lisp/frame.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (defvar initial-frame-alist (quote ((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))) If the value calls for a frame without a minibuffer, and you do not create a minibuffer frame on your own, one is created according to `minibuffer-frame-alist'. Parameters specified here supersede the values given in `default-frame-alist'.") (defvar minibuffer-frame-alist (quote ((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'.") (byte-code "ÀÂÃ!„\nÄÅÆÇ\"ˆÅÈÉ\"ˆÅÊË\"‡" [#[nil "À !‡" [new-frame pop-up-frame-alist] 2] pop-up-frame-function boundp frame-initial-frame nil defalias frame-initialize #[nil "ƒz „zÂ Ä \"„rÅ\"É!‰\n Ì!Íž†=Íž†=ÎÏÐÑ\"ÒBAƒrÓ\n!Õ\nÖמABØמAB×ØžABÙמABÚמAB¯\"ˆ)Û !ˆÎ‰‡Ü‰‡" [window-system noninteractive delq terminal-frame minibuffer-frame-list append initial-frame-alist default-frame-alist frame-initial-frame-alist new-frame frame-initial-frame default-minibuffer-frame frame-remove-geometry-params reverse nil x-get-resource "reverseVideo" "ReverseVideo" ("on" "true") frame-parameters params modify-frame-parameters cursor-color background-color foreground-color mouse-color border-color delete-frame #[(parameters) "ÀÁ!‡" [error "Can't create multiple frames without a window system"] 2] frame-creation-function] 9] frame-notice-user-settings #[nil "pÁ\n!ƒÏà ž†à ž†ÆAÇ=„yÈÉ Ê\n!#! Ì\nÍ \"„6ÈÉÏ\"!ˆÐÑ!‰„F\n=ƒiÐÔ!†NÍ @Ö!\n=ƒbØÙ\"ˆ*)Ú\n \"ˆÛ\nÇ\"ˆ)‚Ï܉‰É \"‰‰ƒÇ܉ !@@\"žA @@žA! !=„½@@!BB*A‰„ã\nŸ\"ˆ+qˆÜ‰)‡" [old-buffer frame-live-p frame-initial-frame minibuffer initial-frame-alist default-frame-alist (minibuffer . t) t new-frame append frame-parameters new delq minibuffer-frame-list minibuffer-frame-alist ((minibuffer . only)) 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 nil tail allparms newparms oldval newval frame-initial-frame-alist modify-frame-parameters] 7] get-other-frame #[nil "ÀÁ !Á šƒ  ‡ÀÁ !‡" [next-frame selected-frame new-frame] 3]] 3) (defalias 'next-multiframe-window #[nil "ÀÁ à ÄVÅ#!‡" [select-window next-window selected-window minibuffer-depth 0 t] 5 "\ Select the next window, regardless of which frame it is on." nil]) (defalias 'previous-multiframe-window #[nil "ÀÁ à ÄVÅ#!‡" [select-window previous-window selected-window minibuffer-depth 0 t] 5 "\ Select the previous window, regardless of which frame it is on." nil]) (defalias (quote new-frame) (quote make-frame)) (defalias 'make-frame #[(&optional parameters) "ÀÂÃ!ˆ !ÂÆ!ˆ )‡" [nil nframe run-hooks before-make-frame-hook frame-creation-function parameters after-make-frame-hook] 2 "\ 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 one of the following forms: (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. The documentation for the function `x-create-frame' describes additional frame parameters that Emacs recognizes for X window frames." nil]) (defalias 'filtered-frame-list #[(predicate) "À Á‰:ƒ @!ƒ @\nB A‰‚\n*‡" [frame-list nil good-frames frames predicate] 3 "\ Return a list of all live frames which satisfy PREDICATE."]) (defalias 'minibuffer-frame-list #[nil "ÀÁ!‡" [filtered-frame-list #[(frame) "ÁÂ!!=‡" [frame window-frame minibuffer-window] 4]] 2 "\ Return a list of all frames with their own minibuffers."]) (defalias 'frame-remove-geometry-params #[(param-list) "À B‰\nA:ƒ,\nA@:ƒ%\nA@@Ã>ƒ%\n‰AA¡ˆ‚\nA‰‚) A‡" [nil param-list tail (height width top left)] 3 "\ Return the parameter list PARAM-LIST, but with geometry specs removed. This deletes all bindings in PARAM-LIST for `top', `left', `width', and `height' parameters. Emacs uses this to avoid overriding explicit moves and resizings from the user during startup."]) (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 unfocus-frame] 5 "\ 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." "p"]) (defalias 'current-frame-configuration #[nil "ÀÁÂà \"B‡" [frame-configuration mapcar #[(frame) "Á!Â!E‡" [frame frame-parameters current-window-configuration] 4] frame-list] 4 "\ 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 '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@Å ž‰ƒÇ \" *\"ˆÈÉ\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 "\ 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 'frame-configuration-p #[(object) ":… @Á=‡" [object frame-configuration] 2 "\ 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-height #[(&optional frame) "ÀÁ\n!žA‡" [height frame-parameters frame] 3 "\ Return number of lines 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 "\ Return number of columns available for display on FRAME. If FRAME is omitted, describe the currently selected frame."]) (defalias 'set-default-font #[(font-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame font font-name] 4 "\ Set the font of the selected frame to FONT. When called interactively, prompt for the name of the font to use." "sFont name: "]) (defalias 'set-background-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame background-color color-name] 4 "\ Set the background color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." "sColor: "]) (defalias 'set-foreground-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame foreground-color color-name] 4 "\ Set the foreground color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." "sColor: "]) (defalias 'set-cursor-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame cursor-color color-name] 4 "\ Set the text cursor color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." "sColor: "]) (defalias 'set-mouse-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame mouse-color color-name] 4 "\ 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." "sColor: "]) (defalias 'set-border-color #[(color-name) "ÀÁ  BC\"‡" [modify-frame-parameters selected-frame border-color color-name] 4 "\ Set the color of the border of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." "sColor: "]) (defalias 'auto-raise-mode #[(arg) "„ÁÂà !žAƒÄ‚ÅÆà ÁÇVBC\"‡" [arg auto-raise frame-parameters selected-frame -1 1 modify-frame-parameters 0] 5 "\ Toggle whether or not the selected frame should auto-raise. With arg, turn auto-raise mode on if and only if arg is positive." "P"]) (defalias 'auto-lower-mode #[(arg) "„ÁÂà !žAƒÄ‚ÅÆà ÁÇVBC\"‡" [arg auto-lower frame-parameters selected-frame -1 1 modify-frame-parameters 0] 5 "\ Toggle whether or not the selected frame should auto-lower. With arg, turn auto-lower mode on if and only if arg is positive." "P"]) (defalias 'toggle-scroll-bar #[(arg) "„ÁÂà !žAƒÄ‚ÅÆà ÁÇVBC\"‡" [arg vertical-scroll-bars frame-parameters selected-frame -1 1 modify-frame-parameters 0] 5 "\ 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." "P"]) (defalias 'toggle-horizontal-scroll-bar #[(arg) "ÀÁ!‡" [error "Horizontal scroll bars aren't implemented yet"] 2 "\ 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." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias screen-height frame-height screen-width frame-width] 3) (defalias 'set-screen-width #[(cols &optional pretend) "ÀÁ \n #‡" [set-frame-width selected-frame cols pretend] 4 "\ 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-height #[(lines &optional pretend) "ÀÁ \n #‡" [set-frame-height selected-frame lines pretend] 4 "\ 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."]) (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) (defvar ctl-x-5-map (make-sparse-keymap) "\ Keymap for frame commands.") (byte-code "ÀÁ\n\"ˆÃ ÅÁ#ˆÃ\nÆÇ#ˆÃ\nÈÉ#ˆÃ\nÊË#ˆÌÍ!‡" [defalias ctl-x-5-prefix ctl-x-5-map define-key ctl-x-map "5" "2" new-frame "0" delete-frame "o" other-frame provide frame] 4) emacs-19.22/lisp/gnus.elc100666 13437 1 471040 5473274732 13736 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 19 20:58:48 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/gnus.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!ˆÂÄ!‡" [provide gnus require nntp mail-utils] 2) (defvar gnus-default-nntp-server nil "\ *Specify default NNTP server. This variable should be defined in paths.el.") (defvar gnus-nntp-server (byte-code "ÀÁ!†\n‡" [getenv "NNTPSERVER" gnus-default-nntp-server] 2) "\ *The name of the host running NNTP server. If it is a string such as `:DIRECTORY', the user's private DIRECTORY is used as a news spool. Initialized from the NNTPSERVER environment variable.") (defvar gnus-nntp-service "nntp" "\ *NNTP service name (\"nntp\" or 119). Go to a local news spool if its value is nil.") (defvar gnus-startup-file "~/.newsrc" "\ *Your `.newsrc' file. Use `.newsrc-SERVER' instead if exists.") (defvar gnus-signature-file "~/.signature" "\ *Your `.signature' file. Use `.signature-DISTRIBUTION' instead if exists.") (defvar gnus-use-cross-reference t "\ *Specifies what to do with cross references (Xref: field). If nil, ignore cross references. If t, mark articles as read in subscribed newsgroups. Otherwise, if not nil nor t, mark articles as read in all newsgroups.") (defvar gnus-use-followup-to t "\ *Specifies what to do with Followup-To: field. If nil, ignore followup-to: field. If t, use its value except for `poster'. Otherwise, if not nil nor t, always use its value.") (defvar gnus-large-newsgroup 50 "\ *The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than the value, confirmation is required for selecting the newsgroup.") (defvar gnus-author-copy (getenv "AUTHORCOPY") "\ *File name saving a copy of an article posted using FCC: field. Initialized from the AUTHORCOPY environment variable. Articles are saved using a function specified by the the variable `gnus-author-copy-saver' (`rmail-output' is default) if a file name is given. Instead, if the first character of the name is `|', the contents of the article is piped out to the named program. It is possible to save an article in an MH folder as follows: (setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")") (defvar gnus-author-copy-saver (quote rmail-output) "\ *A function called with a file name to save an author copy to. The default function is `rmail-output' which saves in Unix mailbox format.") (defvar gnus-use-long-file-name (byte-code "Á>?‡" [system-type (usg-unix-v xenix)] 2) "\ *Non-nil means that a newsgroup name is used as a default file name to save articles to. If it's nil, the directory form of a newsgroup is used instead.") (defvar gnus-article-save-directory (getenv "SAVEDIR") "\ *A directory name to save articles to (default to ~/News). Initialized from the SAVEDIR environment variable.") (defvar gnus-default-article-saver (quote 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 (in Rmail format) gnus-summary-save-in-mail (in Unix mail format) gnus-summary-save-in-folder (in an MH folder) gnus-summary-save-in-file (in article format).") (defvar gnus-rmail-save-name (quote 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 (quote 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 (quote 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 (quote 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-kill-file-name "KILL" "\ *File name of a KILL file.") (defvar gnus-novice-user t "\ *Non-nil means that you are a novice to USENET. If non-nil, verbose messages may be displayed or your confirmations may be required.") (defvar gnus-interactive-catchup t "\ *Require your confirmation when catching up a newsgroup if non-nil.") (defvar gnus-interactive-post t "\ *Newsgroup, subject, and distribution will be asked for if non-nil.") (defvar gnus-interactive-exit t "\ *Require your confirmation when exiting GNUS if non-nil.") (defvar gnus-user-login-name nil "\ *The login name of the user. Got from the USER and LOGNAME environment variable if undefined.") (defvar gnus-user-full-name nil "\ *The full name of the user. Got from the NAME environment variable if undefined.") (defvar gnus-show-mime nil "\ *Show MIME message if non-nil.") (defvar gnus-show-threads t "\ *Show conversation threads in Summary Mode if non-nil.") (defvar gnus-thread-hide-subject t "\ *Non-nil means hide subjects for thread subtrees.") (defvar gnus-thread-hide-subtree nil "\ *Non-nil means hide thread subtrees initially. If non-nil, you have to run the command `gnus-summary-show-thread' by hand or by using `gnus-select-article-hook' to show hidden threads.") (defvar gnus-thread-hide-killed t "\ *Non-nil means hide killed thread subtrees automatically.") (defvar gnus-thread-ignore-subject nil "\ *Don't take care of subject differences, but only references if non-nil. If it is non-nil, some commands work with subjects do not work properly.") (defvar gnus-thread-indent-level 4 "\ *Indentation of thread subtrees.") (defvar gnus-ignored-newsgroups "^to\\..*$" "\ *A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, thus making them effectively invisible.") (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:" "\ *All random fields within the header of a message.") (defvar gnus-required-headers (quote (From Date Newsgroups Subject Message-ID Path Organization Distribution)) "\ *All required fields for articles you post. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID and Path fields. Organization, Distribution and Lines are optional. If you want GNUS not to insert some field, remove it from the variable.") (defvar gnus-show-all-headers nil "\ *Show all headers of an article if non-nil.") (defvar gnus-save-all-headers t "\ *Save all headers of an article if non-nil.") (defvar gnus-optional-headers (quote gnus-optional-lines-and-from) "\ *A function generating a optional string displayed in GNUS Summary mode buffer. The function is called with an article HEADER. The result must be a string excluding `[' and `]'.") (defvar gnus-auto-extend-newsgroup t "\ *Extend visible articles to forward and backward if non-nil.") (defvar gnus-auto-select-first t "\ *Select the first unread article automagically if non-nil. If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in `gnus-select-group-hook' or `gnus-apply-kill-hook'.") (defvar gnus-auto-select-next t "\ *Select the next newsgroup automagically if non-nil. If the value is t and the next newsgroup is empty, GNUS will exit Summary mode and go back to Group mode. If the value is neither nil nor t, GNUS will select the following unread newsgroup. Especially, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations.") (defvar gnus-auto-select-same nil "\ *Select the next article with the same subject automagically if non-nil.") (defvar gnus-auto-center-summary t "\ *Always center the current summary in GNUS Summary window if non-nil.") (defvar gnus-auto-mail-to-author nil "\ *Insert `To: author' of the article when following up if non-nil. Mail is sent using the function specified by the variable `gnus-mail-send-method'.") (defvar gnus-break-pages t "\ *Break an article into pages if non-nil. Page delimiter is specified by the variable `gnus-page-delimiter'.") (defvar gnus-page-delimiter "^ " "\ *Regexp describing line-beginnings that separate pages of news article.") (defvar gnus-digest-show-summary t "\ *Show a summary of undigestified messages if non-nil.") (defvar gnus-digest-separator "^Subject:[ ]" "\ *Regexp that separates messages in a digest article.") (defvar gnus-use-full-window t "\ *Non-nil means to take up the entire screen of Emacs.") (defvar gnus-window-configuration (quote ((summary (0 1 0)) (newsgroups (1 0 0)) (article (0 3 10)))) "\ *Specify window configurations for each action. The format of the variable is a list of (ACTION (G S A)), where G, S, and A are the relative height of Group, Summary, and Article windows, respectively. ACTION is `summary', `newsgroups', or `article'.") (defvar gnus-show-mime-method (quote metamail-buffer) "\ *Function to process a MIME message. The function is expected to process current buffer as a MIME message.") (defvar gnus-mail-reply-method (quote gnus-mail-reply-using-mail) "\ *Function to compose reply mail. The function `gnus-mail-reply-using-mail' uses usual sendmail mail program. The function `gnus-mail-reply-using-mhe' uses the MH-E mail program. You can use yet another program by customizing this variable.") (defvar gnus-mail-forward-method (quote gnus-mail-forward-using-mail) "\ *Function to forward current message to another user. The function `gnus-mail-reply-using-mail' uses usual sendmail mail program. You can use yet another program by customizing this variable.") (defvar gnus-mail-other-window-method (quote gnus-mail-other-window-using-mail) "\ *Function to compose mail in other window. The function `gnus-mail-other-window-using-mail' uses the usual sendmail mail program. The function `gnus-mail-other-window-using-mhe' uses the MH-E mail program. You can use yet another program by customizing this variable.") (defvar gnus-mail-send-method send-mail-function "\ *Function to mail a message too which is being posted as an article. The message must have To: or Cc: field. The default is copied from the variable `send-mail-function'.") (defvar gnus-subscribe-newsgroup-method (quote gnus-subscribe-alphabetically) "\ *Function called with a newsgroup name when new newsgroup is found. The function `gnus-subscribe-randomly' inserts a new newsgroup a the beginning of newsgroups. The function `gnus-subscribe-alphabetically' inserts it in strict alphabetic order. The function `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup order. The function `gnus-subscribe-interactively' asks for your decision.") (defvar gnus-group-mode-hook nil "\ *A hook for GNUS Group Mode.") (defvar gnus-summary-mode-hook nil "\ *A hook for GNUS Summary Mode.") (defvar gnus-article-mode-hook nil "\ *A hook for GNUS Article Mode.") (defvar gnus-kill-file-mode-hook nil "\ *A hook for GNUS KILL File Mode.") (defvar gnus-open-server-hook nil "\ *A hook called just before opening connection to news server.") (defvar gnus-startup-hook nil "\ *A hook called at start up time. This hook is called after GNUS is connected to the NNTP server. So, it is possible to change the behavior of GNUS according to the selected NNTP server.") (defvar gnus-group-prepare-hook nil "\ *A hook called after newsgroup list is created in the Newsgroup buffer. If you want to modify the Newsgroup buffer, you can use this hook.") (defvar gnus-summary-prepare-hook nil "\ *A hook called after summary list is created in the Summary buffer. 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 is prepared in the Article buffer. If you want to run a special decoding program like nkf, use this hook.") (defvar gnus-select-group-hook nil "\ *A hook called when a newsgroup is selected. If you want to sort Summary buffer by date and then by subject, you can use the following hook: (setq gnus-select-group-hook (list (function (lambda () ;; First of all, sort by date. (gnus-keysort-headers (function string-lessp) (function (lambda (a) (gnus-sortable-date (gnus-header-date a))))) ;; Then sort by subject string ignoring `Re:'. ;; If case-fold-search is non-nil, case of letters is ignored. (gnus-keysort-headers (function string-lessp) (function (lambda (a) (if case-fold-search (downcase (gnus-simplify-subject (gnus-header-subject a) t)) (gnus-simplify-subject (gnus-header-subject a) t))))) )))) If you'd like to simplify subjects like the `gnus-summary-next-same-subject' command does, you can use the following hook: (setq gnus-select-group-hook (list (function (lambda () (mapcar (function (lambda (header) (nntp-set-header-subject header (gnus-simplify-subject (gnus-header-subject header) 're-only)))) gnus-newsgroup-headers))))) In some newsgroups author name is meaningless. It is possible to prevent listing author names in GNUS Summary buffer as follows: (setq gnus-select-group-hook (list (function (lambda () (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name) (setq gnus-optional-headers (function gnus-optional-lines))) (t (setq gnus-optional-headers (function gnus-optional-lines-and-from))))))))") (defvar gnus-select-article-hook (quote (gnus-summary-show-thread)) "\ *A hook called when an article is selected. The default hook shows conversation thread subtrees of the selected article automatically using `gnus-summary-show-thread'. If you'd like to run RMAIL on a digest article automagically, you can use the following hook: (setq gnus-select-article-hook (list (function (lambda () (gnus-summary-show-thread) (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name) (gnus-summary-rmail-digest)) ((and (string-equal \"comp.text\" gnus-newsgroup-name) (string-match \"^TeXhax Digest\" (gnus-header-subject gnus-current-headers))) (gnus-summary-rmail-digest) ))))))") (defvar gnus-select-digest-hook (list #[nil "ÀÁÂ\"†ÀÁ!ˆÃÄ!c‡" [mail-position-on-field "Reply-to" t gnus-fetch-field "From"] 3]) "\ *A hook called when reading digest messages using Rmail. This hook can be used to modify incomplete digest articles as follows (this is the default): (setq gnus-select-digest-hook (list (function (lambda () ;; Reply-To: is required by `undigestify-rmail-message'. (or (mail-position-on-field \"Reply-to\" t) (progn (mail-position-on-field \"Reply-to\") (insert (gnus-fetch-field \"From\"))))))))") (defvar gnus-rmail-digest-hook nil "\ *A hook called when reading digest messages using Rmail. This hook is intended to customize Rmail mode for reading digest articles.") (defvar gnus-apply-kill-hook (quote (gnus-apply-kill-file)) "\ *A hook called when a newsgroup is selected and summary list is prepared. This hook is intended to apply a KILL file to the selected newsgroup. The function `gnus-apply-kill-file' is called by default. Since a general KILL file is too heavy to use only for a few 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 (function (lambda () (cond ((string-match \"control\" gnus-newsgroup-name) (gnus-kill \"Subject\" \"rmgroup\") (gnus-expunge \"X\")))))))") (defvar gnus-mark-article-hook (list #[nil " >„\nÂ!ˆÃÄ!‡" [gnus-current-article gnus-newsgroup-marked gnus-summary-mark-as-read gnus-summary-set-current-mark "+"] 2]) "\ *A hook called when an article is selected at the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected. If you'd like to mark as unread (-) instead, use the following hook: (setq gnus-mark-article-hook (list (function (lambda () (gnus-summary-mark-as-unread gnus-current-article) (gnus-summary-set-current-mark \"+\")))))") (defvar gnus-prepare-article-hook (list (quote gnus-inews-insert-signature)) "\ *A hook called after preparing body, but before preparing header fields. The default hook (`gnus-inews-insert-signature') inserts a signature file specified by the variable `gnus-signature-file'.") (defvar gnus-inews-article-hook (list (quote gnus-inews-do-fcc)) "\ *A hook called before finally posting an article. The default hook (`gnus-inews-do-fcc') does FCC processing (save article to a file).") (defvar gnus-exit-group-hook nil "\ *A hook called when exiting (not quitting) Summary mode. If your machine is so slow that exiting from Summary mode takes very long time, set the variable `gnus-use-cross-reference' to nil. This inhibits marking articles as read using cross-reference information.") (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 (not suspending) GNUS.") (defvar gnus-save-newsrc-hook nil "\ *A hook called when saving the newsrc file. This hook is called before saving the `.newsrc' file.") (defvar gnus-local-timezone nil "\ *Local time zone. This value is used only if `current-time-zone' does not work in your Emacs. It specifies the GMT offset, i.e. a decimal integer of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT. For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT. For backwards compatibility, it may also be a string like \"JST\", but strings are obsolescent: you should use numeric offsets instead.") (defvar gnus-local-domain nil "\ *Local domain name without a host name like: \"stars.flab.Fujitsu.CO.JP\" The `DOMAINNAME' environment variable is used instead if defined. If the function (system-name) returns the full internet name, there is no need to define the name.") (defvar gnus-local-organization nil "\ *Local organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\" The `ORGANIZATION' environment variable is used instead if defined.") (defvar gnus-local-distributions (quote ("local" "world")) "\ *List of distributions. The first element in the list is used as default. If distributions file is available, its content is also used.") (defvar gnus-use-generic-from nil "\ *If nil, prepend local host name to the defined domain in the From: field; if stringp, use this; if non-nil, strip of the local host name.") (defvar gnus-use-generic-path nil "\ *If nil, use the NNTP server name in the Path: field; if stringp, use this; if non-nil, use no host name (user name only)") (defconst gnus-version "GNUS 4.1" "\ Version numbers of this version of GNUS.") (defconst gnus-emacs-version (byte-code "ÀÁ\n\"ˆÃ\nĔĕO!‡" [string-match "[0-9]*" emacs-version string-to-int 0] 4) "\ Major version number of this emacs.") (defvar gnus-info-nodes (quote ((gnus-group-mode "(gnus)Newsgroup Commands") (gnus-summary-mode "(gnus)Summary Commands") (gnus-article-mode "(gnus)Article Commands") (gnus-kill-file-mode "(gnus)Kill File") (gnus-browse-killed-mode "(gnus)Maintaining Subscriptions"))) "\ Assoc list of major modes and related Info nodes.") (defvar gnus-access-methods (quote ((nntp (gnus-retrieve-headers nntp-retrieve-headers) (gnus-open-server nntp-open-server) (gnus-close-server nntp-close-server) (gnus-server-opened nntp-server-opened) (gnus-status-message nntp-status-message) (gnus-request-article nntp-request-article) (gnus-request-group nntp-request-group) (gnus-request-list nntp-request-list) (gnus-request-list-newsgroups nntp-request-list-newsgroups) (gnus-request-list-distributions nntp-request-list-distributions) (gnus-request-post nntp-request-post)) (nnspool (gnus-retrieve-headers nnspool-retrieve-headers) (gnus-open-server nnspool-open-server) (gnus-close-server nnspool-close-server) (gnus-server-opened nnspool-server-opened) (gnus-status-message nnspool-status-message) (gnus-request-article nnspool-request-article) (gnus-request-group nnspool-request-group) (gnus-request-list nnspool-request-list) (gnus-request-list-newsgroups nnspool-request-list-newsgroups) (gnus-request-list-distributions nnspool-request-list-distributions) (gnus-request-post nnspool-request-post)) (mhspool (gnus-retrieve-headers mhspool-retrieve-headers) (gnus-open-server mhspool-open-server) (gnus-close-server mhspool-close-server) (gnus-server-opened mhspool-server-opened) (gnus-status-message mhspool-status-message) (gnus-request-article mhspool-request-article) (gnus-request-group mhspool-request-group) (gnus-request-list mhspool-request-list) (gnus-request-list-newsgroups mhspool-request-list-newsgroups) (gnus-request-list-distributions mhspool-request-list-distributions) (gnus-request-post mhspool-request-post)))) "\ Access method for NNTP, nnspool, and mhspool.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ÆÀÇ!„!ÈÀÉ!„*Ê À‡" [boundp gnus-group-buffer "*Newsgroup*" gnus-summary-buffer "*Summary*" gnus-article-buffer "*Article*" gnus-digest-buffer "GNUS Digest" gnus-digest-summary-buffer "GNUS Digest-summary"] 2) (defvar gnus-buffer-list (list gnus-group-buffer gnus-summary-buffer gnus-article-buffer gnus-digest-buffer gnus-digest-summary-buffer) "\ GNUS buffer names which should be killed when exiting.") (defvar gnus-variable-list (quote (gnus-newsrc-options gnus-newsrc-options-n-yes gnus-newsrc-options-n-no gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)) "\ GNUS variables saved in the quick startup file.") (defvar gnus-overload-functions (quote ((news-inews gnus-inews-news "rnewspost") (caesar-region gnus-caesar-region "rnews"))) "\ Functions overloaded by gnus. It is a list of `(original overload &optional file)'.") (byte-code "ÀÁ!„‡" [boundp gnus-distribution-list nil] 2) (defvar gnus-newsrc-options nil "\ Options line in the .newsrc file.") (defvar gnus-newsrc-options-n-yes nil "\ Regexp representing subscribed newsgroups.") (defvar gnus-newsrc-options-n-no nil "\ Regexp representing unsubscribed newsgroups.") (defvar gnus-newsrc-assoc 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-assoc.") (defvar gnus-killed-assoc nil "\ Assoc list of newsgroups removed from gnus-newsrc-assoc. gnus-killed-hashtb should be kept so that both hold the same information.") (defvar gnus-killed-hashtb nil "\ Hashtable of gnus-killed-assoc.") (defvar gnus-marked-assoc nil "\ Assoc list of articles marked as unread. gnus-marked-hashtb should be kept so that both hold the same information.") (defvar gnus-marked-hashtb nil "\ Hashtable of gnus-marked-assoc.") (defvar gnus-unread-hashtb nil "\ Hashtable of unread articles.") (defvar gnus-active-hashtb nil "\ Hashtable of active articles.") (defvar gnus-octive-hashtb nil "\ Hashtable of OLD active articles.") (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.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂÀÆ!„)ÂÀÇ!„2ÂÀÈ!„;ÂÀÉ!„D ‡" [boundp gnus-have-all-newsgroups nil 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] 2) (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-marked nil "\ List of marked articles in the current newsgroup (a subset of unread art).") (defvar gnus-newsgroup-headers nil "\ List of article headers in the current newsgroup. If the variable is modified (added or deleted), the function gnus-clear-hashtables-for-newsgroup-headers must be called to clear the hash tables.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂÀÆ!„)‡" [boundp gnus-newsgroup-headers-hashtb-by-id nil gnus-newsgroup-headers-hashtb-by-number gnus-current-article gnus-current-headers gnus-current-history] 2) (defvar gnus-have-all-headers nil "\ Must be either T or NIL.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂÀÆ!„)ÂÀÇ!„2ÂÀÈ!„;ÂÀÉ!„FÊË! ÀÌ!„QÊÍ! ‡" [boundp gnus-last-article nil gnus-current-kill-article gnus-winconf-kill-file gnus-group-mode-map gnus-summary-mode-map gnus-article-mode-map gnus-kill-file-mode-map rmail-last-file expand-file-name "~/XMBOX" rmail-last-rmail-file "~/XNEWS"] 2) (autoload (quote gnus-group-post-news) "gnuspost" "\ Post an article." t) (autoload (quote gnus-summary-post-news) "gnuspost" "\ Post an article." t) (autoload (quote gnus-summary-followup) "gnuspost" "\ Post a reply article." t) (autoload (quote gnus-summary-followup-with-original) "gnuspost" "\ Post a reply article with original article." t) (autoload (quote gnus-summary-cancel-article) "gnuspost" "\ Cancel an article you posted." t) (autoload (quote gnus-summary-reply) "gnusmail" "\ Reply mail to news author." t) (autoload (quote gnus-summary-reply-with-original) "gnusmail" "\ Reply mail to news author with original article." t) (autoload (quote gnus-summary-mail-forward) "gnusmail" "\ Forward the current message to another user." t) (autoload (quote gnus-summary-mail-other-window) "gnusmail" "\ Compose mail in other window." t) (autoload (quote gnus-group-kill-group) "gnusmisc" "\ Kill newsgroup on current line." t) (autoload (quote gnus-group-yank-group) "gnusmisc" "\ Yank the last killed newsgroup on current line." t) (autoload (quote gnus-group-kill-region) "gnusmisc" "\ Kill newsgroups in current region." t) (autoload (quote gnus-group-transpose-groups) "gnusmisc" "\ Exchange current newsgroup and previous newsgroup." t) (autoload (quote gnus-list-killed-groups) "gnusmisc" "\ List the killed newsgroups." t) (autoload (quote gnus-gmt-to-local) "gnusmisc" "\ Rewrite Date field in GMT to local in current buffer.") (autoload (quote metamail-buffer) "metamail" "\ Process current buffer through 'metamail'." t) (byte-code "ÀÁÂ\"ˆÀÃÂ\"‡" [autoload timezone-make-sortable-date "timezone" timezone-parse-date] 3) (autoload (quote rmail-output) "rmailout" "\ Append this message to Unix mail file named FILE-NAME." t) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÄ\"ˆÆÇÈÉ#ˆÆÊÈÉ#ˆÆËÈÉ#‡" [autoload mail-position-on-field "sendmail" mh-find-path "mh-e" mh-prompt-for-folder put gnus-group-mode mode-class special gnus-summary-mode gnus-article-mode] 4) (defalias 'gnus-eval-in-buffer-window '(macro . #[(buffer &rest forms) "ÀÁÂÃÄÅDD\"ÈEE‡" [let ((GNUSStartBufferWindow (selected-window))) unwind-protect append progn pop-to-buffer buffer forms (select-window GNUSStartBufferWindow)] 7 "\ Pop to BUFFER, evaluate FORMS, and then returns to original window."])) (defalias 'gnus-make-hashtable '(macro . #[(&optional hashsize) "À ƒ  ÃE‚ ÃÄE‡" [make-vector hashsize max 200 0] 4 "\ Make a hash table (default and minimum size is 200). Optional argument HASHSIZE specifies the table size."])) (defalias 'gnus-gethash '(macro . #[(string hashtable) "ÀÁ\n ED‡" [symbol-value intern-soft string hashtable] 4 "\ Get hash value of STRING in HASHTABLE."])) (defalias 'gnus-sethash '(macro . #[(string value hashtable) "ÀÁ\n E E‡" [set intern string hashtable value] 4 "\ Set hash value. Arguments are STRING, VALUE, and HASHTABLE."])) (defalias 'nntp-header-number '(macro . #[(header) "À ÂE‡" [aref header 0] 3 "\ Return article number in HEADER."])) (defalias 'nntp-set-header-number '(macro . #[(header number) "À  F‡" [aset header 0 number] 4 "\ Set article number of HEADER to NUMBER."])) (defalias 'nntp-header-subject '(macro . #[(header) "À ÂE‡" [aref header 1] 3 "\ Return subject string in HEADER."])) (defalias 'nntp-set-header-subject '(macro . #[(header subject) "À  F‡" [aset header 1 subject] 4 "\ Set article subject of HEADER to SUBJECT."])) (defalias 'nntp-header-from '(macro . #[(header) "À ÂE‡" [aref header 2] 3 "\ Return author string in HEADER."])) (defalias 'nntp-set-header-from '(macro . #[(header from) "À  F‡" [aset header 2 from] 4 "\ Set article author of HEADER to FROM."])) (defalias 'nntp-header-xref '(macro . #[(header) "À ÂE‡" [aref header 3] 3 "\ Return xref string in HEADER."])) (defalias 'nntp-set-header-xref '(macro . #[(header xref) "À  F‡" [aset header 3 xref] 4 "\ Set article xref of HEADER to xref."])) (defalias 'nntp-header-lines '(macro . #[(header) "À ÂE‡" [aref header 4] 3 "\ Return lines in HEADER."])) (defalias 'nntp-set-header-lines '(macro . #[(header lines) "À  F‡" [aset header 4 lines] 4 "\ Set article lines of HEADER to LINES."])) (defalias 'nntp-header-date '(macro . #[(header) "À ÂE‡" [aref header 5] 3 "\ Return date in HEADER."])) (defalias 'nntp-set-header-date '(macro . #[(header date) "À  F‡" [aset header 5 date] 4 "\ Set article date of HEADER to DATE."])) (defalias 'nntp-header-id '(macro . #[(header) "À ÂE‡" [aref header 6] 3 "\ Return Id in HEADER."])) (defalias 'nntp-set-header-id '(macro . #[(header id) "À  F‡" [aset header 6 id] 4 "\ Set article Id of HEADER to ID."])) (defalias 'nntp-header-references '(macro . #[(header) "À ÂE‡" [aref header 7] 3 "\ Return references in HEADER."])) (defalias 'nntp-set-header-references '(macro . #[(header ref) "À  F‡" [aset header 7 ref] 4 "\ Set article references of HEADER to REF."])) (byte-code "„ Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÍ#ˆÃÏÐ#ˆÃÑÒ#ˆÃÓÐ#ˆÃÔÒ#ˆÃÕÖ#ˆÃ×Ø#ˆÃÙÚ#ˆÃÛÜ#ˆÃÝÞ#ˆÃßà#ˆÃáâ#ˆÃãä#ˆÃåæ#ˆÃçè#ˆÃéê#ˆÃëì#ˆÃíî#ˆÃïð#ˆÃñò#ˆÃóô#ˆÃõö#ˆÃ÷ø#ˆÃùú#ˆÃûü#ˆÃýþ#ˆÃÿ@#ˆÃAB#ˆÃCD#ˆÃEF#ˆÃGH#ˆÃIJ#ˆÃKL#ˆÁ‡" [gnus-group-mode-map 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 "" "" " " next-line "<" beginning-of-buffer ">" end-of-buffer "u" gnus-group-unsubscribe-current-group "U" gnus-group-unsubscribe-group "c" gnus-group-catchup "C" gnus-group-catchup-all "l" gnus-group-list-groups "L" gnus-group-list-all-groups "g" gnus-group-get-new-news "R" gnus-group-restart "b" gnus-group-check-bogus-groups "r" gnus-group-restrict-groups "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 " " gnus-list-killed-groups "V" gnus-version "s" gnus-group-force-update "z" gnus-group-suspend "q" gnus-group-exit "Q" gnus-group-quit "?" gnus-group-describe-briefly " " gnus-info-find-node] 4) (defalias 'gnus-group-mode #[nil "À ˆÁÂ!ƒÃ‚!ÄÅ!<ƒÃÄÅ!AB‚!ÆÇÉ\nË ÍÏ!ˆÑp!ˆÒÔÕ!‡" [kill-all-local-variables boundp mode-line-modified "--- " default-value mode-line-format "--- GNUS: List of Newsgroups %[(%m)%]----%3p-%-" gnus-group-mode major-mode "Newsgroup" mode-name "GNUS: List of Newsgroups" mode-line-buffer-identification nil mode-line-process use-local-map gnus-group-mode-map buffer-flush-undo t buffer-read-only run-hooks gnus-group-mode-hook] 3 "\ Major mode for reading network news. All normal editing commands are turned off. Instead, these commands are available: SPC Read articles in this newsgroup. = Select this newsgroup. j Move to the specified newsgroup. n Move to the next unread newsgroup. p Move to the previous unread newsgroup. C-n Move to the next newsgroup. C-p Move to the previous newsgroup. < Move point to the beginning of this buffer. > Move point to the end of this buffer. u Unsubscribe from (subscribe to) this newsgroup. U Unsubscribe from (subscribe to) the specified newsgroup. c Mark all articles as read, preserving marked articles. C Mark all articles in this newsgroup as read. l Revert this buffer. L List all newsgroups. g Get new news. R Force to read the raw .newsrc file and get new news. b Check bogus newsgroups. r Restrict visible newsgroups to the current region. a Post a new article. ESC k Edit a local KILL file applied to this newsgroup. ESC K Edit a global KILL file applied to all newsgroups. C-k Kill this newsgroup. C-y Yank killed newsgroup here. C-w Kill newsgroups in current region (excluding current point). C-x C-t Exchange this newsgroup and previous newsgroup. C-c C-l list killed newsgroups. s Save .newsrc file. z Suspend reading news. q Quit reading news. Q Quit reading news without saving .newsrc file. V Show the version number of this GNUS. ? Describe Group Mode commands briefly. C-h m Describe Group Mode. C-c C-i Read Info about Group Mode. The name of the host running NNTP server is asked for if no default host is specified. It is also possible to choose another NNTP server even when the default server is defined by giving a prefix argument to the command `\\[gnus]'. If an NNTP server is preceded by a colon such as `:Mail', the user's private directory `~/Mail' is used as a news spool. This makes it possible to read mail stored in MH folders or articles saved by GNUS. File names of mail or articles must consist of only numeric characters. Otherwise, they are ignored. If there is a file named `~/.newsrc-SERVER', it is used as the startup file instead of standard one when talking to SERVER. It is possible to talk to many hosts by using different startup files for each. Option `-n' of the options line in the startup file is recognized properly the same as the Bnews system. For example, if the options line is `options -n !talk talk.rumors', newsgroups under the `talk' hierarchy except for `talk.rumors' are ignored while checking new newsgroups. If there is a file named `~/.signature-DISTRIBUTION', it is used as signature file instead of standard one when posting a news in DISTRIBUTION. If an Info file generated from `gnus.texinfo' is installed, you can read an appropriate Info node of the Info file according to the current major mode of GNUS by \\[gnus-info-find-node]. The variable `gnus-version', `nntp-version', `nnspool-version', and `mhspool-version' have the version numbers of this version of gnus.el, nntp.el, nnspool.el, and mhspoo.el, respectively. User customizable variables: gnus-nntp-server Specifies the name of the host running the NNTP server. If its value is a string such as `:DIRECTORY', the user's private DIRECTORY is used as a news spool. The variable is initialized from the NNTPSERVER environment variable. gnus-nntp-service Specifies a NNTP service name. It is usually \"nntp\" or 119. Nil forces GNUS to use a local news spool if the variable `gnus-nntp-server' is set to the local host name. gnus-startup-file Specifies a startup file (.newsrc). If there is a file named `.newsrc-SERVER', it's used instead when talking to SERVER. I recommend you to use the server specific file, if you'd like to talk to many servers. Especially if you'd like to read your private directory, the name of the file must be `.newsrc-:DIRECTORY'. gnus-signature-file Specifies a signature file (.signature). If there is a file named `.signature-DISTRIBUTION', it's used instead when posting an article in DISTRIBUTION. Set the variable to nil to prevent appending the file automatically. If you use an NNTP inews which comes with the NNTP package, you may have to set the variable to nil. gnus-use-cross-reference Specifies what to do with cross references (Xref: field). If it is nil, cross references are ignored. If it is t, articles in subscribed newsgroups are only marked as read. Otherwise, if it is not nil nor t, articles in all newsgroups are marked as read. gnus-use-followup-to Specifies what to do with followup-to: field. If it is nil, its value is ignored. If it is non-nil, its value is used as followup newsgroups. Especially, if it is t and field value is `poster', your confirmation is required. gnus-author-copy Specifies a file name to save a copy of article you posted using FCC: field. If the first character of the value is `|', the contents of the article is piped out to a program specified by the rest of the value. The variable is initialized from the AUTHORCOPY environment variable. gnus-author-copy-saver Specifies a function to save an author copy. The function is called with a file name. The default function `rmail-output' saves in Unix mail format. gnus-kill-file-name Use specified file name as a KILL file (default to `KILL'). gnus-novice-user Non-nil means that you are a novice to USENET. If non-nil, verbose messages may be displayed or your confirmations may be required. gnus-interactive-post Non-nil means that newsgroup, subject and distribution are asked for interactively when posting a new article. gnus-use-full-window Non-nil means to take up the entire screen of Emacs. gnus-window-configuration Specifies the configuration of Group, Summary, and Article windows. It is a list of (ACTION (G S A)), where G, S, and A are the relative height of Group, Summary, and Article windows, respectively. ACTION is `summary', `newsgroups', or `article'. gnus-subscribe-newsgroup-method Specifies a function called with a newsgroup name when new newsgroup is found. The default definition adds new newsgroup at the beginning of other newsgroups. And more and more. Please refer to texinfo documentation. Various hooks for customization: gnus-group-mode-hook Entry to this mode calls the value with no arguments, if that value is non-nil. This hook is called before GNUS is connected to the NNTP server. So, you can change or define the NNTP server in this hook. gnus-startup-hook Called with no arguments after the NNTP server is selected. It is possible to change the behavior of GNUS or initialize the variables according to the selected NNTP server. gnus-group-prepare-hook Called with no arguments after a newsgroup list is created in the Newsgroup buffer, if that value is non-nil. gnus-save-newsrc-hook Called with no arguments when saving newsrc file if that value is non-nil. gnus-prepare-article-hook Called with no arguments after preparing message body, but before preparing header fields which is automatically generated if that value is non-nil. The default hook (gnus-inews-insert-signature) inserts a signature file. gnus-inews-article-hook Called with no arguments when posting an article if that value is non-nil. This hook is called just before posting an article. The default hook does FCC (save an article to the specified file). gnus-suspend-gnus-hook Called with no arguments when suspending (not exiting) GNUS, if that value is non-nil. gnus-exit-gnus-hook Called with no arguments when exiting (not suspending) GNUS, if that value is non-nil." nil]) (defalias 'gnus #[(&optional confirm) "ÀŽÁ !!ˆÄ ˆÅ!)‡" [((byte-code "À „ Á ˆ‚1Âà \"ÆÈ ˆÉ ˆÊË!ˆ)ÌÍ!ˆÎ ˆƒ-Ð ˆÑÆ!ˆÆ‡" [gnus-server-opened gnus-group-quit format " {%s}" gnus-nntp-server mode-line-process nil buffer-read-only erase-buffer gnus-group-startup-message sit-for 0 run-hooks gnus-startup-hook gnus-setup-news gnus-novice-user gnus-group-describe-briefly gnus-group-list-groups] 3)) switch-to-buffer get-buffer-create gnus-group-buffer gnus-group-mode gnus-start-news-server confirm] 3 "\ Read network news. If optional argument CONFIRM is non-nil, ask NNTP server." "P"]) (defalias 'gnus-group-startup-message #[nil "ÀÁ\n\"cˆÃedÄ ÅZÆ]Ç¥#ˆebˆÈÉÊ ËZÆ]Ç¥\"‡" [format "\n %s\n\n NNTP-based News Reader for GNU Emacs\n\n\nIf you have any trouble with this software, please let me\nknow. I will fix your problems in the next release.\n\nComments, suggestions, and bug fixes are welcome.\n\nMasanobu UMEDA\numerin@mse.kyutech.ac.jp" gnus-version indent-rigidly window-width 57 0 2 insert-char 10 window-height 18] 5 "\ Insert startup message in current buffer."]) (defalias 'gnus-group-list-groups #[(show-all) "ÀÁ ÂÀ‰\"ˆÁ ÂÃÀ\"ˆÁ qˆÉ\n!ˆË ÌUƒ-ÍÎ!‚jebˆƒ@ÏÐ!ÀÃ#„b ƒNÏÐ !ÀÃ#„b ƒ\\ÏÐ !ÀÃ#„bÂÀ‰Ã#ˆÌyˆÑÒÀÃ#,‡" [nil gnus-group-group-name gnus-group-search-forward t prev-group next-group last-group case-fold-search gnus-group-buffer gnus-group-prepare show-all buffer-size 0 message "No news is good news" re-search-forward gnus-group-make-regexp search-forward ":"] 6 "\ List newsgroups in the Newsgroup buffer. If argument SHOW-ALL is non-nil, unsubscribed groups are also listed." "P"]) (defalias 'gnus-group-prepare #[(&optional all) "À À‰ÂÃ Ê ˆƒu@‰@Ë \"JA@ „=A@ƒl ÂVƒlÎ A@ƒJÏ‚KÐ ÂVƒe Ë\"JAGZYƒeÒ‚fÏ %cˆA‰„ ebˆÔÕ!.‡" [nil gnus-newsrc-assoc 0 "%s%s%5d: %s\n" cntl unread-count group-name group-info newsrc buffer-read-only erase-buffer intern-soft gnus-unread-hashtb all format " " "U" gnus-marked-hashtb "*" gnus-have-all-newsgroups run-hooks gnus-group-prepare-hook] 9 "\ Prepare list of newsgroups in current buffer. If optional argument ALL is non-nil, unsubscribed groups are also listed."]) (defalias 'gnus-group-prepare-line #[(info) "@ \"JA@†ÄÅÆ \"J8AA\"!É\nË\nA@ƒ.Ì‚/ÍÎVƒJΠ\"JAGZYƒJЂKÌ %+‡" [info group-name intern-soft gnus-unread-hashtb gnus-number-of-articles gnus-difference-of-range 2 gnus-active-hashtb unread-count "%s%s%5d: %s\n" cntl format " " "U" 0 gnus-marked-hashtb "*"] 8 "\ Return a string for the Newsgroup buffer from INFO. INFO is an element of gnus-newsrc-assoc or gnus-killed-assoc."]) (defalias 'gnus-group-update-group #[(group &optional visible-only) "À‰Á\n!ÀŒ~ˆÇyˆÈ !„6É Ê¥`Vƒ+ebˆË ÀÌ#„6dbˆÍ ÀÌ#ƒEÌÇyˆ`Îyˆ`|ˆ‚Hebˆ „R?…^ÐÑ\n\"J!cˆÓy-‡" [nil gnus-group-make-regexp group visible regexp case-fold-search buffer-read-only 0 looking-at buffer-size 2 re-search-forward t re-search-backward 1 visible-only gnus-group-prepare-line intern-soft gnus-newsrc-hashtb -1] 4 "\ Update newsgroup info of GROUP. If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."]) (defalias 'gnus-group-group-name #[nil "ŠÀyˆÁÂ!…ÔÕ{)‡" [0 looking-at "^.+:[ ]+\\([^ \n]+\\)\\([ ].*\\|$\\)" 1] 2 "\ Get newsgroup name around point."]) (defalias 'gnus-group-make-regexp #[(newsgroup) "ÀÁ\n!ÃQ‡" ["^.+: " regexp-quote newsgroup "\\([ ].*\\|$\\)"] 3 "\ Return regexp that matches for a line of NEWSGROUP."]) (defalias 'gnus-group-search-forward #[(backward norest &optional heretoo) "À ƒ ‚\nÃÄŃǂȃɂ Ê#À    ƒ?ƒ9Àˆ‚MÐyˆ‚MƒJÐyˆ‚MÀˆ  ÀÑ# ÐyˆÒÓÀÑ#ˆ ,‡" [nil backward re-search-backward re-search-forward format "^%s[ ]*\\(%s\\):" norest ".." " [ ]" "[0-9]+" "[1-9][0-9]*" found regexp func case-fold-search heretoo 0 t search-forward ":"] 6 "\ Search for the next (or previous) newsgroup. If 1st argument BACKWARD is non-nil, search backward instead. If 2nd argument NOREST is non-nil, don't care about newsgroup property. If optional argument HERETOO is non-nil, current line is searched for, too."]) (defalias 'gnus-group-read-group #[(all &optional no-article) "À ‰… †Ä \"JA@ÆU#)‡" [gnus-group-group-name group gnus-summary-read-group all intern-soft gnus-unread-hashtb 0 no-article] 6 "\ Read news in this newsgroup. If argument ALL is non-nil, already read articles become readable. If optional argument NO-ARTICLE is non-nil, no article body is displayed." "P"]) (defalias 'gnus-group-select-group #[(all) "À Â\"‡" [gnus-group-read-group all t] 3 "\ Select this newsgroup. No article is selected automatically. If argument ALL is non-nil, already read articles become readable." "P"]) (defalias 'gnus-group-jump-to-group #[(group) "ÀebˆÂà !ÀÅ#„Æ \"JƒÈ !ˆÉyˆÊËÀÅ#)‡" [nil case-fold-search re-search-forward gnus-group-make-regexp group t intern-soft gnus-newsrc-hashtb gnus-group-update-group 0 search-forward ":"] 4 "\ Jump to newsgroup GROUP." (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil (quote require-match)))]) (defalias 'gnus-group-next-group #[(n) "ÁVƒÂÃÄ\"ƒS‰‚ÂÃÄ\"†ÅÆ!‡" [n 1 gnus-group-search-forward nil t message "No more newsgroups"] 4 "\ Go to next N'th newsgroup." "p"]) (defalias 'gnus-group-next-unread-group #[(n) "ÁVƒÂÉ\"ƒS‰‚ÂÉ\"†ÄÅ!‡" [n 1 gnus-group-search-forward nil message "No more unread newsgroups"] 4 "\ Go to next N'th unread newsgroup." "p"]) (defalias 'gnus-group-prev-group #[(n) "ÁVƒÂÉ\"ƒS‰‚ÂÉ\"†ÄÅ!‡" [n 1 gnus-group-search-forward t message "No more newsgroups"] 4 "\ Go to previous N'th newsgroup." "p"]) (defalias 'gnus-group-prev-unread-group #[(n) "ÁVƒÂÃÄ\"ƒS‰‚ÂÃÄ\"†ÅÆ!‡" [n 1 gnus-group-search-forward t nil message "No more unread newsgroups"] 4 "\ Go to previous N'th unread newsgroup." "p"]) (defalias 'gnus-group-catchup #[(all) "À \n?…à \"JA …7ƒ&Ç\nƒ!È‚\"É!…7ÊË!ˆÌ ‰#ˆÍ !ˆÎÏ!*‡" [gnus-group-group-name group all intern-soft gnus-marked-hashtb marked gnus-interactive-catchup y-or-n-p "Do you really want to mark everything as read? " "Delete all articles not marked as read? " message "" gnus-update-unread-articles gnus-group-update-group gnus-group-next-group 1] 4 "\ Mark all articles not marked as unread in current newsgroup as read. If prefix argument ALL is non-nil, all articles are marked as read. Cross references (Xref: field) of articles are ignored." "P"]) (defalias 'gnus-group-catchup-all #[nil "ÀÁ!‡" [gnus-group-catchup t] 2 "\ Mark all articles in current newsgroup as read. Cross references (Xref: field) of articles are ignored." nil]) (defalias 'gnus-group-unsubscribe-current-group #[nil "ÀÁ !ˆÂÃ!‡" [gnus-group-unsubscribe-group gnus-group-group-name gnus-group-next-group 1] 2 "\ Toggle subscribe from/to unsubscribe current group." nil]) (defalias 'gnus-group-unsubscribe-group #[(group) "À \n\"J‰ƒ% A A@? ˆÄ !ˆÅ !ˆÆyˆÇÈÉÊ#‚J ;ƒFÀ  \"JƒFÌ !ˆÅ !ˆÆyˆÇÈÉÊ#‚JÍÎ \")‡" [intern-soft group gnus-newsrc-hashtb newsrc gnus-update-newsrc-buffer gnus-group-update-group 0 search-forward ":" nil t gnus-active-hashtb gnus-add-newsgroup error "No such newsgroup: %s"] 5 "\ Toggle subscribe from/to unsubscribe GROUP. New newsgroup is added to .newsrc automatically." (list (completing-read "Newsgroup: " gnus-active-hashtb nil (quote require-match)))]) (defalias 'gnus-group-list-all-groups #[nil "ÀÁ!‡" [gnus-group-list-groups t] 2 "\ List all of newsgroups in the Newsgroup buffer." nil]) (defalias 'gnus-group-get-new-news #[nil "À ˆÁ\n!‡" [gnus-setup-news gnus-group-list-groups gnus-have-all-newsgroups] 2 "\ Get newly arrived articles. In fact, read the active file again." nil]) (defalias 'gnus-group-restart #[nil "À ˆÁÂ!ˆÃ !‡" [gnus-save-newsrc-file gnus-setup-news t gnus-group-list-groups gnus-have-all-newsgroups] 2 "\ Force GNUS to read the raw startup file." nil]) (defalias 'gnus-group-check-bogus-groups #[nil "ÀÁ!ˆÂ !‡" [gnus-check-bogus-newsgroups t gnus-group-list-groups gnus-have-all-newsgroups] 2 "\ Check bogus newsgroups." nil]) (defalias 'gnus-group-restrict-groups #[(start end) "ŠbˆÁyˆ`\nbˆÃyˆ`}ˆ)ÄÅÆ!!‡" [start 0 end 1 message substitute-command-keys "Type \\[widen] to remove restriction"] 3 "\ Restrict visible newsgroups to the current region (START and END). Type \\[widen] to remove restriction." "r"]) (defalias 'gnus-group-edit-global-kill #[nil "ÀÂÀ!ˆÃÄÅ!!‡" [nil gnus-current-kill-article gnus-kill-file-edit-file message substitute-command-keys "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)"] 3 "\ Edit a global KILL file." nil]) (defalias 'gnus-group-edit-local-kill #[nil "ÀÂà !ˆÄÅÆ!!‡" [nil gnus-current-kill-article gnus-kill-file-edit-file gnus-group-group-name message substitute-command-keys "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)"] 3 "\ Edit a local KILL file." nil]) (defalias 'gnus-group-force-update #[nil "À ‡" [gnus-save-newsrc-file] 1 "\ Update .newsrc file." nil]) (defalias 'gnus-group-suspend #[nil "ÀÁ!ˆ\n‰ƒ$ @ =„Å @!ƒÆ @!ˆ A‰„\n)Ç ‡" [run-hooks gnus-suspend-gnus-hook gnus-buffer-list buffers gnus-group-buffer get-buffer kill-buffer bury-buffer] 3 "\ 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." nil]) (defalias 'gnus-group-exit #[nil "„Á ÂU„à ƒ ƒÅÆ!…*ÇÈ!ˆÉÊ!ˆË ˆÌ ˆÍ ‡" [noninteractive buffer-size 0 gnus-server-opened gnus-interactive-exit y-or-n-p "Are you sure you want to quit reading news? " message "" run-hooks gnus-exit-gnus-hook gnus-save-newsrc-file gnus-clear-system gnus-close-server] 2 "\ Quit reading news after updating .newsrc. The hook gnus-exit-gnus-hook is called before actually quitting." nil]) (defalias 'gnus-group-quit #[nil "„Á ÂU„à ƒÄÅÆÇ!\"!…)ÉÊ!ˆËÌ!ˆÍ ˆÎ ‡" [noninteractive buffer-size 0 gnus-server-opened yes-or-no-p format "Quit reading news without saving %s? " file-name-nondirectory gnus-current-startup-file message "" run-hooks gnus-exit-gnus-hook gnus-clear-system gnus-close-server] 5 "\ Quit reading news without updating .newsrc. The hook gnus-exit-gnus-hook is called before actually quitting." nil]) (defalias 'gnus-group-describe-briefly #[nil "ÀÁÂ!ÁÃ!ÁÄ!ÁÅ!ÁÆ!ÁÇ!°!‡" [message 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"] 8 "\ Describe Group mode commands briefly." nil]) (byte-code "„³Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕ#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞß#ˆÃàá#ˆÃâã#ˆÃäå#ˆÃæç#ˆÃèé#ˆÃêë#ˆÃìí#ˆÃîï#ˆÃðñ#ˆÃòó#ˆÃôõ#ˆÃö÷#ˆÃøù#ˆÃúû#ˆÃüý#ˆÃþÿ#ˆÃ@A#ˆÃBC#ˆÃDE#ˆÃFG#ˆÃHI#ˆÃJK#ˆÃLM#ˆÃNO#ˆÃPQ#ˆÃRS#ˆÃTU#ˆÃVW#ˆÃXY#ˆÃZ[#ˆÃ\\]#ˆÃ^_#ˆÃ`a#ˆÃbc#ˆÃde#ˆÃfg#ˆÃha#ˆÃic#ˆÃje#ˆÃkg#ˆÃlm#ˆÃno#ˆÃpq#ˆÃrs#ˆÃtu#ˆÃvw#ˆÃxy#ˆÃz{#ˆÃ|}#ˆÃ~#ˆÃ€#ˆÃ‚ƒ#ˆÃ„…#ˆÃ†‡#ˆÃˆ‰#ˆÃŠ‹#ˆÃŒ#ˆÃŽ#ˆÃ‘#ˆÃ’“#ˆÃ”•#ˆÃ–—#ˆÃ˜™#ˆÃš›#ˆÃœ#ˆÃžŸ#ˆÁ‡" [gnus-summary-mode-map 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-digest "" gnus-summary-prev-digest "" gnus-summary-next-subject "" gnus-summary-prev-subject "n" gnus-summary-next-unread-subject "p" gnus-summary-prev-unread-subject "." gnus-summary-first-unread-article "s" gnus-summary-isearch-article "s" gnus-summary-search-article-forward "r" gnus-summary-search-article-backward "<" gnus-summary-beginning-of-article ">" gnus-summary-end-of-article "j" gnus-summary-goto-subject "l" gnus-summary-goto-last-article "^" gnus-summary-refer-parent-article "^" gnus-summary-refer-article "u" gnus-summary-mark-as-unread-forward "U" gnus-summary-mark-as-unread-backward "d" gnus-summary-mark-as-read-forward "D" gnus-summary-mark-as-read-backward "u" gnus-summary-clear-mark-forward "U" gnus-summary-clear-mark-backward "k" gnus-summary-kill-same-subject-and-select " " gnus-summary-kill-same-subject "" 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-kill-thread "&" gnus-summary-execute-command "c" gnus-summary-catchup-and-exit "" gnus-summary-toggle-truncation "x" gnus-summary-delete-marked-as-read "X" gnus-summary-delete-marked-with "n" gnus-summary-sort-by-number "a" gnus-summary-sort-by-author "s" gnus-summary-sort-by-subject "d" gnus-summary-sort-by-date "" "" "" "" "=" gnus-summary-expand-window "" gnus-summary-reselect-current-group "w" gnus-summary-stop-page-breaking "" gnus-summary-caesar-message "g" gnus-summary-show-article "t" gnus-summary-toggle-header "t" gnus-summary-toggle-mime "" gnus-summary-rmail-digest "a" gnus-summary-post-news "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 "m" gnus-summary-mail-other-window "o" gnus-summary-save-article "" gnus-summary-save-in-mail "|" gnus-summary-pipe-output "k" gnus-summary-edit-local-kill "K" gnus-summary-edit-global-kill "V" gnus-version "q" gnus-summary-exit "Q" gnus-summary-quit "?" gnus-summary-describe-briefly " " gnus-info-find-node] 4) (defalias 'gnus-summary-mode #[nil "À ˆÁÂ!ƒÃ‚ÄÅ!<ƒÃÄÅ!ABÆÈ ÊË!ˆÌ ž„5ÌÍD B Î ˆÏ!ˆÑp!ˆÒÒÒÒ×Ø!‡" [kill-all-local-variables boundp mode-line-modified "--- " default-value mode-line-format gnus-summary-mode major-mode "Summary" mode-name make-local-variable minor-mode-alist gnus-show-threads " Thread" gnus-summary-set-mode-line use-local-map gnus-summary-mode-map buffer-flush-undo t buffer-read-only truncate-lines selective-display selective-display-ellipses run-hooks gnus-summary-mode-hook] 3 "\ Major mode for reading articles in this newsgroup. All normal editing commands are turned off. Instead, these commands are available: SPC Scroll to the next page of the current article. The next unread article is selected automatically at the end of the message. DEL Scroll to the previous page of the current article. RET Scroll up (or down) one line the current article. n Move to the next unread article. p Move to the previous unread article. N Move to the next article. P Move to the previous article. ESC C-n Move to the next article which has the same subject as the current article. ESC C-p Move to the previous article which has the same subject as the current article. \\[gnus-summary-next-unread-same-subject] Move to the next unread article which has the same subject as the current article. \\[gnus-summary-prev-unread-same-subject] Move to the previous unread article which has the same subject as the current article. C-c C-n Scroll to the next digested message of the current article. C-c C-p Scroll to the previous digested message of the current article. C-n Move to the next subject. C-p Move to the previous subject. ESC n Move to the next unread subject. ESC p Move to the previous unread subject. \\[gnus-summary-next-group] Exit the current newsgroup and select the next unread newsgroup. \\[gnus-summary-prev-group] Exit the current newsgroup and select the previous unread newsgroup. . Jump to the first unread article in the current newsgroup. s Do an incremental search forward on the current article. ESC s Search for an article containing a regexp forward. ESC r Search for an article containing a regexp backward. < Move point to the beginning of the current article. > Move point to the end of the current article. j Jump to the article specified by the numeric article ID. l Jump to the article you read last. ^ Refer to parent of the current article. ESC ^ Refer to the article specified by the Message-ID. u Mark the current article as unread, and go forward. U Mark the current article as unread, and go backward. d Mark the current article as read, and go forward. D Mark the current article as read, and go backward. ESC u Clear the current article's mark, and go forward. ESC U Clear the current article's mark, and go backward. k Mark articles which has the same subject as the current article as read, and then select the next unread article. C-k Mark articles which has the same subject as the current article as read. ESC k Edit a local KILL file applied to the current newsgroup. ESC K Edit a global KILL file applied to all newsgroups. ESC C-t Toggle showing conversation threads. ESC C-s Show thread subtrees. ESC C-h Hide thread subtrees. \\[gnus-summary-show-all-threads] Show all thread subtrees. \\[gnus-summary-hide-all-threads] Hide all thread subtrees. ESC C-f Go to the same level next thread. ESC C-b Go to the same level previous thread. ESC C-d Go downward current thread. ESC C-u Go upward current thread. ESC C-k Mark articles under current thread as read. & Execute a command for each article conditionally. \\[gnus-summary-catchup] Mark all articles as read in the current newsgroup, preserving articles marked as unread. \\[gnus-summary-catchup-all] Mark all articles as read in the current newsgroup. \\[gnus-summary-catchup-and-exit] Catch up all articles not marked as unread, and then exit the current newsgroup. \\[gnus-summary-catchup-all-and-exit] Catch up all articles, and then exit the current newsgroup. C-t Toggle truncations of subject lines. x Delete subject lines marked as read. X Delete subject lines with the specific marks. C-c C-s C-n Sort subjects by article number. C-c C-s C-a Sort subjects by article author. C-c C-s C-s Sort subjects alphabetically. C-c C-s C-d Sort subjects by date. = Expand Summary window to show headers full window. C-x C-s Reselect the current newsgroup. Prefix argument means to select all. w Stop page breaking by linefeed. C-c C-r Caesar rotates letters by 13/47 places. g Force to show the current article. t Show original article header if pruned header currently shown, or vice versa. ESC-t Toggle MIME processing. C-d Run RMAIL on the current digest article. a Post a new article. f Post a reply article. F Post a reply article with original article. C Cancel the current article. r Mail a message to the author. R Mail a message to the author with original author. C-c C-f Forward the current message to another user. m Mail a message in other window. o Save the current article in your favorite format. C-o Append the current article to a file in Unix mail format. | Pipe the contents of the current article to a subprocess. q Quit reading news in the current newsgroup. Q Quit reading news without recording unread articles information. V Show the version number of this GNUS. ? Describe Summary mode commands briefly. C-h m Describe Summary mode. C-c C-i Read Info about Summary mode. User customizable variables: gnus-large-newsgroup The number of articles which indicates a large newsgroup. If the number of articles in a newsgroup is greater than the value, the number of articles to be selected is asked for. If the given value N is positive, the last N articles is selected. If N is negative, the first N articles are selected. An empty string means to select all articles. gnus-use-long-file-name Non-nil means that a newsgroup name is used as a default file name to save articles to. If it's nil, the directory form of a newsgroup is used instead. gnus-default-article-saver Specifies your favorite article saver which is interactively funcallable. Following functions are available: gnus-summary-save-in-rmail (in Rmail format) gnus-summary-save-in-mail (in Unix mail format) gnus-summary-save-in-folder (in MH folder) gnus-summary-save-in-file (in article format). gnus-rmail-save-name gnus-mail-save-name gnus-folder-save-name gnus-file-save-name Specifies a function generating a file name to save articles in specified format. The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE. Access macros to the headers are defined as nntp-header-FIELD, and functions are defined as gnus-header-FIELD. gnus-article-save-directory Specifies a directory name to save articles to using the commands gnus-summary-save-in-rmail, gnus-summary-save-in-mail and gnus-summary-save-in-file. The variable is initialized from the SAVEDIR environment variable. gnus-show-all-headers Non-nil means that all headers of an article are shown. gnus-save-all-headers Non-nil means that all headers of an article are saved in a file. gnus-show-mime Non-nil means that show a MIME message. gnus-show-threads Non-nil means that conversation threads are shown in tree structure. gnus-thread-hide-subject Non-nil means that subjects for thread subtrees are hidden. gnus-thread-hide-subtree Non-nil means that thread subtrees are hidden initially. gnus-thread-hide-killed Non-nil means that killed thread subtrees are hidden automatically. gnus-thread-ignore-subject Non-nil means that subject differences are ignored in constructing thread trees. gnus-thread-indent-level Indentation of thread subtrees. gnus-optional-headers Specifies a function which generates an optional string displayed in the Summary buffer. The function is called with an article HEADERS. The result must be a string excluding `[' and `]'. The default function returns a string like NNN:AUTHOR, where NNN is the number of lines in an article and AUTHOR is the name of the author. gnus-auto-extend-newsgroup Non-nil means visible articles are extended to forward and backward automatically if possible. gnus-auto-select-first Non-nil means the first unread article is selected automagically when a newsgroup is selected normally (by gnus-group-read-group). If you'd like to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in gnus-select-group-hook or gnus-apply-kill-hook. gnus-auto-select-next Non-nil means the next newsgroup is selected automagically at the end of the newsgroup. If the value is t and the next newsgroup is empty (no unread articles), GNUS will exit Summary mode and go back to Group mode. If the value is neither nil nor t, GNUS won't exit Summary mode but select the following unread newsgroup. Especially, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations. gnus-auto-select-same Non-nil means an article with the same subject as the current article is selected automagically like `rn -S'. gnus-auto-center-summary Non-nil means the point of Summary Mode window is always kept centered. gnus-break-pages Non-nil means an article is broken into pages at page delimiters. This may not work with some versions of GNU Emacs earlier than version 18.50. gnus-page-delimiter Specifies a regexp describing line-beginnings that separate pages of news article. [gnus-more-message is obsolete. overlay-arrow-string interfares with other subsystems, such as dbx mode.] gnus-digest-show-summary Non-nil means that a summary of digest messages is shown when reading a digest article using `gnus-summary-rmail-digest' command. gnus-digest-separator Specifies a regexp separating messages in a digest article. gnus-mail-reply-method gnus-mail-other-window-method Specifies a function to begin composing mail message using commands gnus-summary-reply and gnus-summary-mail-other-window. Functions gnus-mail-reply-using-mail and gnus-mail-reply-using-mhe are available for the value of gnus-mail-reply-method. And functions gnus-mail-other-window-using-mail and gnus-mail-other-window-using-mhe are available for the value of gnus-mail-other-window-method. gnus-mail-send-method Specifies a function to mail a message too which is being posted as an article. The message must have To: or Cc: field. The value of the variable send-mail-function is the default function which uses sendmail mail program. Various hooks for customization: gnus-summary-mode-hook Entry to this mode calls the value with no arguments, if that value is non-nil. gnus-select-group-hook Called with no arguments when newsgroup is selected, if that value is non-nil. It is possible to sort subjects in this hook. See the documentation of this variable for more information. gnus-summary-prepare-hook Called with no arguments after a summary list is created in the Summary buffer, if that value is non-nil. If you'd like to modify the buffer, you can use this hook. gnus-select-article-hook Called with no arguments when an article is selected, if that value is non-nil. See the documentation of this variable for more information. gnus-select-digest-hook Called with no arguments when reading digest messages using Rmail, if that value is non-nil. This hook can be used to modify an article so that Rmail can work with it. See the documentation of the variable for more information. gnus-rmail-digest-hook Called with no arguments when reading digest messages using Rmail, if that value is non-nil. This hook is intended to customize Rmail mode. gnus-apply-kill-hook Called with no arguments when a newsgroup is selected and the Summary buffer is prepared. This hook is intended to apply a KILL file to the selected newsgroup. The format of KILL file is completely different from that of version 3.8. You have to rewrite them in the new format. See the documentation of Kill file mode for more information. gnus-mark-article-hook Called with no arguments when an article is selected at the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected. See the documentation of the variable for more information. gnus-exit-group-hook Called with no arguments when exiting the current newsgroup, if that value is non-nil. If your machine is so slow that exiting from Summary mode takes very long time, inhibit marking articles as read using cross-references by setting the variable gnus-use-cross-reference to nil in this hook." nil]) (defalias 'gnus-summary-setup-buffer #[nil "À !ƒ q‡Â !qˆÃ ‡" [get-buffer gnus-summary-buffer get-buffer-create gnus-summary-mode] 2 "\ Initialize Summary buffer."]) (defalias 'gnus-summary-read-group #[(group &optional show-all no-article) "ÀÁ\n\"ˆÃ\n \"ƒ’Å ˆÆÇ!ˆÈ ˆÆÉ!ˆÊ ËUƒ*ÌÍÎ\"ˆÀÏ!‡ƒ7ƒ7Ò ˆebˆ„[ƒ[Õ ƒ[pÖ!=…‘ËyˆØÙÍÎ#‡ÚÛ!ˆÜ!ˆÝ ˆÖ!ƒ‰ß!ƒ„ŠqˆÍ á ˆ*‚‰â!ˆËyˆØÙÍÎ#‡ã\n$\"Jƒ«å ˆÀæçè\n\"!!ˆéË!‡ê ‡" [message "Retrieving newsgroup: %s..." group gnus-select-newsgroup show-all gnus-summary-setup-buffer run-hooks gnus-select-group-hook gnus-summary-prepare gnus-apply-kill-hook buffer-size 0 gnus-summary-catchup-and-exit nil t "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 get-buffer gnus-summary-buffer search-forward ":" gnus-configure-windows summary pop-to-buffer gnus-summary-set-mode-line gnus-article-buffer get-buffer-window buffer-read-only erase-buffer kill-buffer intern-soft gnus-active-hashtb ding gnus-nntp-message format "Cannot select %s. May be security or active file problem." sit-for gnus-group-check-bogus-groups] 5 "\ Start reading news in newsgroup GROUP. If optional 1st argument SHOW-ALL is non-nil, already read articles are also listed. If optional 2nd argument NO-ARTICLE is non-nil, no article is selected initially."]) (defalias 'gnus-summary-prepare #[nil "À ˆÃ ƒÅ!‚Ç\"ˆÈÉ!ˆebˆÊË!)‡" [nil buffer-read-only erase-buffer gnus-summary-prepare-threads gnus-show-threads gnus-make-threads gnus-newsgroup-headers 0 message "" run-hooks gnus-summary-prepare-hook] 3 "\ Prepare summary list of current newsgroup in Summary buffer."]) (defalias 'gnus-summary-prepare-threads #[(threads level &optional parent-subject) "À‰‰‰‰ †\nÂÃÄÅ!G\" \n   …Ê @  A  :ƒ< @ ‚@  Î !ƒ° ÏH\n ÐH Ñ Ò\"Ã\n>ƒiÔ‚v\n>ƒuÖ‚v×Ø_Û\"\nƒ !†ŽÂÏU† ?†  ˜??…©ØÞ Û\" P&cˆ :ƒ Aƒß AT#ˆ‚.‡" [nil parent-subject "" format "%%s %%s%%%dd: [%%s] %%s\n" prin1-to-string gnus-newsgroup-end cntl child-subject subject number header thread threads vectorp 0 1 gnus-simplify-subject re-only gnus-newsgroup-marked "-" gnus-newsgroup-unreads " " "D" make-string level gnus-thread-indent-level 32 gnus-optional-headers gnus-thread-hide-subject window-width gnus-summary-prepare-threads] 10 "\ Prepare Summary buffer from THREADS and indentation LEVEL. THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).' Optional PARENT-SUBJECT specifies the subject of the parent."]) (defalias 'gnus-summary-set-mode-line #[nil "GÁ\n\"GZ GÁ \n\"GZÆÇÈ \nƒ$ÇË\n\"‚%Ì ÍUƒ5 ÍUƒ5Ì‚G ÍUƒBÇÎ \"‚GÇÏ #$D*ÑÒ!‡" [gnus-newsgroup-unreads gnus-intersection gnus-newsgroup-marked gnus-newsgroup-unselected unselected unmarked 17 format "GNUS: %s%s %s" gnus-newsgroup-name gnus-current-article "/%d" "" 0 "{%d more}" "{%d(+%d) more}" mode-line-buffer-identification set-buffer-modified-p t] 9 "\ Set Summary mode line string. If you don't like it, define your own gnus-summary-set-mode-line."]) (defalias 'gnus-summary-search-group #[(&optional backward) "ŠqˆŠÁ\nÃ\"…Ä *‡" [gnus-group-buffer gnus-group-search-forward backward nil gnus-group-group-name] 3 "\ Search for next unread newsgroup. If optional argument BACKWARD is non-nil, search backward instead."]) (defalias 'gnus-summary-search-subject #[(backward unread subject) "ƒÁ‚ ÂÃÄÅÇ=ƒÈ‚!ƒ É‚!Ê ƒ2ÌÍÎ !!ÏQ‚3Ð#ƒDÔyˆ‚GÈÃÇ#ƒZÕÖ”Ö•{!Ôyˆ×ØÃÇ#ˆ+‡" [backward re-search-backward re-search-forward nil format "^%s[ ]+\\([0-9]+\\):.\\[[^] \n]*\\][ ]+%s" unread t " " "[ ---]" "." subject "\\([Rr][Ee]:[ ]+\\)*" regexp-quote gnus-simplify-subject "\\([ ]*([^ \n]*)\\)*[ ]*\\( \\|$\\)" "" regexp article func 0 string-to-int 1 search-forward ":"] 9 "\ Search for article forward. If 1st argument BACKWARD is non-nil, search backward. If 2nd argument UNREAD is non-nil, only unread article is selected. If 3rd argument SUBJECT is non-nil, the article which has the same subject will be searched for."]) (defalias 'gnus-summary-search-forward #[(&optional unread subject) "ÀÁ\n #‡" [gnus-summary-search-subject nil unread subject] 4 "\ Search for article forward. 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 #[(&optional unread subject) "ÀÁ\n #‡" [gnus-summary-search-subject t unread subject] 4 "\ 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-article-number #[nil "ŠÀyˆÁÂ!ƒÃĔĕ{!‚ )‡" [0 looking-at ".[ ]+\\([0-9]+\\):" string-to-int 1 gnus-current-article] 3 "\ Article number around point. If nothing, return current number."]) (defalias 'gnus-summary-subject-string #[nil "ŠÀyˆÁÂ!…ÔÕ{)‡" [0 looking-at ".[ ]+[0-9]+:.\\[[^] \n]*\\][ ]+\\([^ \n]*\\)[ \n]" 1] 2 "\ Return current subject string or nil if nothing."]) (defalias 'gnus-summary-goto-subject #[(article) "`ebˆ ƒÂÃÄ \"ÅÆ#†bˆÅ)‡" [current article re-search-forward format "^.[ ]+%d:" nil t] 4 "\ Move point to ARTICLE's subject." (list (string-to-int (completing-read "Article number: " (mapcar (function (lambda (headers) (list (int-to-string (nntp-header-number headers))))) gnus-newsgroup-headers) nil (quote require-match))))]) (defalias 'gnus-summary-recenter #[nil "… Á\n!… à ÄZÅ¥Æ`d\"W… Çà ÅZÅ¥!‡" [gnus-auto-center-summary get-buffer-window gnus-article-buffer window-height 1 2 count-lines recenter] 4 "\ Center point in Summary window."]) (defalias 'gnus-summary-jump-to-group #[(newsgroup) "pÀ !=ƒ ‹‡ŠÃ !ƒÄ !ˆ‚ qˆÅ!)‡" [get-buffer gnus-group-buffer ((byte-code "À !ƒ\n !ˆÃ !‡" [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 "\ Move point to NEWSGROUP in Group mode buffer."]) (defalias 'gnus-summary-next-group #[(no-article) "À !ˆÂ ‰„ÄÅ \"ˆÆ ˆÄÇ!‚RÄÈ \"ˆÆÉ!ˆÀ !ˆÊ Ë #ˆpÍ!=†RÉ=†RpÍ!=…RÑ …RÊÑ Ë #)‡" [gnus-summary-jump-to-group gnus-newsgroup-name gnus-summary-search-group group message "Exiting %s..." gnus-summary-exit "" "Selecting %s..." t gnus-summary-read-group nil no-article get-buffer gnus-summary-buffer gnus-auto-select-next gnus-group-buffer gnus-group-group-name] 5 "\ Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially." "P"]) (defalias 'gnus-summary-prev-group #[(no-article) "À !ˆÂÃ!‰„ÅÆ \"ˆÇ ˆÅÈ!‚UÅÉ \"ˆÇÃ!ˆÀ !ˆÊ Ë #ˆpÍ!=†UÃ=†UpÍ!=…UÂÃ!…UÊÂÃ!Ë #)‡" [gnus-summary-jump-to-group gnus-newsgroup-name gnus-summary-search-group t group message "Exiting %s..." gnus-summary-exit "" "Selecting %s..." gnus-summary-read-group nil no-article get-buffer gnus-summary-buffer gnus-auto-select-next gnus-group-buffer] 5 "\ Exit current newsgroup and then select previous unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected initially." "P"]) (defalias 'gnus-summary-next-subject #[(n &optional unread) "ÁVƒ !ƒS‰‚ !ƒÄ ‡ ƒ$ÅÆ!‡ÅÇ!‡" [n 1 gnus-summary-search-forward unread gnus-summary-recenter message "No more unread articles" "No more articles"] 3 "\ Go to next N'th summary line. If optional argument UNREAD is non-nil, only unread article is selected." "p"]) (defalias 'gnus-summary-next-unread-subject #[(n) "À Â\"‡" [gnus-summary-next-subject n t] 3 "\ Go to next N'th unread summary line." "p"]) (defalias 'gnus-summary-prev-subject #[(n &optional unread) "ÁVƒ !ƒS‰‚ !ƒÄ ‡ ƒ$ÅÆ!‡ÅÇ!‡" [n 1 gnus-summary-search-backward unread gnus-summary-recenter message "No more unread articles" "No more articles"] 3 "\ Go to previous N'th summary line. If optional argument UNREAD is non-nil, only unread article is selected." "p"]) (defalias 'gnus-summary-prev-unread-subject #[(n) "À Â\"‡" [gnus-summary-prev-subject n t] 3 "\ Go to previous N'th unread summary line." "p"]) (defalias 'gnus-summary-expand-window #[nil "ÀÁ!ˆÂ !‡" [gnus-configure-windows summary pop-to-buffer gnus-summary-buffer] 2 "\ Expand Summary window to show headers full window." nil]) (defalias 'gnus-summary-display-article #[(article &optional all-header) "??…ÁÀ!ˆÂ !ˆÄ \"ˆÆ ˆÇ ˆÈÉ!ˆÊ‡" [article gnus-configure-windows pop-to-buffer gnus-summary-buffer gnus-article-prepare all-header gnus-summary-recenter gnus-summary-set-mode-line run-hooks gnus-select-article-hook t] 3 "\ Display ARTICLE in Article buffer."]) (defalias 'gnus-summary-select-article #[(&optional all-headers force) "À ?? ƒ\n Uƒ ƒ\" =„\"Æ\n \"‚*ÇÂ!ˆÈ !*‡" [gnus-summary-article-number all-headers article gnus-current-article force gnus-have-all-headers gnus-summary-display-article gnus-configure-windows pop-to-buffer gnus-summary-buffer] 3 "\ Select the current article. Optional first argument ALL-HEADERS is non-nil, show all header fields. Optional second argument FORCE is nil, the article is only selected again when current header does not match with ALL-HEADERS option."]) (defalias 'gnus-summary-set-current-mark #[(&optional current-mark) "ŠqˆÁebˆÃÄÁÅ#ƒÆÇ!ˆÈcˆebˆÃÉÊ \"ÁÅ#…2ÆÌ!ˆ †1Îc*‡" [gnus-summary-buffer nil buffer-read-only re-search-forward "^.[ ]+[0-9]+:[^ ]" t delete-char -1 " " format "^.[ ]+%d:" gnus-current-article 1 current-mark "+"] 4 "\ Put `+' at the current article. Optional argument specifies CURRENT-MARK instead of `+'."]) (defalias 'gnus-summary-next-article #[(unread &optional subject) "ÀÂà \"!†ý ƒBƒBÇ \"ƒB\nË>ƒBp`  Î ˆ p=…>` W…>ÏÐ!*‚ýƒo „o „oÒ ‰ƒoÓ À\"ˆÀdbˆÕ CÖ\"ˆ)×!‚ýÙÚ !Û …„\nÝ>…„Þ ? !Ïâ ƒ”ã‚•äƒËå=„Ë ƒ½æçèé!!! ê +\"JA@$‚Ìæìèé!!!-#‚Ìä#ˆƒàå=ƒàîÀ!‚ü…üï ‰0!UƒöîÀ!‚û0‰1)+)‡" [nil header gnus-summary-display-article gnus-summary-search-forward unread subject gnus-auto-select-same gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked this-command (gnus-summary-next-unread-article gnus-summary-next-page gnus-summary-kill-same-subject-and-select) last-point buffer gnus-summary-first-unread-article message "Wrapped" gnus-auto-extend-newsgroup gnus-more-header-forward gnus-extend-newsgroup buffer-read-only gnus-summary-prepare-threads 0 gnus-summary-goto-article gnus-newsgroup-end string-to-char this-command-keys gnus-summary-search-group gnus-auto-select-next (gnus-summary-next-unread-article gnus-summary-next-article gnus-summary-next-page gnus-summary-next-same-subject gnus-summary-next-unread-same-subject gnus-summary-kill-same-subject gnus-summary-kill-same-subject-and-select) input-pending-p auto-select group cmd "No more%s articles%s" " unread" "" quietly format " (Type %s for %s [%d])" key-description char-to-string intern-soft gnus-unread-hashtb " (Type %s to exit %s)" gnus-newsgroup-name gnus-summary-next-group read-char char unread-command-char] 11 "\ Select article after current one. If argument UNREAD is non-nil, only unread article is selected." "P"]) (defalias 'gnus-summary-next-unread-article #[nil "ÀÁ\n…à \"‡" [gnus-summary-next-article t gnus-auto-select-same gnus-summary-subject-string] 3 "\ Select unread article after current one." nil]) (defalias 'gnus-summary-prev-article #[(unread &optional subject) "ÀÂà \"!†a ƒ+ƒ+Ç \"ƒ+\nË>ƒ+Ì À\"‚a ƒ5ÍÎ!‚aƒ^ „^Ð ‰ƒ^Ñ Ò\"ˆÀebˆÔ CÕ\"ˆ)Ö!‚aÍØ!)‡" [nil header gnus-summary-display-article gnus-summary-search-backward unread subject gnus-auto-select-same gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked this-command (gnus-summary-prev-unread-article) gnus-summary-prev-article message "No more unread articles" gnus-auto-extend-newsgroup gnus-more-header-backward gnus-extend-newsgroup t buffer-read-only gnus-summary-prepare-threads 0 gnus-summary-goto-article gnus-newsgroup-begin "No more articles"] 4 "\ Select article before current one. If argument UNREAD is non-nil, only unread article is selected." "P"]) (defalias 'gnus-summary-prev-unread-article #[nil "ÀÁ\n…à \"‡" [gnus-summary-prev-article t gnus-auto-select-same gnus-summary-subject-string] 3 "\ Select unred article before current one." nil]) (defalias 'gnus-summary-next-page #[(lines) "À Á ƒ U„Å !‚JÆÃ!ˆÇ!ˆÉ \nËŽÇ !ˆÍ!*\nƒ>ƒ>ÏÐ!‚J\n…J?…JÑ *‡" [gnus-summary-article-number nil endp article gnus-current-article gnus-summary-display-article gnus-configure-windows pop-to-buffer gnus-summary-buffer selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) gnus-article-buffer gnus-article-next-page lines message "End of message" gnus-summary-next-unread-article] 2 "\ Show next page of selected article. If end of article, select next article. Argument LINES specifies lines to be scrolled up." "P"]) (defalias 'gnus-summary-prev-page #[(lines) "À \nƒ \nU„à !‚,ÄÁ!ˆÅ!ˆÇ ÉŽÅ\n!ˆË !*)‡" [gnus-summary-article-number article gnus-current-article gnus-summary-display-article gnus-configure-windows pop-to-buffer gnus-summary-buffer selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) gnus-article-buffer gnus-article-prev-page lines] 2 "\ Show previous page of selected article. Argument LINES specifies lines to be scrolled down." "P"]) (defalias 'gnus-summary-scroll-up #[(lines) "À ˆÁ ÃŽÄ !ˆÇVƒ È!…,ÉÊ!‚,ÇW…,Ë[!*‡" [gnus-summary-select-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer lines 0 gnus-article-next-page message "End of message" gnus-article-prev-page] 2 "\ Scroll up (or down) one line current article. Argument LINES specifies lines to be scrolled up (or down if negative)." "p"]) (defalias 'gnus-summary-next-same-subject #[nil "ÀÁ \"‡" [gnus-summary-next-article nil gnus-summary-subject-string] 3 "\ Select next article which has the same subject as current one." nil]) (defalias 'gnus-summary-prev-same-subject #[nil "ÀÁ \"‡" [gnus-summary-prev-article nil gnus-summary-subject-string] 3 "\ Select previous article which has the same subject as current one." nil]) (defalias 'gnus-summary-next-unread-same-subject #[nil "ÀÁ \"‡" [gnus-summary-next-article t gnus-summary-subject-string] 3 "\ Select next unread article which has the same subject as current one." nil]) (defalias 'gnus-summary-prev-unread-same-subject #[nil "ÀÁ \"‡" [gnus-summary-prev-article t gnus-summary-subject-string] 3 "\ Select previous unread article which has the same subject as current one." nil]) (defalias 'gnus-summary-refer-parent-article #[(child) "ÀÁ‰\"ˆÂ ƒÅÂ!‚DÆ ÈŽÉ\n!ˆËÌ!‰ ƒ5ÎÏ \"ƒ5 ДЕO+ ;ƒAÅ !‚DÑÒ!)‡" [gnus-summary-select-article t nil referenced-id child gnus-summary-refer-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-fetch-field "References" references string-match "\\(<[^<>]+>\\)[^>]*\\'" 1 error "No more parents"] 4 "\ Refer parent article of current article. If a prefix argument CHILD is non-nil, go back to the child article using internally maintained articles history. NOTE: This command may not work with nnspool.el." "P"]) (defalias 'gnus-summary-refer-article #[(message-id) "ÀÁ‰\"ˆ\n;ƒP\nGÃVƒPÄ ÆŽÇ!ˆÉÊ\n\"„&Ë\nPÉÌ\n\"„1\nÍPÎÏ!‰\nš„L@š„LB+‚Y@A\n;ƒcÒ\nÁ\"‡ÓÔ!‡" [gnus-summary-select-article t message-id 0 selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer string-match "^<" "<" ">$" ">" gnus-fetch-field "Message-ID" current gnus-current-history gnus-article-prepare error "No such references"] 4 "\ Refer article specified by MESSAGE-ID. If the MESSAGE-ID is nil or an empty string, Message-ID is poped from internally maintained articles history. NOTE: This command may not work with nnspool.el nor mhspool.el." "sMessage-ID: "]) (defalias 'gnus-summary-next-digest #[(nth) "À ˆÁ ÃŽÄ !ˆÆ†È!*‡" [gnus-summary-select-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-article-next-digest nth 1] 2 "\ Move to head of NTH next digested message." "p"]) (defalias 'gnus-summary-prev-digest #[(nth) "À ˆÁ ÃŽÄ !ˆÆ†È!*‡" [gnus-summary-select-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-article-prev-digest nth 1] 2 "\ Move to head of NTH previous digested message." "p"]) (defalias 'gnus-summary-first-unread-article #[nil "`ebˆÁÂÃÄ#ƒÅÆ !‚bˆÇÈ!ˆÃ)‡" [begin re-search-forward "^ [ ]+[0-9]+:" nil t gnus-summary-display-article gnus-summary-article-number message "No more unread articles"] 4 "\ Select first unread article. Return non-nil if successfully selected." nil]) (defalias 'gnus-summary-isearch-article #[nil "À ˆÁ ÃŽÄ !ˆÆ *‡" [gnus-summary-select-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer isearch-forward] 2 "\ Do incremental search forward on current article." nil]) (defalias 'gnus-summary-search-article-forward #[(regexp) "Á˜ƒ\n† Á‚ÃÄ\"ƒ(Å ÇŽÈ !ˆÊË!*‡ÌÍ\"‡" [regexp "" gnus-last-search-regexp gnus-summary-search-article nil selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer recenter 0 error "Search failed: \"%s\""] 3 "\ Search for an article containing REGEXP forward. gnus-select-article-hook is not called during the search." (list (read-string (concat "Search forward (regexp): " (if gnus-last-search-regexp (concat "(default " gnus-last-search-regexp ") ")))))]) (defalias 'gnus-summary-search-article-backward #[(regexp) "Á˜ƒ\n† Á‚ÃÄ\"ƒ(Å ÇŽÈ !ˆÊË!*‡ÌÍ\"‡" [regexp "" gnus-last-search-regexp gnus-summary-search-article t selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer recenter 0 error "Search failed: \"%s\""] 3 "\ Search for an article containing REGEXP backward. gnus-select-article-hook is not called during the search." (list (read-string (concat "Search backward (regexp): " (if gnus-last-search-regexp (concat "(default " gnus-last-search-regexp ") ")))))]) (defalias 'gnus-summary-search-article #[(regexp &optional backward) "À‰ ƒ\n‚ ÃÀ‰É ˆÊ ˆËÌ \"ˆ Î ÐŽÑ!ˆŒ~ˆÀÔ#+ „tÕÖ À‰#!ƒtËÌ \"ˆÎ ׎Ñ!ˆŒ~ˆ ƒed‚febˆÀÔ#+‚;ËØ!ˆ  =„‚  -‡" [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 gnus-summary-select-article message "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)) "" gnus-last-article] 5 "\ 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-execute-command #[(field regexp command &optional backward) "À ˆŠÁ‹)‡" [gnus-summary-show-all-threads ((byte-code "ÀÁ !\"ˆÄ ÇÈÉÊË !DDE $ˆÀÍ !\"‡" [message "Executing %s..." key-description command gnus-execute field regexp lambda nil call-interactively quote key-binding backward "Executing %s... done"] 9))] 1 "\ If FIELD of article header matches REGEXP, execute a COMMAND string. If FIELD is an empty string (or nil), entire article body is searched for. If optional (prefix) argument BACKWARD is non-nil, do backward instead." (list (let ((completion-ignore-case t)) (completing-read "Field name: " (quote (("Number") ("Subject") ("From") ("Lines") ("Date") ("Id") ("Xref") ("References"))) nil (quote require-match))) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)]) (defalias 'gnus-summary-beginning-of-article #[nil "À ˆÁ ÃŽÄ !ˆ~ˆÆ ˆ…È *‡" [gnus-summary-select-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer beginning-of-buffer gnus-break-pages gnus-narrow-to-page] 2 "\ Go to beginning of article body" nil]) (defalias 'gnus-summary-end-of-article #[nil "À ˆÁ ÃŽÄ !ˆ~ˆÆ ˆ…È *‡" [gnus-summary-select-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer end-of-buffer gnus-break-pages gnus-narrow-to-page] 2 "\ Go to end of article body" nil]) (defalias 'gnus-summary-goto-article #[(article &optional all-headers) "À !…\n \"‡" [gnus-summary-goto-subject article gnus-summary-display-article all-headers] 3 "\ Read ARTICLE if exists. Optional argument ALL-HEADERS means all headers are shown." (list (string-to-int (completing-read "Article number: " (mapcar (function (lambda (headers) (list (int-to-string (nntp-header-number headers))))) gnus-newsgroup-headers) nil (quote require-match))))]) (defalias 'gnus-summary-goto-last-article #[nil "…Á!‡" [gnus-last-article gnus-summary-goto-article] 2 "\ Go to last subject line." nil]) (defalias 'gnus-summary-show-article #[nil "?Á?Â\"‡" [gnus-have-all-headers gnus-summary-select-article t] 3 "\ Force to show current article." nil]) (defalias 'gnus-summary-toggle-header #[(arg) "À „\n\n?‚à !ÄVÇ È\"*‡" [nil arg gnus-have-all-headers prefix-numeric-value 0 all-headers gnus-show-all-headers gnus-summary-select-article t] 3 "\ Show original header if pruned header currently shown, or vice versa. With arg, show original header iff arg is positive." "P"]) (defalias 'gnus-summary-show-all-headers #[nil "ÀÁ‰\"‡" [gnus-summary-select-article t] 3 "\ Show original article header." nil]) (defalias 'gnus-summary-toggle-mime #[(arg) "„ ?‚Â!ÃV ?Å ?Æ\"‡" [arg gnus-show-mime prefix-numeric-value 0 gnus-have-all-headers gnus-summary-select-article t] 3 "\ Toggle MIME processing. With arg, turn MIME processing on iff arg is positive." "P"]) (defalias 'gnus-summary-stop-page-breaking #[nil "À ˆÁ ÃŽÄ !ˆ~*‡" [gnus-summary-select-article selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer] 2 "\ Stop page breaking by linefeed temporary (Widen article buffer)." nil]) (defalias 'gnus-summary-kill-same-subject-and-select #[(unmark) "ƒÁ!Âà \"ÅÆ…à \"ˆÈÉ ƒ$Ê‚%Ë#)‡" [unmark prefix-numeric-value gnus-summary-mark-same-subject gnus-summary-subject-string count gnus-summary-next-article t gnus-auto-select-same message "%d articles are marked as %s" "unread" "read"] 4 "\ Mark articles which has the same subject as read, and then select next. If argument UNMARK is positive, remove any kinds of marks. If argument UNMARK is negative, mark articles as unread instead." "P"]) (defalias 'gnus-summary-kill-same-subject #[(unmark) "ƒÁ!Âà \"„ÅÆÇ\"ˆÈÉ ƒ\"Ê‚#Ë#)‡" [unmark prefix-numeric-value gnus-summary-mark-same-subject gnus-summary-subject-string count gnus-summary-next-subject 1 t message "%d articles are marked as %s" "unread" "read"] 4 "\ Mark articles which has the same subject as read. If argument UNMARK is positive, remove any kinds of marks. If argument UNMARK is negative, mark articles as unread instead." "P"]) (defalias 'gnus-summary-mark-same-subject #[(subject &optional unmark) "ÀŠ\n„ÃÄÅ\"ˆ‚ \nÆVƒÇÄÈ\"ˆ‚ Ç ˆ ƒPÊÄ \"ƒP\n„9ÃÄÅ\"ˆ‚J\nÆVƒGÇÄÈ\"ˆ‚JÇ ˆ T‚ ) )‡" [1 count unmark gnus-summary-mark-as-read nil "K" 0 gnus-summary-mark-as-unread t subject gnus-summary-search-forward] 3 "\ 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-as-unread-forward #[(count) "ÁV…ÂÉ\"ˆÄÅÃ\"ˆS‰‚‡" [count 0 gnus-summary-mark-as-unread nil gnus-summary-next-subject 1] 4 "\ Mark current article as unread, and then go forward. Argument COUNT specifies number of articles marked as unread." "p"]) (defalias 'gnus-summary-mark-as-unread-backward #[(count) "ÁV…ÂÉ\"ˆÄÅÃ\"ˆS‰‚‡" [count 0 gnus-summary-mark-as-unread nil gnus-summary-prev-subject 1] 4 "\ Mark current article as unread, and then go backward. Argument COUNT specifies number of articles marked as unread." "p"]) (defalias 'gnus-summary-mark-as-unread #[(&optional article clear-mark) "ŠqˆÁ ˆÂÄ † Ç\"ˆ =„)É!…;ÊyˆËÌ!ˆƒ9Í‚:Îc,‡" [gnus-summary-buffer gnus-summary-show-thread nil buffer-read-only gnus-summary-article-number current article gnus-mark-article-as-unread clear-mark gnus-summary-goto-subject 0 delete-char 1 " " "-"] 3 "\ 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-mark-as-read-forward #[(count) "ÁV… ˆÃÄÅ\"ˆS‰‚‡" [count 0 gnus-summary-mark-as-read gnus-summary-next-subject 1 unread-only] 4 "\ Mark current article as read, and then go forward. Argument COUNT specifies number of articles marked as read" "p"]) (defalias 'gnus-summary-mark-as-read-backward #[(count) "ÁV… ˆÃÄÅ\"ˆS‰‚‡" [count 0 gnus-summary-mark-as-read gnus-summary-prev-subject 1 unread-only] 4 "\ Mark current article as read, and then go backward. Argument COUNT specifies number of articles marked as read" "p"]) (defalias 'gnus-summary-mark-as-read #[(&optional article mark) "ŠqˆÁ ˆÂ †ÅÆ †É!ˆ=„0Ê!…9ËyˆÌÍ!ˆ c-‡" [gnus-summary-buffer gnus-summary-show-thread nil buffer-read-only mark "D" gnus-summary-article-number current article gnus-mark-article-as-read gnus-summary-goto-subject 0 delete-char 1] 2 "\ Mark current article as read. Optional 1st argument ARTICLE specifies article number to be marked as read. Optional 2nd argument MARK specifies a string inserted at beginning of line. Any kind of string (length 1) except for a space and `-' is ok."]) (defalias 'gnus-summary-clear-mark-forward #[(count) "ÁV…ÂÃÄ\"ˆÅÆÃ\"ˆS‰‚‡" [count 0 gnus-summary-mark-as-unread nil t gnus-summary-next-subject 1] 4 "\ Remove current article's mark, and go forward. Argument COUNT specifies number of articles unmarked" "p"]) (defalias 'gnus-summary-clear-mark-backward #[(count) "ÁV…ÂÃÄ\"ˆÅÆÃ\"ˆS‰‚‡" [count 0 gnus-summary-mark-as-unread nil t gnus-summary-prev-subject 1] 4 "\ Remove current article's mark, and go backward. Argument COUNT specifies number of articles unmarked" "p"]) (defalias 'gnus-summary-delete-marked-as-read #[nil "ƒ#ÁŠebˆÃÄ!ˆ)mƒÅÆ!‚!ÇyˆÈÉÁÊ#)‡ËÌ!‡" [gnus-newsgroup-unreads nil buffer-read-only delete-non-matching-lines "^[ ---]" gnus-summary-prev-subject 1 0 search-forward ":" t message "All articles are marked as read"] 4 "\ Delete lines which is marked as read." nil]) (defalias 'gnus-summary-delete-marked-with #[(marks) "ÀŠebˆÂà ÅQ!ˆ)Æ ÇU†'mƒÈÉ!‚'ÇyˆÊËÀÌ#)‡" [nil buffer-read-only delete-matching-lines "^[" marks "]" buffer-size 0 gnus-summary-prev-subject 1 search-forward ":" t] 4 "\ Delete lines which are marked with MARKS (e.g. \"DK\")." "sMarks: "]) (defalias 'gnus-summary-toggle-threads #[(arg) "À \n„ ?‚Ä\n!ÅVÆ ˆÇ !)‡" [gnus-summary-article-number current arg gnus-show-threads prefix-numeric-value 0 gnus-summary-prepare gnus-summary-goto-subject] 2 "\ Toggle showing conversation threads. With arg, turn showing conversation threads on iff arg is positive." "P"]) (defalias 'gnus-summary-show-all-threads #[nil "…ŠÁÃedÄÅÆ%*‡" [gnus-show-threads nil buffer-read-only subst-char-in-region 13 10 t] 6 "\ Show all thread subtrees." nil]) (defalias 'gnus-summary-show-thread #[nil "…ŠÁÃÄyˆ`Áˆ`ÅÆÇ%*‡" [gnus-show-threads nil buffer-read-only subst-char-in-region 0 13 10 t] 6 "\ Show thread subtrees." nil]) (defalias 'gnus-summary-hide-all-threads #[nil "…%ŠebˆÁÂÃÄ#ˆiÆ ˆÇ …$ iYƒÆ ˆ‚*‡" [gnus-show-threads search-forward ":" nil t level gnus-summary-hide-thread gnus-summary-search-forward] 4 "\ Hide all thread subtrees." nil]) (defalias 'gnus-summary-hide-thread #[nil "…=ŠÁyˆÂÃÄÅ#ˆÄ``i Ê ƒ3iWƒ3iWƒ`‚ËÌÍÅ%-‡" [gnus-show-threads 0 search-forward ":" nil t level last init buffer-read-only gnus-summary-search-forward subst-char-in-region 10 13] 6 "\ Hide thread subtrees." nil]) (defalias 'gnus-summary-next-thread #[(n) "ÀyˆÁÂÃÄ#ˆ``iÀVƒ5É ƒ5 iXƒ5 iUƒ`S‰‚U?bˆ+‡" [0 search-forward ":" nil t level last init n gnus-summary-search-forward] 5 "\ Go to the same level next thread. Argument N specifies the number of threads." "p"]) (defalias 'gnus-summary-prev-thread #[(n) "ÀyˆÁÂÃÄ#ˆ``iÀVƒ5É ƒ5 iXƒ5 iUƒ`S‰‚U?bˆ+‡" [0 search-forward ":" nil t level last init n gnus-summary-search-backward] 5 "\ Go to the same level previous thread. Argument N specifies the number of threads." "p"]) (defalias 'gnus-summary-down-thread #[(d) "ÀyˆÁÂÃÄ#ˆ`iÀVƒ4È ƒ4 iXƒ4 iWƒ`iS‰‚b*‡" [0 search-forward ":" nil t level last d gnus-summary-search-forward] 5 "\ Go downward current thread. Argument D specifies the depth goes down." "p"]) (defalias 'gnus-summary-up-thread #[(d) "ÀyˆÁÂÃÄ#ˆ`iÀVƒ.È ƒ. iVƒ`iS‰‚b*‡" [0 search-forward ":" nil t level last d gnus-summary-search-backward] 5 "\ Go upward current thread. Argument D specifies the depth goes up." "p"]) (defalias 'gnus-summary-kill-thread #[(unmark) "ƒÁ!ÂyˆÃÄÅÆ#ˆŠi„!ÈÅÉ\"ˆ‚2ÂVƒ/ÊÅÆ\"ˆ‚2Ê ˆË ƒ^iWƒ^„JÈÅÉ\"ˆ‚2ÂVƒXÊÅÆ\"ˆ‚2Ê ˆ‚2*„k ƒkÍ ˆ?…tÎÏÆ\"‡" [unmark prefix-numeric-value 0 search-forward ":" nil t level gnus-summary-mark-as-read "K" gnus-summary-mark-as-unread gnus-summary-search-forward gnus-thread-hide-killed gnus-summary-hide-thread gnus-summary-next-subject 1] 4 "\ Mark articles under current thread as read. If argument UNMARK is positive, remove any kinds of marks. If argument UNMARK is negative, mark articles as unread instead." "P"]) (defalias 'gnus-summary-toggle-truncation #[(arg) "„ ?‚Â!ÃVÄ ‡" [arg truncate-lines prefix-numeric-value 0 redraw-display] 2 "\ Toggle truncation of summary lines. With arg, turn line truncation on iff arg is positive." "P"]) (defalias 'gnus-summary-sort-by-number #[(reverse) "ÀÁ #‡" [gnus-summary-keysort-summary < #[(a) "ÁH‡" [a 0] 2] reverse] 4 "\ Sort Summary buffer by article number. Argument REVERSE means reverse order." "P"]) (defalias 'gnus-summary-sort-by-author #[(reverse) "ÀÁ #‡" [gnus-summary-keysort-summary string-lessp #[(a) "ƒ ÂH—‡ ÂH‡" [case-fold-search a 2] 2] reverse] 4 "\ Sort Summary buffer by author name alphabetically. If case-fold-search is non-nil, case of letters is ignored. Argument REVERSE means reverse order." "P"]) (defalias 'gnus-summary-sort-by-subject #[(reverse) "ÀÁ #‡" [gnus-summary-keysort-summary string-lessp #[(a) "ƒ Á\nÃHÄ\"—‡Á\nÃHÄ\"‡" [case-fold-search gnus-simplify-subject a 1 re-only] 3] reverse] 4 "\ 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." "P"]) (defalias 'gnus-summary-sort-by-date #[(reverse) "ÀÁ #‡" [gnus-summary-keysort-summary string-lessp #[(a) "À ÂH!‡" [gnus-sortable-date a 5] 3] reverse] 4 "\ Sort Summary buffer by date. Argument REVERSE means reverse order." "P"]) (defalias 'gnus-summary-keysort-summary #[(predicate key &optional reverse) "À  #ˆÆ ˆÇ !)‡" [gnus-summary-article-number current gnus-keysort-headers predicate key reverse gnus-summary-prepare gnus-summary-goto-subject] 4 "\ Sort Summary buffer by PREDICATE using a value passed by KEY. Optional argument REVERSE means reverse order."]) (defalias 'gnus-summary-sort-summary #[(predicate &optional reverse) "À  \"ˆÅ ˆÆ !)‡" [gnus-summary-article-number current gnus-sort-headers predicate reverse gnus-summary-prepare gnus-summary-goto-subject] 3 "\ Sort Summary buffer by PREDICATE. Optional argument REVERSE means reverse order."]) (defalias 'gnus-summary-reselect-current-group #[(show-all) "À ÂÃ!ˆÄ !ˆÆÃ\"ˆÈ !)‡" [gnus-summary-article-number current-subject gnus-summary-exit t gnus-summary-jump-to-group gnus-newsgroup-name gnus-group-read-group show-all gnus-summary-goto-subject] 3 "\ Once exit and then reselect the current newsgroup. Prefix argument SHOW-ALL means to select all articles." "P"]) (defalias 'gnus-summary-caesar-message #[(rotnum) "À ˆÁ ˆÂ ÄŽÅ!ˆŒ~ˆÇÈ!ˆ` Ê !ˆ bˆÌÈ!,‡" [gnus-summary-select-article gnus-overload-functions selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer move-to-window-line 0 last news-caesar-buffer-body rotnum recenter] 2 "\ Caesar rotates all letters of current message by 13/47 places. With prefix arg, specifies the number of places to rotate each letter forward. Caesar rotates Japanese letters by 47 places in any case." "P"]) (defalias 'gnus-summary-rmail-digest #[nil "À ˆÁÂ!ˆ Ä !Æ qˆÊp!ˆË Í ˆÎ !ˆÏÐ!ˆÑ ˆebˆÒ ˆÓ ˆÔ ˆÕ ˆËÖ×+‡" [gnus-summary-select-article require rmail gnus-article-buffer get-buffer-create gnus-digest-buffer "" mail-header-separator digbuf artbuf buffer-flush-undo nil buffer-read-only erase-buffer insert-buffer-substring run-hooks gnus-select-digest-hook gnus-convert-article-to-rmail rmail-insert-rmail-file-header rmail-mode rmail-set-message-counters rmail-show-message (byte-code "À ˆÁ ˆÂÄ ÆHPÈÉ!ˆÊC    # #Ò!ÕÖ!ˆ×Ø!ˆÙ!ˆƒf×ß!ˆÙ!ˆà ˆÙ!ˆáâã!!ˆ*‚z×ä!ˆÙ!ˆáâå!!ˆ)æ!ˆæ!ˆæ!ˆæ!‡" [undigestify-rmail-message rmail-expunge "GNUS Digest" buffer-file-name "Digest: " gnus-current-headers 1 mode-line-buffer-identification make-local-variable write-file-hooks #[nil "ÀÁ!ˆÂÃ!ˆÄ‡" [set-buffer-modified-p nil message "(No changes need to be saved)" no-need-to-write-this-buffer] 2] gnus-rmail-save-name gnus-newsgroup-name gnus-newsgroup-last-rmail rmail-last-rmail-file gnus-mail-save-name gnus-newsgroup-last-mail rmail-last-file get-buffer-create gnus-digest-summary-buffer rmail-summary-buffer run-hooks gnus-rmail-digest-hook gnus-configure-windows (1 0 0) pop-to-buffer gnus-group-buffer gnus-digest-show-summary gnus-digest-buffer gnus-article-buffer gnus-summary-buffer article rmail-summary message substitute-command-keys "Type \\[rmail-summary-quit] to return to GNUS" summary "Type \\[rmail-quit] to return to GNUS" bury-buffer] 4) ((error (byte-code "ÀÁ!ˆÂ !ˆÄ ˆÅÆ!‡" [set-buffer-modified-p nil kill-buffer digbuf ding message "Article is not a digest"] 2)))] 3 "\ Run RMAIL on current digest article. gnus-select-digest-hook will be called with no arguments, if that value is non-nil. It is possible to modify the article so that Rmail can work with it. gnus-rmail-digest-hook will be called with no arguments, if that value is non-nil. The hook is intended to customize Rmail mode." nil]) (defalias 'gnus-summary-save-article #[nil "À ‰\"ˆ\nƒ Ã\n!‡ÄÅ!‡" [gnus-summary-select-article gnus-save-all-headers gnus-default-article-saver call-interactively error "No default saver is defined."] 3 "\ Save this article using default saver function. The variable `gnus-default-article-saver' specifies the saver function." nil]) (defalias 'gnus-summary-save-in-rmail #[(&optional filename) "À ‰\"ˆÂ ÄŽÅ!ˆŠŒ~ˆ \n#  „4ÍÎÏ !ÐQÑ ! # ÒÑ !!ˆÓ !ˆ ‰\n-‡" [gnus-summary-select-article gnus-save-all-headers selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-rmail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-rmail default-name filename read-file-name "Save article in Rmail file: (default " file-name-nondirectory ") " file-name-directory gnus-make-directory gnus-output-to-rmail] 4 "\ 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." nil]) (defalias 'gnus-summary-save-in-mail #[(&optional filename) "À ‰\"ˆÂ ÄŽÅ!ˆŠŒ~ˆ \n#  „4ÍÎÏ !ÐQÑ ! # Ò  …@Ñ !\" ÓÑ !!ˆÔ !ƒ`Õ !ƒ`Ö !ˆ‚h× ØÙ‰$ˆ ‰\n-‡" [gnus-summary-select-article gnus-save-all-headers selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail default-name filename read-file-name "Save article in Unix mail file: (default " file-name-nondirectory ") " file-name-directory expand-file-name gnus-make-directory file-readable-p rmail-file-p gnus-output-to-rmail rmail-output 1 t] 5 "\ 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." nil]) (defalias 'gnus-summary-save-in-file #[(&optional filename) "À ‰\"ˆÂ ÄŽÅ!ˆŠŒ~ˆ \n#  „4ÍÎÏ !ÐQÑ ! # ÒÑ !!ˆÓ !ˆ ‰\n-‡" [gnus-summary-select-article gnus-save-all-headers selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-file-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-file default-name filename read-file-name "Save article in file: (default " file-name-nondirectory ") " file-name-directory gnus-make-directory gnus-output-to-file] 4 "\ 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." nil]) (defalias 'gnus-summary-save-in-folder #[(&optional folder) "À ‰\"ˆÂ ÄŽÅ!ˆŒ~ˆÇ ˆ†'ÉÊ   #Ï#ÐÑ!ÓŽÔedÕÖ\"ØØ&.‡" [gnus-summary-select-article gnus-save-all-headers selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer 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 ((byte-code "qˆÁ ÂUƒÃÄ \"ˆ‚ÃÆÇ \"ˆÈ!ˆ  Á‡" [errbuf buffer-size 0 message "Article saved in folder: %s" folder "%s" buffer-string kill-buffer gnus-newsgroup-last-folder] 3)) call-process-region expand-file-name "rcvstore" mh-lib nil] 8 "\ Save this article to MH folder (using `rcvstore' in MH library). Optional argument FOLDER specifies folder name." nil]) (defalias 'gnus-summary-pipe-output #[nil "À ‰\"ˆÂ ÄŽÅ!ˆŒ~ˆÇÈ \"‰\n˘ƒ# \nÌed\nÍ$ˆ\n‰ ,‡" [gnus-summary-select-article gnus-save-all-headers selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer read-string "Shell command on article: " gnus-last-shell-command command "" shell-command-on-region nil] 6 "\ Pipe this article to subprocess." nil]) (defalias 'gnus-summary-catchup #[(all &optional quietly) "„Á\nƒ ÂÄ!…=Å\n?…\"ÉÊ!ˆË ˆ…<Ì@Í\"ˆA‰„+Î)‡" [quietly y-or-n-p all "Do you really want to mark everything as read? " "Delete all articles not marked as unread? " gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked unmarked message "" gnus-summary-show-all-threads gnus-summary-mark-as-read "C" nil] 4 "\ 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." "P"]) (defalias 'gnus-summary-catchup-all #[(&optional quietly) "ÀÁ\n\"‡" [gnus-summary-catchup t quietly] 3 "\ Mark all articles in this newsgroup as read." nil]) (defalias 'gnus-summary-catchup-and-exit #[(all &optional quietly) "„Á\nƒ ÂÄ!…GÅ\n?…\"ÉÊ!ˆƒ7Ë@!ˆA‰„( À=ƒDÍÎ!‚FÏ )‡" [quietly y-or-n-p all "Do you really want to mark everything as read? " "Delete all articles not marked as unread? " gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked unmarked message "" gnus-mark-article-as-read gnus-auto-select-next gnus-summary-next-group nil gnus-summary-exit] 4 "\ 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." "P"]) (defalias 'gnus-summary-catchup-all-and-exit #[(&optional quietly) "ÀÁ\n\"‡" [gnus-summary-catchup-and-exit t quietly] 3 "\ Mark all articles in this newsgroup as read, and then exit." nil]) (defalias 'gnus-summary-edit-global-kill #[nil "À ÂÃ!ˆÄÅÆ!!‡" [gnus-summary-article-number gnus-current-kill-article gnus-kill-file-edit-file nil message substitute-command-keys "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)"] 3 "\ Edit a global KILL file." nil]) (defalias 'gnus-summary-edit-local-kill #[nil "À  !ˆÄÅÆ!!‡" [gnus-summary-article-number gnus-current-kill-article gnus-kill-file-edit-file gnus-newsgroup-name message substitute-command-keys "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)"] 3 "\ Edit a local KILL file applied to the current newsgroup." nil]) (defalias 'gnus-summary-exit #[(&optional temporary) "À \n ÆÇ!ˆÈ Ê \n\" #ˆ ƒ(Ì \n Í=$qˆ ƒ=Ï @Í\"ˆ A‰„0Ï !ˆ-Ð !ˆÑÒ!ˆ?…rÔ!ƒ^Ö!ˆÔ!ƒjÖ!ˆØÙ!ˆÚ!‡" [nil gnus-newsgroup-headers gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked updated run-hooks gnus-exit-group-hook gnus-update-unread-articles gnus-newsgroup-name append gnus-use-cross-reference gnus-mark-as-read-by-xref t gnus-group-buffer gnus-group-update-group gnus-group-jump-to-group gnus-group-next-unread-group 1 temporary get-buffer gnus-summary-buffer bury-buffer gnus-article-buffer gnus-configure-windows newsgroups pop-to-buffer] 7 "\ 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." nil]) (defalias 'gnus-summary-quit #[nil "ÀÁ!…1ÂÃ!ˆÄ !ƒÆ !ˆÄ!ƒ Æ!ˆÈÉ!ˆÊ !ˆÌ !ˆÎÏ!‡" [y-or-n-p "Do you really wanna quit reading this group? " message "" get-buffer gnus-summary-buffer bury-buffer gnus-article-buffer gnus-configure-windows newsgroups pop-to-buffer gnus-group-buffer gnus-group-jump-to-group gnus-newsgroup-name gnus-group-next-group 1] 2 "\ Quit reading current newsgroup without updating read article info." nil]) (defalias 'gnus-summary-describe-briefly #[nil "ÀÁÂ!ÁÃ!ÁÄ!ÁÅ!ÁÆ!ÁÇ!°!‡" [message 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"] 8 "\ Describe Summary mode commands briefly." nil]) (byte-code "„;Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÍ#ˆÃÏÐ#ˆÃÑÒ#ˆÁ‡" [gnus-article-mode-map make-keymap suppress-keymap define-key " " gnus-article-next-page "" gnus-article-prev-page "r" gnus-article-refer-article "o" gnus-article-pop-article "h" gnus-article-show-summary "s" "?" gnus-article-describe-briefly " " gnus-info-find-node] 4) (defalias 'gnus-article-mode #[nil "À ˆÁÂ!ƒÃ‚ÄÅ!<ƒÃÄÅ!ABÆÈ ÊË!ˆÌ ž„5ÌÍD B Î ˆÏ!ˆÊÑ!ˆÊÓ!ˆÔÕp!ˆÖØÙ!‡" [kill-all-local-variables boundp mode-line-modified "--- " default-value mode-line-format gnus-article-mode major-mode "Article" mode-name make-local-variable minor-mode-alist gnus-show-mime " MIME" gnus-article-set-mode-line use-local-map gnus-article-mode-map page-delimiter gnus-page-delimiter mail-header-separator "" buffer-flush-undo t buffer-read-only run-hooks gnus-article-mode-hook] 3 "\ Major mode for browsing through an article. All normal editing commands are turned off. Instead, these commands are available: \\{gnus-article-mode-map} Various hooks for customization: gnus-article-mode-hook Entry to this mode calls the value with no arguments, if that value is non-nil. gnus-article-prepare-hook Called with no arguments after an article is prepared for reading, if that value is non-nil." nil]) (defalias 'gnus-article-setup-buffer #[nil "À !†ŠÂ !qˆÃ )‡" [get-buffer gnus-article-buffer get-buffer-create gnus-article-mode] 2 "\ Initialize Article mode buffer."]) (defalias 'gnus-article-prepare #[(article &optional all-headers) "À „ Á ˆÂ !ˆŠ qˆÅÇ ˆ;… É!‰\nƒ-\nËH‚/Ì!*ƒÍ!ˆ†E??§ƒi=„iÔ!Ö×!ˆ§ƒrÅÖÙ!ˆƒ…ÛÜ!ƒ… ˆ„Þ ˆebˆƒ˜à ˆá ‚®§ƒ¨â!ˆã ˆäå!*‡" [gnus-server-opened gnus-start-news-server gnus-request-group gnus-newsgroup-name gnus-article-buffer nil buffer-read-only erase-buffer article gnus-get-header-by-id header 0 gnus-request-article insert-buffer-substring nntp-server-buffer all-headers gnus-show-all-headers gnus-have-all-headers gnus-current-article gnus-last-article gnus-get-header-by-number gnus-current-headers run-hooks gnus-mark-article-hook gnus-current-history gnus-article-prepare-hook gnus-show-mime gnus-fetch-field "Mime-Version" gnus-show-mime-method gnus-article-delete-headers gnus-break-pages gnus-narrow-to-page gnus-article-set-mode-line gnus-summary-mark-as-read ding message "No such article (may be canceled)"] 3 "\ Prepare ARTICLE in Article mode buffer. ARTICLE can be either a article number or Message-ID. If optional argument ALL-HEADERS is non-nil, all headers are inserted."]) (defalias 'gnus-article-show-all-headers #[nil "†Á\nÃ\"‡" [gnus-have-all-headers gnus-article-prepare gnus-current-article t] 3 "\ Show all article headers in Article mode buffer."]) (defalias 'gnus-article-set-mode-line #[nil "À ƒ ÂH‚ ÃÆÇ ƒÆÊ \"‚ Ã Ë G ^O G Vƒ2Ì‚3ÃÍËÎ GZ]Ï\"&*ÑÒ!‡" [15 gnus-current-headers 1 "" subject maxlen format "GNUS: %s%s %s%s%s" gnus-newsgroup-name gnus-current-article "/%d" 0 "..." make-string 17 32 mode-line-buffer-identification set-buffer-modified-p t] 10 "\ Set Article mode line string. If you don't like it, define your own gnus-article-set-mode-line."]) (defalias 'gnus-article-delete-headers #[nil "ŠŒebˆeÀÁÂÃ#ˆ`}ˆebˆ ;…0Å ÂÆ#…0Çyˆ`ÅÈ!ˆÉuˆ`|ˆ‚*‡" [search-forward "\n\n" nil move gnus-ignored-headers re-search-forward t 0 "\n[^ ]" -1] 5 "\ Delete unnecessary headers."]) (defalias 'gnus-article-next-page #[(lines) "ÀÁ!ˆŠÂˆÃ …m)ƒ* ƒ\"ŠŒ~ˆÅ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 "\ Show next page of current article. If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." "P"]) (defalias 'gnus-article-prev-page #[(lines) "ÀÁ!ˆ\nƒoƒŒ~ˆo)„ÃÄ!ˆdbˆÅÄ!‡Æ!‡" [move-to-window-line 0 gnus-break-pages gnus-narrow-to-page -1 recenter scroll-down lines] 2 "\ Show previous page of current article. Argument LINES specifies lines to be scrolled down." "P"]) (defalias 'gnus-article-next-digest #[(nth) "~ˆÀˆ ÂVƒà ÀÅ#ƒ S‰‚à ÀÆ#ƒL`ÀˆÃ ÀÆ#ƒ:ÈÉ!ˆÂyˆ‚=dbˆÊ ˆbˆËyˆÌÂ!)‡ÍÎ!‡" [nil nth 1 re-search-forward gnus-digest-separator move t begin search-backward "\n\n" push-mark 0 recenter message "End of message"] 5 "\ Move to head of NTH next digested message. Set mark at end of digested message."]) (defalias 'gnus-article-prev-digest #[(nth) "~ˆÀyˆ ÂVƒà ÅÆ#ƒ S‰‚à ÅÇ#ƒI`ÅˆÉ ÅÇ#ƒ:ÊË!ˆÂyˆ‚=dbˆÌ ˆbˆÍÂ!)‡ebˆÎÏ!‡" [0 nth 1 re-search-backward gnus-digest-separator nil move t begin re-search-forward search-backward "\n\n" push-mark recenter message "Top of message"] 5 "\ Move to head of NTH previous digested message."]) (defalias 'gnus-article-refer-article #[nil "À‹‡" [((byte-code "ŠÀÁÂÃ#ˆÄÅÂÃ#ƒ\"Ɣƕ{qˆÉ!)‚%ÊË!)‡" [re-search-forward ">" nil t re-search-backward "\\(<[^<> \n]+>\\)" 1 message-id gnus-summary-buffer gnus-summary-refer-article error "No references around point"] 4))] 1 "\ Read article specified by message-id around point." nil]) (defalias 'gnus-article-pop-article #[nil "À‹‡" [((byte-code "qˆÁÂ!‡" [gnus-summary-buffer gnus-summary-refer-article nil] 2))] 1 "\ Pop up article history." nil]) (defalias 'gnus-article-show-summary #[nil "ÀÁ!ˆÂ !ˆÄ !‡" [gnus-configure-windows article pop-to-buffer gnus-summary-buffer gnus-summary-goto-subject gnus-current-article] 2 "\ Reconfigure windows to show Summary buffer." nil]) (defalias 'gnus-article-describe-briefly #[nil "ÀÁÂ!ÁÃ!ÁÄ!ÁÅ!ÁÆ!°!‡" [message 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"] 7 "\ Describe Article mode commands briefly." nil]) (byte-code "„,Á\n!ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÁ‡" [gnus-kill-file-mode-map copy-keymap emacs-lisp-mode-map define-key " " gnus-kill-file-kill-by-subject " " gnus-kill-file-kill-by-author "" gnus-kill-file-apply-buffer "" gnus-kill-file-apply-last-sexp "" gnus-kill-file-exit " " gnus-info-find-node] 4) (defalias 'gnus-kill-file-mode #[nil "À ˆÁ\n!ˆÃ !ˆÅÇÉÊ!ˆËÌÍ\"‡" [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-File" mode-name lisp-mode-variables nil run-hooks emacs-lisp-mode-hook gnus-kill-file-mode-hook] 3 "\ Major mode for editing KILL file. In addition to Emacs-Lisp Mode, the following commands are available: \\[gnus-kill-file-kill-by-subject] Insert KILL command for current subject. \\[gnus-kill-file-kill-by-author] Insert KILL command for current author. \\[gnus-kill-file-apply-buffer] Apply current buffer to selected newsgroup. \\[gnus-kill-file-apply-last-sexp] Apply sexp before point to selected newsgroup. \\[gnus-kill-file-exit] Save file and exit editing KILL file. \\[gnus-info-find-node] Read Info about KILL file. 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 is default 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." nil]) (defalias 'gnus-kill-file-edit-file #[(newsgroup) "À !ÃÄ\n!!ˆÅ\n!ƒÆÅ\n!!„Ç É\n!\nÆ\n!ƒ0Ë\n!ˆ‚r Í=ƒQÎÏ!ˆË!ˆ\nÎÒ!ˆË\n!ˆ)‚r Ó=ƒnÎÔ!ˆË!ˆÖ!ˆ×\n!ˆ‚rØ\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 (1 0 0) gnus-group-buffer gnus-summary-buffer (1 1 0) gnus-summary-mode article gnus-article-buffer bury-buffer switch-to-buffer find-file-other-window gnus-kill-file-mode] 3 "\ Begin editing a KILL file of NEWSGROUP. If NEWSGROUP is nil, the global KILL file is selected." "sNewsgroup: "]) (defalias 'gnus-kill-file-kill-by-subject #[nil "ÀÁ ƒÄÅ \"ÇH!‚È!\"c‡" [format "(gnus-kill \"Subject\" %s)\n" prin1-to-string gnus-current-kill-article regexp-quote gnus-find-header-by-number gnus-newsgroup-headers 1 ""] 7 "\ Insert KILL command for current subject." nil]) (defalias 'gnus-kill-file-kill-by-author #[nil "ÀÁ ƒÄÅ \"ÇH!‚È!\"c‡" [format "(gnus-kill \"From\" %s)\n" prin1-to-string gnus-current-kill-article regexp-quote gnus-find-header-by-number gnus-newsgroup-headers 2 ""] 7 "\ Insert KILL command for current author." nil]) (defalias 'gnus-kill-file-apply-buffer #[nil "ƒÁ\n!ƒÃÄ ÅQŠÇ‹*‡È ˆÉÊ!‡" [gnus-current-kill-article get-buffer gnus-summary-buffer "(progn \n" buffer-string "\n)" string ((byte-code "À !ˆÂà !@!‡" [pop-to-buffer gnus-summary-buffer eval read-from-string string] 3)) ding message "No newsgroup is selected."] 3 "\ Apply current buffer to current newsgroup." nil]) (defalias 'gnus-kill-file-apply-last-sexp #[nil "ƒÁ\n!ƒŠÃÄ!ˆ`)`{ŠÆ‹*‡Ç ˆÈÉ!‡" [gnus-current-kill-article get-buffer gnus-summary-buffer forward-sexp -1 string ((byte-code "À !ˆÂà !@!‡" [pop-to-buffer gnus-summary-buffer eval read-from-string string] 3)) ding message "No newsgroup is selected."] 2 "\ Apply sexp before point in current buffer to current newsgroup." nil]) (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] 3 "\ Save a KILL file, then return to the previous buffer." nil]) (defalias 'gnus-batch-kill #[nil "„ÁÂ!ˆÃÃÃÇÈÉÊË \"\"!‰ @ AÃÃÃÃ Ó ˆÔ!ƒ“@@@A@A ƒ9Ö \"JA@ØU„9ƒlÙ \"‚mÚƒ9ƒ}Ù \"„9Û ÃÚ#ˆpÜ!=ƒ9ÞÚ!ˆ‚9qˆà . ‡" [noninteractive error "gnus-batch-kill is to be used only with -batch" nil group subscribed newsrc gnus-parse-n-options apply concat mapcar #[(g) "ÁP‡" [g " "] 2] command-line-args-left yes-and-no yes no gnus-novice-user gnus-large-newsgroup nntp-large-newsgroup gnus copy-sequence gnus-newsrc-assoc intern-soft gnus-unread-hashtb 0 string-match t gnus-summary-read-group get-buffer gnus-summary-buffer gnus-summary-exit gnus-group-buffer gnus-group-exit] 7 "\ Run batched KILL. Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."]) (defalias 'gnus-Numeric-save-name #[(newsgroup headers &optional last-file) "À ƒ  !‚Ä !ÅÆÈH!Q †Ê\"  ƒ?Í !Í !˜ƒ?ÎÏÐ !\"ƒ? ‚F †F )‡" [expand-file-name gnus-use-long-file-name 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 "\ 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) "À ƒ \n‚ Ã\n!ÄÅÇH!Q†É\"\n ƒ=Ì\n!Ì !˜ƒ=ÍÎÏ !\"ƒ=\n‚D †D\n)‡" [expand-file-name gnus-use-long-file-name 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 "\ 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-Plain-save-name #[(newsgroup headers &optional last-file) "†Á\nƒà !‚Å !ÆP†È\"‡" [last-file expand-file-name gnus-use-long-file-name gnus-capitalize-newsgroup newsgroup gnus-newsgroup-directory-form "/news" gnus-article-save-directory "~/News"] 3 "\ Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group. Otherwise, it is like ~/News/news/group/news."]) (defalias 'gnus-plain-save-name #[(newsgroup headers &optional last-file) "†Á\nƒ ‚Ä !ÅP†Ç\"‡" [last-file expand-file-name gnus-use-long-file-name newsgroup gnus-newsgroup-directory-form "/news" gnus-article-save-directory "~/News"] 3 "\ Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group. Otherwise, it is like ~/News/news/group/news."]) (defalias 'gnus-Folder-save-name #[(newsgroup headers &optional last-folder) "†Á\nƒà !‚Å !P‡" [last-folder "+" gnus-use-long-file-name gnus-capitalize-newsgroup newsgroup gnus-newsgroup-directory-form] 3 "\ 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 "\ 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-apply-kill-file #[nil "ÀÁÂ!ÃÂÃ$ˆÀÁ !ÃÂÃ$‡" [load gnus-newsgroup-kill-file nil t gnus-newsgroup-name] 5 "\ Apply KILL file to the current newsgroup."]) (defalias 'gnus-Newsgroup-kill-file #[(newsgroup) "ƒ\nÁ˜ƒ †Å\"‡ƒ&ÂÇ!È Q †$Å\"‡ÂÉ!Ê Q †2Å\"‡" [newsgroup "" expand-file-name gnus-kill-file-name gnus-article-save-directory "~/News" gnus-use-long-file-name gnus-capitalize-newsgroup "." gnus-newsgroup-directory-form "/"] 4 "\ Return the name of a KILL file of NEWSGROUP. If NEWSGROUP is nil, return the global KILL file instead."]) (defalias 'gnus-newsgroup-kill-file #[(newsgroup) "ƒ\nÁ˜ƒ †Å\"‡ƒ$ÂÇ Q †\"Å\"‡ÂÈ!É Q †0Å\"‡" [newsgroup "" expand-file-name gnus-kill-file-name gnus-article-save-directory "~/News" gnus-use-long-file-name "." gnus-newsgroup-directory-form "/"] 4 "\ Return the name of a KILL file of NEWSGROUP. If NEWSGROUP is nil, return the global KILL file instead."]) (defalias 'gnus-subscribe-randomly #[(newsgroup) "À \n@@\"‡" [gnus-subscribe-newsgroup newsgroup gnus-newsrc-assoc] 3 "\ Subscribe new NEWSGROUP and insert it at the beginning of newsgroups."]) (defalias 'gnus-subscribe-alphabetically #[(newgroup) "Á\n„\" ƒ\" @@™ƒ @@‰‚ A‚Å \n\"*‡" [gnus-newsrc-assoc nil before groups newgroup gnus-subscribe-newsgroup] 4 "\ Subscribe new NEWSGROUP and insert it in strict alphabetic order."]) (defalias 'gnus-subscribe-hierarchically #[(newgroup) "ŠÀ !qˆ\nà „D ƒDebˆÆÇ !ÈQ Ê ÃË#ƒ2̔̕{‰\n™„)ÍÎ \"…@ ̔̕O‚\nÏ\n \"+‡" [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 "\ Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."]) (defalias 'gnus-subscribe-interactively #[(newsgroup) "ÀÁ \"!ƒ Ä !‡Å !ˆÆ !‡" [y-or-n-p format "Subscribe new newsgroup: %s " newsgroup gnus-subscribe-hierarchically gnus-subscribe-newsgroup gnus-kill-newsgroup] 4 "\ Subscribe new NEWSGROUP interactively. It is inserted in hierarchical newsgroup order if subscribed. Unless, it is killed."]) (defalias 'gnus-subscribe-newsgroup #[(newsgroup &optional next) "À ÂD \"ˆÄÅ \"‡" [gnus-insert-newsgroup newsgroup t next message "Subscribe newsgroup: %s"] 3 "\ Subscribe new NEWSGROUP. If optional argument NEXT is non-nil, it is inserted before NEXT."]) (defalias 'gnus-newsgroup-directory-form #[(newsgroup) "ÁÂOGÁ Wƒ$ HÅUƒ ÆIˆ T‰‚ +‡" [newsgroup 0 nil idx len 46 47] 4 "\ Make hierarchical directory name from NEWSGROUP name."]) (defalias 'gnus-make-directory #[(directory) "À \n\"à !†ÄÅ \")‡" [expand-file-name directory default-directory file-exists-p gnus-make-directory-1 ""] 3 "\ Make DIRECTORY recursively."]) (defalias (quote gnus-make-directory-1) #[(head tail) "ÀÁ\n\"ƒ2ÔÕÆ!\n OPÈ!„(ÉÊˉ‰%ˆÌ\n ËO\"*‡\n͘…9·" [string-match "^/\\([^/]+\\)" tail 1 end beg file-name-as-directory head file-exists-p call-process "mkdir" nil gnus-make-directory-1 "" t] 6]) (defalias 'gnus-capitalize-newsgroup #[(newsgroup) "ÀÁ !ÃŽÄÅÆ\"ˆÄÇÆ\"ˆÈ !*‡" [copy-syntax-table syntax-table current-syntax-table ((set-syntax-table current-syntax-table)) modify-syntax-entry 45 "w" 46 capitalize newsgroup] 3 "\ Capitalize NEWSGROUP name with treating '.' and '-' as part of words."]) (defalias 'gnus-simplify-subject #[(subject &optional re-only) "ÀÂà \"ƒ Å•ÆO„$ÂÈ \"ƒ$ ʼn”O‚ )‡" [t case-fold-search string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ ]+\\)+" subject 0 nil re-only "[ \n]*([^()]*)[ \n]*\\'"] 3 "\ Remove `Re:' and words in parentheses. If optional argument RE-ONLY is non-nil, strip `Re:' only."]) (defalias 'gnus-optional-lines-and-from #[(header) "ÀGÂà ÅHÆ ÇH!È É\"P#Ê Å\\O)‡" ["umerin@photon" name-length format "%3d:%s" header 4 mail-strip-quoted-names 2 make-string 32 0] 7 "\ Return a string like `NNN:AUTHOR' from HEADER."]) (defalias 'gnus-optional-lines #[(header) "ÀÁ\nÃH\"‡" [format "%4d" header 4] 4 "\ Return a string like `NNN' from HEADER."]) (defalias 'gnus-keysort-headers #[(predicate key &optional reverse) "À\nƒà Ÿ #Ÿ‚à #‰)‡" [t inhibit-quit reverse gnus-keysort gnus-newsgroup-headers predicate key] 4 "\ Sort current headers by PREDICATE using a value passed by KEY safely. *Safely* means C-g quitting is disabled during sort. Optional argument REVERSE means reverse order."]) (defalias 'gnus-keysort #[(list predicate key) "ÀÁÂÀà \"Å\"\"‡" [mapcar cdr sort #[(a) " ! B‡" [key a] 2] list #[(a b) " @\n@\"‡" [predicate a b] 3]] 6 "\ Sort LIST by PREDICATE using a value passed by KEY."]) (defalias 'gnus-sort-headers #[(predicate &optional reverse) "À\nƒà Ÿ \"Ÿ‚à \"‰)‡" [t inhibit-quit reverse sort gnus-newsgroup-headers predicate] 3 "\ Sort current headers by PREDICATE safely. *Safely* means C-g quitting is disabled during sort. Optional argument REVERSE means reverse order."]) (defalias 'gnus-string-lessp #[(a b) "ƒ\n —\n—™‡ \n™‡" [case-fold-search a b] 2 "\ Return T if first arg string is less than second in lexicographic order. If case-fold-search is non-nil, case of letters is ignored."]) (defalias 'gnus-date-lessp #[(date1 date2) "À !À\n!™‡" [gnus-sortable-date date1 date2] 3 "\ Return T if DATE1 is earlyer than DATE2."]) (defalias 'gnus-sortable-date #[(date) "À ! ÃH! ÅH! ÇH! ÉH\nË \n$-‡" [timezone-parse-date date string-to-int 0 year 1 month 2 day 3 time timezone-make-sortable-date] 5 "\ Make sortable string by string-lessp from DATE. Timezone package is used."]) (defalias 'gnus-fetch-field #[(field) "ŠŒ~ˆebˆeÀÁÂÃ#ˆ`}ˆÄ !*‡" [search-forward "\n\n" nil move mail-fetch-field field] 5 "\ Return the value of the header FIELD of current article."]) (fset (quote gnus-expunge) (quote gnus-summary-delete-marked-with)) (defalias 'gnus-kill #[(field regexp &optional command all) "ŠÀ‹)‡" [((byte-code "À Â\"ˆebˆ „ÄÅ È ?%‡" [switch-to-buffer gnus-summary-buffer norecord command (gnus-summary-mark-as-read nil "X") gnus-execute field regexp nil all] 6))] 1 "\ 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-execute #[(field regexp form &optional backward ignore-marked) "À‰‰ ŘƒÀ ƒ7 ;„Æ !ÇÈ —P!‰ƒ2É !ƒ2 K‚7ÊË \"ˆ <ƒL @Í=„LÍÀ E ƒfÏ ‰ƒf >ƒn >„nÒ  #ˆÔÀ#…ƒÒ  #ˆ‚n+‡" [nil article header function field "" symbol-name intern-soft "gnus-header-" fboundp error "Unknown header field: \"%s\"" form lambda ignore-marked gnus-summary-article-number gnus-newsgroup-unreads gnus-newsgroup-marked gnus-execute-1 regexp gnus-summary-search-subject backward] 5 "\ 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 unread are ignored."]) (defalias (quote gnus-execute-1) #[(function regexp form) "ŠÀ ‰??…\nƒCà !ĉ…?\n!‰;„'Ç !È \"…?\n;ƒ<Ë\n!‚?\n *‚ĉ‰‰  ÐÑ \"ˆÒ ˆÓ Ô\"ˆŠqˆebˆÖ ÄÔ#)…~\n;ƒ{Ë\n!‚~\n ,*‡" [gnus-summary-article-number article function gnus-get-header-by-number nil value header 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..." gnus-article-setup-buffer gnus-article-prepare t gnus-article-buffer re-search-forward] 5]) (defalias 'gnus-caesar-region #[(&optional n) "§„\nÁ‚ÂÃ\"ÄU?…/ÅÆ!ƒ'ÇHÇ\\U„çÄÈÉ\n  ÍÎ!ˆÏÐÄ\" ÐWƒQ ‰Iˆ T‰ ‚< ‰P‰ –\nÄ ÄÃWƒ‹ Ç\\  \\HIˆ Ñ\\\n \\HIˆ T‰ ‚_Ò ÓÒÔ ÐWƒá  H‰XƒÄWƒ½‚ÕÙ\\‚ÕXƒÓÙZ‚Õ)Iˆ T‰ ‚™+ÍÚ!ˆ+Û Ü Äɉ ‰ {‰G Wƒ!  HHIˆ T‰ ‚ 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 161 207 254 t3 t2 t1 v 47 "Building caesar-translate-table... done" region-beginning region-end len str to from] 6 "\ Caesar rotation of region by N, default 13, for decrypting netnews. ROT47 will be performed for Japanese text in any case." (byte-code "ƒ Á!C‡ÂC‡" [current-prefix-arg prefix-numeric-value nil] 2)]) (defalias 'gnus-header-number #[(header) "ÁH‡" [header 0] 2 "\ Return article number in HEADER."]) (defalias 'gnus-header-subject #[(header) "ÁH‡" [header 1] 2 "\ Return subject string in HEADER."]) (defalias 'gnus-header-from #[(header) "ÁH‡" [header 2] 2 "\ Return author string in HEADER."]) (defalias 'gnus-header-xref #[(header) "ÁH‡" [header 3] 2 "\ Return xref string in HEADER."]) (defalias 'gnus-header-lines #[(header) "ÁH‡" [header 4] 2 "\ Return lines in HEADER."]) (defalias 'gnus-header-date #[(header) "ÁH‡" [header 5] 2 "\ Return date in HEADER."]) (defalias 'gnus-header-id #[(header) "ÁH‡" [header 6] 2 "\ Return Id in HEADER."]) (defalias 'gnus-header-references #[(header) "ÁH‡" [header 7] 2 "\ Return references in HEADER."]) (defalias 'gnus-output-to-rmail #[(file-name) "ÀÁ!ˆÂ !‰pÅÆ!ŠÉ !„NÊ !„NËÌ ÍQ!ƒJÎ !ŠqˆÐ ˆÑÓed ÔÕ%ˆ*Ö!ˆ)‚N×Ø!ˆqˆÙp!ˆÚ ˆÛ!ˆÜ ˆÉ !‰„sÞed #ˆ‚´qˆÑßà!…€ !\"!ƒ~ˆdd}ˆÛ!ˆ!ƒ³ebˆ~ˆãä!ˆ`d}ˆeTbˆåÔ!ˆæ!!ˆ**Ö!*‡" [require rmail expand-file-name file-name rmail-last-rmail-file get-buffer-create " *GNUS-output*" tmpbuf artbuf 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 1 kill-buffer error "Output file does not exist" buffer-flush-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 "\ Append the current article to an Rmail file named FILE-NAME."]) (defalias 'gnus-output-to-file #[(file-name) "À !pÂÃ!Š qˆÆp!ˆÇ ˆÈ !ˆdbˆÉcˆÊed #ˆ)Ë !*‡" [expand-file-name file-name get-buffer-create " *GNUS-output*" tmpbuf artbuf buffer-flush-undo erase-buffer insert-buffer-substring "\n" append-to-file kill-buffer] 4 "\ Append the current article to a file named FILE-NAME."]) (defalias 'gnus-convert-article-to-rmail #[nil "ÀebˆÂcˆÃÄÀÅ#ƒÆÇ!ˆ‚dbˆÈc)‡" [nil buffer-read-only " \n0, unseen,,\n*** EOOH ***\n" search-forward "\n" t replace-match "\n^_" ""] 4 "\ Convert article in current buffer to Rmail message format."]) (defalias 'gnus-start-news-server #[(&optional confirm) "À ?…œ „\n„4 ƒ2ÄÅ!ƒ* ƒ*ÆÇ\nC Bȉ\n%‚4ÉÇ\n\"‚4Ê\nʘ„@\n˘ƒCÌ  „]\nÌ ˜ƒ]ÍÎ!ˆÏÎ!ˆÐÑ!ˆ‚|ÒÓ\n\"ƒsÍÔ!ˆÏÔ!ˆÐÕ!ˆ‚|ÏÖ!ˆÐ×\n\"ˆØÙ!ˆÀ ƒ‰ÐÊ!‡Ú\n \"ƒ”ÐÊ!‡ÛÜÝÞ\n\"!!‡" [gnus-server-opened confirm gnus-nntp-server gnus-nntp-service boundp gnus-secondary-servers completing-read "NNTP server: " nil read-string "" "::" system-name require nnspool gnus-define-access-method message "Looking up local news spool..." string-match ":" mhspool "Looking up private directory..." nntp "Connecting to NNTP server on %s..." run-hooks gnus-open-server-hook gnus-open-server error gnus-nntp-message format "Cannot open NNTP server on %s"] 6 "\ Open network stream to remote NNTP server. If optional argument CONFIRM is non-nil, ask you host that NNTP server is running even if it is defined. Run gnus-open-server-hook just before opening news server."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias gnus-server-opened (lambda nil) gnus-close-server (lambda nil)] 3) (defalias 'gnus-nntp-message #[(&optional message) "À †Â‰;ƒ GÄVƒ ‚ *‡" [gnus-status-message message "" status 0] 3 "\ Return a message returned from NNTP server. If no message is available and optional MESSAGE is given, return it."]) (defalias 'gnus-define-access-method #[(method &optional access-methods) "À \n† \"A‰„ÅÆ \"‚* …* @@ @A@Mˆ A‰„Ç)‡" [assoc method access-methods gnus-access-methods bindings error "Unknown access method: %s" nil] 4 "\ Define access functions for the access METHOD. Methods definition is taken from optional argument ACCESS-METHODS or the variable gnus-access-methods."]) (defalias 'gnus-select-newsgroup #[(group &optional show-all) "À ˆÁ\n!…ýÃ\nÆÇ\n\"JAA! \nƒ,ÆÇ\n \"JAA!‚/ à  §ƒ›Ã G VƒšÃÐшÒVƒfWƒfZ ›‚“ÒWƒŠ[WƒŠ[Ó !S ›Ã¡ˆ‚“ÒUƒ“ÃÔ \" *Õ !× ØÙ\"\" ×Ú  \"Ç\n\"JA\"ƒÉ@ÒH‚ÊÒƒÚÞ!ÒH‚ÛÒà Ã!Ã\"Ã#Ã$Ã%Ã&Ã'Ã(é ˆ)ê‡" [gnus-start-news-server gnus-request-group group nil articles gnus-newsgroup-name gnus-uncompress-sequence intern-soft gnus-unread-hashtb gnus-newsgroup-unreads show-all gnus-active-hashtb gnus-newsgroup-unselected gnus-large-newsgroup number selected (byte-code "ÀÁ #!‰Ƙƒ ‚Ç !)À‡" [read-string format "How many articles from %s (default %d): " gnus-newsgroup-name number input "" string-to-int selected] 6) ((quit (byte-code "ÀÀ‡" [0 selected] 1))) 0 copy-sequence gnus-set-difference gnus-retrieve-headers gnus-newsgroup-headers gnus-intersection mapcar #[(header) "ÁH‡" [header 0] 2] append gnus-marked-hashtb gnus-newsgroup-marked gnus-newsgroup-begin gnus-last-element gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-current-article gnus-current-headers gnus-current-history gnus-have-all-headers gnus-last-article gnus-clear-hashtables-for-newsgroup-headers t] 5 "\ Select newsgroup GROUP. If optional argument SHOW-ALL is non-nil, all of articles in the group are selected."]) (defalias 'gnus-get-header-by-number #[(number) "„Á ˆÂà !\"J‡" [gnus-newsgroup-headers-hashtb-by-number gnus-make-headers-hashtable-by-number intern-soft int-to-string number] 3 "\ Return a header specified by a NUMBER. If the variable gnus-newsgroup-headers is updated, the hashed table gnus-newsgroup-headers-hashtb-by-number must be set to nil to indicate rehash is necessary."]) (defalias 'gnus-get-header-by-id #[(id) "„Á ˆ\n;…Ã\n\"J‡" [gnus-newsgroup-headers-hashtb-by-id gnus-make-headers-hashtable-by-id id intern-soft] 3 "\ Return a header specified by an ID. If the variable gnus-newsgroup-headers is updated, the hashed table gnus-newsgroup-headers-hashtb-by-id must be set to nil to indicate rehash is necessary."]) (defalias 'gnus-make-headers-hashtable-by-number #[nil "À Ä\nGÅ]Æ\"\n…(\n@ÈÉ ÆH!\" Lˆ\nA‰„À*‡" [nil gnus-newsgroup-headers headers header make-vector 200 0 gnus-newsgroup-headers-hashtb-by-number intern int-to-string] 5 "\ Make hashtable for the variable gnus-newsgroup-headers by number."]) (defalias 'gnus-make-headers-hashtable-by-id #[nil "À Ä\nGÅ]Æ\"\n…&\n@È ÉH\" Lˆ\nA‰„À*‡" [nil gnus-newsgroup-headers headers header make-vector 200 0 gnus-newsgroup-headers-hashtb-by-id intern 6] 4 "\ Make hashtable for the variable gnus-newsgroup-headers by id."]) (defalias 'gnus-clear-hashtables-for-newsgroup-headers #[nil "ÀÀ‰‡" [nil gnus-newsgroup-headers-hashtb-by-id gnus-newsgroup-headers-hashtb-by-number] 2 "\ Clear hash tables created for the variable gnus-newsgroup-headers."]) (defalias 'gnus-more-header-backward #[nil "ÀÁ\n \"J8@ Å„.Vƒ.SÉC!@‰ƒ+‡" [2 intern-soft gnus-newsgroup-name gnus-active-hashtb gnus-newsgroup-begin nil header artnum first gnus-retrieve-headers] 5 "\ Find new header backward."]) (defalias 'gnus-more-header-forward #[nil "ÀÁ\n \"J8A Å„.Wƒ.TÉC!@‰ƒ+‡" [2 intern-soft gnus-newsgroup-name gnus-active-hashtb gnus-newsgroup-end nil header artnum last gnus-retrieve-headers] 5 "\ Find new header forward."]) (defalias 'gnus-extend-newsgroup #[(header &optional backward) "…=ÁH ƒ B‚Å C\"Æ ˆ\n>ƒ(\nBÉ\n\"\n\n^\n \n]‰ )‡" [header 0 artnum backward gnus-newsgroup-headers append gnus-clear-hashtables-for-newsgroup-headers gnus-newsgroup-unselected gnus-newsgroup-unreads delq gnus-newsgroup-begin gnus-newsgroup-end] 3 "\ Extend newsgroup selection with HEADER. Optional argument BACKWARD means extend toward backward."]) (defalias 'gnus-mark-article-as-read #[(article) "À \n\"À \"‰‡" [delq article gnus-newsgroup-unreads gnus-newsgroup-marked] 3 "\ Remember that ARTICLE is marked as read."]) (defalias 'gnus-mark-article-as-unread #[(article &optional clear-mark) " >„\n B\nƒÃ \"‰‡ >†  B‰‡" [article gnus-newsgroup-unreads clear-mark delq gnus-newsgroup-marked] 3 "\ Remember that ARTICLE is marked as unread. Optional argument CLEAR-MARK means ARTICLE should not be remembered that it was marked as read once."]) (defalias 'gnus-clear-system #[nil "‰ƒ @ÂLˆ A‰„) Â\n  ƒ>Í !ƒ>ÎÍ !!ˆÂ ‰…aÑ@!ƒWÎ@!ˆA‰„IÂ)‡" [gnus-variable-list variables nil gnus-newsrc-hashtb gnus-marked-hashtb gnus-killed-hashtb gnus-active-hashtb gnus-octive-hashtb gnus-unread-hashtb gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-id gnus-newsgroup-headers-hashtb-by-number gnus-current-startup-file get-file-buffer kill-buffer gnus-buffer-list buffers get-buffer] 4 "\ Clear all variables and buffer."]) (defalias 'gnus-configure-windows #[(action) "<ƒ ‚ žA@à !Ã!Ã! Ê Ê ÍÍÍ\n?†R ?\n@ÍU=…R?\nA@ÍU=…R ?Ñ\n8ÍU=?…}Ò †g†g †gÓ !ˆƒzÕ ˆÖÓ ! ‚£ ƒ„Ö !‚…̓‘Ö!‚’Í ƒžÖ !‚ŸÍ\\\\ × Ø\"ˆÙ!ƒ´Ú!ˆÙ!ƒÀÚ!ˆÛÜ\n\" \n@ÍU„Ú \n@_ ¥]\nA@ÍU„ð \nA@_ ¥]Ñ\n8ÍU„ Ñ\n8_ ¥]\\\\ ÞÍ ÖÓ !Z]!ˆß!„9ß!ƒ1ß!„9à\\!ˆß!„Lß!„Là!ˆß!„\\× Ø\"ˆáâ!ˆß!„m×Ø\"ˆáâ!ˆÍU?…}ã ˆ×Ø\". ‡" [action gnus-window-configuration windows get-buffer-window gnus-group-buffer grpwin gnus-summary-buffer subwin gnus-article-buffer artwin nil winsum height 0 grpheight subheight artheight 2 select-window selected-window gnus-use-full-window delete-other-windows window-height switch-to-buffer norecord get-buffer delete-windows-on apply + window-min-height enlarge-window zerop split-window-vertically other-window 1 gnus-article-setup-buffer] 5 "\ Configure GNUS windows according to the next ACTION. The ACTION is either a symbol, such as `summary', or a configuration list such as `(1 1 2)'. If ACTION is not a list, configuration list is got from the variable gnus-window-configuration."]) (defalias 'gnus-find-header-by-number #[(headers number) "À\nƒ „ \n@ÄH=ƒ\n@\nA‰„ )‡" [nil found headers number 0] 4 "\ Return a header which is a element of HEADERS and has NUMBER."]) (defalias 'gnus-find-header-by-id #[(headers id) "À\nƒ „ \n@ÄH˜ƒ\n@\nA‰„ )‡" [nil found headers id 6] 4 "\ Return a header which is a element of HEADERS and has Message-ID."]) (defalias 'gnus-version #[nil "ÀÁ!ƒÀÂ!ƒÃÄ \n %‡ÀÁ!ƒ#ÃÇ  $‡ÀÂ!ƒ1ÃÇ \n$‡ÃÈ #‡" [boundp mhspool-version nnspool-version message "%s; %s; %s; %s" gnus-version nntp-version "%s; %s; %s" "%s; %s"] 6 "\ Version numbers of this version of GNUS." nil]) (defalias 'gnus-info-find-node #[nil "ÀÁ!ˆ\nÃ=ƒÄÅ!ˆÆ!ˆ‚%\nÈ=ƒ%ÄÉ!ˆÆ\n!ˆË\n žA@!‡" [require info major-mode gnus-group-mode gnus-configure-windows (1 0 0) pop-to-buffer gnus-group-buffer gnus-summary-mode (0 1 0) gnus-summary-buffer Info-goto-node gnus-info-nodes] 3 "\ Find Info documentation of GNUS." nil]) (defalias 'gnus-overload-functions #[(&optional overloads) "À †\n …3 @ AÄ @!„) AA@ƒ)Å AA@ÀÆ#ˆ @ A@Mˆ‚*‡" [nil overloads gnus-overload-functions defs fboundp load nomessage] 4 "\ Overload functions specified by optional argument OVERLOADS. If nothing is specified, use the variable gnus-overload-functions."]) (defalias 'gnus-make-threads #[(newsgroup-headers) "Á‰‰‰‰ƒi@AÈ !ƒ ÉH‰…<ÊË\"…<Ì͔͕O!„X ƒXÏ ÍHÐ\"Ï ÍHÐ\"˜„XÁ B\nB „ B‚ÑÒ Ÿ\".‡" [newsgroup-headers nil dependencies roots d h refer headers vectorp 7 string-match "\\(<[^<>]+>\\)[^>]*$" gnus-get-header-by-id 1 gnus-thread-ignore-subject gnus-simplify-subject re mapcar #[(root) "À \n\"‡" [gnus-make-threads-1 root dependencies] 3]] 7 "\ Make conversation threads tree from NEWSGROUP-HEADERS."]) (defalias (quote gnus-make-threads-1) #[(parent dependencies) "À‰ \nƒ(\n@\nA Aƒ ÆH AÆH=ƒ @ B‚ ÇÈ \"+B‡" [nil dependencies depends d children parent 6 mapcar #[(child) "À \n\"‡" [gnus-make-threads-1 child dependencies] 3]] 4]) (defalias 'gnus-narrow-to-page #[(&optional arg) "ƒ\nÁ!‚ ŠÃÄ!ˆ~ˆÂVƒ Ã!ˆ‚+ÂWƒ+ÃS!ˆÃ ˆ`ÃÄ!ˆlƒ>o„>Åyˆ`})‡" [arg prefix-numeric-value 0 forward-page -1 1] 3 "\ 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." "P"]) (defalias 'gnus-make-hashtable-from-alist #[(alist &optional hashsize) "À †\nGÃ]Ä\"\nƒ!Æ\n@@ \"\n@Lˆ\nA‰„ )‡" [make-vector hashsize alist 200 0 hashtb intern] 4 "\ Return hash table for ALIST. Optional argument HASHSIZE specifies the hashtable size. Hash key is a car of alist element, which must be a string."]) (defalias 'gnus-last-element #[(list) "À\nƒ\nA„\n@\nA‰„ )‡" [nil last list] 2 "\ Return last element of LIST."]) (defalias 'gnus-set-difference #[(list1 list2) "À !\nƒÃ\n@ \"\nA‰„ )‡" [copy-sequence list1 list2 delq] 4 "\ Return a list of elements of LIST1 that do not appear in LIST2."]) (defalias 'gnus-intersection #[(list1 list2) "À\nƒ\n@ >ƒ\n@ B\nA‰„ )‡" [nil result list2 list1] 3 "\ Return a list of elements that appear in both LIST1 and LIST2."]) (defalias 'gnus-setup-news #[(&optional rawfile) "… …\n… ??‰ƒÅÅÅÆ ˆ ƒ(Ç ˆÈ !ˆÉ ˆÊ ˆ …LË ‰ …K  @!ˆ A‰ „:Å))‡" [gnus-newsrc-assoc gnus-active-hashtb gnus-unread-hashtb rawfile init nil gnus-read-active-file gnus-read-distributions-file gnus-read-newsrc-file gnus-expire-marked-articles gnus-get-unread-articles gnus-find-new-newsgroups new-newsgroups gnus-subscribe-newsgroup-method] 3 "\ Setup news information. If optional argument RAWFILE is non-nil, force to read raw startup file."]) (defalias 'gnus-add-newsgroup #[(newsgroup) "À \n\"J?…\"À \"J…\"ÄÀ \"J† ÆD@@\"‡" [intern-soft newsgroup gnus-newsrc-hashtb gnus-active-hashtb gnus-insert-newsgroup gnus-killed-hashtb t gnus-newsrc-assoc] 4 "\ Subscribe new NEWSGROUP safely and put it at top."]) (defalias 'gnus-find-new-newsgroups #[nil "À‰ÃÄ \"ˆ *‡" [nil new-newsgroups group mapatoms #[(sym) "À ! ƒÄ \n\"ƒ …5Ä \n\"…5Æ\n\"J?…5Æ\n\"J?…5\n B‰ ‡" [symbol-name sym group gnus-newsrc-options-n-no string-match gnus-newsrc-options-n-yes intern-soft gnus-killed-hashtb gnus-newsrc-hashtb new-newsgroups] 3] gnus-active-hashtb] 3 "\ Looking for new newsgroups and return names. `-n' option of options line in .newsrc file is recognized."]) (defalias 'gnus-kill-newsgroup #[(group) "À \n\"J‰??…<Ä \"Æ \n\"ÇLˆ ÄÀ \"J \"B Æ \" LˆÆ \n\"ÇLˆË Ì\"ˆ )‡" [intern-soft group gnus-newsrc-hashtb info delq gnus-newsrc-assoc intern nil gnus-killed-hashtb gnus-killed-assoc gnus-unread-hashtb gnus-update-newsrc-buffer delete] 6 "\ Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."]) (defalias 'gnus-insert-newsgroup #[(info &optional next) "„ ÁÂ\"ˆ@ÄÅÆ \"J8AA\"Æ  \"Jƒ)ÁÊ \"ˆ  @@˜ƒ< B ‚ŒÍ A „pƒp @@˜ƒcщ‚JAA‚H:ƒB¡ˆ‚‹Ò B\" +Ó  \"LˆÔÆ \"J\"Ó \"ÍLˆ× Í #ˆÓ \" Ù!BBL*‡" [info error "Invalid argument: %s" group gnus-difference-of-range 2 intern-soft gnus-active-hashtb range gnus-newsrc-hashtb "Duplicated: %s" next gnus-newsrc-assoc nil tail rest found t append intern delq gnus-killed-hashtb gnus-killed-assoc gnus-update-newsrc-buffer gnus-unread-hashtb gnus-number-of-articles] 6 "\ Insert newsrc INFO entry before NEXT. If optional argument NEXT is nil, appended to the last."]) (defalias 'gnus-check-killed-newsgroups #[nil "À‰ \nƒ;\n@@ ƒ&Æ \"ƒ&ƒ4Æ \"ƒ4È  \"J„4\n@ B\nA‰„\n ŸÊ !‰ +‡" [nil gnus-killed-assoc old-killed new-killed group gnus-newsrc-options-n-no string-match gnus-newsrc-options-n-yes intern-soft gnus-newsrc-hashtb gnus-make-hashtable-from-alist gnus-killed-hashtb] 4 "\ Check consistency between gnus-newsrc-assoc and gnus-killed-assoc. gnus-killed-hashtb is also updated."]) (defalias 'gnus-check-bogus-newsgroups #[(&optional confirm) "À À‰\nÀ À \n ÌÍ!ˆ\nƒY\n@@ Î \"J„>ƒIÑÒÓ \"!„I\n@ B ‚P B\nA‰\n„ ŸÔ !ƒ’@@ Î \"Jƒ‰Î \"J„‰@BA‰„gŸÔ\n!ƒ°×@Ø\"ˆA‰„  ƒÕ @@ @AƒÎÎ \"JƒÎ @ B A‰„´ Ô !ÌÚ!.‡" [nil gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc new-marked old-marked new-killed old-killed bogus new-newsrc old-newsrc group message "Checking bogus newsgroups..." intern-soft gnus-active-hashtb confirm y-or-n-p format "Delete bogus newsgroup: %s " gnus-make-hashtable-from-alist gnus-newsrc-hashtb gnus-killed-hashtb gnus-update-newsrc-buffer delete gnus-marked-hashtb "Checking bogus newsgroups... done"] 9 "\ Delete bogus newsgroups. If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."]) (defalias 'gnus-get-unread-articles #[nil "Á‰‰‰ÇÈ!ˆ „Ê GÌ]Í\" ƒl@‰@ÎÏ  \"J8ƒN ÎÏ \"J8šƒNÏ  \"J„cÑ AA\"Ò  \" Ó\n!\nBBLˆA‰„#ÇÔ!-‡" [gnus-newsrc-assoc nil range active group-name group-info read message "Checking new news..." gnus-unread-hashtb make-vector gnus-active-hashtb 200 0 2 intern-soft gnus-octive-hashtb gnus-difference-of-range intern gnus-number-of-articles "Checking new news... done"] 6 "\ Compute diffs between active and read articles."]) (defalias 'gnus-expire-marked-articles #[nil "Á‰‰‰‰‰ƒV@‰AÁÈÉ @\n\"J8@\nƒ@ ƒ@ @\nYƒ: @ B A‚& ƒM @ BBA‰„Ë!‰ .‡" [gnus-marked-assoc nil begin updated articles marked updated-assoc marked-assoc 2 intern-soft gnus-active-hashtb gnus-make-hashtable-from-alist gnus-marked-hashtb] 7 "\ Check expired article which is marked as unread."]) (defalias 'gnus-mark-as-read-by-xref #[(group headers unreads &optional subscribed-only) "À‰‰‰‰‰ƒ@‰ÈH >„„Ê ËH!‰ƒ„ @‰@ A \n˜„} ƒIÎ\n\"JA@ƒ} Î\n\"JA>„}Ñ\n\"‰ƒt A>„| AB¡ˆ‚|\n DB) A‰„)A‰„Ó!ˆÔÕ\".‡" [nil article gname xref xrefs header xref-list headers 0 unreads gnus-parse-xref-field 3 group subscribed-only intern-soft gnus-newsrc-hashtb gnus-marked-hashtb assoc group-xref gnus-mark-xrefed-as-read mapcar car] 7 "\ Mark articles as read using cross references and return updated newsgroups. Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."]) (defalias 'gnus-parse-xref-field #[(xref-value) "À †ÂÄÅ \"ƒ Æ”ÀO‚À ƒGÄÇ \"ƒA ƔƕOÈ É”É•O!B B É•ÀO‰‚À‰„ *‡" [nil xref-value "" xref-list string-match "^[ ]*[^ ,]+[ ,]+\\(.*\\)$" 1 "^[ ,]*\\([^ ,]+\\):\\([0-9]+\\)[^0-9]*" string-to-int 2] 6 "\ Parse Xref: field value, and return list of `(group . article-id)'."]) (defalias 'gnus-mark-xrefed-as-read #[(xrefs) "À‰‰ …< @@ @AÅÆ \"JAA!\nƒ.È\n@ \"\nA‰„!É Ê#ˆ A‰„\nÀ+‡" [nil unread idlist group xrefs gnus-uncompress-sequence intern-soft gnus-unread-hashtb delq gnus-update-unread-articles ignore] 5 "\ Update unread article information using XREFS alist."]) (defalias 'gnus-update-unread-articles #[(group unread-list marked-list) "ÀÁ\n \"J8Á\n \"J‰?† ??…ƒ* AÈ!¡ˆ‚/ AÉ¡ˆ AÊ AA! ˆ@ËVƒGÌABÁ\n \"JAÎ AA\"¡ˆÏ\n!ˆ<…Á\n\"J‰ƒu¡‚…\nB‰BÕ\n\"L))*‡" [2 intern-soft group gnus-active-hashtb gnus-unread-hashtb unread active unread-list gnus-compress-sequence ((0 . 0)) gnus-number-of-articles 0 1 gnus-newsrc-hashtb gnus-difference-of-range gnus-update-newsrc-buffer marked-list gnus-marked-hashtb marked info gnus-marked-assoc intern] 5 "\ Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."]) (defalias 'gnus-read-active-file #[nil "À ˆÁÂ!ˆÃ ƒŠ qˆÅ ˆÁÆ!)‡ÇÈ!‡" [gnus-start-news-server message "Reading active file..." gnus-request-list nntp-server-buffer gnus-active-to-gnus-format "Reading active file... done" error "Cannot read active file from NNTP server."] 2 "\ Get active file from NNTP server."]) (defalias 'gnus-active-to-gnus-format #[nil "ebˆÀ !ˆ\nÄÅed\"Æ]Ç\"ebˆÈÉÊË#…GÌ͔͕{\n\"͔͕{ΔΕ{ϘÐєѕ{!ÐÒ”Ò•{!BELˆ‚‡" [delete-matching-lines gnus-ignored-newsgroups gnus-active-hashtb gnus-octive-hashtb make-vector count-lines 200 0 re-search-forward "^\\([^ ]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]+\\([ymn]\\).*$" nil t intern 1 4 "y" string-to-int 3 2] 7 "\ Convert active file format to internal format. Lines matching gnus-ignored-newsgroups are ignored."]) (defalias 'gnus-read-newsrc-file #[(&optional rawfile) "À ! ‰ƒ @ÅLˆ A‰„\n)\n‰ÇPÅ ŠÊ!qˆÅË̈ „PÎ\"„P ƒPƒPÐ!‰‚aÒÓ\"ˆÔ ˆÕ ˆÒÖ\",‡" [gnus-make-newsrc-file gnus-startup-file gnus-current-startup-file gnus-variable-list variables nil newsrc-file ".el" quick-file quick-loaded find-file-noselect (byte-code "À ‰‰$Ä !Ä!À‡" [load quick-file t quick-loaded gnus-make-hashtable-from-alist gnus-killed-assoc gnus-killed-hashtb gnus-marked-assoc gnus-marked-hashtb] 5) ((error)) rawfile file-newer-than-file-p gnus-newsrc-assoc gnus-make-hashtable-from-alist gnus-newsrc-hashtb message "Reading %s..." gnus-newsrc-to-gnus-format gnus-check-killed-newsgroups "Reading %s... Done"] 4 "\ Read startup FILE. If optional argument RAWFILE is non-nil, the raw startup file is read."]) (defalias 'gnus-make-newsrc-file #[(file) "À Â\"‰à QÆ !ƒ ‚ *‡" [expand-file-name file nil "-" gnus-nntp-server real-file file-exists-p] 4 "\ Make server dependent file name by catenating FILE and server host name."]) (defalias 'gnus-newsrc-to-gnus-format #[nil "À‰‰‰‰ÀÀÀÀ Ê GÌed\"]Í]Î\"ebˆÐÑÀÒ#ƒSÓ”Ó•{ÔÕ\"ƒSÖΕÀO!‰@A)ebˆÐÙUƒbÚ‚cÛÀÒ#ƒýÓ”Ó•{Ü \"Jƒ€ÝÞ \"ˆ‚Vߔߕ{à˜á”á•{ÀÔâ \"ƒå Ó”Ó•O Ó•ÀOÔã\n\"ƒÂä\nÓ”Ó•O!ä\nߔߕO!B B‚Ôå\n\"ƒÖä\n!ä\n!B B‚æ ˆÝç \"ˆèÎ!ˆ‚ ŸBB B é \" @Lˆ‚V Ÿ‰ -‡" [nil read-list subrange ranges subscribe newsgroup gnus-newsrc-options gnus-newsrc-options-n-yes gnus-newsrc-options-n-no gnus-newsrc-assoc make-vector gnus-active-hashtb count-lines 200 0 gnus-newsrc-hashtb re-search-forward "^[ ]*options[ ]*\\(.*\\(\n[ ]+.*\\)*\\)[ ]*$" t 1 string-match "\\(^\\|[ \n]\\)-n" gnus-parse-n-options yes-and-no gnus-emacs-version 18 "^\\([^:! \n]+\\)\\([:!]\\)[ ]*\\(\\(...\\)*.*\\)$" "^\\([^:! \n]+\\)\\([:!]\\)[ ]*\\(.*\\)$" intern-soft message "Ignore duplicated newsgroup: %s" 2 ":" 3 "^[, ]*\\([0-9-]+\\)" "^\\([0-9]+\\)-\\([0-9]+\\)$" string-to-int "^[0-9]+$" ding "Ignoring bogus lines of %s" sit-for intern] 6 "\ Parse current buffer as .newsrc file."]) (defalias 'gnus-parse-n-options #[(options) "À‰‰‰ÅÆ\"ƒ[ȔȕOÉʔʕO!Ê•ÀOÅË \"ƒA ÌÈ•OÍ Ê”ÀOQ‚*\nΘƒN B‚ ͘„ B‚ …lÏÐÑÒÓ A\"\" @ÔR …}ÏÐÑÒÕ A\"\" @ÔR,B‡" [nil newsgroup yes-or-no no yes string-match "^[ \n,]*\\(!?\\)\\([^--- \n,][^ \n,]*\\)" options 1 regexp-quote 2 "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" 0 ".+" "!" "^\\(" apply concat mapcar #[(newsgroup) "ÁP‡" [newsgroup "\\|"] 2] "\\)\\(\\.\\|$\\)" #[(newsgroup) "ÁP‡" [newsgroup "\\|"] 2]] 7 "\ Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."]) (defalias 'gnus-save-newsrc-file #[nil "„ …[\n…[ŠÃ\n!qˆÄ „ÅÆ!‚ZÅÇ\n\"ˆÈÉÈ\n  ÍÎ!ˆÏ ˆ+ÐÑ!qˆÒp!ˆÓ ˆÔ ˆÉ‰È\n  Õ\nÖP!ˆ+×p!ˆÅØ\n\")‡" [gnus-newsrc-assoc gnus-killed-assoc gnus-current-startup-file find-file-noselect buffer-modified-p message "(No changes need to be saved)" "Saving %s..." t nil require-final-newline version-control make-backup-files run-hooks gnus-save-newsrc-hook save-buffer get-buffer-create " *GNUS-newsrc*" buffer-flush-undo erase-buffer gnus-gnus-to-quick-newsrc-format write-file ".el" kill-buffer "Saving %s... Done"] 3 "\ Save to .newsrc FILE."]) (defalias 'gnus-update-newsrc-buffer #[(group &optional delete next) "ŠÀ !†\n !qˆÃ‰‰ebˆÇÈÉ\n!ËQÃÌ#ƒ4Íyˆ`Îyˆ`|ˆÌ‚?…©Ð\n\"J‰??…¨„u;ƒkebˆÇÈÉ!ËQÃÌ#ƒkÍyˆ‚udbˆn„uÔcˆÕÖ!ƒŽÎyˆm„ŽÕ×!ƒŽÎyˆ‚~\nA@ƒ›Ø‚œÙ±ˆÚAA!ˆÔc),‡" [get-file-buffer gnus-current-startup-file find-file-noselect nil buffer-read-only case-fold-search deleted re-search-forward "^" regexp-quote group "[:!]" t 0 1 delete intern-soft gnus-newsrc-hashtb newsrc next "\n" looking-at "^[ ]*options\\([ ]\\|$\\)" "^[ ]+" ": " "! " gnus-ranges-to-newsrc-format] 5 "\ Incrementally update .newsrc buffer about GROUP. If optional 1st argument DELETE is non-nil, delete the group. If optional 2nd argument NEXT is non-nil, inserted before it."]) (defalias 'gnus-gnus-to-quick-newsrc-format #[nil "ÀcˆÁcˆÂ È ˆ…C@É!ƒ9Jƒ9ÊË!ÌÍJ!αˆA‰„Â,‡" [";; GNUS internal format of .newsrc.\n" ";; Touch .newsrc instead if you think to remove this file.\n" nil gnus-variable-list gnus-killed-assoc gnus-killed-hashtb variables variable gnus-check-killed-newsgroups boundp "(setq " symbol-name " '" prin1-to-string ")\n"] 6 "\ Insert GNUS variables such as gnus-newsrc-assoc in lisp format."]) (defalias 'gnus-ranges-to-newsrc-format #[(ranges) "À\n…G\n@\nA @ AUƒ1 @ÃUƒ!À‰‚Ä @!cˆ\nƒÅcˆ‚Ä @!ÆÄ A!±ˆ\nƒÅcˆ‚)‡" [nil range ranges 0 int-to-string "," "-"] 5 "\ Insert ranges of read articles."]) (defalias 'gnus-compress-sequence #[(numbers) "ÀÁ\n!Ã\"‰@\n@Æ\nƒ> \n@U„7 T\n@Uƒ)\n@‚7 BB\n@\n@\nA‰„ BBŸ,‡" [sort copy-sequence numbers < first last nil result] 4 "\ Convert list of sorted numbers to ranges."]) (defalias 'gnus-uncompress-sequence #[(ranges) "À‰‰ ƒ. @@ @A \nWƒ# B T‰‚ B A‰„\n Ÿ+‡" [nil result last first ranges] 4 "\ Expand compressed format of sequence."]) (defalias 'gnus-number-of-articles #[(range) "À\nƒ!\n@AÀU„ \n@A\n@@ZÃ\\\\\nA‰„ )‡" [0 count range 1] 4 "\ Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."]) (defalias 'gnus-difference-of-range #[(src obj) "@AÁƒQ ƒQ @@ @A Vƒ%Á‚J Wƒ= S ^B\nBT‚J YƒJ T] A*‚ƒa Xƒa B\nB\nƒj\nŸ‚nȉBC+‡" [src nil range end beg obj end1 beg1 0] 3 "\ Compute (SRC - OBJ) on range. Range of SRC is expressed as `(beg . end)'. Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."]) (defalias 'gnus-read-distributions-file #[nil "À ˆÁÂ!ˆÃÅ ƒŠqˆÇ ˆÁÈ!ˆ)É\n!à ‰ …KÍ @ \"‰ ƒ:Î \" @C B A‰ „(Ã*‡" [gnus-start-news-server message "Reading distributions file..." nil gnus-distribution-list gnus-request-list-distributions nntp-server-buffer gnus-distributions-to-gnus-format "Reading distributions file... done" reverse gnus-local-distributions dist defaults assoc delq] 4 "\ Get distributions file from NNTP server (NNTP2 functionality)."]) (defalias 'gnus-distributions-to-gnus-format #[nil "ÀebˆÂÃÀÄ#ƒŔŕ{C B‚ Ÿ‰‡" [nil gnus-distribution-list re-search-forward "^\\([^ \n]+\\).*$" t 1] 4 "\ Convert distributions file format to internal format."]) (byte-code "ÀÁ!„\nÁÂMˆÀ‡" [fboundp file-newer-than-file-p #[(file1 file2) "ÀÁ\n!8ÀÁ !8Æ\n!„Ç‚?Æ !„ È‚? …? …? @ @W†? @ @U…? A@ A@X*‡" [5 file-attributes file1 file2 mod2 mod1 file-exists-p nil t] 4 "Return t if file FILE1 is newer than file FILE2.\nIf FILE1 does not exist, the answer is nil;\notherwise, if FILE2 does not exist, the answer is t."]] 2) emacs-19.22/lisp/gnusmail.elc100666 12241 1 10256 5416166673 15106 0ustar rolanddaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:12:59 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/gnusmail.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃÄ\"ˆÂÅÄ\"ˆÂÆÇ\"ˆÂÈÇ\"ˆÂÉÇ\"ˆÂÊÇ\"‡" [require gnus autoload news-mail-reply "rnewspost" news-mail-other-window mh-send "mh-e" mh-send-other-window mh-find-path mh-yank-cur-msg] 3) (defalias 'gnus-summary-reply #[(yank) "ÀÁ‰\"ˆÂ !ˆ~ˆÄ ˆÅ !ˆ!‡" [gnus-summary-select-article t switch-to-buffer gnus-article-buffer delete-other-windows bury-buffer gnus-mail-reply-method yank] 3 "\ 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." "P"]) (defalias 'gnus-summary-reply-with-original #[nil "ÀÁ!‡" [gnus-summary-reply t] 2 "\ Reply mail to news author with original article. Customize the variable gnus-mail-reply-method to use another mailer." nil]) (defalias 'gnus-summary-mail-forward #[nil "À ˆÁ\n!ˆ~ˆÃ ˆÄ\n!ˆ ‡" [gnus-summary-select-article switch-to-buffer gnus-article-buffer delete-other-windows bury-buffer gnus-mail-forward-method] 2 "\ Forward the current message to another user. Customize the variable gnus-mail-forward-method to use another mailer." nil]) (defalias 'gnus-summary-mail-other-window #[nil "À ˆÁ\n!ˆ~ˆÃ ˆÄ\n!ˆ ‡" [gnus-summary-select-article switch-to-buffer gnus-article-buffer delete-other-windows bury-buffer gnus-mail-other-window-method] 2 "\ Compose mail in other window. Customize the variable gnus-mail-other-window-method to use another mailer." nil]) (defalias 'gnus-mail-reply-using-mail #[(&optional yank) "À ˆÁ ˆ\n…`dbˆÄÅ!ˆ b)‡" [news-mail-reply gnus-overload-functions yank last mail-yank-original nil] 2 "\ Compose reply mail using mail. Optional argument YANK means yank original article."]) (defalias 'gnus-mail-forward-using-mail #[nil "pÀ ÂÃÄ!† ÅRÈÉ!ƒÊˉ#‚%Ìˉ#…>ŠdbˆÍcˆÎ!ˆdbˆÏcˆÐÑ!)*‡" ["[" gnus-newsgroup-name "] " gnus-fetch-field "Subject" "" subject forward-buffer one-window-p t mail nil mail-other-window "------- Start of forwarded message -------\n" insert-buffer "------- End of forwarded message -------\n" run-hooks gnus-mail-forward-hook] 6 "\ Forward the current message to another user using mail."]) (defalias 'gnus-mail-other-window-using-mail #[nil "À ˆÁ ‡" [news-mail-other-window gnus-overload-functions] 1 "\ Compose mail other window using mail."]) (defalias 'gnus-mail-reply-using-mhe #[(&optional yank) "À‰‰‰‰‰pŒÈ ˆÉÊ!ÉË!‰ƒ.ÌÍ \"„.Î P‚/ )ÉÏ!ÉÐ!ÉÑ! \n†GÓ ˆÔ †SÕ #ˆŠÖ×ØÌÙ\"OÚ Q\"ˆ) Ü.…`à ˆb)‡" [nil buffer reply-to to date subject cc from gnus-article-show-all-headers gnus-fetch-field "from" "subject" string-match "^[Rr][Ee]:.+$" "Re: " "reply-to" "cc" "date" mh-show-buffer mh-find-path mh-send "" mh-insert-fields "In-reply-to:" 0 " *at \\| *@ \\| *(\\| *<" "'s message of " mh-sent-from-folder 1 mh-sent-from-msg yank last mh-yank-cur-msg] 8 "\ 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-forward-using-mhe #[nil "ÀÁ!ÀÂ!pÃÈ ÊËÌ!†ÍR Ï ˆÐ†*Í #ˆŠdbˆÑcˆÒ !ˆdbˆÓcˆ Õ‰-‡" [read-string "To: " "Cc: " nil subject buffer cc to "[" gnus-newsgroup-name "] " gnus-fetch-field "subject" "" mh-show-buffer mh-find-path mh-send "\n------- Forwarded Message\n\n" insert-buffer "\n------- End of Forwarded Message\n" mh-sent-from-folder 1 mh-sent-from-msg] 5 "\ Forward the current message to another user using mh-e."]) (defalias 'gnus-mail-other-window-using-mhe #[nil "ÀÁ!ÀÂ!ÀÃÄÅ!\"É ˆp\nË ˆÌ#ˆp Ή+‡" [read-string "To: " "Cc: " "Subject: " gnus-fetch-field "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] 6 "\ Compose mail other window using mh-e."]) (provide (quote gnusmail)) emacs-19.22/lisp/gnusmisc.elc100666 12241 1 13007 5416166711 15105 0ustar rolanddaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:13:12 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/gnusmisc.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote gnus)) (defvar gnus-browse-killed-mode-hook nil "\ *A hook for GNUS Browse-Killed Mode.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ÄÆÇÈ\"ˆÉÊËÌ#ˆ  >„0  B „„Î Ï Ð\"ˆÑ ÒÓ#ˆÑ ÔÕ#ˆÑ ÖÓ#ˆÑ ×Õ#ˆÑ ØÓ#ˆÑ ÙÕ#ˆÑ ÚÛ#ˆÑ ÜÛ#ˆÑ ÝÞ#ˆÑ ßà#ˆÑ áà#ˆÑ âã#ˆÄ‡" [boundp gnus-browse-killed-buffer "*Killed Newsgroup*" gnus-browse-killed-mode-map nil gnus-winconf-browse-killed autoload timezone-make-date-arpa-standard "timezone" put gnus-browse-killed-mode mode-class special gnus-buffer-list make-keymap suppress-keymap t define-key " " gnus-group-next-group "" gnus-group-prev-group "" "" "n" "p" "y" gnus-browse-killed-yank "" "l" gnus-list-killed-groups "q" gnus-browse-killed-exit "" " " gnus-info-find-node] 4) (defalias 'gnus-browse-killed-mode #[nil "À ˆÁÂ!ƒÃ‚!ÄÅ!<ƒÃÄÅ!AB‚!ÆÇÉ\nË Í!ˆÏp!ˆÐÒÓ!‡" [kill-all-local-variables boundp mode-line-modified "--- " default-value mode-line-format "--- GNUS: Killed Newsgroups %[(%m)%]----%3p-%-" gnus-browse-killed-mode major-mode "Browse-Killed" mode-name "GNUS: Killed Newsgroups" mode-line-buffer-identification use-local-map gnus-browse-killed-mode-map buffer-flush-undo t buffer-read-only run-hooks gnus-browse-killed-mode-hook] 3 "\ Major mode for browsing the killed newsgroups. All normal editing commands are turned off. Instead, these commands are available: \\{gnus-browse-killed-mode-map} The killed newsgroups are saved in the quick startup file (.newsrc.el) unless it against the options line in the startup file (.newsrc). Entry to this mode calls gnus-browse-killed-mode-hook with no arguments, if that value is non-nil." nil]) (defalias 'gnus-list-killed-groups #[nil "„ÁÂ!ˆÃ !„Å ÇÈ !!ˆÉ ˆÊ  Í ˆ ƒ9Î @!cˆ A‰ „)eb*‡" [gnus-killed-assoc error "No killed newsgroups" get-buffer-window gnus-browse-killed-buffer current-window-configuration gnus-winconf-browse-killed pop-to-buffer get-buffer-create gnus-browse-killed-mode nil killed-assoc buffer-read-only erase-buffer gnus-group-prepare-line] 4 "\ List the killed newsgroups. The keys y and C-y yank the newsgroup on the current line into the Newsgroups buffer." nil]) (defalias 'gnus-browse-killed-yank #[nil "À ‰ƒ/ÂÄ \"JÇ!ˆƒÉ!ˆÇ\n!ˆËyˆ`Ìyˆ`|ˆ*)Í ‡" [gnus-group-group-name group nil buffer-read-only intern-soft gnus-killed-hashtb killed pop-to-buffer gnus-group-buffer gnus-group-insert-group gnus-browse-killed-buffer 0 1 gnus-browse-killed-check-buffer] 4 "\ Yank current newsgroup to Newsgroup buffer." nil]) (defalias 'gnus-browse-killed-check-buffer #[nil "?… Á\n!… à ‡" [gnus-killed-assoc get-buffer gnus-browse-killed-buffer gnus-browse-killed-exit] 2 "\ Exit if the buffer is empty by deleting the window and killing the buffer."]) (defalias 'gnus-browse-killed-exit #[nil "À !ƒ ÂÀ !!ˆÃ !ˆ ƒÅ !ˆÆ‰‡" [get-buffer-window gnus-browse-killed-buffer delete-window kill-buffer gnus-winconf-browse-killed set-window-configuration nil] 3 "\ Exit this mode by deleting the window and killing the buffer." nil]) (defalias 'gnus-group-transpose-groups #[(arg) "ÁV…#ÂÉ\"ˆÄÅ!ˆÂÆÃ\"ˆÇ ˆÂÆÃ\"ˆS‰‚‡" [arg 0 gnus-group-search-forward t gnus-group-kill-group 1 nil gnus-group-yank-group] 4 "\ Exchange current newsgroup and previous newsgroup. With argument ARG, takes previous newsgroup and moves it past ARG newsgroup." "p"]) (defalias 'gnus-group-kill-region #[(begin end) "ŠÀ bˆÂyˆ` bˆÄˆ`\")S bˆÂyˆÆ !)‡" [count-lines begin 0 end nil lines gnus-group-kill-group] 3 "\ Kill newsgroups in current region (excluding current point). The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." "r"]) (defalias 'gnus-group-kill-group #[(n) "À‰ ÄVƒCÅ ‰„ÆÇÀ\"ˆÄyˆ`Èyˆ`|ˆÉ !ˆ SÊ !ƒŠ qˆÀebˆÌ @!cˆ*‚ÎÏÀÐ#*‡" [nil group buffer-read-only n 0 gnus-group-group-name signal end-of-buffer 1 gnus-kill-newsgroup get-buffer gnus-browse-killed-buffer gnus-group-prepare-line gnus-killed-assoc search-forward ":" t] 5 "\ Kill newsgroup on current line, repeated prefix argument N times. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." "p"]) (defalias 'gnus-group-yank-group #[nil "À @!ˆÂ !ƒŠ qˆÄebˆeÆyˆ`|ˆ*Ç ‡" [gnus-group-insert-group gnus-killed-assoc get-buffer gnus-browse-killed-buffer nil buffer-read-only 1 gnus-browse-killed-check-buffer] 2 "\ Yank the last newsgroup killed with \\[gnus-group-kill-group], inserting it before the newsgroup on the line containing point." nil]) (defalias 'gnus-group-insert-group #[(info) "„ÁÂ!ˆÃÄ Ç \"ˆÉyˆÊ!cˆËyˆÌÍÃÎ#*‡" [gnus-killed-assoc error "No killed newsgroups" nil gnus-group-group-name group buffer-read-only gnus-insert-newsgroup info 0 gnus-group-prepare-line -1 search-forward ":" t] 4 "\ Insert newsgroup at current line using gnus-newsrc-assoc INFO."]) (defalias 'gnus-gmt-to-local #[nil "ŠŒ~ˆebˆeÀÁÂÃ#ˆ`}ˆebˆÄÅÂÆ#…5ÂǔǕ{ ǔǕ|ˆÊ #c**‡" [search-forward "\n\n" nil move re-search-forward "^Date:[ ]\\(.*\\)$" t 1 date buffer-read-only timezone-make-date-arpa-standard gnus-local-timezone] 5 "\ Rewrite Date: field described in GMT to local in current buffer. The variable gnus-local-timezone is used for local time zone. Intended to be used with gnus-article-prepare-hook."]) (provide (quote gnusmisc)) emacs-19.22/lisp/gnuspost.elc100666 12241 1 34732 5474060060 15141 0ustar rolanddaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 22 01:46:08 1993 ;;; from file /home/fsf/rms/e19/lisp/gnuspost.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (require (quote gnus)) (defvar gnus-organization-file "/usr/lib/news/organization" "\ *Local news organization file.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÅÆÇ\"ˆÅÈÉ\"‡" [boundp gnus-post-news-buffer "*post-news*" gnus-winconf-post-news nil autoload news-reply-mode "rnewspost" timezone-make-date-arpa-standard "timezone"] 3) (defalias 'gnus-group-post-news #[nil "À ÂŽÃ ˆ)Ä !ƒÆ !ˆÄ!…Æ!‡" [current-window-configuration gnus-winconf-post-news ((byte-code "pÀ !=ƒÂà !ƒÄ !ˆÀ‡" [get-buffer gnus-post-news-buffer zerop buffer-size set-window-configuration gnus-winconf-post-news] 3)) gnus-post-news get-buffer gnus-summary-buffer bury-buffer gnus-article-buffer] 2 "\ Post an article." nil]) (defalias 'gnus-summary-post-news #[nil "ÀÁÂ\"ˆÃ ÅŽÆ!ˆ~ˆÈ ˆÉ ˆ)Ê!‡" [gnus-summary-select-article t nil current-window-configuration gnus-winconf-post-news ((byte-code "pÀ !=ƒÂà !ƒÄ !ˆÀ‡" [get-buffer gnus-post-news-buffer zerop buffer-size set-window-configuration gnus-winconf-post-news] 3)) switch-to-buffer gnus-article-buffer delete-other-windows gnus-post-news bury-buffer] 3 "\ Post an article." nil]) (defalias 'gnus-summary-followup #[(yank) "ÀÁÂ\"ˆ qˆ ƒ%ÅÆ!ǘƒ% Á=ƒ ÈÉ!„%Ê !‡Ì  ÎŽÏ !ˆ~ˆÐ ˆÑ !ˆ)Ò !‡" [gnus-summary-select-article t nil gnus-article-buffer gnus-use-followup-to gnus-fetch-field "followup-to" "poster" y-or-n-p "Do you want to ignore `Followup-To: poster'? " gnus-summary-reply yank current-window-configuration gnus-winconf-post-news ((byte-code "pÀ !=ƒÂà !ƒÄ !ˆÀ‡" [get-buffer gnus-post-news-buffer zerop buffer-size set-window-configuration gnus-winconf-post-news] 3)) switch-to-buffer delete-other-windows gnus-news-reply bury-buffer] 3 "\ Post a reply article. If prefix argument YANK is non-nil, original article is yanked automatically." "P"]) (defalias 'gnus-summary-followup-with-original #[nil "ÀÁ!‡" [gnus-summary-followup t] 2 "\ Post a reply article with original article." nil]) (defalias 'gnus-summary-cancel-article #[nil "ÀÁÂ\"ˆÃ ÅŽÆ!ˆÈ *‡" [gnus-summary-select-article t nil selected-window GNUSStartBufferWindow ((select-window GNUSStartBufferWindow)) pop-to-buffer gnus-article-buffer gnus-cancel-news] 3 "\ Cancel an article you posted." nil]) (byte-code "ÀÁMˆÂÁM‡" [sendnews gnus-post-news postnews] 2) (defalias 'gnus-post-news #[nil "ƒ\nÁÂ!ƒçp Ä=… Æ@ \n Ì „*ÍÎ!ˆÏ ˆŒÐÑ !„F ÄšƒFÒ ˆeebˆÓÔ!ˆ`}ˆÕÖ!ÕØ!)Ú!ˆÜ ˆÝ ˆÞ ƒvÑ ßVƒvÁà!„v ‰!‚åâ ˆ#ƒ²$„†å ˆ\n„–æç$Æè\n%\néê! +:ƒ­æì+Ɖ%‚°éì!íÆ Æ\n %ˆîï!ˆ†Çðcˆ1ƒÖîò!ˆ1cˆ#ƒàdb‚åebˆÆ,‡óð!‡" [gnus-novice-user y-or-n-p "Are you sure you want to post to all of USENET? " major-mode gnus-article-mode gnus-newsgroup-name nil gnus-local-distributions distribution subject newsgroups artbuf gnus-server-opened gnus-start-news-server t gnus-setup-news zerop buffer-size gnus-article-show-all-headers search-forward "\n\n" mail-fetch-field "from" news-reply-yank-from "message-id" news-reply-yank-message-id pop-to-buffer gnus-post-news-buffer news-reply-mode gnus-overload-functions buffer-modified-p 0 "Unsent article being composed; erase it? " mail-reply-buffer erase-buffer gnus-interactive-post gnus-newsrc-assoc gnus-read-newsrc-file completing-read "Newsgroup: " require-match read-string "Subject: " gnus-distribution-list "Distribution: " news-setup mail-position-on-field "Distribution" "" gnus-author-copy "FCC" message] 6 "\ Begin editing a new USENET news article to be posted. Type \\[describe-mode] once editing the article to get a list of commands." nil]) (defalias 'gnus-news-reply #[(&optional yank) "ƒ\nÁÂ!ƒ}ɉ‰‰‰‰‰‰‰‰p \n   ŒÐÑ !„IÓšƒIÔ ˆeebˆÕÖ!ˆ`}ˆ×Ø!‰×Ú! ×Û! ×Ü!\nƒs\nÞ˜„s\nߘƒvÃ\n\n†~×à! ×á!×â!×ã!‰$)å&!ˆç ˆè ˆé ƒµÑ êVƒµÁë!„µ ,‚hí ˆ ƒÆîï ð\"P ƒèñò\"‰3ƒßê3O‚áô Q)õà  %ˆ\nƒÿö ˆ\ncˆ÷ø!ˆ`ùú;<=ƒcˆƒ! ƒ!þcˆ ƒ( cˆÿ=`T\"ˆ+÷@!ˆ†<ÞcˆAƒM÷B!ˆAcˆCƒeƒeebˆDE±ˆdbˆF…z`GHÃ!ˆGb). ‡IÞ!‡" [gnus-novice-user y-or-n-p "Are you sure you want to followup to all of USENET? " nil artbuf message-id distribution references message-of newsgroups followup-to to date subject cc from zerop buffer-size major-mode gnus-article-mode gnus-article-show-all-headers search-forward "\n\n" mail-fetch-field "from" news-reply-yank-from "subject" "date" "followup-to" gnus-use-followup-to "" "poster" "newsgroups" "references" "distribution" "message-id" news-reply-yank-message-id pop-to-buffer gnus-post-news-buffer news-reply-mode gnus-overload-functions buffer-modified-p 0 "Unsent article being composed; erase it? " mail-reply-buffer erase-buffer "Re: " gnus-simplify-subject re-only string-match " *at \\| *@ \\| *(\\| *<" stop-pos "'s message of " news-setup news-reply-followup-to mail-position-on-field "References" 79 " " fill-prefix fill-column begin " " fill-region-as-paragraph "Distribution" gnus-author-copy "FCC" gnus-auto-mail-to-author "To: " "\n" yank last news-reply-yank-original message] 13 "\ 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." nil]) (defalias 'gnus-inews-news #[nil "À ŠÄ ˆ~ˆebˆÅÆ!ˆŒeebˆÇÈ ÈQ!ˆ`}ˆÊËÀÌ#†/ÊÍÀÌ#)ƒRƒGÏÐ!ˆ ˆÏÑ!ˆ‚RÒ ˆÏÓ!ˆÔÕ!ˆÏÖ!ˆ× ƒbÏØ!ˆ‚kÒ ˆÏÙÚ \"ˆÛÀ!ˆ) „wÜ ˆÝÞ!ƒ€Þ ˆƒŠà!ˆÀ‰*‡" [nil case-fold-search gnus-server-opened server-running gnus-start-news-server run-hooks news-inews-hook search-forward "\n" mail-header-separator mail-fetch-field "to" t "cc" gnus-mail-send-method message "Sending via mail..." "Sending via mail... done" ding "No mailer defined. To: and/or Cc: fields ignored." sit-for 1 "Posting to USENET..." gnus-inews-article "Posting to USENET... done" "Article rejected: %s" gnus-status-message set-buffer-modified-p gnus-close-server fboundp bury-buffer gnus-winconf-post-news set-window-configuration] 5 "\ Send a news message." nil]) (defalias 'gnus-cancel-news #[nil "ÀÁ!…‡Â‰‰‰ŠŒÇ ˆebˆÈÉÂÊ#ˆe`}ˆËÌ!ËÍ!ËÎ!ËÏ!)Ð!—ÐÑ !—˜„JÒ ˆÓÔ!‚†ÕÖ!qˆ×p!ˆØ ˆÙ ÚÛ ÚÜ ÚÝ †eÞÚÚ±ˆÓà!ˆá ƒ|Óâ!ˆ‚ƒÒ ˆÓã!ˆäp!-‡" [yes-or-no-p "Do you really want to cancel this article? " nil distribution message-id newsgroups from 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 message "This article is not yours." get-buffer-create " *GNUS-canceling*" buffer-flush-undo erase-buffer "Newsgroups: " "\n" "Subject: cancel " "Control: cancel " "Distribution: " "" mail-header-separator "Canceling your article..." gnus-inews-article "Canceling your article... done" "Failed to cancel your article" kill-buffer] 14 "\ Cancel an article you posted." nil]) (defalias 'gnus-inews-article #[nil "pÀÁ!Š\nqˆÄp!ˆÅ ˆÆ !ˆebˆÇÈ ÈQ!ˆÊË!ˆdbˆhÌU„0ÌcˆÍÎ!ˆŒebˆÇË!ˆe`}ˆÏ ˆ)ÍÐ!ˆÑ Òp!ˆ+‡" [get-buffer-create " *GNUS-posting*" tmpbuf artbuf buffer-flush-undo erase-buffer insert-buffer-substring search-forward "\n" mail-header-separator replace-match "\n\n" 10 run-hooks gnus-prepare-article-hook gnus-inews-insert-headers gnus-inews-article-hook gnus-request-post kill-buffer] 4 "\ Post an article in current buffer using NNTP protocol."]) (defalias 'gnus-inews-insert-headers #[nil "ŠÀ Á  ebˆÆÇ!„!È >ƒ!ÊË Ì±ˆÆÍ!„5Î >ƒ5ÏР̱ˆÆÑ!„EÒ >ƒEÓcˆÆÔ!„UÕ >ƒUÖcˆÆ×!„l ƒlØ >ƒl٠̱ˆÆÚ!„ƒ ƒƒÛ >ƒƒÜ ̱ˆÆÝ!„ª ƒªÞ >ƒª`ßà!\"#ä ̱ˆå#`\"ˆ+Ææ!„ºç >ƒºècˆÆé!†Íê >…Íëì ̱,‡" [gnus-inews-date gnus-inews-message-id gnus-inews-organization organization message-id date mail-fetch-field "path" Path gnus-required-headers "Path: " gnus-inews-path "\n" "from" From "From: " gnus-inews-user-name "subject" Subject "Subject: \n" "newsgroups" Newsgroups "Newsgroups: \n" "message-id" Message-ID "Message-ID: " "date" Date "Date: " "organization" Organization 79 " " fill-prefix fill-column begin "Organization: " fill-region-as-paragraph "distribution" Distribution "Distribution: \n" "lines" Lines "Lines: " gnus-inews-lines] 3 "\ Prepare article headers. Fields already prepared in the buffer are not modified. Fields in gnus-required-headers will be generated."]) (defalias 'gnus-inews-insert-signature #[nil "ŠŒ…\nÁÂ\"ÂebˆÅÆ!ˆe`}ˆÇÈ!~ˆ …?É Ê Q!ƒ0 Ê QÉ !…?dbˆËcˆÌ !,‡" [gnus-signature-file expand-file-name nil distribution signature search-forward "\n\n" mail-fetch-field "distribution" file-exists-p "-" "--\n" insert-file-contents] 4 "\ Insert signature file in current article buffer. If there is a file named .signature-DISTRIBUTION, it is used instead of usual .signature when the distribution of the article is DISTRIBUTION. Set the variable to nil to prevent appending the signature file automatically. Signature file is specified by the variable gnus-signature-file."]) (defalias 'gnus-inews-do-fcc #[nil "À‰ÁŠŒebˆÅÆ!ˆe`}ˆebˆÇÈÀÁ#ƒ6`ÀˆÉÀxˆ`{ BÊ”Ëyˆ`|ˆ‚~ˆ …” @ AÌÍ \"ƒc ˔˕OÏedÀ‰‰Ñ&ˆ)‚8ƒwÓ=„w !ˆ‚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-author-copy-saver rmail-output file-readable-p rmail-file-p gnus-output-to-rmail] 9 "\ 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-path #[nil "À \n„ Ä Q‚\n;ƒ\nÄ Q‚ )‡" [gnus-inews-login-name login-name gnus-use-generic-path gnus-nntp-server "!"] 3 "\ Return uucp path."]) (defalias 'gnus-inews-user-name #[nil "À Á ‰ÄÅ!\nǘƒÇ‚'\nȘƒ#É ÊQ‚'É\nÊQR*‡" [gnus-inews-login-name gnus-inews-full-name full-name login-name "@" gnus-inews-domain-name gnus-use-generic-from "" "&" " (" ")"] 7 "\ Return user's network address as `NAME@DOMAIN (FULL NAME)'."]) (defalias 'gnus-inews-login-name #[nil "†ÁÂ!†ÁÃ!†Ä ‡" [gnus-user-login-name getenv "USER" "LOGNAME" user-login-name] 2 "\ Return user login name. Got from the variable gnus-user-login-name, the environment variables USER and LOGNAME, and the function user-login-name."]) (defalias 'gnus-inews-full-name #[nil "† ÁÂ!† à ‡" [gnus-user-full-name getenv "NAME" user-full-name] 2 "\ Return user full name. Got from the variable gnus-user-full-name, the environment variable NAME, and the function user-full-name."]) (defalias 'gnus-inews-domain-name #[(&optional genericfrom) "„ ÁÂ!ƒ \n ;ƒ †3ÄÅ!†3†3ÆÇÈ \"ƒ0È É•ÊO†3ËÌ!ÆÇÈ \"ƒDÈ É‰”O†FÈ  ‰ÉÏOИƒZÏÊO„a „n ÐQ‚p*‡" [gnus-local-domain boundp gnus-your-domain genericfrom getenv "DOMAINNAME" string-match "\\." system-name 0 nil read-string "Domain name (no host): " host domain 1 "."] 5 "\ Return user's domain name. If optional argument GENERICFROM is a string, use it as the domain name; if it is non-nil, strip of 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-message-id #[nil "ÀÁ Âà ݇" ["<" gnus-inews-unique-id "@" gnus-inews-domain-name ">"] 5 "\ Generate unique Message-ID for user."]) (defalias 'gnus-inews-unique-id #[nil "À Á ÄÅ \"ƒ9\n–Æ Ç”Ç•O ȔȕO ɔɕO ʔʕO ˔˕O ̔̕O°‚=ÍÎ \"*‡" [current-time-string gnus-inews-login-name name date string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)" "." 6 1 2 3 4 5 error "Cannot understand current-time-string: %s."] 10 "\ Generate unique ID from user name and current time."]) (defalias 'gnus-current-time-zone #[(time) "ÀÁ!… Á\n!‰ƒ @ƒ ‚ )‡" [fboundp current-time-zone time z gnus-local-timezone] 3 "\ The local time zone in effect at TIME, or nil if not known."]) (defalias 'gnus-inews-date #[nil "ÀÁ!…Á Ã\n!‰ƒÅ\n \"‚Æ\n!*‡" [fboundp current-time now gnus-current-time-zone zone gnus-inews-valid-date gnus-inews-buggy-date] 4 "\ Date string of today. If `current-time-zone' works, or if `gnus-local-timezone' is set correctly, this yields a date that conforms to RFC 822. Otherwise a buggy date will be generated; this might work with some older news servers."]) (defalias 'gnus-inews-valid-date #[(&optional time zone) "ÀÁÂ!ƒ à !‚à Æ#‡" [timezone-make-date-arpa-standard fboundp current-time current-time-string time zone "GMT"] 4 "\ A date string that represents TIME and conforms to the Usenet standard. TIME is optional and defaults to the current time. Some older versions of Emacs always act as if TIME is nil. The optional argument ZONE specifies the local time zone (default GMT)."]) (defalias 'gnus-inews-buggy-date #[(&optional time) "ÀÁ!ƒ  !‚ ÅÆ \"ƒ6 ǔǕOÈ É”É•OÈ Ê”Ê•OÈ Ë”Ë•O°‚:ÌÍ \")‡" [fboundp current-time current-time-string time date string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" 2 " " 1 4 3 error "Cannot understand current-time-string: %s."] 9 "\ A buggy date string that represents TIME. TIME is optional and defaults to the current time. Some older versions of Emacs always act as if TIME is nil."]) (defalias 'gnus-inews-organization #[nil "„ ÁÂ!ƒ \nÃÄÅ\"ÇÈ!††‰ ;ƒm GÊVƒm ÊËO̘ƒmÍÎ!Ð ÑQ!ƒP ÑQ‚jÐ !ƒ\\ ‚jÐ!ƒh‚j  ) ;„wÅ‚² ÊËO̘ƒ¤Ð !ƒ¤ŠÓÔ!‰qˆÖ ˆ× !ˆØ Ù!ˆ*‚² ˜ƒ°Å‚² *‡" [gnus-local-organization boundp gnus-your-organization expand-file-name "~/.organization" nil private-file getenv "ORGANIZATION" organization 0 1 "/" mail-fetch-field "distribution" dist file-exists-p "-" gnus-organization-file get-buffer-create " *GNUS organization*" tmpbuf erase-buffer insert-file-contents buffer-string kill-buffer] 5 "\ Return user's organization. The ORGANIZATION environment variable is used if defined. If not, the variable gnus-local-organization is used instead. If the value begins with a slash, it is taken as the name of a file containing the organization."]) (defalias 'gnus-inews-lines #[nil "ŠŒ~ˆebˆÀÁÂÃ#ˆÄÅ`d\"!*‡" [search-forward "\n\n" nil move int-to-string count-lines] 4 "\ Count the number of lines and return numeric string."]) (provide (quote gnuspost)) emacs-19.22/lisp/gomoku.elc100666 74777 1 51740 5427115414 14251 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 2 00:41:47 1993 ;;; from file /home/fsf/rms/e19/lisp/gomoku.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (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.") (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" " " "p" "b" gomoku-human-takes-back "r" gomoku-human-resigns "e" gomoku-emacs-plays [up] [down] [left] [right] [kp-enter] [insert]] 4) (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 "\ 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." nil]) (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 "\ After how many moves will Emacs offer a draw?") (defalias 'gomoku-xy-to-index #[(x y) " _\n\\\\‡" [y gomoku-board-width x] 3 "\ Translate X, Y cartesian coords into the corresponding board index."]) (defalias 'gomoku-index-to-x #[(index) " T¦‡" [index gomoku-board-width] 2 "\ Return corresponding x-coord of board INDEX."]) (defalias 'gomoku-index-to-y #[(index) " T¥‡" [index gomoku-board-width] 2 "\ Return corresponding y-coord of board INDEX."]) (defalias 'gomoku-init-board #[nil "À Â\" S Xƒ$ ÇIˆ ÇIˆ T S‚\n* W…= ÇIˆ È\\\\‰‚()‡" [make-vector gomoku-vector-length 0 gomoku-board ii i gomoku-board-width -1 1] 4 "\ Create the gomoku-board vector and fill it with initial values."]) (defvar gomoku-score-table nil "\ Vector recording the actual score of the free squares.") (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.") (defconst gomoku-score-trans-table (byte-code "À \n ÆƉ‰‰‰Ɖ‰‰‰ Ɖ‰‰‰\nƉ‰‰‰‰&‡" [vector nil-score Xscore XXscore XXXscore XXXXscore 0 Oscore OOscore OOOscore OOOOscore] 32) "\ Vector associating qtuple contents to their score.") (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.") (defalias 'gomoku-strongest-square #[nil "À‰Á‰\"Á \"ʼn \n  Xƒ  H W„„  H‰ Vƒ[  HÀUƒQÂ\n  ‚„  ÎIˆ‚„  HÀU„o  Î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 "\ Compute index of free square with highest score, or nil if none."]) (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.") (defalias 'gomoku-init-score-table #[nil "ƒ \nUƒ UƒÅ!‰‡Ç Ê_\"ˉ‰‰‰‰   TÒ¥ TÒ¥Ó^ Ó^ ÔÔ XƒxÔÔXƒoÕ\"ˆT‰‚YT‰‚OXƒ£ÔÔ XƒšÕ\"ˆ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 "\ Create the score table vector and fill it with initial values."]) (defalias 'gomoku-nb-qtuples #[(i j) "À S^À\n Z^À S^À Z^‰\\É]Ê^ \\É]Ê^^ ^\\É]Ê^^ ^\\É]Ê^Ë\\\\\\\\,‡" [4 i gomoku-board-width j gomoku-board-height down up right left 3 8 -12] 7 "\ Return the number of qtuples containing square I,J."]) (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 "\ Give initial score to square I,J and to its mirror images."]) (defalias 'gomoku-update-score-table #[(square dval) "À !à !ÅÆ\nZ]ÅÆ Z]É\n\nZËZ^ É ZËZ^Ï ÆÉ&ˆÏ ÉÆ&ˆÏ] ^ Ɖ&ˆÏÆ ZÅ\n\nZ]]É\nÑZ ZË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 "\ Update score table after SQUARE received a DVAL increment."]) (defalias 'gomoku-update-score-in-direction #[(left right square dx dy dval) " V†¾Â‰‰‰‰‰É\n \" _\\ _\\Í_\\ Î XƒW  H\\ \\‰ ‚?X…¼ H ZHZ‰ÎU„ž‰ Xƒž HÎUƒ“  H \\Iˆ \\‰ ‚w \\ H[ 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 "\ 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."]) (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 "\ Non-nil if Emacs is in the middle of a computation.") (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 "\ Initialize a new game on an N by M board."]) (defalias 'gomoku-play-move #[(square val &optional dont-update-score) "À\nÃUƒ T‚ ÆUƒÀ HB\nB\n TË\n\"ˆ \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 "\ Go to SQUARE, play VAL and update everything."]) (defalias 'gomoku-take-back #[nil "À\n@‰@ H‰ÇUƒS\nA S Ê Ë\"ˆ ËIˆÌ [\"ˆ 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 "\ Take back last move and update everything."]) (defvar gomoku-number-of-wins 0 "\ Number of games already won in this session.") (defvar gomoku-number-of-losses 0 "\ Number of games already lost in this session.") (defvar gomoku-number-of-draws 0 "\ Number of games already drawn in this session.") (defalias 'gomoku-terminate-game #[(result) "À\nÃ=ƒM T ÆWƒÇ‚IƒÉ‚I\nƒ'Ë‚I „0Í‚IÏUƒHÏUƒH ÑVƒHÒ‚IÓ‚É\nÔ=ƒoT\nƒaÕ‚k ƒjÖ‚kׂÉ\nØ=ƒ} TÙ‚É\nÚ=ƒŸT\nƒ‘Û‚› ƒšÜ‚›Ý‚É\nÞ=ƒÁT\nƒ³ß‚½ ƒ¼à‚½á‚É\nâ=ƒÉãä ˆ ƒÔÁ !ˆå ˆÀ‰&)‡" [nil message result emacs-won gomoku-number-of-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-losses 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 "\ Terminate the current game with RESULT."]) (defalias 'gomoku-crash-game #[nil "ÀÂÃ!ˆÄÅ!ˆÆ ‡" [nil gomoku-emacs-is-computing gomoku-terminate-game crash-game sit-for 4 gomoku-prompt-for-other-game] 2 "\ What to do when Emacs detects it has been interrupted."]) (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 "\ 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." nil]) (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 "\ Compute Emacs next move and play it." nil]) (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 "\ 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." nil]) (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 "\ Signal to the Gomoku program that you wish to take back your last move." nil]) (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 "\ Signal to the Gomoku program that you may want to resign." nil]) (defalias 'gomoku-prompt-for-move #[nil "À ÂUƒ  Ä!ˆŠÅ q)‡" [message gomoku-number-of-human-moves 0 "Your move ? (move to a free square and hit X, RET ...)" "Your move ?" other-buffer] 3 "\ Display a message asking for Human's move."]) (defalias 'gomoku-prompt-for-other-game #[nil "ÀÁ!ƒ  \"‡ÅÆ!‡" [y-or-n-p "Another game " gomoku gomoku-board-width gomoku-board-height message "Chicken !"] 3 "\ Ask for another game, and start 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 "\ Offer a draw and return T if Human accepted it."]) (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.") (defalias 'gomoku-max-width #[nil "ÀÁ !\nZ\nZÃZ ¥T‡" [window-width selected-window gomoku-x-offset 1 gomoku-square-width] 2 "\ Largest possible board width for the current window."]) (defalias 'gomoku-max-height #[nil "ÀÁ !\nZ\nZÃZ ¥T‡" [window-height selected-window gomoku-y-offset 2 gomoku-square-height] 2 "\ Largest possible board height for the current window."]) (defalias 'gomoku-point-x #[nil "iZ‰ÂY… ¦ÂU… ¥T‰ X… )‡" [gomoku-x-offset col 0 gomoku-square-width gomoku-board-width] 3 "\ Return the board column where point is, or nil if it is not a board column."]) (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 "\ Return the board row where point is, or nil if it is not a board row."]) (defalias 'gomoku-point-square #[nil "À‰à ‰…Ä ‰…Å\n \"*‡" [nil y x gomoku-point-x gomoku-point-y gomoku-xy-to-index] 3 "\ Return the index of the square point is on, or nil if not on the board."]) (defalias 'gomoku-goto-square #[(index) "ÀÁ\n!Ã\n!\"‡" [gomoku-goto-xy gomoku-index-to-x index gomoku-index-to-y] 4 "\ Move point to square number INDEX."]) (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 "\ Move point to square at X, Y coords."]) (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 "\ Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there."]) (defalias 'gomoku-put-char #[(char) "ƒÁ ˆ\ncˆÃÄ!ˆÅÄ!ˆÁ ‡" [buffer-read-only toggle-read-only char delete-char 1 backward-char] 2 "\ Draw CHAR on the Gomoku screen."]) (defalias 'gomoku-init-display #[(n m) "Àp!ˆ ƒ  ˆÃ ˆÄ‰‰‰É\nSË\"ÌPÍÎÏS\"\"ÉË\"ÌÒRÉS\n_Ó\\\\Ë\"‰ÒPÍÎÏS\"\"‰PÍÎÏS\"\"ÍÎÏ\"\"‰±ˆ, ˆ×TØ¥TØ¥\"ˆÙÚ!‡" [buffer-disable-undo buffer-read-only toggle-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 "\ Display an N by M Gomoku board."]) (defalias 'gomoku-display-statistics #[nil "ÁU„Âà $‚5 ÁU„ÂÆ #‚5 ÁUƒ'Ç‚5 ÈUƒ1É‚5ÂÊ \" ÌÍ !‡" [gomoku-number-of-draws 0 format ": Won %d, lost %d, drew %d" gomoku-number-of-wins gomoku-number-of-losses ": Won %d, lost %d" "" 1 ": Already won one" ": Won %d in a row" mode-line-process set-buffer-modified-p buffer-modified-p] 5 "\ Obnoxiously display some statistics about previous games in mode line."]) (defalias 'gomoku-switch-to-window #[nil "ÀÁ!‰ƒÃ\n!‚ ƒÅ ˆÃÁ!ˆÆ )‡" [get-buffer "*Gomoku*" buff switch-to-buffer gomoku-game-in-progress gomoku-crash-game gomoku-mode] 3 "\ Find or create the Gomoku buffer, and display it." nil]) (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).") (defalias 'gomoku-find-filled-qtuple #[(square value) "À \nÃÄ$†!À \nÄÃ$†!À \nÉ$†!À \nÅÃ$‡" [gomoku-check-filled-qtuple square value 1 0 -1] 5 "\ Return T if SQUARE belongs to a qtuple filled with VALUEs."]) (defalias 'gomoku-check-filled-qtuple #[(square value dx dy) "À‰ ‰Â \"Å \n‰ ÌVƒ5  Z‰ HUƒ5 S‰ ‚ Ï\\\nWƒ] \\‰HUƒ]\nT‰\n‚=\nU…~  _\\ \n_\\  Ô.‡" [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 "\ Return T if SQUARE belongs to a qtuple filled with VALUEs along DX, DY."]) (defalias 'gomoku-cross-winning-qtuple #[nil "À \n $‡" [gomoku-cross-qtuple gomoku-winning-qtuple-beg gomoku-winning-qtuple-end gomoku-winning-qtuple-dx gomoku-winning-qtuple-dy] 5 "\ Cross winning qtuple, as found by `gomoku-find-filled-qtuple'."]) (defalias 'gomoku-cross-qtuple #[(square1 square2 dx dy) "ŠÀ \n\" U„ªÆ !ˆ \\ Ç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 "\ Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."]) (defalias 'gomoku-move-left #[nil "À  „  ÃVƒ ‚Å!)‡" [gomoku-point-x x backward-char 1 gomoku-square-width 0] 3 "\ Move point backward one column on the Gomoku board." nil]) (defalias 'gomoku-move-right #[nil "À ‰„ ‚ Wƒ ‚Åu)‡" [gomoku-point-x x 1 gomoku-board-width gomoku-square-width 0] 3 "\ Move point forward one column on the Gomoku board." nil]) (defalias 'gomoku-move-down #[nil "À  „  Wƒ ‚Æ!)‡" [gomoku-point-y y next-line 1 gomoku-board-height gomoku-square-height 0] 3 "\ Move point down one row on the Gomoku board." nil]) (defalias 'gomoku-move-up #[nil "À  „  ÃVƒ ‚Å!)‡" [gomoku-point-y y previous-line 1 gomoku-square-height 0] 3 "\ Move point up one row on the Gomoku board." nil]) (defalias 'gomoku-move-ne #[nil "À ˆÁ ‡" [gomoku-move-up gomoku-move-right] 1 "\ Move point North East on the Gomoku board." nil]) (defalias 'gomoku-move-se #[nil "À ˆÁ ‡" [gomoku-move-down gomoku-move-right] 1 "\ Move point South East on the Gomoku board." nil]) (defalias 'gomoku-move-nw #[nil "À ˆÁ ‡" [gomoku-move-up gomoku-move-left] 1 "\ Move point North West on the Gomoku board." nil]) (defalias 'gomoku-move-sw #[nil "À ˆÁ ‡" [gomoku-move-down gomoku-move-left] 1 "\ Move point South West on the Gomoku board." nil]) (provide (quote gomoku)) emacs-19.22/lisp/gosmacs.elc100666 13437 1 5560 5416167062 14350 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:14:58 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/gosmacs.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ Äć" [require mlsupport boundp non-gosmacs-binding-alist nil] 2) (defalias 'set-gosmacs-bindings #[nil "ÀÁ!‰‡" [rebind-and-record (("" compile) ("" save-buffers-kill-emacs) (" " insert-file) (" " save-some-buffers) ("" next-error) ("" switch-to-buffer) ("" insert-file) ("" undo) ("" find-file-other-window) ("" shrink-window) ("!" shell-command) ("d" delete-window) ("n" gosmacs-next-window) ("p" gosmacs-previous-window) ("z" enlarge-window) ("" scroll-one-line-up) ("" save-buffers-kill-emacs) ("!" line-to-top-of-window) ("(" backward-paragraph) (")" forward-paragraph) ("?" apropos) ("h" delete-previous-word) ("j" indent-sexp) ("q" query-replace) ("r" replace-string) ("z" scroll-one-line-down) ("" suspend-emacs)) non-gosmacs-binding-alist] 2 "\ Rebind some keys globally to make GNU Emacs resemble Gosling Emacs. Use \\[set-gnu-bindings] to restore previous global bindings." nil]) (defalias 'rebind-and-record #[(bindings) "À\nƒ'\n@‰@ A@ Æ \"D BÈ \"ˆ+\nA‰„ Ÿ)‡" [nil old bindings this key newdef lookup-key global-map global-set-key] 5 "\ Establish many new global bindings and record the bindings replaced. Arg BINDINGS is an alist whose elements are (KEY DEFINITION). Returns a similar alist whose elements describe the same KEYs but each with the old definition that was replaced,"]) (defalias 'set-gnu-bindings #[nil "À !‡" [rebind-and-record non-gosmacs-binding-alist] 2 "\ Restore the global bindings that were changed by \\[set-gosmacs-bindings]." nil]) (defalias 'gosmacs-previous-window #[nil "ÀÁ !‡" [select-window previous-window] 2 "\ Select the window above or to the left of the window now selected. From the window at the upper left corner, select the one at the lower right." nil]) (defalias 'gosmacs-next-window #[nil "ÀÁ !‡" [select-window next-window] 2 "\ Select the window below or to the right of the window now selected. From the window at the lower right corner, select the one at the upper left." nil]) (defalias 'scroll-one-line-up #[(&optional arg) "À †Â!‡" [scroll-up arg 1] 2 "\ Scroll the selected window up (forward in the text) one line (or N lines)." "p"]) (defalias 'scroll-one-line-down #[(&optional arg) "À †Â!‡" [scroll-down arg 1] 2 "\ Scroll the selected window down (backward in the text) one line (or N)." "p"]) (defalias 'line-to-top-of-window #[nil "ÀÁ!‡" [recenter 0] 2 "\ Scroll the selected window up so that the current line is at the top." nil]) emacs-19.22/lisp/grow-vers.elc100666 13437 1 1150 5416167067 14643 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:15:02 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/grow-vers.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!ˆÄcˆÅÁ!ˆÆedÁÇÈ%‡" [insert-file-contents "lisp/version.el" re-search-forward "emacs-version \"[0-9.]*" ".0" delete-file write-region nil nomsg] 6) emacs-19.22/lisp/hanoi.elc100666 13437 1 4727 5417070056 14013 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Thu Jul 8 15:06:22 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/hanoi.el ;;; emacs version 19.16.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 "This file was compiled for Emacs 19")) (defalias (quote hanoi-topos) #[(row col) "À !ˆÂyˆ u‡" [goto-line row 0 col] 2]) (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" set-buffer-modified-p buffer-modified-p] 10 "\ Towers of Hanoi diversion. Argument is number of rings." (list (if (null current-prefix-arg) 3 (prefix-numeric-value current-prefix-arg)))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÈ!‡" [defalias hanoi0 #[(n from to work) "À ƒ ÁÂÃC\"‡ ÅW†.Æ S $ˆÊ  #ˆÆ S $‡" [input-pending-p signal quit "I can tell you've had enough" n 0 hanoi0 from work to hanoi-move-ring] 5] hanoi-move-ring #[(n from to) " H‰ÅH@ ZÇZ@ ZÇZA \n  Í  \"ˆ VƒNÏ ÂÐ#ˆÑÇ!ˆÏ ÐÂ#ˆÒÅ!ˆ S‰ ‚+‰AT¡ˆ\n š„¥\n VƒÇˆÓÔ!ˆÅyˆÕ‰±ˆÒÅ!ˆ TT ‚U\n WƒUÅyˆÖÔ!ˆÇˆÕ‰±ˆÒÅ!ˆ SS ‚UÍ\n\"ˆ  WƒÕÏ Â V#ˆ×Ç!ˆÏ ÐÂ#ˆÒÅ!ˆ T‰ ‚® Å 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] hanoi-draw-ring #[(ring f1 f2) "Šƒ ÂH‚ ÃH‰GÆ !ˆ cˆ…,È Â\\Ã¥!ˆÆÂ!ˆÉc+‡" [f1 ring 1 2 string len delete-char f2 backward-char 124] 4] provide hanoi] 3) emacs-19.22/lisp/help-macro.elc100666 12120 1 3711 5416167175 14610 0ustar rmsdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:16:13 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/help-macro.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide help-macro require backquote] 2) (defalias 'make-help-screen '(macro . #[(fname help-line help-text helped-map) "À  ÄÅÆÇDDCÉÅÊËÌÍÎÌÏÐÑÒÓÔ DDDÕÖ¯EÅ×ØÙÚEDDCÜEEÝEEF¯‡" [defun fname nil help-text (interactive) let line-prompt substitute-command-keys help-line (message line-prompt) ((char (read-event)) config) unwind-protect progn if (or (eq char 63) (eq char help-char)) (setq config (current-window-configuration)) (switch-to-buffer-other-window "*Help*") (erase-buffer) insert documentation quote (goto-char (point-min)) (while (memq char (cons help-char (quote (63 22 32 127 -8388490)))) (if (memq char (quote (22 32))) (scroll-up)) (if (memq char (quote (127 -8388490))) (scroll-down)) (message "%s%s: " line-prompt (if (pos-visible-in-window-p (point-max)) "" " or Space to scroll")) (let ((cursor-in-echo-area t)) (setq char (read-event)))) defn cdr assq (if (integerp char) (downcase char) char) helped-map (if defn (if (keymapp defn) (error "sorry, this command cannot be run from the help screen. Start over.") (if config (progn (set-window-configuration config) (setq config nil))) (call-interactively defn)) (if (listp char) (setq unread-command-events (cons char unread-command-events) config nil) (ding))) (if config (set-window-configuration config))] 22 "\ Constructs function FNAME that when invoked shows HELP-LINE and if a help character is requested, shows HELP-TEXT. The user is prompted for a character from the HELPED-MAP and the corresponding interactive function is executed."])) emacs-19.22/lisp/help.elc100666 13437 1 26673 5471651146 13676 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 04:56:53 1993 ;;; from file /home/fsf/rms/e19/lisp/help.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defvar help-map (make-sparse-keymap) "\ Keymap for characters following the Help key.") (byte-code "À  !Ä#ˆÄ MˆÀ  !Æ#ˆÀ ÇÆ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÙ#ˆÀ ÛÜ#ˆÀ ÝÞ#ˆÀ ßà#ˆÀ áâ#ˆÀ ãä#ˆÀ åæ#ˆÀ çæ#ˆÀ èé#ˆêéë\"ˆÀ ìí#ˆÀ îï#ˆÀ ðñ#ˆÀ òó#‡" [define-key global-map char-to-string help-char help-command help-map help-for-help "?" "" 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" "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 autoload "finder" "s" describe-syntax "t" help-with-tutorial "w" where-is "v" describe-variable] 4) (defalias 'help-with-tutorial #[nil "ÀÁ!à ˆÄ\n!ƒÅÄ\n!!‚SÅÆ\n!!ˆ\nÀÈ! Ê ÌÀÍ\"!ˆebˆÏÐ!ˆÑyˆ`ʈ`|ˆÒÓÔ !Õe`\"ZÖ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 newline window-height selected-window count-lines 6 set-buffer-modified-p] 5 "\ Select the Emacs learn-by-doing tutorial." nil]) (defalias 'describe-key-briefly #[(key) "‰GSH‰<ƒ @ 9ƒÂà !>ƒÄ ˆ)Å!‰ƒ.¨ƒ7ÇÈÉ!\"‚LÇÊÉ!9ƒG‚KË!#)‡" [key type down event-modifiers read-event key-binding defn message "%s is undefined" key-description "%s runs the command %s" prin1-to-string] 6 "\ Print the name of the function KEY invokes. KEY is a string." "kDescribe key briefly: "]) (defalias 'print-help-return-message #[(&optional function) "À !?…'\n† ÃÄÅÆ!ƒ ƒÈ‚!É‚!Ê!ÄË!P!‡" [get-buffer-window standard-output function message substitute-command-keys one-window-p t pop-up-windows "Type \\[delete-other-windows] to remove help window." "Type \\[switch-to-buffer] RET to remove help window." "Type \\[switch-to-buffer-other-window] RET to restore the other window." " \\[scroll-other-window] to scroll the help."] 4 "\ 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 'describe-key #[(key) "‰GSH‰<ƒ @ 9ƒÂà !>ƒÄ ˆ)Å!‰ƒ.¨ƒ7ÇÈÉ!\"‚ZÊË!ˆÌÍ!ˆÎ!ƒSÌÎ!!ˆ‚WÌÏ!ˆÐ ‘)‡" [key type down event-modifiers read-event key-binding defn message "%s is undefined" key-description "*Help*" prin1 princ ":\n" documentation "not documented" print-help-return-message] 5 "\ Display documentation of the function invoked by KEY. KEY is a string." "kDescribe key: "]) (defalias 'describe-mode #[(&optional minor) "ÀÁ\n!ˆÁÃ!ˆÁÄ !!ˆÇ ‰ ƒ\\ @@\n @A@ \nž‰ ƒR AƒRÍ\n!ƒRÁÎÏ\n #!ˆÁÄ\n!!ˆ+ A‰ „*Ð ‘‡" ["*Help*" princ mode-name " Mode:\n" documentation major-mode minor-mode-alist buffer-local-variables locals minor-modes minor-mode indicator local-binding fboundp format "\n\n\n%s minor mode (indicator%s):\n" print-help-return-message] 7 "\ Display documentation of current major mode. If optional 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." nil]) (byte-code "ÀÁKM‡" [defining-kbd-macro start-kbd-macro] 2) (defalias 'describe-distribution #[nil "ÀÁ \"!‡" [find-file-read-only expand-file-name "DISTRIB" data-directory] 4 "\ Display info on how to obtain the latest version of GNU Emacs." nil]) (defalias 'describe-copying #[nil "ÀÁ \"!ˆeb‡" [find-file-read-only expand-file-name "COPYING" data-directory] 4 "\ Display info on how you may redistribute copies of GNU Emacs." nil]) (defalias 'describe-project #[nil "ÀÁ \"!ˆeb‡" [find-file-read-only expand-file-name "GNU" data-directory] 4 "\ Display info on the GNU project." nil]) (defalias 'describe-no-warranty #[nil "À ˆÁÃÄ!ˆÅÆ!)‡" [describe-copying nil case-fold-search search-forward "NO WARRANTY" recenter 0] 2 "\ Display info on all the kinds of warranty Emacs does NOT have." nil]) (defalias 'describe-prefix-bindings #[nil "À  GSÃ\"ÃÆÆ GWƒ# HIˆ T‰‚Ç !+‡" [this-command-keys key make-vector nil prefix i 0 describe-bindings] 5 "\ 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." nil]) (byte-code "ÀÀ‡" [describe-prefix-bindings prefix-help-command] 1) (defalias 'view-emacs-news #[nil "ÀÁ \"!‡" [find-file-read-only expand-file-name "NEWS" data-directory] 4 "\ Display info on recent changes to Emacs." nil]) (defalias 'view-lossage #[nil "ÀÁÂà !!ˆŠ qˆebˆÅÆ!ˆm„$ÇÈÉÊ#ˆËcˆ‚)Ì ‘‡" ["*Help*" princ key-description recent-keys standard-output move-to-column 50 search-forward " " nil t "\n" print-help-return-message] 5 "\ Display last 100 input keystrokes." nil]) (defalias 'help-for-help #[nil "ÀÁ!Ã\n!ˆÄ ÅÈŽÉ=„ \n=ƒlË ÌÍ!ˆÎ ˆÏÐ!cˆebˆ\nÑB>ƒlÒ>ƒGÓ ˆÔ>ƒQÕ ˆÃÖ\n×d!ƒ^Ø‚_Ù#ˆÚÄ )‚3¨ƒx—‚zžA‰ƒ¥Þ!ƒ‘ßà!‚»ƒžá!ˆÅâ!‚»<ƒ¹#B#ʼ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. Type \\[help-command] again for more help: " line-prompt message read-event nil config char ((byte-code "ƒÁ!ˆÁ‡" [config set-window-configuration] 2)) 63 help-char current-window-configuration switch-to-buffer-other-window "*Help*" erase-buffer documentation help-for-help (63 22 32 127 -8388490) (22 32) scroll-up (127 -8388490) scroll-down "%s%s: " pos-visible-in-window-p "" " or Space to scroll" t cursor-in-echo-area help-map defn keymapp error "sorry, this command cannot be run from the help screen. Start over." set-window-configuration call-interactively unread-command-events ding] 6 "\ You have typed \\[help-command], the help character. Type a Help option: a command-apropos. Give a substring, and see a list of commands (functions interactively callable) that contain that substring. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; it prints the function name that sequence runs. f describe-function. Type a function name and get documentation of it. C-f Info-goto-emacs-command-node. Type a function name; it takes you to the Info node for that command. i info. The info documentation reader. k describe-key. Type a command key sequence; it displays the full documentation. C-k Info-goto-emacs-key-command-node. Type a command key sequence; it takes you to the Info node for the command bound to that key. l view-lossage. Shows last 100 characters you typed. m describe-mode. Print documentation of current major mode, which describes the commands peculiar to it. n view-emacs-news. Shows emacs news file. p finder-by-keyword. Find packages matching a given topic keyword. 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." nil]) (defalias (quote function-called-at-point) #[nil "ÀÁ† ÀÃć" [nil (byte-code "ŠŒe`ÀZ]d}ˆÁÂ!ˆÂuˆÃÅp!‰9…#Æ !…# +‡" [1000 backward-up-list 1 nil obj read fboundp] 4) ((error)) (byte-code "ŠÀÁ!ˆÂÃwˆÄp!‰9…Æ !… *‡" [forward-sexp -1 "'" nil read obj fboundp] 3) ((error))] 3]) (defalias 'describe-function #[(function) "ÀÁ\n!ˆÃÄ!ˆ\nKÆ !ƒÇ‚È à ;„&Ê !ƒ*Ë‚˜Ì !ƒ7 ÍP‚˜Î !ƒD ÏP‚˜ 9ƒPÐÑ \"‚˜ ¢Ò=ƒ^ ÓP‚˜ ¢Ô=ƒiÕ‚˜ ¢Ö=ƒtׂ˜ ¢Ø=ƒ—ÐÙÆ !ƒ‡Ú‚ˆÛÜ 8ƒ’Ý‚“Þ#‚˜ß!ˆà ˆÎ !ƒ«á â\"@‚¹ ¢Ò=ƒ¸ A@‚¹ã‰$<ƒÍÃ\nåæ$\"B!ˆà ˆ)ç\n!ƒàà ˆÃç\n!!ˆ‚äÃè!ˆ*é ˆŠ*qˆë )‘‡" ["*Help*" prin1 function princ ": " def 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" "" terpri append nil t arglist mapcar #[(arg) "Á>ƒ‡ÂÃ!–!‡" [arg (&optional &rest) intern symbol-name] 3] documentation "not documented" print-help-return-message standard-output buffer-string] 8 "\ Display the full documentation of FUNCTION (a symbol)." (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 (quote variable-at-point) #[nil "ÀÁ‡" [nil (byte-code "ŠÀÁ!ˆÂÃwˆÄp!‰9…Æ !… *‡" [forward-sexp -1 "'" nil read obj boundp] 3) ((error))] 3]) (defalias 'describe-variable #[(variable) "ÀÁ\n!ˆÃÄ!ˆÅ\n!„ÃÆ!ˆ‚Á\nJ!ˆÇ ˆÇ ˆÃÈ!ˆÇ ˆÉ\nÊ\"‰ ƒ=ÃÌ !!ˆ‚AÃÍ!ˆ)Î ˆŠqˆÐ )‘‡" ["*Help*" prin1 variable princ "'s value is " boundp "void." terpri "Documentation:" documentation-property variable-documentation doc substitute-command-keys "not documented as a variable." print-help-return-message standard-output buffer-string] 5 "\ Display the full documentation of VARIABLE (a symbol). Returns the documentation as a string, also." (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)]) (defalias 'command-apropos #[(string) "ÀÁ!ÃÄ!)ÆÈÉ#… …Å !)‡" [get-buffer-create "*Help*" standard-output print-help-return-message identity message apropos string t commandp] 4 "\ Like apropos but lists only symbols that are names of commands (interactively callable functions). Argument REGEXP is a regular expression that is matched against command symbol names. Returns list of symbols and documentation found." "sCommand apropos (regexp): "]) (defalias 'locate-library #[(library &optional nosuffix) "ÀÁ‡" [answer (byte-code "ÀÁ\n\"ˆÃÄ \"ˆÆ‡" [mapcar #[(dir) "ÀÁ\nƒ\n Ä\"‡" [mapcar #[(suf) "À \nP \"Å !…Æ !?…ÇÈ \"ˆÉÊ \")‡" [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 "\ 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')." "sLocate library: "]) emacs-19.22/lisp/helper.elc100666 13437 1 5645 5416167244 14201 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:16:52 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/helper.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÀÃ!„ „BÄ Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÅ ÎÏ#ˆÅ Ð!Ï#ˆÃ MˆÒÓÔ\"‡" [boundp Helper-return-blurb nil 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 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]] 4) (defalias 'Helper-help-options #[nil "ÀÁ!ˆÂÃ!‡" [message "c (key briefly), m (mode), k (key), b (bindings)" sit-for 4] 2 "\ Describe help options." nil]) (defalias 'Helper-describe-key-briefly #[(key) "À !ˆÂÃ!‡" [describe-key-briefly key sit-for 4] 2 "\ Briefly describe binding of KEY." "kDescribe key briefly: "]) (defalias 'Helper-describe-key #[(key) "À‹ˆÁ ‡" [((describe-key key)) Helper-help-scroller] 1 "\ Describe binding of KEY." "kDescribe key: "]) (defalias 'Helper-describe-function #[nil "À‹ˆÁ ‡" [((byte-code "ÀÁ!‡" [call-interactively describe-function] 2)) Helper-help-scroller] 1 "\ Describe a function. Name read interactively." nil]) (defalias 'Helper-describe-variable #[nil "À‹ˆÁ ‡" [((byte-code "ÀÁ!‡" [call-interactively describe-variable] 2)) Helper-help-scroller] 1 "\ Describe a variable. Name read interactively." nil]) (defalias 'Helper-describe-mode #[nil "Á\n!ŠÄÅ!qˆÆ ˆ Ç ±ˆ+È ‡" [mode-name documentation major-mode name get-buffer-create "*Help*" erase-buffer " Mode\n" Helper-help-scroller] 3 "\ Describe the current mode." nil]) (defalias 'Helper-describe-bindings #[nil "ÀÁ!ˆÂ‹ˆÃ ‡" [message "Making binding list..." ((describe-bindings)) Helper-help-scroller] 2 "\ Describe local key bindings of current mode." nil]) (defalias 'Helper-help #[nil "ÀÁ …>ÄÅ!ˆÆÇ —!È \n\"‰Ê=ƒ$Ê ˆ‚Ë\n!ƒ4Ì\n!ˆÁ‰‚Í ˆÁ‰„Á*‡" [t nil c continue message "Help (Type ? for further options)" char-to-string read-char lookup-key Helper-help-map Helper-help-options commandp call-interactively ding] 4 "\ Provide help for current mode." nil]) (provide (quote helper)) emacs-19.22/lisp/hexl.elc100666 13437 1 37301 5474621343 13673 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:01:20 1993 ;;; from file /home/fsf/rms/e19/lisp/hexl.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (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.") (byte-code "ÀÁ!„‡" [boundp hexl-mode-map nil] 2) (defalias 'hexl-mode #[(&optional arg) "Á=ƒ\nÂÃ!‡Ä ˆÅÆ!ˆÇ È !ˆÅÊ!ˆ \nÌ ÅÍ!ˆ ÁÅÎ!ˆÏÎÐ\"ˆÑ `S×=„^ƒ^Ø SÙ¥Ú_Û\\‰‚vÝØ 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 buffer-modified-p buffer-read-only original-point read-only modified arg 1 buffer-size 68 16 15 hexl-max-address nil hexlify-buffer set-buffer-modified-p hexl-goto-address] 3 "\ \\ 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." "p"]) (byte-code "ÀÁ!„‡" [boundp hexl-in-save-buffer nil] 2) (defalias 'hexl-save-buffer #[nil "?…`Á ƒXŠÃÄ!Å Æ edÇ \n  ‰ qˆÎ \n #ˆ qˆÏ ˆÐÑ ˆ) 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 save-buffer kill-buffer message "(No changes need to be saved)"] 8 "\ Save a hexl format buffer as binary in visited file if modified." nil]) (defalias 'hexl-find-file #[(filename) "À !ˆ\nÃ=?… à ‡" [find-file filename major-mode hexl-mode] 2 "\ Edit file FILENAME in hexl-mode. Switch to a buffer visiting file FILENAME, creating one in none exists." "fFilename: "]) (defalias 'hexl-mode-exit #[(&optional arg) "Á=„\n„+Â Ä TÈÉ ˆÊËÌ\"ˆÍ!ˆ bˆ+Ð!ˆÔp!‡" [arg 1 buffer-modified-p buffer-read-only hexl-current-address original-point read-only modified nil 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 switch-to-buffer] 3 "\ Exit Hexl mode, returning to previous mode. With arg, don't unhexlify buffer." "p"]) (defalias 'hexl-current-address #[nil "`À¦ÁZÂ`À¥Å_ ‰Æ¥ZÇ¥\\‰*‡" [68 11 0 hexl-address current-column 16 5 2] 5 "\ Return current hexl-address." nil]) (defalias 'hexl-address-to-marker #[(address) "Á¥Â_Á¦Ã_Ä¥Å\\\\‡" [address 16 68 5 2 11] 3 "\ Return marker for ADDRESS." "nAddress: "]) (defalias 'hexl-goto-address #[(address) "ÁW„ \nVƒÃÄ!ˆÅ!b‡" [address 0 hexl-max-address error "Out of hexl region." hexl-address-to-marker] 2 "\ Goto hexl-mode (decimal) address ADDRESS. Signal error if ADDRESS out of range." "nAddress: "]) (defalias 'hexl-goto-hex-address #[(hex-address) "ÀÁ\n!!‡" [hexl-goto-address hexl-hex-string-to-integer hex-address] 3 "\ Go to hexl-mode address (hex string) HEX-ADDRESS. Signal error if HEX-ADDRESS is out of range." "sHex Address: "]) (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 "\ Return decimal integer for HEX-STRING." "sHex number: "]) (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 "\ Return decimal integer for OCTAL-STRING." "sOctal number: "]) (defalias 'hexl-backward-char #[(arg) "ÀÁ \nZ!‡" [hexl-goto-address hexl-current-address arg] 3 "\ Move to left ARG bytes (right if ARG negative) in hexl-mode." "p"]) (defalias 'hexl-forward-char #[(arg) "ÀÁ \n\\!‡" [hexl-goto-address hexl-current-address arg] 3 "\ Move right ARG bytes (left if ARG negative) in hexl-mode." "p"]) (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 "\ Move to left ARG shorts (right if ARG negative) in hexl-mode." "p"]) (defalias 'hexl-forward-short #[(arg) "À [!‡" [hexl-backward-short arg] 2 "\ Move right ARG shorts (left if ARG negative) in hexl-mode." "p"]) (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 "\ Move to left ARG words (right if ARG negative) in hexl-mode." "p"]) (defalias 'hexl-forward-word #[(arg) "À [!‡" [hexl-backward-word arg] 2 "\ Move right ARG words (left if ARG negative) in hexl-mode." "p"]) (defalias 'hexl-previous-line #[(arg) "À [!‡" [hexl-next-line arg] 2 "\ 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." "p"]) (defalias 'hexl-next-line #[(arg) "ÀÁ \nÃ_\\\nÅWƒ ÅWƒ ÆÇ!ˆÁ æ‚N Vƒ8æ æWƒ8‚N VƒNÆÇ!ˆÉÊ\"Á æ\\ )!‡" [hexl-goto-address hexl-current-address arg 16 address 0 message "Out of hexl region." hexl-max-address logand -16] 4 "\ 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." "p"]) (defalias 'hexl-beginning-of-buffer #[(arg) "À`!ˆÁ\nS!‡" [push-mark hexl-goto-address arg] 2 "\ 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." "p"]) (defalias 'hexl-end-of-buffer #[(arg) "À`!ˆÁ\n SZ!‡" [push-mark hexl-goto-address hexl-max-address arg] 3 "\ Go to `hexl-max-address' minus ARG." "p"]) (defalias 'hexl-beginning-of-line #[nil "`À¥À_Á\\b‡" [68 11] 2 "\ Goto beginning of line in hexl mode." nil]) (defalias 'hexl-end-of-line #[nil "ÀÁ Ã\"‰ Vƒ  )!‡" [hexl-goto-address logior hexl-current-address 15 address hexl-max-address] 5 "\ Goto end of line in hexl mode." nil]) (defalias 'hexl-scroll-down #[(arg) "„ Á S‚Â!Ã[!‡" [arg window-height prefix-numeric-value hexl-scroll-up] 2 "\ Scroll hexl buffer window upward ARG lines; or near full window if no ARG." "P"]) (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 "\ Scroll hexl buffer window upward ARG lines; or near full window if no ARG." "P"]) (defalias 'hexl-beginning-of-1k-page #[nil "ÀÁ Ã\"!‡" [hexl-goto-address logand hexl-current-address -1024] 4 "\ Goto to beginning of 1k boundry." nil]) (defalias 'hexl-end-of-1k-page #[nil "ÀÁ Ã\"‰ Vƒ  )!‡" [hexl-goto-address logior hexl-current-address 1023 address hexl-max-address] 5 "\ Goto to end of 1k boundry." nil]) (defalias 'hexl-beginning-of-512b-page #[nil "ÀÁ Ã\"!‡" [hexl-goto-address logand hexl-current-address -512] 4 "\ Goto to beginning of 512 byte boundry." nil]) (defalias 'hexl-end-of-512b-page #[nil "ÀÁ Ã\"‰ Vƒ  )!‡" [hexl-goto-address logior hexl-current-address 511 address hexl-max-address] 5 "\ Goto to end of 512 byte boundry." nil]) (defalias 'hexl-quoted-insert #[(arg) "ÀÁ \n\"‡" [hexl-insert-char read-quoted-char arg] 3 "\ 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" "p"]) (defalias 'hexlify-buffer #[nil "Àed Â$‡" [shell-command-on-region hexlify-command t] 5 "\ Convert a binary buffer to hexl format" nil]) (defalias 'dehexlify-buffer #[nil "Àed Â$‡" [shell-command-on-region dehexlify-command t] 5 "\ Convert a hexl format buffer to binary." nil]) (defalias 'hexl-char-after-point #[nil "À`f`Tf\"‡" [hexl-htoi] 3 "\ Return char for ASCII hex digits at point."]) (defalias 'hexl-htoi #[(lh rh) "À !Â_À !\\‡" [hexl-hex-char-to-integer lh 16 rh] 3 "\ Hex (char) LH (char) RH to integer."]) (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 "\ Take a char and return its value as if it was a hex digit."]) (defalias 'hexl-oct-char-to-integer #[(character) "ÁYƒÂXƒÁZ‡ÃÄÅ\"!‡" [character 48 55 error format "Invalid octal digit `%c'."] 4 "\ Take a char and return its value as if it was a octal digit."]) (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 "\ Return a displayable string for character CH."]) (defalias 'hexl-self-insert-command #[(arg) "À \n\"‡" [hexl-insert-char last-command-char arg] 3 "\ Insert this character." "p"]) (defalias 'hexl-insert-char #[(ch num) "À \nÃV…EÄÅ!ˆÆÇ\"cˆ É¥Ê_ ɦË\\\\bˆÄÌ!ˆÍ!cˆ =ƒ9Ï !ˆ‚>Ï T!ˆ\nS‰‚)‡" [hexl-current-address address num 0 delete-char 2 format "%02x" ch 16 68 52 1 hexl-printable-character hexl-max-address hexl-goto-address] 4 "\ Insert a character in a hexl buffer."]) (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 "\ Insert a ASCII char ARG times at point for a given hexadecimal number." "p"]) (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 "\ Insert a ASCII char ARG times at point for a given decimal number." "p"]) (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 "\ Insert a ASCII char ARG times at point for a given octal number." "p"]) (byte-code "„NÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÍÎ!!Ð=„7ÂÈ#ˆÂÑÒ#ˆÂÓÒ#ˆÂÔÈ#ˆÂÕÒ#ˆÂÖ×#ˆÂØÈ#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÈ#ˆÂÞß#ˆÂàÈ#ˆÂáÈ#ˆâ#âäWƒ›Âåæ#\"Ò#ˆ#T‰#‚ƒ)Âçè#ˆÂéê#ˆÂëÈ#ˆÂìí#ˆÂîï#ˆÂðñ#ˆÂòÈ#ˆÂóÈ#ˆÂôÈ#ˆÂõÈ#ˆÂöÈ#ˆÂ÷È#ˆÂøÈ#ˆÂùÈ#ˆÂúû#ˆÂüÈ#ˆÂýÈ#ˆÂþÈ#ˆÂÿÈ#ˆÂ@È#ˆÂAÈ#ˆÂBÈ#ˆÂCD#ˆÂEÈ#ˆÂFÈ#ˆÂGH#ˆÂIÈ#ˆÂJÈ#ˆÂKÈ#ˆÂLM#ˆÂNO#ˆÂPÈ#ˆÂQÈ#ˆÂRS#ˆÂTÈ#ˆÂUÈ#ˆÂVÈ#ˆÂWÈ#ˆÂXÈ#ˆÂYÈ#ˆÂZÈ#ˆÂ[È#ˆÂ\\È#ˆÂ]È#ˆÂ^È#ˆÂ_`#ˆÂaÈ#ˆÂbÈ#ˆÂcd#ˆÂef#ˆÂgh#ˆÂij#ˆÂkl#ˆÂmÈ#ˆÂno#ˆÂpÈ#ˆÁ‡" [hexl-mode-map make-sparse-keymap define-key "" hexl-beginning-of-line "" hexl-backward-char "" undefined "" hexl-end-of-line "" hexl-forward-char key-binding char-to-string help-char help-command " " hexl-self-insert-command "\n" " " " " "" hexl-next-line "" "" hexl-previous-line "" hexl-quoted-insert "" "" hexl-scroll-up "" "" 32 ch 127 format "%c" "" hexl-beginning-of-512b-page "" hexl-backward-short "" "" hexl-insert-decimal-char "" hexl-end-of-512b-page "" hexl-forward-short "" "" " " "\n" " " " " " " "" "" 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" hexl-scroll-down "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.22/lisp/hideif.elc100666 13437 1 41123 5416167367 14167 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:18:14 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/hideif.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar hide-ifdef-mode-map nil "\ Keymap used with Hide-Ifdef mode") (defconst hide-ifdef-mode-prefix-key "" "\ Prefix key for all Hide-Ifdef mode commands.") (defvar hide-ifdef-mode-map-before nil "\ Buffer-local variable to store a copy of the local keymap before `hide-ifdef-mode' modifies it.") (defalias (quote define-hide-ifdef-mode-map) #[nil "„uÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆáâã‰ä$‰%ƒtÂ%æ#ˆ)ÀM‡" [hide-ifdef-mode-map 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 "" forward-ifdef "" backward-ifdef "" down-ifdef "" up-ifdef "" next-ifdef "" previous-ifdef "" hide-ifdef-toggle-read-only where-is-internal toggle-read-only nil t where hide-ifdef-toggle-outside-read-only] 6]) (defalias 'hif-update-mode-line #[nil "ÀÁ !‡" [set-buffer-modified-p buffer-modified-p] 2 "\ Update mode-line by setting buffer-modified to itself."]) (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.") (byte-code "À ž„\n Bà ž„Ä BÀ‡" [hide-ifdef-hiding minor-mode-alist (hide-ifdef-hiding " Hiding") hide-ifdef-mode (hide-ifdef-mode " Ifdef")] 2) (defalias 'hide-ifdef-mode #[(arg) "ÀÁ!ˆ\n„ ?‚Ã\n!ÄVÅ ˆ ƒvÆÇÈ\"ˆÆÉÊ\"ˆÆËÊ\"ˆÀÌ!ˆÍÌ! ÀÎ!ˆÍÎ!ÀÏ!ˆÀÑ!ˆÒ ÓÔÒ !!ˆÕ!ˆ×Ø\"ˆÙ ˆÚÛ!ˆƒoÝ ˆ‚rÞ ˆßà!‡ƒ~Þ ˆÓ!ˆßá!‡" [make-local-variable hide-ifdef-mode arg prefix-numeric-value 0 hif-update-mode-line modify-syntax-entry 95 "w" 38 "." 124 hide-ifdef-env default-value hide-ifdef-hiding hif-outside-read-only buffer-read-only hide-ifdef-mode-map-before current-local-map use-local-map copy-keymap local-unset-key hide-ifdef-mode-prefix-key local-set-key hide-ifdef-mode-map define-hide-ifdef-mode-map run-hooks hide-ifdef-mode-hook hide-ifdef-initially hide-ifdefs show-ifdefs message "Enter hide-ifdef-mode." "Exit hide-ifdef-mode."] 3 "\ 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}" "P"]) (defalias 'hif-outline-flag-region #[(from to flag) "À ÂŽÃ ÇUƒÈ‚ÇÉ%*‡" [buffer-modified-p modp ((set-buffer-modified-p modp)) subst-char-in-region from to flag 10 13 t] 6 "\ 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-show-all #[nil "ÀedÁ#‡" [hif-outline-flag-region 10] 4 "\ Show all of the text in the current buffer." nil]) (defalias 'hide-ifdef-region #[(start end) "À \nÃ#‡" [hif-outline-flag-region start end 13] 4 "\ START is the start of a #if or #else form. END is the ending part. Everything including these lines is made invisible."]) (defalias 'hif-show-ifdef-region #[(start end) "À \nÃ#‡" [hif-outline-flag-region start end 10] 4 "\ Everything between START and END is made visible."]) (defvar hide-ifdef-evaluator (quote 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.") (defalias 'hif-set-var #[(var value) " B\nB‰‡" [var value hide-ifdef-env] 2 "\ Prepend (var value) pair to hide-ifdef-env."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÅÇPÉP\nËP ÍP\nÏ Ï°À‡" [defalias hif-lookup #[(var) "À \n\"‰ƒ A‚ )‡" [assoc var hide-ifdef-env val hif-undefined-symbol] 4] hif-defined #[(var) "À !‡" [hif-lookup var] 2] "\\(^\\| \\)[ ]*#[ ]*" hif-cpp-prefix "ifndef" hif-ifndef-regexp "if\\(n?def\\)?[ ]+" hif-ifx-regexp "else" hif-else-regexp "endif" hif-endif-regexp "\\|" hif-ifx-else-endif-regexp] 5) (defalias 'hif-infix-to-prefix #[(token-list) "GÁUƒÂÃ@DD‡Ä!‡" [token-list 1 hif-lookup quote hif-parse-if-exp] 3 "\ Convert list of tokens in infix into prefix list"]) (byte-code "ÀÂć" ["^\\(!\\|&&\\|||\\|[()]\\|\\w+\\)" hif-token-regexp "\\*/" hif-end-of-comment nil] 1) (defalias 'hif-tokenize #[(expr-string) "ÀÁ\nG Wƒ»ÆÇ\n #ƒ!Á•\n SÈIˆ‚ÆÉ\n #ƒMÁ•\n SÈIˆÆ\n\n #„AÆË\n #ˆÁ•\n SÈIˆ‚Æ \n #ƒ³\n Á•O Á•\n SÈIˆ ΘƒqÏ‚¬ Иƒ|Ñ‚¬ Ò˜ƒ‡Ó‚¬ Ô˜ƒ’Õ‚¬ Ö˜ƒ×‚¬ ؘƒ¨Ù‚¬Ú ! B)‚ÛÜ\n\"ˆ‚ Ÿ+‡" [nil 0 expr-string expr-length expr-start token-list string-match "^[ ]+" 10 "^/\\*" hif-end-of-comment "$" hif-token-regexp token "||" or "&&" and "!" not "defined" hif-defined "(" lparen ")" rparen intern error "Bad #if expression: %s"] 4 "\ Separate string into a list of tokens"]) (defalias 'hif-parse-if-exp #[(token-list) "À ˆÁ \nƒÃÄ\n\"ˆ‡" [hif-nexttoken hif-expr token error "Error: unexpected token: %s"] 4 "\ Parse the TOKEN-LIST. Return translated list in prefix form."]) (defalias 'hif-nexttoken #[nil "@A ‡" [token-list token] 1 "\ Pop the next token from token-list into the let variable \"token\"."]) (defalias 'hif-expr #[nil "À \nÃ=ƒÄ ˆÃ À E‚ )‡" [hif-term result token or hif-nexttoken] 3 "\ Parse and expression of the form expr : term | expr '||' term."]) (defalias 'hif-term #[nil "À \nÃ=ƒÄ ˆÃ À E‚ )‡" [hif-factor result token and hif-nexttoken] 3 "\ Parse a term of the form term : factor | term '&&' factor."]) (defalias 'hif-factor #[nil "Á=ƒ ˆÁà D‡Ä=ƒ/ ˆÅ Ç=„(ÈÉ\"‚- ˆ)‡Ê=ƒk ˆÄ=„BÈË!ˆÂ ˆ Í>ƒSÈÎ\"ˆÂ ˆÇ=„`ÈÏ!ˆÂ ˆÊÐ )DD‡‰ Ñ>ƒxÈÒ!ˆÂ ˆÓÐ )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 "\ Parse a factor of the form factor : '!' factor | '(' expr ')' | 'defined(' id ')' | id."]) (defalias 'hif-canonicalize #[nil "ŠÀ !à !ˆ`ÅÆ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 "\ When at beginning of #ifX, returns a canonical (evaluatable) form for the expression."]) (defalias 'hif-find-any-ifX #[nil "À dÂ#Ãyˆ‡" [re-search-forward hif-ifx-regexp t 0] 4 "\ Position at beginning of next #if, #ifdef, or #ifndef, 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 "\ Position at beginning of next #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 "\ Position at beginning of previous #ifdef, #ifndef, #else, #endif, NOT including one on this line."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias hif-looking-at-ifX #[nil "À !‡" [looking-at hif-ifx-regexp] 2] hif-looking-at-endif #[nil "À !‡" [looking-at hif-endif-regexp] 2] hif-looking-at-else #[nil "À !‡" [looking-at hif-else-regexp] 2]] 3) (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 "\ If positioned at #ifX or #else form, skip to corresponding #endif."]) (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 "\ If positioned at #endif form, skip backward to corresponding #ifX."]) (defalias 'forward-ifdef #[(&optional arg) "„ÁÂWƒÃ[!ˆÂW…:[`Å „$Æ ˆÅ ƒ/Ç ˆ‚6 bˆÈÉ!ˆ)‚‡" [arg 1 0 backward-ifdef start hif-looking-at-ifX hif-find-next-relevant hif-ifdef-to-endif error "No following #ifdef"] 2 "\ Move point to beginning of line of the next ifdef-endif. With argument, do this that many times." "p"]) (defalias 'backward-ifdef #[(&optional arg) "„ÁÂWƒÃ[!ˆÂW…=SÂyˆ`Å „'Æ ˆÅ ƒ2Ç ˆ‚9 bˆÈÉ!ˆ)‚‡" [arg 1 0 forward-ifdef start hif-looking-at-endif hif-find-previous-relevant hif-endif-to-ifdef error "No previous #ifdef"] 2 "\ Move point to beginning of the previous ifdef-endif. With argument, do this that many times." "p"]) (defalias 'down-ifdef #[nil "`Á ˆÂ † à ?…bˆÄÅ!)‡" [start hif-find-next-relevant hif-looking-at-ifX hif-looking-at-else error "No following #ifdef"] 2 "\ Move point to beginning of nested ifdef or else-part." nil]) (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 "\ Move point to beginning of enclosing ifdef or else-part." nil]) (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 "\ Move to the beginning of the next #ifX, #else, or #endif. With argument, do this that many times." "p"]) (defalias 'previous-ifdef #[(&optional arg) "„ÁÂWƒÃ[!ˆÂW…-S`Å ˆ `Uƒ)ÆÇ!ˆ)‚‡" [arg 1 0 next-ifdef start hif-find-previous-relevant error "No previous #ifdefs, #elses, or #endifs"] 2 "\ Move to the beginning of the previous #ifX, #else, or #endif. With argument, do this that many times." "p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias hif-make-range #[(else-p start end &optional else) " \n F‡" [else-p start else end] 4] hif-range-else-p #[(range) "Áœ‡" [range 0] 2] hif-range-start #[(range) "Áœ‡" [range 1] 2] hif-range-else #[(range) "Áœ‡" [range 2] 2] hif-range-end #[(range) "Áœ‡" [range 3] 2]] 3) (defalias 'hif-find-range #[nil "ŠÀyˆ`Á‰‰Æ ˆÇ ƒÈ ˆÆ ˆ‚É ƒ)Ê`‚+` ƒKÆ ˆÇ ƒ@È ˆÆ ˆ‚2É ƒIËÌ!ˆ`Í \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 "\ Returns a Range structure describing the current #if region. Point is left unchanged."]) (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 "\ Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil."]) (defalias 'hif-recurse-on #[(start end) "ŠŒbˆÁˆ`\n}ˆÃ *‡" [start nil end hide-ifdef-guts] 2 "\ Call `hide-ifdef-guts' after narrowing to end of START line and END line."]) (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 "\ Called at #ifX expression, this hides those parts that should be hidden, according to judgement of `hide-ifdef-evaluator'."]) (defalias 'hide-ifdef-guts #[nil "ŠebˆÀ …Á ˆ‚)‡" [hif-find-any-ifX hif-possibly-hide] 1 "\ Does the work of `hide-ifdefs', except for the work that's pointless to redo on a recursive entry."]) (defvar hide-ifdef-initially nil "\ *Non-nil if `hide-ifdefs' should be called when Hide-Ifdef mode is first activated.") (defvar hide-ifdef-hiding nil "\ Non-nil if text might be hidden.") (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.") (defvar hide-ifdef-lines nil "\ *Set to t if you don't want to see the #ifX, #else, and #endif lines.") (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 hif-update-mode-line] 3 "\ Toggle hide-ifdef-read-only." nil]) (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 hif-update-mode-line] 3 "\ Replacement for `toggle-read-only' within Hide Ifdef mode." nil]) (defalias 'hide-ifdef-define #[(var) "À Â\"ˆ … Ä ‡" [hif-set-var var t hide-ifdef-hiding hide-ifdefs] 3 "\ Define a VAR so that #ifdef VAR would be included." "SDefine what? "]) (defalias 'hide-ifdef-undef #[(var) "À Â\"ˆ … Ä ‡" [hif-set-var var nil hide-ifdef-hiding hide-ifdefs] 3 "\ Undefine a VAR so that #ifdef VAR would not be included." "SUndefine what? "]) (defalias 'hide-ifdefs #[nil "ÀÁ!ˆ\n„ ÂÃ!ˆ ƒÅ ˆƒÇ ˆÈ ÈÊ ˆ „- ƒ0Ç ˆÀÍ!‡" [message "Hiding..." hide-ifdef-mode 1 hide-ifdef-hiding show-ifdefs buffer-read-only toggle-read-only t selective-display hide-ifdef-guts hide-ifdef-read-only hif-outside-read-only "Hiding done"] 2 "\ 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-ifdef'." nil]) (defalias 'show-ifdefs #[nil "ƒÁ ˆÂÄ ˆ ƒÁ ˆÂ‰‡" [buffer-read-only toggle-read-only nil selective-display hif-show-all hif-outside-read-only hide-ifdef-hiding] 2 "\ Cancel the effects of `hide-ifdef'. The contents of all #ifdefs is shown." nil]) (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 "\ Utility for hide and show `ifdef-block'. Set top and bottom of ifdef block."]) (defalias 'hide-ifdef-block #[nil "„ÀÁ!ˆ\nƒà ˆÄƉÉ ˆÊ\"ˆ ƒ1Ì!ˆÌT!ˆÄ *„?…Aà ‡" [hide-ifdef-mode 1 buffer-read-only toggle-read-only t selective-display nil 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] 3 "\ Hide the ifdef block (true or false part) enclosing or before the cursor." nil]) (defalias 'show-ifdef-block #[nil "‰ƒ  ˆ ƒŠÄyˆÅ`Sƈ`\"ˆ)‚0ƉÉ ˆÅS\"ˆ* …6 )‡" [buffer-read-only old-read-only toggle-read-only hide-ifdef-lines 0 hif-show-ifdef-region nil bottom top hif-find-ifdef-block] 4 "\ Show the ifdef block (true or false part) enclosing or before the cursor." nil]) (defvar hide-ifdef-define-alist nil "\ A global assoc list of pre-defined symbol lists") (defalias 'hif-compress-define-list #[(env) "ÀÁ\n\"Ƀ @ƒ @ B A‰„ *‡" [mapcar #[(arg) "À @!… @‡" [hif-lookup arg] 2] env nil new-defs defs] 4 "\ Compress the define list ENV into a list of defined symbols only."]) (defalias 'hide-ifdef-set-define-alist #[(name) "Á\n!B B‰‡" [name hif-compress-define-list hide-ifdef-env hide-ifdef-define-alist] 3 "\ Set the association for NAME to `hide-ifdef-env'." "SSet define list: "]) (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 "\ Set `hide-ifdef-env' to the define list specified by NAME." "SUse define list: "]) emacs-19.22/lisp/hilit19.elc100666 12120 1 72116 5451135626 14064 0ustar rmsdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:43:50 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/hilit19.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (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 "\ * 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 (quote hilit-auto-rehighlight)) (defvar hilit-auto-rehighlight-fallback (quote (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.") (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 (quote 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") (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.") (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 netcom.com:/pub/stig/src/Beta/hilit19.el.gz\n" " for a newer release that fixes the problem.\n" " >> I HAVE ALSO CHECKED netcom.com:/pub/stig/src/Beta/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 "\ Submit feedback on hilit19 to the author: Stig@netcom.com" nil]) (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))) "\ 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 (byte-code "À ƒ ž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) "\ alist that maps symbolic face-names to real face names") (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 "\ (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-lookup-face-create #[(face &optional force) "ÀÁ ƒ) \n>ƒÅÆ\n\"ˆ‚ \nB ž‰ƒ A‚*È ! Ê  ÌÍ !žAÁÁÁ ƒ) >„)„i Ó >ƒiƒ) ÎN˜„)ÕÖ×\"ˆØÙ \"ƒ‚Ú×!ˆ Û•ÁO ØÜ \"ƒ¥Ý”…Þ ߔߕOP Û•ÁO ‚ªÅà \"ˆØá \"ƒÊÝ”…¸Þ ߔߕOP Û•ÁO ☃ÔÁ☃ÞÁÁãäˆ „)å Á #ˆæ Øç \"\"ˆØè \"ƒé  ê#ˆå ë  \"À#ˆØì \"ƒ)í  ê#ˆå ë  \"À#ˆ. ‡" [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\"ˆÃÁ \"ˆÅÁ\"ˆÇÈ#‡" [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 face-font ".*italic" make-face-italic] 6 "\ 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-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 "\ 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 (quote hilit-region-set-face) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'hilit-unhighlight-region #[(start end &optional quietly) "„ „ ÂÃ!ˆÄƒ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 "\ Unhighlights the region from START to END, optionally in a QUIET way" "r"]) (defalias 'hilit-highlight-region #[(start end &optional patterns quietly) "„ \nžA‚9ƒ\nžA@GSɉ‰‰Ä \n  AŠŒ }ˆƒ@‰\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 Á Ê \" Ì Ä#ˆÌ †8ÍÎ#ˆ …EÌ Ï #)ˆ-‚)‚ ;ƒ¯ÐÁÎÁ$ƒÑ”‰bˆÐ ÁÎÁ$ƒ©Ñ• Á Ê \" Ì Ä#ˆÌ †–ÍÎ#ˆ …£Ì Ï #)ˆ-‚TÓuˆ‚T §ƒýÐÁÎÁ$ƒ •bˆ ” • Á Ê \" Ì Ä#ˆÌ †êÍÎ#ˆ …÷Ì Ï #)ˆ-‚´ÔÕ!ˆÁ‡" [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 "\ 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." "r"]) (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 "\ Re-highlights the region, optionally in a QUIET way" "r"]) (defalias 'hilit-rehighlight-buffer #[(&optional quietly) " žA‰ƒ\n !ˆ‚Äed #ˆ)Ň" [major-mode hilit-parser-alist parse-fn quietly hilit-rehighlight-region nil] 5 "\ Re-highlights the buffer, optionally in a QUIET way" ""]) (defalias (quote hilit-rehighlight-buffer-quietly) #[nil "ÀÁ!‡" [hilit-rehighlight-buffer t] 2]) (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 "\ Highlight a buffer containing a news article or mail message."]) (defalias (quote hilit-highlight-buffer) (quote hilit-rehighlight-buffer)) (defalias 'hilit-find-file-hook #[nil "…\" \nž…\" @Vƒ A V?…\"Ç ˆÈÉ!‡" [hilit-auto-highlight major-mode hilit-patterns-alist buffer-saved-size hilit-auto-rehighlight-fallback hilit-auto-rehighlight hilit-auto-highlight-maxout hilit-rehighlight-buffer set-buffer-modified-p nil] 2 "\ Find-file hook for hilit package. See the variable hilit-auto-highlight."]) (defalias 'hilit-repaint-command #[(arg) "À‰‰ „  Æ=„ Ç=ƒ#È É Ê‚A §ƒ:Š [yˆ`)Š yˆ`)‚A ƒAË ˆ …JÌ \n #+‡" [nil quietly en st arg hilit-auto-rehighlight visible - window-start window-end t hilit-rehighlight-buffer hilit-rehighlight-region] 4 "\ 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" "P"]) (defalias 'hilit-recenter #[(arg) "À !ˆÂÃ!ˆÄ :!‡" [recenter arg sit-for 0 hilit-repaint-command] 2 "\ 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." "P"]) (defalias 'hilit-yank #[(arg) "À !ˆ ƒÅÆ Ç È#ˆÂ‰ )‡" [nil transient-mark-mode yank arg hilit-auto-rehighlight hilit-rehighlight-region region-beginning region-end t this-command] 4 "\ Yank with rehighlighting" "*P"]) (defalias 'hilit-yank-pop #[(arg) "À !ˆ ƒÅÆ Ç È#ˆÉ‰\n)‡" [nil transient-mark-mode yank-pop arg hilit-auto-rehighlight hilit-rehighlight-region region-beginning region-end t yank this-command] 4 "\ Yank-pop with rehighlighting" "*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 [2097164] 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 gnus-article-prepare-hook gnus-summary-prepare-hook gnus-group-prepare-hook rmail-show-message-hook mail-setup-hook mh-show-mode-hook dired-after-readin-hook) add-hook gnus-mark-article-hook #[nil " >„\nÂ!ˆÃ ˆŠ qˆÅÆ Ç È#)‡" [gnus-current-article gnus-newsgroup-marked gnus-summary-mark-as-read gnus-summary-set-current-mark gnus-summary-buffer hilit-rehighlight-region window-start window-end t] 4]] 3) ((error (byte-code "ÀÁ\n\"ˆÃ ˆÄÅ!‡" [message "Error loading highlight hooks: %s" c ding sit-for 1] 3))) nil hilit-patterns-alist] 4) (defalias 'hilit-associate #[(alist key val) "Á\n!ž‰ƒ ¡‚\n BÁ\n!BL)‡" [key eval alist oldentry val] 5 "\ creates, or destructively replaces, the pair (key . val) in alist"]) (defalias 'hilit-set-mode-patterns #[(modelist patterns &optional parse-fn case-fold) "ÀÁ\n\"ˆ \nB :„ CÅ@Ç= ÀÊ \"*‡" [mapcar #[(p) "@;…A@?…AÁ ‡" [p 0] 2] patterns case-fold modelist nil hilit-mode-enable-list not flip ok #[(m) "?† > ƒ\n?\n…$ ƒÅÆ #ˆÅÇ #‡" [hilit-mode-enable-list m ok flip parse-fn hilit-associate hilit-parser-alist hilit-patterns-alist patterns] 4]] 3 "\ 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-add-pattern #[(pstart pend face &optional mode first) "Ášƒ\nÂÃ!ˆ ÁšƒÅ‚ ÆÇ \"ƒ È ! „)\n   žA  E ‰„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 "\ Highlight pstart with face for the current major-mode. Optionally, place the new pattern first in the pattern list" "sPattern start regex: \nsPattern end regex (default none): \nxFace: "]) (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 "\ 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."]) (byte-code "ÀÁÂÃÈÉÊ Ë$\"ˆÈÌÊ Í%\"ˆ,ÈÎÏ\"ˆÈÐÑ\"ˆÈÒÓÔÕ$ˆÈÖ×ÔÕ$ˆÈØÙ\"ˆÈÚÛ\"ˆÈÜÝ\"ˆÈÞß\"ˆÈàá\"ˆâ#ä%Ê#%\"&Èç#\"ˆÈè%\"ˆÈé&ê#ˆ+Èëì\"ˆÈíî\"ˆÈïð\"ˆÈñò\"ˆÈóô\"ˆÈõö\"ˆÈ÷øÔÕ$ˆÈùú\"ˆÈûÊüýþÿ@A#BQCBC\"\"ˆÈDE\"ˆÈFG\"ˆÈHI\"ˆÈJKÔÕ$ˆÈLM\"ˆNO!‡" [(("/\\*" "\\*/" 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)) 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)) gnus-summary-mode (("^D +[0-9]+: \\[.*$" nil summary-seen) ("^K +[0-9]+: \\[.*$" nil summary-killed) ("^X +[0-9]+: \\[.*$" nil summary-Xed) ("^- +[0-9]+: \\[.*$" nil summary-unread) ("^. +[0-9]+:\\+\\[.*$" nil summary-current) ("^ +[0-9]+: \\[.*$" nil summary-new)) 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\\)\\|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) ("[0-9]+\\*" nil defun) ("[0-9]+\\+" nil comment)) 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.22/lisp/hippie-exp.elc100666 13437 1 31620 5422175446 15002 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Sun Jul 18 03:26:29 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/hippie-exp.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÀÃ!„Ä ÀÅ!„Ä ÀÆ!„#ÇÀÈ!„,ÇÀÉ!„5Ç ÀÊ!„?Ä \nÀË!„HÇ ÀÌ!„QÇ ÀÍ!„ZÇ LJ" [boundp he-num -1 he-string-beg make-marker he-string-end he-search-string nil he-expand-list he-tried-table he-search-loc he-search-bw he-search-bufs he-searched-n-bufs] 2) (defvar hippie-expand-try-functions-list (quote (try-complete-file-name try-expand-all-abbrevs try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-complete-lisp-symbol)) "\ The list of expansion functions tried in order by `hippie-expand'. To change the behavior of `hippie-expand', remove, change the order of, or insert functions in this list.") (defvar hippie-expand-verbose t "\ *Non-nil makes `hippie-expand' output which function it is trying.") (defvar hippie-expand-max-buffers nil "\ *The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched.") (defalias 'hippie-expand #[(arg) "ƒ¨ƒ˜ÁVƒ˜\nÃU† š?‰ƒ$Ãǃ3„5É ˆ‚5Á\n\\Á]‰\n GY„\\Ì\n 8\n\nUC\"„\\\nT‰\n‚=\n)\n GYƒÃƒvÍÎ!ˆ‚zÍÏ!ˆÐ ‚–…–ÒÓ !?…–ÍÔÕ\n 8!P!)‡\nÁY…³ÃÉ ˆ…³ÒÓ !?…³ÍÖ!‡" [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 "Undoing expansions"] 6 "\ 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." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"‡" [defalias he-init-string #[(beg end) " “ˆ “ˆ {‰‡" [he-string-beg beg nil he-string-end end he-search-string] 3] he-reset-string #[nil "À \n |ˆ\nbˆ cˆ `Å“ˆ \nUƒ b‚ b)‡" [point-marker newpos he-string-beg he-string-end he-search-string nil] 3] he-substitute-string #[(str &optional trans-case) "… …\n…à \"Æ È ˆ bˆÊ !ˆËƒ* —‚+ ?Ì#ˆ `Γˆ UƒD b‚Gb*‡" [trans-case case-replace case-fold-search he-transfer-case-ok str he-search-string point-marker newpos he-reset-string he-string-beg search-forward replace-match literal he-string-end nil] 4] he-ordinary-case-p #[(str) "‰—˜†‰–˜†Á!˜‡" [str capitalize] 3] he-transfer-case-ok #[(to-str from-str) " ÂG G^O˜?…à !…Ã!‡" [from-str to-str 0 he-ordinary-case-p] 5] he-string-member #[(str lst) "ƒ# ƒ\nƒ@— —˜‚@ ˜„#A‰„‡" [lst case-fold-search case-replace str] 3]] 3) (defalias 'make-hippie-expand-function '(macro . #[(try-list &optional verbose) "ÀÁÂÃÄÅÆ!È#PÉÊËDÌ DDÎE¯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 "\ 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 'try-complete-file-name #[(old) "„IÁ `\"ˆÃ !ÅÆ !†Ç! Ê  \"„*  B Çš„EÌ!ƒEÍÎ \"Ï\"‚HÑ*ƒaÊ@ \"ƒaA‰„N„oƒmÒ ˆÑ‡Æ !@PÔ!ˆ@ B A)Õ‡" [old he-init-string he-file-name-beg file-name-nondirectory he-search-string expand-file-name file-name-directory "" dir-part name-part he-string-member he-tried-table file-directory-p sort file-name-all-completions string-lessp he-expand-list nil he-reset-string filename he-substitute-string t] 5 "\ 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-partially #[(old) "À\n„CÃÄ `\"ˆÅ!ÇÈ!†É!\n Éš„3Ì\n!ƒ3Í \n\" Î=„@  ˜ƒBÀ* „R\nƒNÏ ˆÀ‚gÈ! PÑ!ˆ B)Î)‡" [nil expansion old he-init-string he-file-name-beg file-name-nondirectory he-search-string expand-file-name file-name-directory "" dir-part name-part file-directory-p file-name-completion t he-reset-string filename he-substitute-string he-tried-table] 4 "\ 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 (quote he-file-name-beg) #[nil "ÀŠ Âxˆ`*‡" ["-a-zA-Z0-9_./~^#$" skips nil] 2]) (defalias 'try-complete-lisp-symbol #[(old) "„'Á `\"ˆÃ \"„ B Æš?…%ÇÈ  Ê#Ë\"  ƒ>à @ \"ƒ> A‰ „, „LƒJÍ ˆÎ‡Ï @!ˆ @ B A Ї" [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 "\ 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-partially #[(old) "À\n„'ÃÄ `\"ˆ Ƙ„Ç É# Ê=„% ˜ƒ'À „6\nƒ2Ë ˆÀ‚AÌ !ˆ  B Ê)‡" [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-reset-string he-substitute-string he-tried-table] 4 "\ 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 (quote he-lisp-symbol-beg) #[nil "ÀŠ Âxˆ`*‡" ["-a-zA-Z0-9_." skips nil] 2]) (defalias 'try-expand-line #[(old) "ÀÁp!…\n „ÆÇ !`\"ˆ À“ˆÊ  Íš„aŠ ƒKbˆÎ Ê#`À“ˆ „KÀ“ˆÀ „`bˆÎ À#`À“ˆ) „p ƒlÐ ˆÀ‚|Ñ Ê\"ˆ BÊ*‡" [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 he-tried-table] 4 "\ 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-all-buffers #[(old) "ÀÁp!…\np„'ÇÈ !`\"ˆÉ \nË  Î\n@“ˆК„¬\nƒ¬ „¬ƒD Wƒ¬\n@qˆp =„œÒÓÔp!\"„œÖ=„œŠ bˆÁp!…k\n× À# `À“ˆ ƒ† B‚˜\nA\n T  Î\n@“ˆ)‚.\nA\n Î\n@“ˆ‚. qˆ „¿ƒ»Ù ˆÀ‚ÅÚ Û\"ˆÛ+‡" [nil get-buffer-process comint-prompt-regexp 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 string-match " \\*Minibuf-[0-9]+\\*" buffer-name major-mode dired-mode he-line-search he-tried-table he-reset-string he-substitute-string t] 4 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias he-line-search #[(str strip-prompt reverse) "À „6\nƒÃÄ \"ÀÇ#‚ÈÄ \"ÀÇ#ƒ6ɔɕ{Ê  \"ƒÀ‰ƒ )‡" [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] he-line-beg #[(strip-prompt) "ŠÀˆÁÂà \"ŠÅyˆ`)Æ#ƒÇ”‚Åyˆ`)‡" [nil re-search-backward he-line-search-regexp "" strip-prompt 0 t 2] 4] he-line-search-regexp #[(pat strip-prompt) "ƒÁ\nÃÄ !Æ°‡ÇÄ !ÆQ‡" [strip-prompt "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(" regexp-quote pat "[^\n]*[^ \n]\\)" "^\\(\\s-*\\)\\("] 5]] 3) (defalias 'try-expand-list #[(old) "À\n„ÃÄ `\"ˆ À“ˆÇ Êš„PŠƒ= bˆË Ç\" `À“ˆ „=  À“ˆÀ „O bˆË À\" `À“ˆ) „_\nƒ[Í ˆÀ‚kÎ Ç\"ˆ BÇ)‡" [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 he-tried-table] 3 "\ 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-all-buffers #[(old) "Àp „ÄÅ `\"ˆÆ È \nË@“ˆ Íš„™ƒ™\n„™ƒ: Wƒ™@qˆp =„‰ÏÐÑp!\"„‰Ó=„‰Š\nbˆÔ À\"\n`À“ˆ\nƒs\nB‚…A T \nË@“ˆ)‚$A\nË@“ˆ‚$ qˆ\n„« ƒ§Ö ˆÀ‚±×\nØ\"ˆØ*‡" [nil 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 string-match " \\*Minibuf-[0-9]+\\*" buffer-name major-mode dired-mode he-list-search he-tried-table he-reset-string he-substitute-string t] 4 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias he-list-search #[(str reverse) "À‰‰‰ „I ƒÆÀÈ#‚ÉÀÈ#ƒI`Ê”‰bˆÀÀË̈ „C `{Í \"ƒCÀ\nbˆ‚ ,‡" [nil err pos beg result reverse search-backward str t search-forward 0 (forward-list 1) ((error (byte-code "ÀÀ‡" [t err] 1))) he-string-member he-tried-table] 5] he-list-beg #[nil "ŠÀÁˆ`)‡" [nil (backward-up-list 1) ((error))] 3]] 3) (defalias 'try-expand-all-abbrevs #[(old) "„Á `\"ˆ Äš?…ÅÆÇÈ \"\"\n\nƒ9\n@ƒ0Ë\n@ \"ƒ9\nA‰\n„ \n„GƒEÍ ˆÎ‡Ï\n@Ð\"ˆ\n@ B \nA\nЇ" [old he-init-string he-dabbrev-beg he-search-string "" mapcar #[(sym) "À — !\"‡" [abbrev-expansion he-search-string eval sym] 4] append (local-abbrev-table global-abbrev-table) abbrev-table-name-list he-expand-list he-string-member he-tried-table he-reset-string nil he-substitute-string t] 6 "\ 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-dabbrev #[(old) "À\n„ÃÄ `\"ˆ À“ˆÇ Êš„PŠƒ= bˆË Ç\" `À“ˆ „=  À“ˆÀ „O bˆË À\" `À“ˆ) „_\nƒ[Í ˆÀ‚kÎ Ç\"ˆ BÇ)‡" [nil expansion old he-init-string he-dabbrev-beg he-search-loc he-string-beg t he-search-bw he-search-string "" he-dab-search he-string-end he-reset-string he-substitute-string he-tried-table] 3 "\ 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-all-buffers #[(old) "Àp „ÄÅ `\"ˆÆ È \nË@“ˆ Íš„™ƒ™\n„™ƒ: Wƒ™@qˆp =„‰ÏÐÑp!\"„‰Ó=„‰Š\nbˆÔ À\"\n`À“ˆ\nƒs\nB‚…A T \nË@“ˆ)‚$A\nË@“ˆ‚$ qˆ\n„« ƒ§Ö ˆÀ‚±×\nØ\"ˆØ*‡" [nil 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 string-match " \\*Minibuf-[0-9]+\\*" buffer-name major-mode dired-mode he-dab-search he-tried-table he-reset-string he-substitute-string t] 4 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÈ!‡" [defalias he-dab-search-regexp #[(pat) "ÀÁ\n!ÃQ‡" ["\\b" regexp-quote pat "\\(\\sw\\|\\s_\\)+"] 3] he-dab-search #[(pattern reverse) "À „2\nƒÃÄ !ÀÆ#‚ÇÄ !ÀÆ#ƒ2Ȕȕ{É \n\"ƒÀ‰ƒ )‡" [nil result reverse re-search-backward he-dab-search-regexp pattern t re-search-forward 0 he-string-member he-tried-table] 5] he-dabbrev-beg #[nil "ŠÀÁ!ˆÂÃ!ˆ`)‡" [skip-syntax-backward "w_" skip-syntax-forward "_"] 2] provide hippie-exp] 3) emacs-19.22/lisp/holidays.elc100666 13437 1 36227 5462656530 14560 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 25 01:00:07 1993 ;;; from file /home/fsf/rms/e19/lisp/holidays.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (require (quote calendar)) (autoload (quote solar-equinoxes-solstices) "solar" "\ Date and time of equinoxes and solstices, if visible in the calendar window. Requires floating point." t) (defalias 'holidays #[(&optional arg) "ŠÀ  ƒ#ÅÆÇÈÉÊË Í\"\"ÍÀ$!Î !\"A‚% @ ƒ9ÐÑÒÓ AA@!#‚= AA@Õ -‡" [t completion-ignore-case calendar-current-date date arg assoc capitalize completing-read "Month name: " mapcar list append calendar-month-name-array nil calendar-make-alist displayed-month calendar-read "Year (>0): " (lambda (x) (> x 0)) int-to-string displayed-year list-calendar-holidays] 9 "\ 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." "P"]) (defalias 'check-calendar-holidays #[(date) "@AA@à Å ƒ+Ç @@\"ƒ$È @A\" A‰„,‡" [date displayed-month displayed-year calendar-holiday-list h nil holiday-list calendar-date-equal append] 4 "\ 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 'calendar-cursor-holidays #[nil "ÀÁ!ˆÂ † ÃÄ!Æ !È ! ÊË Ì# ÎÏ # „5ÀÑ\"‚pGÒ XƒEÀ!‚pÓ!qˆÕ×!ˆØ ˆÊË Ù#cˆebˆÚÕ!ˆÛÜ!ˆÀÝ!-‡" [message "Checking holidays..." calendar-cursor-to-date error "Cursor is not on a date!" 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 t display-buffer "Checking holidays...done"] 4 "\ Find holidays for the date specified by the cursor in the calendar window." nil]) (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 "\ Mark notable days in the calendar window." nil]) (defalias 'list-calendar-holidays #[nil "ÀÁ!ˆÂ ‰ „ÀÊ!ˆË‚„Ì !qˆËÏ_Ð\\\\‰ϦTÏ¥) Ï_\\‰ϦTÏ¥)ÒÓÔÕ!Õ! %!ˆÖ ˆ×Ø Ù#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, %d to %s, %d%%-" calendar-month-name erase-buffer mapconcat #[(x) "À @! A@Q‡" [calendar-date-string x ": "] 3] "\n" set-buffer-modified-p t display-buffer "Looking up holidays...done"] 8 "\ 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." nil]) (defalias 'calendar-holiday-list #[nil "Á‰ƒ/ ƒÅÇ @!)‚ÁÈɉ\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 "\ Form the list of holidays that occur on dates in the calendar window. The holidays are those in the list calendar-holidays."]) (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 "\ 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-float #[(month dayname n string &optional day) " \nÄ_ ÅZÇ\\\\\\‰ĦTÄ¥) ÉV…2Ê  \n %DC*‡" [displayed-month displayed-year y m 12 11 month -1 macro-y 9 calendar-nth-named-day n dayname day string] 7 "\ 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-julian #[(month day string) "  ÂÈ_É\\\\‰\nȦT\nÈ¥) È_ \\‰\nȦT\nÈ¥)ËEAA@S ËE@ ËEA@ËEAA@ SÏ_\\ ÑVƒš Ò_Ó\\Ô¥Z Ò¦ÕUƒš Ö¦ÕUƒ• צÕUƒšT, Ø_ Ò¥ Ö¥[ ×¥\\\\\\\\) ‰ÑUƒØ Ò¦ÕUƒØ Ö¦ÕUƒÔ צÕUƒØÚ‚ÜÛ SH EAA@S ‰ÑUƒ Ò¦ÕUƒ Ö¦ÕUƒ צÕUƒÚ‚ Û SH E@ ‰ÑUƒ3 Ò¦ÕUƒ3 Ö¦ÕUƒ/ צÕUƒ3Ú‚7Û SH EA@ ‰ÑUƒ` Ò¦ÕUƒ` Ö¦ÕUƒ\\ צÕUƒ`Ú‚dÛ SH EAA@ SÏ_\\ ÑVƒ¥ Ò_Ó\\Ô¥Z Ò¦ÕUƒ¥ Ö¦ÕUƒ  צÕUƒ¥T, Ø_ Ò¥ Ö¥[ ×¥\\\\\\\\)Ý!Ý!AA@ AA@!Ô Wƒæ ‚è!âã  E!!$å$!…$&DC. ‡" [displayed-month displayed-year nil year y2 m2 y1 m1 12 -2 macro-y 1 prior-years month day 31 day-of-year 2 4 23 10 0 100 400 365 start-date 29 [31 28 31 30 31 30 31 31 30 31 30 31] end-date calendar-julian-from-absolute julian-start julian-end julian-y1 julian-y2 calendar-gregorian-from-absolute calendar-absolute-from-julian date calendar-date-is-visible-p string] 7 "\ 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."]) (defalias 'holiday-islamic #[(month day string) "À  EAA@S  E@  EA@  EAA@ SÈ_\\ ÊVƒ\\ Ë_Ì\\Í¥Z ˦ÎUƒ\\ϦÎUƒWЦÎUƒ\\ T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)!‰@AA@Õ×W?…ÇØ_Í ZÙ\\\\\\‰ئTØ¥)ÛV…ÇÜÝ E!!Þ!…ÆDC),‡" [calendar-islamic-from-absolute displayed-month 15 displayed-year prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 islamic-date m y nil date 1 12 -1 macro-y 7 calendar-gregorian-from-absolute calendar-absolute-from-islamic calendar-date-is-visible-p string] 8 "\ 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."]) (defalias 'holiday-hebrew #[(month day string) "Á\nWƒ \nÁZ‚\nÃ\\Ä\nWƒ\nÄZ‚\nÅ\\Æ\nWƒ+\nÆZ‚.\nÇ\\È\nWƒ:\nÈZ‚=\nÉ\\Ê\nWƒI\nÊZ‚L\nË\\¯>…w  ÍÓ_Ô\\\\‰Ó¦TÓ¥)Ó_\\‰Ó¦TÓ¥)ÃEAA@SÃE@ÃEA@ÃEAA@\nSØ_\\\nÅVƒõ\nÉ_Ú\\Ä¥ZɦÛUƒõܦÛUƒðݦÛUƒõT,Þ_ɥܥ[Ý¥\\\\\\\\)‰ÅUƒ7ɦÛUƒ7ܦÛUƒ3ݦÛUƒ7à‚<áSHEAA@S‰ÅUƒlɦÛUƒlܦÛUƒhݦÛUƒlà‚qáSHE@‰ÅUƒɦÛUƒܦÛUƒ™ݦÛUƒà‚¢áSHEA@‰ÅUƒÐɦÛUƒÐܦÛUƒÌݦÛUƒÐà‚ÕáSHEAA@\nSØ_\\\nÅVƒ\nÉ_Ú\\Ä¥ZɦÛUƒܦÛUƒݦÛUƒT,Þ_ɥܥ[Ý¥\\\\\\\\)\"ã!$ã\"!%$AA@&%AA@'è\nWƒX'‚Z&éê\nE!!+ì+!…u+-DC. ‡" [displayed-month 11 month 1 10 2 9 3 8 4 7 5 displayed-year nil year y2 m2 y1 m1 12 -2 macro-y prior-years day 31 day-of-year 23 0 100 400 365 start-date 29 [31 28 31 30 31 30 31 31 30 31 30 31] end-date calendar-hebrew-from-absolute hebrew-start hebrew-end hebrew-y1 hebrew-y2 6 calendar-gregorian-from-absolute calendar-absolute-from-hebrew date calendar-date-is-visible-p string] 8 "\ 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."]) (defalias 'holiday-sexp #[(sexp string) " \nÄ_ Å\\\\‰ĦTÄ¥)ÇÈ\n Ê !‰ …+Ê !   +DC\nT Ê !‰ …FÊ !   +DC\"!*‡" [displayed-month displayed-year y m 12 -2 macro-y filter-visible-calendar-holidays append year eval sexp date string] 6 "\ 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-advent #[nil " ‰Ä_\nÅ\\\\‰ĦTÄ¥)ÇÈÉÄÊ EAA@S ÄÊ E@ÄÊ EA@ ÄÊ EAA@ \nSÍ_\\\nÏVƒs\nÐ_Ñ\\Ò¥Z ЦÉUƒs Ó¦ÉUƒn Ô¦ÉUƒsT, Õ_ Ð¥ Ó¥[ Ô¥\\\\\\\\)\"!×!…œØDC+‡" [displayed-year displayed-month month year 12 -2 macro-y calendar-gregorian-from-absolute calendar-dayname-on-or-before 0 3 prior-years day 31 day-of-year 2 4 23 10 100 400 365 advent calendar-date-is-visible-p "Advent"] 10 "\ Date of Advent, if visible in calendar window."]) (defalias 'holiday-easter-etc #[nil "ÁV…\n??…| Ä¥T ƦÇ_ È_É¥[ Ê_Á\\Ë¥ Ì_Í\\\\\\\\̦‰ÏU„DÐUƒJÑ Æ¦WƒJT‚LÉÆ EAA@SÉÆ E@ÉÆ EA@ÉÆ EAA@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¯>ÿ&!@\nƒxAÿ>!@\"@@.‡" [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 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 "\ List of dates related to Easter, as visible in calendar window."]) (defalias 'holiday-greek-orthodox-easter #[nil " \nÄ_ \\‰ĦT Ä¥)Æ ‰ÇUƒ8\nȦÉUƒ8\nʦÉUƒ4\n˦ÉUƒ8Ì‚<Í SH\nEAA@S ‰ÇUƒg\nȦÉUƒg\nʦÉUƒc\n˦ÉUƒgÌ‚kÍ SH\nE@ ‰ÇUƒ“\nȦÉUƒ“\nʦÉUƒ\n˦ÉUƒ“Ì‚—Í SH\nEA@ ‰ÇUƒÀ\nȦÉUƒÀ\nʦÉUƒ¼\n˦ÉUƒÀÌ‚ÄÍ SH\nEAA@SÒ_\\ÇVƒ È_Ô\\Õ¥ZȦÉUƒ ʦÉUƒ˦ÉUƒ T,Ö_ȥʥ[Ë¥\\\\\\\\)!AA@‰ئÙ_Ú\\Û¦ÝÈØE!ZßàÉá\\\"!\"ã\"!…V\"äDC.‡" [displayed-month displayed-year y m 12 macro-y calendar-julian-from-absolute 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] prior-years month day year 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)"] 8 "\ Date of Easter according to the rule of the Council of Nicaea."]) (defalias 'holiday-rosh-hashanah-etc #[nil "ÁW† ÂV?…àÃÄÅÇ\\E!É!ÊËÇ\\\"DÉÌ\\!ÍDÉÎ\\!ÏDÉÐ\\!ÑDÉÒ\\!ÓD¯ÉÕÖ×Z\"!ØDÉS!ÙDÉT!ÚDÉĦ×UƒrÛ\\‚vÜ\\!ÝDÉÕÖÄ\\\"!ÞDÉÁ\\!ßDÉà\\!áDÉâ\\!ãDÉä\\!åDÉæ\\!çDÉè\\!éDÉê\\!ëDÉì\\!íD¯ .ï!01ƒÝòï.!0\"00,‡" [displayed-month 8 11 calendar-absolute-from-hebrew 7 1 displayed-year 3761 abs-r-h calendar-gregorian-from-absolute format "Rosh HaShanah %d" 9 "Yom Kippur" 14 "Sukkot" 21 "Shemini Atzeret" 22 "Simchat Torah" mandatory calendar-dayname-on-or-before 6 4 "Selichot (night)" "Erev Rosh HaShannah" "Rosh HaShanah (second day)" 3 2 "Tzom Gedaliah" "Shabbat Shuvah" "Erev Yom Kippur" 13 "Erev Sukkot" 15 "Sukkot (second day)" 16 "Hol Hamoed Sukkot (first day)" 17 "Hol Hamoed Sukkot (second day)" 18 "Hol Hamoed Sukkot (third day)" 19 "Hol Hamoed Sukkot (fourth day)" 20 "Hoshannah Rabbah" optional filter-visible-calendar-holidays output-list all-hebrew-calendar-holidays append] 15 "\ List of dates related to Rosh Hashanah, as visible in calendar window."]) (defalias 'holiday-hanukkah #[nil "Á>…‚\n Å_ \\‰ŦTÅ¥)Ç ‰ÈUƒ@ ɦÊUƒ@ ˦ÊUƒ< ̦ÊUƒ@Í‚DÎ SH EAA@S ‰ÈUƒo ɦÊUƒo ˦ÊUƒk ̦ÊUƒoÍ‚sÎ SH E@ ‰ÈUƒ› ɦÊUƒ› ˦ÊUƒ— ̦ÊUƒ›Í‚ŸÎ SH EA@ ‰ÈUƒÈ ɦÊUƒÈ ˦ÊUƒÄ ̦ÊUƒÈÍ‚ÌÎ SH EAA@SÓ_\\ÈVƒÉ_Õ\\Ö¥ZɦÊUƒ˦ÊUƒ ̦ÊUƒT,×_ɥ˥[Ì¥\\\\\\\\)!AA@ÙÚÛE!ÝÞS!ßDÞ!àDÞT!áDÞÈ\\!âDÞã\\!äDÞÉ\\!åDÞæ\\!çDÞè\\!éDÞê\\!ëD¯ !,‡" [displayed-month (10 11 12 1 2) displayed-year y m 12 macro-y calendar-hebrew-from-absolute 2 4 0 100 400 29 [31 28 31 30 31 30 31 31 30 31 30 31] prior-years month day year 31 day-of-year 23 10 365 h-y calendar-absolute-from-hebrew 9 25 abs-h filter-visible-calendar-holidays calendar-gregorian-from-absolute "Erev Hanukkah" "Hanukkah (first day)" "Hanukkah (second day)" "Hanukkah (third day)" 3 "Hanukkah (fourth day)" "Hanukkah (fifth day)" 5 "Hanukkah (sixth day)" 6 "Hanukkah (seventh day)" 7 "Hanukkah (eighth day)"] 13 "\ List of dates related to Hanukkah, as visible in calendar window."]) (defalias 'holiday-passover-etc #[nil "À W?…DÂÃÄ Æ\\E!È!ÉDÈÊ\\!ËDD ÈÍÎÏZ\"!ÐDÈÍÎÑZ\"!ÒDÈÀ¦ÓUƒIÔZ‚MÕZ!ÖDÈÕZ!×DÈÑZ!ØDÈÀ¦ÙUƒqÚZ‚uÛZ!ÜDÈÍÎÝZ\"ÀZ!ÞDÈÍÎÝZ\"!ßDÈÍÎS\"!àDÈS!áDÈT!âDÈÓ\\!ãDÈä\\!åDÈæ\\!çDÈè\\!éDÈÎ\\!êDÈÀ\\!ëDÈì\\!íDÈÀ¦ÙUƒñî\\‚À¦ÎUƒï\\‚ð\\!ñDÈÔ\\!òDÈÏ\\!óDÈô\\!õDÈö\\!÷D¯8ù !:;ƒAüù8!:\"::,‡" [7 displayed-month calendar-absolute-from-hebrew 1 15 displayed-year 3760 abs-p calendar-gregorian-from-absolute "Passover" 50 "Shavuot" mandatory calendar-dayname-on-or-before 6 43 "Shabbat Shekalim" 30 "Shabbat Zachor" 2 33 31 "Fast of Esther" "Erev Purim" "Purim" 0 28 29 "Shushan Purim" 14 "Shabbat Parah" "Shabbat HaHodesh" "Shabbat HaGadol" "Erev Passover" "Passover (second day)" "Hol Hamoed Passover (first day)" 3 "Hol Hamoed Passover (second day)" 4 "Hol Hamoed Passover (third day)" 5 "Hol Hamoed Passover (fourth day)" "Passover (seventh day)" "Passover (eighth day)" 12 "Yom HaShoah" 18 19 20 "Yom HaAtzma'ut" "Lag BaOmer" "Yom Yerushalim" 49 "Erev Shavuot" 51 "Shavuot (second day)" optional filter-visible-calendar-holidays output-list all-hebrew-calendar-holidays append] 25 "\ List of dates related to Passover, as visible in calendar window."]) (defalias 'holiday-tisha-b-av-etc #[nil "ÁW† ÂV?…\\ÃÁ Å\\E!ÇÈɦÊUƒ)ËZ‚-ÌZ!ÍDÈÎÊ\"!ÏDÈɦÊUƒIT‚K!ÐDÈÎÊÉ\\\"!ÑDF!)‡" [displayed-month 5 9 calendar-absolute-from-hebrew displayed-year 3760 abs-t-a filter-visible-calendar-holidays calendar-gregorian-from-absolute 7 6 20 21 "Tzom Tammuz" calendar-dayname-on-or-before "Shabbat Hazon" "Tisha B'Av" "Shabbat Nahamu"] 9 "\ List of dates around Tisha B'Av, as visible in calendar window."]) (defalias 'filter-visible-calendar-holidays #[(l) "À \nƒ$\n@@ƒÄ\n@@!ƒÅ\n@C \"\nA‰„ *‡" [nil l p visible calendar-date-is-visible-p append] 4 "\ Return a list of all visible holidays of those on L."]) (provide (quote holidays)) emacs-19.22/lisp/icon.elc100666 13437 1 22347 5416167625 13673 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:20:52 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/icon.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar icon-mode-abbrev-table nil "\ Abbrev table in use in Icon-mode buffers.") (define-abbrev-table (quote icon-mode-abbrev-table) nil) (defvar icon-mode-map nil "\ Keymap used in Icon mode.") (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) (defvar icon-mode-syntax-table nil "\ Syntax table in use in Icon-mode buffers.") (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) (defconst icon-indent-level 4 "\ *Indentation of Icon statements with respect to containing block.") (defconst icon-brace-imaginary-offset 0 "\ *Imagined indentation of a Icon open brace that actually follows a statement.") (defconst icon-brace-offset 0 "\ *Extra indentation for braces, compared with other text in same context.") (defconst icon-continued-statement-offset 4 "\ *Extra indent for lines not starting new statements.") (defconst icon-continued-brace-offset 0 "\ *Extra indent for substatements that start with open-braces. This is in addition to icon-continued-statement-offset.") (defconst icon-auto-newline nil "\ *Non-nil means automatically newline before and after braces inserted in Icon code.") (defconst 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.") (defalias 'icon-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍP ËÏ!ˆ ËÐ!ˆÑËÒ!ˆÓËÔ!ˆÕËÖ!ˆ×ËØ!ˆÙËÚ!ˆÛËÜ!ˆÝÞß!‡" [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 "\ 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." nil]) (defalias (quote icon-comment-indent) #[nil "ÀÁ!ƒ‡ŠÃÄxˆnƒ‚iT ])‡" [looking-at "^#" 0 " " nil comment-column] 2]) (defalias 'electric-icon-brace #[(arg) "À\n„AlƒAŠÃÀxˆn)„ ƒAÅ ˆÆ ˆcˆÅ ˆ ƒ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 "\ Insert character and correct line's indentation." "P"]) (defalias (quote icon-indent-command) #[(&optional whole-exp) "ƒ3Á ‰ŠƒÇyˆ`ÈÉ!ˆ` bˆÉyˆ`) V…1Ê Ë$+‡„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"]) (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ˆ -‡" [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 "\ Indent current line as Icon code. Return the amount the indentation changed by."]) (defalias 'calculate-icon-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰‰ƒbˆ‚È `Wƒ6`É`À#‰A@‚Ê 8„BË 8ƒHË 8‚ ƒ[ 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 "\ 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."]) (byte-code "ÀÂÃÄ\"ˆÂÅÆ\"ˆÂÇÈ\"ˆÂÉÊ\"‡" [(("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 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] icon-backward-to-noncomment #[(lim) "À‰ ?….à xˆ`ÅyˆÆÇ`\n\"8ƒ( `Wƒ(ÈÉ!ˆ‚ʉ‚*‡" [nil stop opoint " \n " lim 0 5 parse-partial-sexp search-backward "#" t] 5] 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] icon-is-continued-line #[nil "ŠÀˆÁ )‡" [0 icon-is-continuation-line] 1]] 3) (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 "\ Move to the start of the last \"unbalanced\" if."]) (defalias 'mark-icon-function #[nil "À`!ˆÁ ˆÀ`!ˆÂyˆÃ ‡" [push-mark end-of-icon-defun -1 beginning-of-icon-defun] 2 "\ Put mark at end of Icon function, point at beginning." nil]) (defalias 'beginning-of-icon-defun #[nil "ÀÁeÂ#ƒ ÃÄ!‡Å‡" [re-search-backward "^procedure\\s \\|^end[ \n]" move looking-at "e" t] 4 "\ Go to the start of the enclosing procedure; return t if at top level." nil]) (defalias (quote end-of-icon-defun) #[nil "o„ÀuˆÁÂdÃ#ˆÀvˆÄy‡" [-1 re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" move 1] 4 nil nil]) (defalias 'indent-icon-exp #[nil "ÀC`CÀ‰‰‰‰‰‰‰‰‰‰`Á \n   ŠÑÒ!ˆ)ŠÀ m?…ß ?…ß\nÀ„¡mƒVÕ‰ „¡\n Ö`Àˆ`À‰\n%‰\n@\nAA@ƒƒ\nAA@ÁYƒƒ\nAA@× 8ƒØ ˆÙ\n8ƒšÒyˆ‚FÕ‰ƒK\nÁXƒªÕ  „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 "\ Indent each line of the Icon grouping following point." nil]) emacs-19.22/lisp/inc-vers.elc100666 13437 1 1534 5423456006 14434 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Jul 22 05:21:10 1993 ;;; from file /home/fsf/rms/e19/lisp/inc-vers.el ;;; emacs version 19.16.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!ˆÄuˆŠŒ`ÅÆxˆ`}ˆebˆÇp!ed|ˆÉTp\"ˆ+ÊÆxˆËÌ`ÊÆwˆ`{\"ˆÍÎ!ƒHÏÁ!„HÐÁ!ˆÑedÁÆÒ%ˆÓ ˆÔÆ!ˆÕ ‡" [insert-file-contents "../lisp/version.el" re-search-forward "emacs-version \"[^\"]*[0-9]+\"" -1 "0-9" nil read version prin1 "^\"" message "New Emacs version will be %s" file-accessible-directory-p "../lisp/" file-writable-p delete-file write-region nomsg erase-buffer set-buffer-modified-p kill-emacs] 6) emacs-19.22/lisp/indent.elc100666 13437 1 12563 5430554036 14213 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 6 18:15:58 1993 ;;; from file /home/fsf/rms/e19/lisp/indent.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (defvar indent-line-function (quote indent-to-left-margin) "\ Function to indent current line.") (defalias 'indent-according-to-mode #[nil " ‡" [indent-line-function] 1 "\ Indent line in proper way for current major mode." nil]) (defalias 'indent-for-tab-command #[nil "Á=ƒ  ‡ ‡" [indent-line-function indent-to-left-margin insert-tab] 2 "\ Indent line in proper way for current major mode." nil]) (defalias (quote insert-tab) #[nil "ƒÁ ˆ\nƒÃc‡ i ¥T_j‡" [abbrev-mode expand-abbrev indent-tabs-mode 9 tab-width] 3]) (defalias 'indent-rigidly #[(start end arg) "ŠbˆÁ \nbˆn„Ãyˆ`Wƒ7Ä `ÆÇwˆ`|ˆl„0ÈÉ \n\\]É\"ˆ)Ãyˆ‚lj“)‡" [end point-marker start 1 current-indentation indent " " nil indent-to 0 arg] 4 "\ Indent all lines starting in the region sideways by ARG columns. Called from a program, takes three arguments, START, END and ARG." "r\np"]) (defalias (quote indent-to-left-margin) #[nil "À U†$ŠÄyˆ`ÅÂwˆ`|ˆ jˆ`)` W…# b)‡" [current-indentation left-margin nil epos 0 " "] 3]) (defvar indent-region-function nil "\ Function which is short cut to indent region using indent-according-to-mode. A value of nil means really run indent-according-to-mode on each line.") (defalias 'indent-region #[(start end column) "„q ƒ7Š\nbˆÃ  bˆÅ !`\nW…5Ç!„/nƒ,l„/ cˆÈyˆ‚*‡ ƒB \n\"‡Š\nbˆÃ  bˆn„SÈyˆ`\nWƒknƒal„e\n ˆÈyˆ‚S\nˉ“)‡Ì!Š\nbˆÃ  bˆ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 "\ 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." "r\nP"]) (defalias 'indent-relative-maybe #[nil "ÀÁ!‡" [indent-relative t] 2 "\ Indent a new line like previous nonblank line." nil]) (defalias 'indent-relative #[(&optional unindented-ok) "ƒÁ ˆiŠÅyˆÆÇÂÈ#ƒLŠÉyˆ`)\nË !ˆi Vƒ-ÌÉ!ˆÍÎ!„=„=Ð\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 "\ 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." "P"]) (defvar tab-stop-list (quote (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'.") (defvar edit-tab-stops-map nil "\ Keymap used in `edit-tab-stops'.") (byte-code "„Á ÂÃÄ#ˆÂÅÄ#ˆÁ‡" [edit-tab-stops-map make-sparse-keymap define-key "" edit-tab-stops-note-changes ""] 4) (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.") (defalias 'edit-tab-stops #[nil "pÁÂÃ!!ˆÄ !ˆÆÇ!ˆÈÉÊ!ˆË Í ˆ‰ƒ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 "\ 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." nil]) (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 "\ Put edited tab stops into effect." nil]) (defalias 'tab-to-tab-stop #[nil "ƒÁ ˆ\n‰ƒi @Yƒ A‰„ ƒ% @j‚'Äc)‡" [abbrev-mode expand-abbrev tab-stop-list tabs 32] 3 "\ 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." nil]) (defalias 'move-to-tab-stop #[nil "‰ƒi @Yƒ A‰„ … @Ã\")‡" [tab-stop-list tabs move-to-column t] 4 "\ 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." nil]) (byte-code "À ÂÃ#ˆÀ ÅÆ#ˆÀÂÈ#ˆÀ ÉÊ#‡" [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.22/lisp/inf-lisp.elc100666 74777 1 35326 5474032363 14476 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 21 22:41:39 1993 ;;; from file /home/fsf/rms/e19/lisp/inf-lisp.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint lisp-mode] 2) (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.)") (byte-code "ÀÁ!„ „>à !‰ ¤Æ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÆÖ×#ˆÆÇÈ#ˆÆØ×#ˆÆÙÚ#ˆÆÛÜ#ˆÆÝÞ#ˆÆÉÊ#ˆÆËÌ#ˆÆÍÎ#ˆÆÏÐ#ˆÆÑÒ#ˆÆÓÔ#ˆßàá\"‡" [boundp inferior-lisp-mode-map nil full-copy-sparse-keymap comint-mode-map shared-lisp-mode-map define-key "" lisp-eval-last-sexp " " 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 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]] 5) (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 "^[^> ]*>+:? *" "\ Regexp to recognise prompts in the Inferior Lisp mode. Defaults to \"^[^> ]*>+:? *\", 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].") (defvar inferior-lisp-mode-hook nil "\ *Hook for customising Inferior Lisp mode.") (defalias 'inferior-lisp-mode #[nil "À ˆ ÃÅÇÉÊ!ˆË !ˆÍÏÑÓÔ!‡" [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 "\ 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." nil]) (defalias 'lisp-get-old-input #[nil "Š`Á ˆ`{*‡" [end backward-sexp] 2 "\ Return a string containing the sexp ending at point."]) (defalias 'lisp-input-filter #[(str) "À \n\"?‡" [string-match inferior-lisp-filter-regexp str] 3 "\ t if STR does not match `inferior-lisp-filter-regexp'."]) (defalias 'inferior-lisp #[(cmd) "ÀÁ!„ !ÅÆÇ @È A%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 switch-to-buffer] 6 "\ 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.)" (list (if current-prefix-arg (read-string "Run lisp: " inferior-lisp-program) inferior-lisp-program))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias run-lisp inferior-lisp inferior-lisp-args-to-list #[(string) "ÀÁ\n\"‰„\nC‚: ÄU„%\nÄ OÅ\n Æ\\\nGO!B‚:ÀÇ\n\"‰??…9Å\n\nGO!))‡" [string-match "[ ]" string where 0 inferior-lisp-args-to-list 1 "[^ ]" pos] 6]] 3) (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 "\ Send the current region to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." "r\nP"]) (defalias 'lisp-eval-defun #[(&optional and-go) "ŠÀ ˆÁÂxˆ`Ä ˆÅ` \"ˆ*…ÇÈ!‡" [end-of-defun " \n " nil end beginning-of-defun lisp-eval-region and-go switch-to-lisp t] 3 "\ Send the current defun to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." "P"]) (defalias 'lisp-eval-last-sexp #[(&optional and-go) "ÀŠÁ ˆ`)`\n#‡" [lisp-eval-region backward-sexp and-go] 4 "\ Send the previous sexp to the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." "P"]) (defalias 'lisp-compile-region #[(start end &optional and-go) "ÀÁ Âà {\"\"ˆ…ÇÈ!‡" [comint-send-string inferior-lisp-proc format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n" start end and-go switch-to-lisp t] 6 "\ Compile the current region in the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." "r\nP"]) (defalias 'lisp-compile-defun #[(&optional and-go) "ŠÀ ˆÁÂxˆ`Ä ˆÅ` \"ˆ*…ÇÈ!‡" [end-of-defun " \n " nil e beginning-of-defun lisp-compile-region and-go switch-to-lisp t] 3 "\ Compile the current defun in the inferior Lisp process. Prefix argument means switch to the Lisp buffer afterwards." "P"]) (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 "\ Switch to the inferior Lisp process buffer. With argument, positions cursor at end of buffer." "P"]) (defalias 'lisp-eval-region-and-go #[(start end) "À \nÃ#‡" [lisp-eval-region start end t] 4 "\ Send the current region to the inferior Lisp, and switch to its buffer." "r"]) (defalias 'lisp-eval-defun-and-go #[nil "ÀÁ!‡" [lisp-eval-defun t] 2 "\ Send the current defun to the inferior Lisp, and switch to its buffer." nil]) (defalias 'lisp-compile-region-and-go #[(start end) "À \nÃ#‡" [lisp-compile-region start end t] 4 "\ Compile the current region in the inferior Lisp, and switch to its buffer." "r"]) (defalias 'lisp-compile-defun-and-go #[nil "ÀÁ!‡" [lisp-compile-defun t] 2 "\ Compile the current defun in the inferior Lisp, and switch to its buffer." nil]) (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 (quote (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.") (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 "\ Load a Lisp file into the inferior Lisp process." (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file lisp-source-modes nil)]) (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 "\ Compile a Lisp file in the inferior Lisp process." (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file lisp-source-modes nil)]) (defvar lisp-function-doc-command "(let ((fn '%s))\n (format t \"Documentation for ~a:~&~a\"\n fn (documentation fn 'function))\n (values))\n" "\ Command to query inferior Lisp for a function'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" "\ Command to query inferior Lisp for a variable's documentation.") (defvar lisp-arglist-command "(let ((fn '%s))\n (format t \"Arglist for ~a: ~a\" fn (arglist fn))\n (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.") (defalias (quote lisp-symprompt) #[(prompt default) "ƒ Á #‚ ÄPÅ !‰GÇUƒ ‚\"*C‡" [default format "%s (default %s): " prompt ": " read-string ans 0] 5]) (defalias 'lisp-fn-called-at-pt #[nil "ÀÁ‡" [nil (byte-code "ŠŒe`ÀZ]d}ˆÁÂ!ˆÂuˆÃp!‰9… +‡" [1000 backward-up-list 1 read obj] 4) ((error))] 3 "\ Returns the name of the function called in the current call. The value is nil if it can't find one."]) (defalias (quote lisp-var-at-pt) #[nil "ÀÁ‡" [nil (byte-code "ŠÀÁ!ˆÂÃwˆÄp!‰9… *‡" [forward-sexp -1 "'" nil read obj] 3) ((error))] 3]) (defalias 'lisp-show-function-documentation #[(fn) "ÀÁ  \"\"‡" [comint-proc-query inferior-lisp-proc format lisp-function-doc-command fn] 5 "\ Send a command to the inferior Lisp to give documentation for function FN. See variable `lisp-function-doc-command'." (byte-code "ÀÁ \"‡" [lisp-symprompt "Function doc" lisp-fn-called-at-pt] 3)]) (defalias 'lisp-show-variable-documentation #[(var) "ÀÁ  \"\"‡" [comint-proc-query inferior-lisp-proc format lisp-var-doc-command var] 5 "\ Send a command to the inferior Lisp to give documentation for function FN. See variable `lisp-var-doc-command'." (byte-code "ÀÁ \"‡" [lisp-symprompt "Variable doc" lisp-var-at-pt] 3)]) (defalias 'lisp-show-arglist #[(fn) "ÀÁ  \"\"‡" [comint-proc-query inferior-lisp-proc format lisp-arglist-command fn] 5 "\ Send a query to the inferior Lisp for the arglist for function FN. See variable `lisp-arglist-command'." (byte-code "ÀÁ \"‡" [lisp-symprompt "Arglist" lisp-fn-called-at-pt] 3)]) (defalias 'lisp-describe-sym #[(sym) "ÀÁ  \"\"‡" [comint-proc-query inferior-lisp-proc format lisp-describe-sym-command sym] 5 "\ Send a command to the inferior Lisp to describe symbol SYM. See variable `lisp-describe-sym-command'." (byte-code "ÀÁ \"‡" [lisp-symprompt "Describe" lisp-var-at-pt] 3)]) (defalias (quote inferior-lisp-proc) #[nil "À Â=ƒ p‚ !‰†ÅÆ!)‡" [get-buffer-process major-mode inferior-lisp-mode inferior-lisp-buffer proc error "No Lisp subprocess; see variable `inferior-lisp-buffer'"] 4]) (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.") (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks inferior-lisp-load-hook provide inf-lisp] 2) emacs-19.22/lisp/info.elc100666 13437 1 73706 5474621522 13676 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:03:12 1993 ;;; from file /home/fsf/rms/e19/lisp/info.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (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-default-directory-list nil "\ List of default directories to search for Info documentation files. This value is used as the default for `Info-directory-list'. It is set in paths.el.") (defvar Info-fontify t "\ *Non-nil enables highlighting and fonts in Info nodes.") (defvar Info-directory-list (byte-code "ÀÁ!‰ƒ7É\nGÆVƒ1ÇÈ\n\"†\nG\nÆ O B\n T\nG^ÃO‰‚ Ÿ*‚9 )‡" [getenv "INFOPATH" path nil idx list 0 string-match ":" Info-default-directory-list] 4) "\ 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.") (defvar Info-current-file nil "\ Info file that Info is now looking at, or nil.") (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 (quote ((".info") ("") (".Z" . "uncompress") (".Y" . "unyabba") (".gz" . "gunzip") (".z" . "gunzip") (".info.Z" . "uncompress") (".info.Y" . "unyabba") (".info.gz" . "gunzip") (".info.z" . "gunzip"))) "\ 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.") (defalias 'info-insert-file-contents #[(filename &optional visit) "ÀÁ?… Âà \"‡" [ok (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(x) " @PÃ\n!…%Ä\n \"ˆ Aƒ!ÆÈed AÉ$ˆ)ÊËÉ\")‡" [filename x compressed file-exists-p insert-file-contents visit nil buffer-read-only shell-command-on-region t throw ok] 5] Info-suffix-list nil] 3) error "Can't find %s or any compressed version of it!" filename] 3 "\ 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 #[(&optional file) "ƒ ÁÂÃQ!‡ÄÅ!ƒÆÅ!‡Ç ‡" [file Info-goto-node "(" ")" get-buffer "*info*" switch-to-buffer Info-directory] 4 "\ 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." (byte-code "… ÁÂÉÄ$C‡" [current-prefix-arg read-file-name "Info file name: " nil t] 5)]) (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 "\ Run Emacs as a standalone Info reader. Usage: emacs -f info-standalone [filename] In standalone mode, \\\\[Info-exit] exits Emacs itself."]) (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅÃÆ!„ÅÃÇ!„ÅÀÈÉ\"ˆÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"‡" [defalias Info-find-node #[(filename nodename &optional no-going-back) "ƒ_Á‰‰Å!Æ!—ǘƒÈ‚PÉÊ\"ƒ'Ë‚) ‰ ƒO\n„OÎ @\"Η @\"ÏЈ A‰ „/)\nƒY\n‚^ÑÒ\"ˆ+ƒt„t`EB×Ø!ˆÙp!ˆÛ=„†Û ˆ~ˆÁÜŽƒ3š„3ÁÁÁÁÁ Á!â ˆÈ=ƒ¹ã ˆ‚ÃäÈ\"ˆå!&çÁ!ˆ(Á‰“ˆdbˆéyˆ*ëš„\"ìíÁÈ#ƒ\"Á.ïð!ˆ`.Šñyˆòó!)ƒŠp4õö!qˆÙp!ˆÈ7â ˆø4!ˆ(ù•Á“ˆ*‚!(.Á“ˆ)È=ƒ,Ç‚0ú!!)*뚃D*û ˆ‚®eüý*!þQ?@A(!ƒ–ŠB(!qˆ(bˆC?ÁÈ#ƒDp!@pEØ!=„•F@!@‚•ÑG*\"ˆ)e@HZ]bˆIJˆ*K ˆ)eb‡" [filename nil found temp-downcase temp substitute-in-file-name file-name-nondirectory "dir" t string-match "^\\./" ("./") Info-directory-list dirs expand-file-name foundit (mapcar #[(x) "À \n@P!ƒ ÄÅÆ\"ˆÀ\n@P!…!ÄÅÆ\"‡" [file-exists-p temp x found throw foundit nil temp-downcase] 3] Info-suffix-list) 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@\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 file-name-sans-versions 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ˆÆ Ã#ƒÈÉÃ\"ˆ)‚ÊË \"‡" [search-forward "\n" nil t 1 beg re-search-backward regexp throw foo error "No such node: %s" nodename] 4) Info-select-node] 5] boundp Info-dir-contents nil Info-dir-contents-directory Info-dir-file-attributes Info-insert-dir #[nil "ƒ ƒÂÃÄÅ \"B!ƒcˆ‚ lj‰‰‰ \n  ‰ ƒàÎÏ @!!„×ÐÎÏ @!!!„×ÇÏÒ @\"Ó!ƒeÔ!‚¤ÏÕ @\"Ó!ƒ{Ô!‚¤ÏÖ @\"Ó!ƒ‘Ô!‚¤Ï× @\"Ó!…¤Ô! ÎÏ @!!ÐÎÏ @!!!BB ƒÖ  B Ø !ÙØ !!B B* A‰ „0 @  A\nÚ !ˆŠ qˆ)\nƒV\n@ŠqˆebˆÞßÇà#ƒLlj‰!\"#äyˆ`#åæ!ˆçè!ˆé \"çæÇê#ˆëyˆ`!\"#!F B +‚ *\nA‰\n„þÞß!ˆäyˆì àŠçíÇà#ˆ`)!. / ƒ¬ @@‰\"—/„¢Þðñ\"!òQ!à#„¢ó\"ô±ˆ\"/B/) A‰ „w, ƒô @@\"ebˆÞõñ\"!öQÇà#ƒÕçæÇê#ˆëyˆ‚ßdbˆ÷\"ø±ˆùú @A\"ˆôcˆ) A‰ „² ƒû @!ˆ A‰ „ù.ü ‰‡" [Info-dir-contents Info-dir-file-attributes eval and mapcar #[(elt) "AÁ@!š‡" [elt file-attributes] 3] Info-directory-list nil dirs-done nodes others buffer buffers dirs file-truename expand-file-name directory-file-name temp "DIR" file-exists-p find-file-noselect "dir" "DIR.INFO" "dir.info" buffer-file-name file-attributes 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 buffer-string] 8] Info-read-subfile #[(nodepos) "À !qˆebˆÂÃ!ˆÄ‰ÇyˆÈɈÊË!qˆ š„;Ä Ä~ˆÏ ˆÐ !ˆÑÄ!ˆ  )ebˆÂÃ!ˆZ`\\*‡" [marker-buffer Info-tag-table-marker search-forward "\n" nil lastfilename lastfilepos 2 foo (byte-code "ÀÁ!„=l„7`‰ÆÇ!ˆ `ÈZ{Ép!Êyˆ  Vƒ-ÌÍÎ\"ˆ  +‚Ê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] Info-select-node #[nil "ŠÀÁ!ˆÂyˆÃÄ!ˆ`ÅÆwˆ`{È ˆÉyˆÆ\n`ÃËÆÌ#ƒ;`SÍÎ!ƒ<É•bˆÏp!\n‚<d}ˆƒHÑ\n!ˆƒPÓ ˆÔÕ!*‡" [search-backward "\n" 2 re-search-forward "Node:[ ]*" "^, \n" nil Info-current-node Info-set-mode-line 0 active-expression "\n[ ]" t looking-at "[\n ]*execute: " read Info-enable-active-nodes eval Info-fontify Info-fontify-node run-hooks Info-selection-hook] 5] Info-set-mode-line #[nil "À ƒ  !‚ ÃÄ †ÃR‰‡" ["Info: (" Info-current-file file-name-nondirectory "" ")" Info-current-node mode-line-buffer-identification] 4]] 3) (defalias 'Info-goto-node #[(nodename) "ÀÂà \"ˆÅ”Å•UƒÆ‚ ǔǕO ȔȕOÂÉ \"‰\nƒ1 Ë\nO)ÂÉ \"‰\nƒB Ë\nO)Ì Æš?…L ÆšƒVÍ‚W \")‡" [nil filename string-match "\\s *\\((\\s *\\([^ )]*\\)\\s *)\\s *\\|\\)\\(.*\\)" nodename 1 "" 2 3 "\\s *\\'" trim 0 Info-find-node "Top"] 5 "\ Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME." (list (Info-read-node-name "Goto node: "))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias Info-read-node-name #[(prompt &optional default) "ÀÂ Ä \"‰Æšƒ†È !‚ *‡" [t completion-ignore-case completing-read prompt Info-build-node-completions nodename "" default Info-read-node-name] 4] Info-build-node-completions #[nil "†[ÁŠŒÃ !ƒ*à !qˆ bˆÅÆÁÇ#ƒVȔȕ{C\nB‚~ˆebˆÉÊÁÇ#ƒVÈyˆ` ÈyˆÌÍ Ç#ƒRȔȕ{C\nB)‚/*\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]] 3) (defalias 'Info-restore-point #[(hl) "…@@ šƒ@A@\nšƒÃ@8b‡ÄA!‡" [hl Info-current-file Info-current-node 2 Info-restore-point] 2 "\ If this node has been visited, restore the point value when we left."]) (defvar Info-last-search nil "\ Default regexp for \\\\[Info-search] command to search for.") (defalias 'Info-search #[(regexp) "Ášƒ \n‚ É ` \n  ŠŒ~ˆ„3Í!ˆ` ‚8ÎÏЈ* „ÝÑŽÃÓ!qˆebˆÕÖ!ˆŒ`Õ×!ˆ`S}ˆebˆÕØÙQ!ˆÚyˆm„ŒÍÛ!ˆÜ•Ý\\bˆÞp!ܔܕ{BBÚ•Tbˆ‚hŸ‰@@ A)ƒÊßà@A\"ˆá@@!ˆAebˆÍÃâ#ƒœ` É„¡ ƒÖßÁ!ˆ‚ÜãäC\"ˆ*~ˆ bˆå ˆ\n šƒô š† \nE&B‰&.‡" [regexp "" Info-last-search nil 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 "\ Search for REGEXP, starting from point, and select node it's found in." "sSearch (regexp): "]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] Info-following-node-name #[(&optional allowedchars) "ÀÁwˆ`Âà † ÅÆQ!ƒ) †ÅÇPÁwˆÂÇ!ƒÈÁwˆ‚ÉÁxˆ`{‡" [" " nil looking-at "[" allowedchars "^, \n" "]" "(" "^)" " "] 5]] 3) (defalias 'Info-next #[nil "ÀÁÂ!!‡" [Info-goto-node Info-extract-pointer "next"] 3 "\ Go to the next node of this node." nil]) (defalias 'Info-prev #[nil "ÀÁÂÃ\"!‡" [Info-goto-node Info-extract-pointer "prev[ious]*" "previous"] 4 "\ Go to the previous node of this node." nil]) (defalias 'Info-up #[nil "ÀÁÂ!!ˆÃ !‡" [Info-goto-node Info-extract-pointer "up" Info-restore-point Info-history] 3 "\ Go to the superior node of this node." nil]) (defalias 'Info-last #[nil "„ÁÂ!ˆÃ‰‰@@@A@@AA@AÇ \"ˆA b+‡" [Info-history error "This is the first Info node you looked at" nil opoint nodename filename Info-find-node] 3 "\ Go back to the last node visited." nil]) (defalias 'Info-directory #[nil "ÀÁÂ\"‡" [Info-find-node "dir" "top"] 3 "\ Go to the Info directory node." nil]) (defalias 'Info-follow-reference #[(footnotename) "À‰‰Á\nPÇÈ #‰ƒ( É OÊ TÀOQ Ë\\‚ ŠebˆÌ ÀÍ#„9ÎÏ\n\"ˆÉ”Ð\\bˆÑÒÍ\")ÇÊ #‰ƒgÉ OÈÉ•ÀOQ Ó\\‚FÔ!,‡" [nil "\\*note " 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] 5 "\ Follow cross reference named NAME to the node it refers to. NAME may be an abbreviation of the reference name." (byte-code "ÀÁ‰`Á‰ŠebˆÈÉÁÀ#ƒdÊ”`S{ „3Ë” Xƒ3 `Xƒ3ÀËÌÍ \n#‰ƒQ Ë\nOÎ Ë•ÁOQ\nT‚5 À=ƒY  ÁBB‚)ƒÏ ƒvÐ ÑQ‚wÒÁÀ$‰Ôšƒˆ ‚Š)C‚’ÕÖ!.‡" [t nil i str start-point default completions completion-ignore-case re-search-forward "\\*note[ \n ]*\\([^:]*\\):" 1 0 string-match "[ \n ]+" " " completing-read "Follow reference named: (" ") " "Follow reference named: " input "" error "No cross-references in this node"] 7)]) (defalias (quote Info-extract-menu-node-name) #[(&optional errmessage multi-line) "ÀÁwˆ`Á‰ÅÁwˆÆuˆÇÈ!ƒ `S{‚.ÀÁwˆÉ\nƒ,Ë‚-Ì!ÍÎ \n#‰ƒA \nÏIˆ‚/ +‡" [" \n" nil i str beg "^:" 1 looking-at ":" Info-following-node-name multi-line "^., " "^., \n" string-match "\n" 32] 4]) (defalias 'Info-menu #[(menu-item) "ÀÁ\n!!‡" [Info-goto-node Info-extract-menu-item menu-item] 3 "\ Go to node for menu item named (or abbreviated) NAME. Completion is allowed, and the menu item point is on is the default." (byte-code "À‰`ÀŠebˆÅÆÀÇ#„ÈÉ!ˆÊËÀÇ#ƒI „; …+ \nWÌ”ƒ;\n Xƒ; @@͔͕{Í”B B‚ „d ƒd \nWƒd\nÀˆ`Xƒd @@)À„œÇÐ ƒ|ÑÒ \"‚}Ó ÀÇ$)‰Ô˜ƒh ƒ• ‰‚jÀ‰ƒm-C‡" [nil last p default completions search-forward "\n* menu:" t error "No menu in this node" re-search-forward "\n\\* \\([^: \n]*\\):" 0 1 item completion-ignore-case completing-read format "Menu item (default %s): " "Menu item: " ""] 6)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] 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]] 3) (defalias 'Info-nth-menu-item #[nil "ÀÁ  GSHÃZ!!‡" [Info-goto-node Info-extract-menu-counting this-command-keys 48] 4 "\ Go to the node of the Nth menu item. N is the digit argument used to invoke this command." nil]) (defalias 'Info-top-node #[nil "ÀÁ!‡" [Info-goto-node "Top"] 2 "\ Go to the Top node of this file." nil]) (defalias 'Info-final-node #[nil "ÀÁ!ˆÂÀÄÂ!!ˆÅƉ\"„ ÇÈ \"?…/ŠÊËÂÆ#)…/ÀÄÂ!!ˆ‚)‡" [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 "\ Go to the final node in this file." nil]) (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 "\ Go forward one node, considering all nodes as forming one sequence." nil]) (defalias 'Info-backward-node #[nil "ÀÁÂ\"ÀÃÂ\" ƒÆÇ \"ƒÈÉ!‚] ƒ0 ƒ+ — —šƒ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 "\ Go backward one node, considering all nodes as forming one sequence." nil]) (defalias 'Info-exit #[nil "ƒÁ ‡ÂÃp!Äp!ˆ!‡" [Info-standalone save-buffers-kill-emacs switch-to-buffer other-buffer bury-buffer] 4 "\ Exit Info by selecting some other buffer." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [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] Info-last-menu-item #[nil "ŠÀyˆÁÂÃÄ#ˆÁÅÃÄ#„ÆÇ!ˆÈÉ !)‡" [1 search-backward "\n* menu:" nil t "\n* " error "No previous items in menu" Info-goto-node Info-extract-menu-node-name] 4 nil nil] Info-no-error (macro . #[(&rest body) "ÀÁÂà Å\"BÆF‡" [condition-case nil progn append body (t) (error nil)] 6])] 3) (defalias 'Info-next-preorder #[nil "ÀÁ!ƒÂÔÕ{!‡ÄÅƆ\"ÄÇȃÃy‡ÉÊ!‡" [looking-at "\\*note[ \n]*\\([^:]*\\):" Info-follow-reference 1 nil (byte-code "À ˆÁ‡" [Info-next-menu-item t] 1) ((error)) (byte-code "À ˆÁ‡" [Info-up t] 1) ((error)) error "No more nodes"] 3 "\ Go to the next node, popping up a level if there is none." nil]) (defalias 'Info-last-preorder #[nil "ÀÁ†ÀÃăÅy‡ÆÇ!‡" [nil (byte-code "À ˆÁ‡" [Info-last-menu-item t] 1) ((error)) (byte-code "À ˆÁ‡" [Info-up t] 1) ((error)) -1 error "No previous nodes"] 3 "\ Go to the last node, popping up a level if there is none." nil]) (defalias 'Info-scroll-up #[nil "Àd!ƒ Á ‡Â ‡" [pos-visible-in-window-p Info-next-preorder scroll-up] 2 "\ Read the next screen. If end of buffer is visible, go to next entry." nil]) (defalias 'Info-scroll-down #[nil "Àe!ƒ Á ‡Â ‡" [pos-visible-in-window-p Info-last-preorder scroll-down] 2 "\ Read the previous screen. If start of buffer is visible, go to last entry." nil]) (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 "\ Move cursor to the next cross-reference or menu item in the node." nil]) (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 "\ Move cursor to the previous cross-reference or menu item in the node." nil]) (defalias 'Info-index #[(topic) "ÁÂÃÄ !\"Á ÊË!ˆÌÍÁÎ#„!ÏÐ!ˆÑÒÁÎ#„-ÏÐ!ˆÓ”bˆÁÊÕ !ˆ) Öš†ÅÁ‰‰‰ebˆÑÁÎ#ƒuÓ”Ó•{Ú”Ú•{ÛÜݔݕ{P!FB‚OÞßÎ\"‰ƒàá\"ƒÊ!ˆ‚L„œâ ˆÏã \"ˆä \"‰ƒ¹Bå\"‚œŸ¤&çè!,,‡" [Info-current-node nil format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ ]*\\([^.\n]*\\)\\.[ t]*\\([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-keeping-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 "\ 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." "sIndex topic: "]) (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 "\ Go to the next matching index item from the last `i' command." "p"]) (defalias 'Info-undefined #[nil "À ‡" [ding] 1 "\ Make command be undefined in Info." nil]) (defalias 'Info-help #[nil "À ˆÁÂà ÄWƒÅ‚Æ\"‡" [delete-other-windows Info-find-node "info" window-height 23 "Help-Small-Screen" "Help"] 4 "\ Enter the Info tutorial." nil]) (defalias 'Info-summary #[nil "À‹‡" [((byte-code "ÀÁ!ˆÂ ˆÃÄ!cˆebˆÅ‰Èd!?Ƀ%Ê‚&Ë!ˆÌ ‰Í=„:C‚EƒEÏ ˆ‚*ÐÁ!‡" [switch-to-buffer "*Help*" erase-buffer documentation Info-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 "\ Display a brief summary of all Info commands." nil]) (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 "\ 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-follow-nearest-node #[(click) "‰A@)‰@\nA@Å !ˆ bˆ+ÆÈ`ÉÊ#‰ƒ+Ë!‚¡È`ÌÍ#‰ƒ=Î!‚¡È`ÌÏ#‰ƒOÐ!‚¡È`ÑÒ#‰ƒaÎ!‚¡È`ÓÔ#‰ƒsÎ!‚¡È`ÕÖ#‰ƒ„Î×!‚¡È`ØÙ#‰ƒ–Î!‚¡ŠÚyˆm)…¡Û )‡" [click event start window pos select-window 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 ]*\\)" 1 Info-next] 5 "\ \\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." "e"]) (defvar Info-mode-map nil "\ Keymap containing Info commands.") (byte-code "„ûÁ Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÏ#ˆÃÑÏ#ˆÃÒÏ#ˆÃÓÏ#ˆÃÔÏ#ˆÃÕÏ#ˆÃÖÏ#ˆÃ×Ï#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞß#ˆÃàá#ˆÃâã#ˆÃäÅ#ˆÃåæ#ˆÃçè#ˆÃéê#ˆÃëì#ˆÃíî#ˆÃïð#ˆÃñò#ˆÃóô#ˆÃõö#ˆÃ÷ø#ˆÃùú#ˆÃûü#ˆÃýá#ˆÃþÿ#ˆÃ@A#ˆÃBC#ˆÃDE#ˆFGHI#‡" [Info-mode-map make-keymap suppress-keymap define-key "." beginning-of-buffer " " Info-scroll-up " " Info-next-preorder " " 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-follow-nearest-node put info-mode mode-class special] 4) (defalias 'Info-mode #[nil "À ˆÁÃÅ!ˆÇ!ˆ \nË Ë ÎÏ!ˆÎÐ!ˆÎÑ!ˆÎÒ!ˆÎÓ!ˆÎÔ!ˆÕÖ!ƒ‡Ö×!ˆÖØ!ˆÖÙ!ˆÚ×!„^ÚÛ!ƒYÜÛ×\"ˆ‚^ÜÝ×\"ˆÚØ!„yØËÞ !â!ã ä%ˆ+ÚÙ!„ŠÜÝÙ\"ˆ‚ŠÞ%æ ˆçè!‡" [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 fboundp make-face info-node info-menu-5 info-xref face-differs-from-default-p bold-italic copy-face bold nil frame underline-p face internal-set-face-1 underline 7 Info-fontify Info-set-mode-line run-hooks Info-mode-hook] 6 "\ \\ 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-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-preorder] Next-preorder; that is, try to go to the next menu item, and if that fails try to move up, and if that fails, tell user he/she is done reading. \\[Info-next-reference] Move cursor to next cross-reference or menu item. \\[Info-prev-reference] Move cursor to previous cross-reference or menu item."]) (defvar Info-edit-map nil "\ Local keymap used within `e' command of Info.") (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) (defun Info-edit-mode nil "\ 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 #[nil "„ÁÂ!ˆÃ !ˆÅÇÉÊ!ˆË ÍÎ !ˆÏÐÑ!!‡" [Info-enable-edit error "Editing info nodes is not enabled" 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 set-buffer-modified-p buffer-modified-p message substitute-command-keys "Editing: Type \\\\[Info-cease-edit] to return to info"] 3 "\ Edit the contents of this Info node. Allowed only if variable `Info-enable-edit' is non-nil." nil]) (defalias 'Info-cease-edit #[nil "À ƒÁÂ!ƒà ˆÄ !ˆÆÈ Ê ˆË ÍÀ !ˆÎ!…2À …2ÐÑ!‡" [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 set-buffer-modified-p marker-position Info-tag-table-marker message "Tags may have changed. Use Info-tagify if necessary"] 2 "\ Finish editing Info node; switch back to Info proper." nil]) (defalias 'Info-find-emacs-command-nodes #[(command) "ÀÁ!ˆÂÃÄÅ!!ÇQ ŠÊËÌ\"ˆ A dbˆÎÂÏ#ƒ:єѕ{ÒE B ‚  +‡" [require info nil "^\\* " regexp-quote symbol-name command ":\\s *\\(.*\\)\\.$" cmd-desc where Info-find-node "emacs" "Command Index" Info-history re-search-backward t Info-current-file 1 0] 5 "\ Return a list of locations documenting COMMAND in the Emacs Info manual. The locations are of the format used in Info-history, i.e. (FILENAME NODENAME BUFFERPOS)."]) (defalias 'Info-goto-emacs-command-node #[(command) "À !„ ÂÃÀ D\"ˆÄ !‰ƒ\\ GÇ‹ˆÈÉ!ˆÊ @@ @A@\"ˆËV…X A ¤ ÍÎÏSÐVƒIÑ‚JÒÐVƒUÓ‚VÔ$!)‚`ÕÖ \")‡" [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%. Use \\[Info-last] to see %s." 2 "ies" "y" "them" "it" error "Couldn't find documentation for %s."] 8 "\ 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." "CFind documentation for command: "]) (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 "\ 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." "kFind documentation for key:"]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias Info-fontify-node #[nil "ŠÀebˆÂÃ!ƒ&Ä•bˆÂÅ!ƒ&Ä•bˆÆǔǕÈÉ$ˆ‚ebˆÊËÀÌ#ƒFÄ”SfÍU„)ÆǔǕÈÉ$ˆ‚)ebˆÎÏÀÌ#ƒŽÐÑ\"„Žd`ZÓWƒŽÄÊÕÀÌ#ƒT‰Ö>ƒÆĔĔTÈ×$ˆÆǔǕÈØ$ˆ‚d)ÙÀ!*‡" [nil buffer-read-only looking-at "^File: [^,: ]+,?[ ]+" 0 "[ ]*[^:, \n]+:[ ]+\\([^:, \n]+\\),?" put-text-property 1 face info-xref re-search-forward "\\*Note[ \n ]*\\([^:]*\\):" t 34 search-forward "\n* Menu:" string-match "\\" Info-current-node 10000 n "^\\* \\([^: \n]*\\):" (5 9) info-menu-5 info-node set-buffer-modified-p] 6] provide info] 3) emacs-19.22/lisp/lpr.elc100666 13437 1 5356 5471634665 13525 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 03:11:33 1993 ;;; from file /home/fsf/rms/e19/lisp/lpr.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defvar lpr-switches nil "\ *List of strings to pass as extra switch args to lpr when it is invoked.") (defvar lpr-command (byte-code "Á>ƒ‡Ç" [system-type (usg-unix-v dgux-unix hpux irix) "lp" "lpr"] 2) "\ *Shell command for printing a file") (defvar print-region-function nil "\ Function to call to print the region on a printer. See definition of `print-region-1' for calling conventions.") (defalias 'lpr-buffer #[nil "Àed Â$‡" [print-region-1 lpr-switches nil] 5 "\ Print buffer contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." nil]) (defalias 'print-buffer #[nil "Àed Â$‡" [print-region-1 lpr-switches t] 5 "\ Print buffer contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." nil]) (defalias 'lpr-region #[(start end) "À \n Ä$‡" [print-region-1 start end lpr-switches nil] 5 "\ Print region contents as with Unix command `lpr'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." "r"]) (defalias 'print-region #[(start end) "À \n Ä$‡" [print-region-1 start end lpr-switches t] 5 "\ Print region contents as with Unix command `lpr -p'. `lpr-switches' is a list of extra switches (strings) to pass to lpr." "r"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias print-region-1 #[(start end switches page-headers) "À ÁP\nŠÅÆ!ˆ\nÇU„*È \n\"ˆ Š\nbˆË \n)Ìed\"ˆ ƒRÏ=ƒLÈ \n\"ˆÐ \nÑÒ‰Ó&ˆ‚RÔBÖ†YÐ \nÓ‰‰¯Ù=…pÚ Û F¤¤\"ˆÜ\n!ƒƒ\nÓ‰“ˆÅÝ!+‡" [buffer-name " Emacs buffer" tab-width width name message "Spooling..." 8 print-region-new-buffer start end point-marker untabify page-headers system-type usg-unix-v call-process-region "pr" t nil "-p" switches apply print-region-function lpr-command berkeley-unix "-J" "-T" markerp "Spooling...done"] 8] print-region-new-buffer #[(start end) "À Á˜†#pÃÁ!qˆ~ˆÄ ˆÅ\n#ˆed‰)‡" [buffer-name " *spool temp*" oldbuf get-buffer-create erase-buffer insert-buffer-substring start end] 4]] 3) (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 "\ Turn nonprinting characters (other than TAB, LF, SPC, RET, and FF) in the current buffer into printable representations as control or hexadecimal escapes." "r"]) emacs-19.22/lisp/informat.elc100666 13437 1 14651 5416170060 14544 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:23:28 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/informat.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote info)) (defalias 'Info-tagify #[nil "ÀÁÂà !\"ˆeddÄ TU`ÉŽ~ˆebˆÊËÌÍ#ƒ-ÀÎ!ˆ‚ºÏÍÌÊÓÌÍ#ƒbÔyˆ`Ô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‚ d^}‡" [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" 1 beg re-search-backward -8 buffer-read-only "\nEnd tag table\n" end search-backward "\nTag table:\n" 0 " \nTag table:\n" Info-tag-table-marker "Node: " 127 princ 10 "Tagifying %s ... done"] 5 "\ Create or update Info-file tag table in current buffer." nil]) (defalias 'Info-split #[nil "À ÁWƒ ÂÃ!ˆebˆÄÅ!ˆÆuˆ`ÇÈÉÊË ! dbˆÓyˆÈÄÕÈÊ#„?ÂÖ!ˆ×Ø!ˆÙÚ!ƒMÂÛ!ˆÇyˆÉuˆŒe`}ˆebˆ`TdWƒ²`Ü\\d^bˆÄÅÈÝ#ˆ\\Þ !ßà\"PDBácˆâe` ßà\"P#ˆ`S`|ˆÆuˆ`Z\\`|ˆT‚[)ƒÕbˆ@A@ßã@@\"᱈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 "\ 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." nil]) (defalias 'Info-validate #[nil "ŠŒ~ˆebˆÀÁÂÃ#ƒÄÅÆp!\"ˆebˆÇÈÉ \n   ÀÎÂÃ#ƒŠÏyˆ`ÏyˆÑ Ã#ƒ†Ï”Ï•bˆÒÂxˆ`{—Ô \"ƒhÕÂE B ‚…ˆÑÖÃ#…}וbˆØ —E B ))‚(ebˆÀÎÂÃ#ƒ Ïyˆ`‰ÏyˆÑ Ã#ƒœŒÀÎÂÛ#ˆ`}ˆÏ”Ï•bˆÒÂxˆ`{—ˆÜÝÂÃ#ƒ1Þß!‰ƒ1Ô \"ƒ1Ô \"A@šƒ& ‰ ƒ\" @A@ᚃ @@šƒâ @ \"  A‰ „ü)‚1áE B ˆÑÖÂÃ#ƒ@Þã!ˆÂˆÜäÂÃ#ƒOÞå!ˆæçÂÃ#ƒræèÂÃ#ƒrÞé`ŠêÂwˆ`){Pë \"ˆ‚WebˆæìÂÃ#ƒ›×”í\\bˆîÂwˆÞï`ŠêÂwˆ`){Pëð!\"ˆ‚u)+‚ñ ?\n „¯\nƒ3ò ƒ'óô!ˆó @@!ˆóõ!ˆ @A@ ö÷ \"ƒäó ׉”O!ˆóø!ˆ‚éó !ˆ)ù @8ƒóú!ˆù @8 ö÷ \"ƒó ׉”O!ˆóø!ˆ‚ó !ˆ)û ˆ A‰ „¶\n…/óü!‘‚GŠýò!ƒAòqˆþp!ˆ)ÿ@!.‡" [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 " " 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 "\ Check current buffer for validity as an Info file. Check that every node pointer points to an existing node." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias Info-validate-node-name #[(kind &optional name) "„Á•bˆÂÃwˆgÄU„`ÅÃwˆÆÃxˆ`{ƒG—‰GÁVƒ4ÁHÄU„GÇ\"„G \nE B ‡" [name 0 " " nil 40 "^, \n" " " assoc allnodes thisnode kind lossages] 4] Info-validate-tags-table #[nil "ebˆÀÁÂÃ#„ ÇÄÅ?‡" [search-forward "\nEnd tag table\n" nil t losing (byte-code "À”ÂÃ!ˆÀ•Sʼnƒ> bˆ@@Èš„5ÉÊ@@ËQ Ì#„5ÍÎÏ\"ˆA‰„ TbˆÐÑ!ƒ†Ò”Ò•{—Ó\"‰ƒ~ÔÕ”bˆAA@Öp!Z‰ÀVƒw‚z[WƒBÍÎ×\"ˆ‚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]+\\)$" 1 assoc 1000 2 read y "End tag table\n" z] 5)] 4]] 3) (defalias 'batch-info-validate #[nil "„ÁÂ!ˆÃĉʼn \nËĉ  ƒhÏ@! Ð !„CÑÒ \"ˆÓA‰‚!Ô !ƒXÕ !A¤‰‚!  B A‰„$ ƒƒ @  A Ä×ØÙˆ)‚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 \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 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 "\ 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\""]) emacs-19.22/lisp/isearch.elc100666 13437 13 61523 5475604055 14114 0ustar jimbuser;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 02:56:28 1993 ;;; from file /home/fsf/rms/e19/lisp/isearch.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ÃÄ!ÆƇ" [fboundp set-frame-height isearch-gnu-emacs-events boundp pre-command-hook isearch-pre-command-hook-exists nil isearch-event-data-type] 2) (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 (quote 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.") (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.") (defvar isearch-mode-map nil "\ Keymap for isearch-mode.") (byte-code "„Áà ÅÆ 8!„ÇÈ!ˆ AÉÊË\" ˆÌ ÍÎ#ˆ\nÏWƒ9Ì ÐÆ\n\"Î#ˆ\nT‰‚$ÏÏ A@GWƒSÌ Ñ\n!Ò#ˆ\nT‰‚<Ì ÓÔ#ˆÌ ÕÖ#ˆÌ ×Ø#ˆÌ ÙÚ#ˆÌ ÛÜ#ˆÌ ÝÞ#ˆÌ ßÒ#ˆÌ àÒ#ˆÌ áâ#ˆÌ ãä#ˆÌ åæ#ˆÌ çè#ˆÌ éË#ˆÌ êÒ#ˆÌ ëØ#ˆÌ ìØ#ˆÌ íÞ#ˆÌ îÒ#ˆÌ ïð#ˆÌ ñð#ˆÌ òó#ˆô 5Ì ö7!5#ˆÌ ø5#ˆ)Ì Ñ7ù\"ú#ˆÌ ûü#ˆÌ ýþ#ˆÌ ÿè#ˆÌ @A#ˆBƒÌ CD#ˆ *ˇ" [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 "" isearch-repeat-forward "" isearch-repeat-backward "" isearch-delete-char "" isearch-abort "" isearch-quote-char " " isearch-exit "\n" " " " " isearch-whitespace-chars "" isearch-yank-word "" isearch-yank-line [mouse-2] isearch-yank-kill [down-mouse-2] [tab] [delete] [backspace] [return] [newline] "*" isearch-*-char "?" "|" isearch-|-char make-sparse-keymap meta-map char-to-string meta-prefix-char [escape] t isearch-other-meta-char "î" isearch-ring-advance "ð" isearch-ring-retreat "ù" "‰" isearch-complete isearch-gnu-emacs-events [switch-frame] isearch-switch-frame-handler] 6) (defvar minibuffer-local-isearch-map nil "\ Keymap for editing isearch strings in the minibuffer.") (byte-code "„/Á\n!Ä ÅÆ#ˆÄ ÇÈ#ˆÄ ÉÊ#ˆÄ ËÌ#ˆÄ ÍÎ#ˆÄ ÏÐ#ˆ )ÑÒ!„8ÓÑÔ!„AÓÑÕ!„JÓÑÖ!„SÓÑ×!„\\ØÑÙ!„eØÑÚ!„nÛÑÜ!„wÓÑÝ!„€ÓÑÞ!„‰ÓÑß!„’àÑá!„›Ó!Ñâ!„¤Ó\"Ñã!„­Ó#Ñä!„¶Ó$Ñå!„¿à%Ñæ!„ÈÓ&Ñç!„ÑÓ'Ñè!„ÚÓ(Ñé!„ãÓ)Ñê!„ìÓ*Ñë!„õÓ+Ñì!„þÓ,í.ž„ .ïC¤ˆÑí!„Ó-ðí!ˆÄ1ÍÒ#ˆÄ2Íó#ˆÄ1Ïô#ˆÄ2Ïõ#‡" [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 isearch-regexp isearch-word isearch-cmds isearch-string "" isearch-message isearch-success t isearch-invalid-regexp 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-old-local-map 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) (defalias 'isearch-forward #[(&optional regexp-p no-recursive-edit) "ÀÁ\n??à ?$‡" [isearch-mode t regexp-p nil no-recursive-edit] 5 "\ 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'). If this function is called non-interactively, it does not return to the calling function until the search is done." "P\np"]) (defalias 'isearch-forward-regexp #[(&optional not-regexp no-recursive-edit) "ÀÁ\n?à ?$‡" [isearch-mode t not-regexp nil no-recursive-edit] 5 "\ 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." "P\np"]) (defalias 'isearch-backward #[(&optional regexp-p no-recursive-edit) "ÀÁ\n??Á ?$‡" [isearch-mode nil regexp-p no-recursive-edit] 5 "\ Do incremental search backward. With a prefix argument, do a regular expression search instead. See \\[isearch-forward] for more information." "P\np"]) (defalias 'isearch-backward-regexp #[(&optional not-regexp no-recursive-edit) "ÀÁ\n?Á ?$‡" [isearch-mode nil not-regexp no-recursive-edit] 5 "\ 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." "P\np"]) (defalias (quote isearch-mode-help) #[nil "ÀÁ!ˆÂ ‡" [describe-function isearch-forward isearch-update] 2 nil nil]) (defalias 'isearch-mode #[(forward &optional regexp op-fun recursive-edit word-p) "\n  Ê Ê ÍÏÍ`ÍÍÍÖ X…8Ø Ú_VÍÍ`ß  Í!Í\"ƒVã $å&çè !ˆÏ)ê ˆë,!ˆí ˆîï!ˆ0…{Ï1ð )‡" [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 baud-rate search-slow-speed window-height search-slow-window-lines 4 isearch-slow-terminal-mode isearch-other-end isearch-small-window isearch-opoint current-local-map isearch-old-local-map search-ring-yank-pointer regexp-search-ring-yank-pointer current-window-configuration isearch-window-configuration " Isearch" isearch-mode set-buffer-modified-p buffer-modified-p deactivate-mark isearch-push-state use-local-map isearch-mode-map isearch-update run-hooks isearch-mode-hook recursive-edit isearch-recursive-edit] 3 "\ Start isearch minor mode. Called by isearch-forward, etc."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias isearch-update #[nil "ƒ ?‚\nƒ ?‚ ÅWƒÆ „ Ç ˆƒ‚ „‚Ê „‚` Ì ÍÅ!ˆÎÐÑÅWƒL[T‚RÓ TZ\"ˆ)ÅWƒyÔÎZ!ˆÕÖ `\"ˆ×Ö Ø \"ˆ×Ù Å\"ˆ‚}ÚÎ!ˆ bˆ)ƒ`Wƒ—Ü`\"ˆ‚Ü`\"ˆÑщ‡" [isearch-event-data-type unread-command-event isearch-gnu-emacs-events unread-command-events unread-command-char 0 input-pending-p isearch-message isearch-slow-terminal-mode isearch-small-window pos-visible-in-window-p found-point t move-to-window-line 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-adjusted isearch-yank-flag] 4] isearch-done #[(&optional nopush) "À !ˆÂÃ!ˆÄÅ !`ƒÉ!ˆ\nƒ'bˆ‚/ËÅ Ã#ˆ*` U„TÍ Ã\"ˆÎÐÑ!ˆ„TÓ ÔV„TÕÖ!ˆÎØÙ !ˆGÔVƒ½„½ƒ—ƒ|@˜„½B‰GVƒ½S›Î¡ˆ‚½ ƒ¥ @˜„½ B‰ GVƒ½S ›Î¡ˆÐá!ˆ\"…Èã ‡" [use-local-map isearch-old-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 push-mark nil mark-active run-hooks deactivate-mark-hook executing-macro minibuffer-depth 0 message "Mark saved where search started" isearch-mode set-buffer-modified-p buffer-modified-p isearch-string nopush isearch-regexp regexp-search-ring regexp-search-ring-max search-ring-max search-ring isearch-mode-end-hook isearch-recursive-edit exit-recursive-edit] 5] isearch-switch-frame-handler #[nil "À ˆÁ A@!‡" [isearch-done handle-switch-frame isearch-last-command-char] 2 nil nil]] 3) (defalias 'isearch-exit #[nil "ƒ GÂUƒÃÅ ˆ)Æ ‡" [search-nonincremental-instead isearch-string 0 t isearch-nonincremental isearch-edit-string isearch-done] 2 "\ 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'." nil]) (defalias 'isearch-edit-string #[nil "ÀÁ‡" [err (byte-code " \n  \n   Ó    \n ÙÚۈ ˆÜŽÝß ) á\"ãäá‰Ý#!ˆå&ç !\"è=ƒzÝÝ‚é !ˆáá*ëä ,áê%)íîï#+ GðUƒ® ƒª1‚¬2@ó ˆô ˆõ ˆ…½ö .‡" [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-other-end 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 (isearch-done t) ((exit)) ((byte-code "À \n %ˆ \n À‡" [isearch-mode isearch-forward isearch-regexp isearch-op-fun isearch-recursive-edit 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 isearch-message-prefix lookup-key isearch-mode-map vector isearch-yank-word isearch-unread junk-ring read-from-minibuffer minibuffer-local-isearch-map mapconcat text-char-description "" 0 regexp-search-ring search-ring isearch-push-state isearch-search isearch-update isearch-done] 20) ((quit (isearch-abort)))] 3 "\ 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-backward-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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias isearch-nonincremental-exit-minibuffer #[nil "À ‡" [t isearch-nonincremental exit-minibuffer] 1 nil nil] isearch-forward-exit-minibuffer #[nil "À ‡" [t isearch-new-forward exit-minibuffer] 1 nil nil] isearch-reverse-exit-minibuffer #[nil "À ‡" [nil isearch-new-forward exit-minibuffer] 1 nil nil]] 3) (defalias 'isearch-abort #[nil "À ˆ ƒ\nbˆÃÄ!ˆÅÆÇ\"‡ „È ˆ‚É ‡" [discard-input isearch-success isearch-opoint isearch-done t signal quit nil isearch-pop-state isearch-update] 3 "\ 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." nil]) (defalias (quote isearch-repeat) #[(direction) " Â==ƒ@ Äšƒ* ƒ@‚@†ÄÈÉ Ä#\n‚C „Cƒ7e‚8dbˆÌ ‚C?`Ì Äš„eÏ•Ï”šƒbƒ_Ђ`Ñ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 1 -1 isearch-search isearch-push-state isearch-update] 4]) (defalias 'isearch-repeat-forward #[nil "ÀÁ!‡" [isearch-repeat forward] 2 "\ Repeat incremental search forwards." nil]) (defalias 'isearch-repeat-backward #[nil "ÀÁ!‡" [isearch-repeat backward] 2 "\ Repeat incremental search backwards." nil]) (defalias 'isearch-toggle-regexp #[nil "?‰ƒ Áà ‡" [isearch-regexp nil isearch-word isearch-update] 2 "\ Toggle regexp searching on or off." nil]) (defalias 'isearch-delete-char #[nil "A„ Á ˆ‚ ˆÃ ‡" [isearch-cmds ding isearch-pop-state isearch-update] 1 "\ Discard last input item and move point back. If no previous match was done, just beep." nil]) (defalias (quote isearch-yank) #[(chunk) "Á=ƒ ÂÃ!‚3Š „ ƒ bˆ`ŠÆ=ƒ&Çvˆ‚/È=ƒ/Ɉ`){)\n ƒ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]) (defalias 'isearch-yank-kill #[nil "ÀÁ!‡" [isearch-yank kill] 2 "\ Pull string from kill ring into search string." nil]) (defalias 'isearch-yank-word #[nil "ÀÁ!‡" [isearch-yank word] 2 "\ Pull next word from buffer into search string." nil]) (defalias 'isearch-yank-line #[nil "ÀÁ!‡" [isearch-yank line] 2 "\ Pull rest of line from buffer into search string." nil]) (defalias (quote isearch-search-and-update) #[nil "„ ƒS\n„3 „3ÄÅƃ3„'È• \n^Xƒ3ËÄ È• ‚S ƒP „P\nƒE ‚N \n T^^bˆÎ ˆÏ ˆƒ_ ˆÑ ‡" [isearch-success isearch-regexp isearch-forward isearch-adjusted nil (byte-code "À ƒ \n‚ Ã\n!!‡" [looking-at isearch-regexp isearch-string regexp-quote] 3) ((error)) isearch-yank-flag 0 isearch-opoint isearch-barrier t isearch-invalid-regexp isearch-other-end isearch-search isearch-push-state isearch-op-fun isearch-update] 3]) (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 "\ Handle * and ? specially in regexps." nil]) (defalias 'isearch-|-char #[nil "ƒ Á bˆÄÅ !‡" [isearch-regexp t isearch-adjusted isearch-barrier isearch-process-search-char isearch-last-command-char] 2 "\ If in regexp search, jump to the barrier." nil]) (defalias (quote isearch-other-control-char) (quote isearch-other-meta-char)) (defalias 'isearch-other-meta-char #[nil "Á=ƒ ÄÅÆ !\"ˆ)Ç ‡ƒ€Â ÈÉ\n ÄÅÆ !\"ˆ GÌVƒK ÈH9ƒK ÌH<ƒKÍÎ ÌH!!§„KÌ  H<ƒ|  H‰A@)‰@)‰\nƒ|Ñ\n!ƒ|ŠÒ\n!qˆÓ )‚~Ó +‡Ô  \"‡" [search-exit-option edit this-command-keys key apply isearch-unread listify-key-sequence isearch-edit-string 0 nil window index 1 posn-point event-start event position windowp window-buffer isearch-done isearch-process-search-string] 5 "\ 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." nil]) (defalias 'isearch-quote-char #[nil "ÀÁÂÃ!!!‡" [isearch-process-search-char read-quoted-char isearch-message t] 4 "\ Quote special characters for incremental search." nil]) (defalias 'isearch-return-char #[nil "ÀÁ!‡" [isearch-process-search-char 10] 2 "\ Convert return into newline for incremental search. Obsolete." nil]) (defalias 'isearch-printing-char #[nil "ÀÁ !‡" [isearch-process-search-char isearch-last-command-char] 2 "\ Add this ordinary printing character to the search string and search." nil]) (defalias 'isearch-whitespace-chars #[nil "ƒ ƒ  Ã\"‡Ä ‡Ä ‡" [isearch-regexp search-whitespace-regexp isearch-process-search-string " " isearch-printing-char] 3 "\ Match all whitespace chars, if in regexp mode. If you want to search for just a space, type C-q SPC." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias isearch-process-search-char #[(char) "ÀÁ\n!Ã\n!\"‡" [isearch-process-search-string isearch-char-to-string char isearch-text-char-description] 4] isearch-process-search-string #[(string message) " P\n PÄ ‡" [isearch-string string isearch-message message isearch-search-and-update] 2] isearch-ring-adjust1 #[(advance) "ƒ ‚ \n‰GƒÅ‚ÆÈ! ÊU?…OË †.Ê ƒ7Í‚8Î\\ \"‰ 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] 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]] 3) (defalias 'isearch-ring-advance #[nil "ÀÁ!‡" [isearch-ring-adjust advance] 2 "\ Advance to the next search string in the ring." nil]) (defalias 'isearch-ring-retreat #[nil "ÀÁ!‡" [isearch-ring-adjust nil] 2 "\ Retreat to the previous search string in the ring." nil]) (defalias 'isearch-ring-advance-edit #[(n) "ƒÁ‚ ÂÄ !ƒ‚‰G‰ ÊU?…B Ë †-Ê Z \"‰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 "\ Insert the next element of the search history into the minibuffer." "p"]) (defalias 'isearch-ring-retreat-edit #[(n) "À [!‡" [isearch-ring-advance-edit n] 2 "\ Inserts the previous element of the search history into the minibuffer." "p"]) (defalias (quote 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]) (defalias 'isearch-complete #[nil "À ƒÁ ‡ÂÃ!ˆÄ ‡" [isearch-complete1 isearch-edit-string sit-for 1 isearch-update] 2 "\ 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." nil]) (defalias 'isearch-complete-edit #[nil "À  … à ˆ c‡" [buffer-string isearch-string isearch-complete1 erase-buffer] 1 "\ Same as `isearch-complete' except in the minibuffer." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÏÐ!„,ÑÀÒÓ\"ˆÀÔÕ\"‡" [defalias isearch-top-state #[nil "@‰@ A@Ä 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] 3] isearch-pop-state #[nil "AÁ ‡" [isearch-cmds isearch-top-state] 1] isearch-push-state #[nil " `\n ¯\n B‰ ‡" [isearch-string isearch-message isearch-success isearch-forward isearch-other-end isearch-word isearch-invalid-regexp isearch-wrapped isearch-barrier isearch-cmds] 10] isearch-message #[(&optional c-q-hack ellipsis) "Á\n # Å\n\"Q\nƒ‚ÈÉ\"*‡" [ellipsis isearch-message-prefix c-q-hack isearch-nonincremental isearch-message isearch-message-suffix m cursor-in-echo-area message "%s"] 6] isearch-message-prefix #[(&optional c-q-hack ellipsis nonincremental) "ƒ ƒ ÂÃĈ „ ƒÆ‚Ç…\"É\nƒ+Ë‚,Æ ƒ5Í‚6ƃ?Ï‚@ЃIÒ‚JÓ°‰ÕÕH–Iˆ)‡" [isearch-invalid-regexp ellipsis nil (byte-code "À `Â#ˆÃÇ" [re-search-forward isearch-string t nil isearch-invalid-regexp] 4) ((error)) isearch-success "" "failing " isearch-wrapped "wrapped " isearch-word "word " isearch-regexp "regexp " nonincremental "search" "I-search" isearch-forward ": " " backward: " m 0] 7] isearch-message-suffix #[(&optional c-q-hack ellipsis) "ƒÁ‚  ƒÄ ÅQ‚ÂP‡" [c-q-hack "^Q" "" isearch-invalid-regexp " [" "]"] 4] isearch-search #[nil "ÀÁÂ\"ˆ ƒ ƒÅ\"ÈÉʈ ?…0Ì @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 "À  ƒ\nÀƒƒÈ‚7É‚7 ƒ-ƒ)Ê‚7Ë‚7ƒ6Ì‚7ÍÀÏ#‰ƒPƒLÑ”‚NÑ•*À‡" [nil isearch-case-fold-search case-fold-search inhibit-quit isearch-regexp isearch-invalid-regexp 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 "\\`Premature \\|\\`Unmatched \\|\\`Invalid " "incomplete input"] 3)) (error (byte-code "A@‡" [lossage isearch-invalid-regexp nil] 1))) isearch-success 3 isearch-cmds ding 2] 3] boundp isearch-overlay nil isearch-highlight #[(beg end) "??…& „ \"Å p$ˆÆ ÇÈÉÊ\"ƒ$É‚%Ë#‡" [search-highlight isearch-overlay make-overlay beg end move-overlay overlay-put face internal-find-face isearch nil region] 6] isearch-dehighlight #[(totally) "…Á!‡" [isearch-overlay delete-overlay] 2]] 3) (defalias 'isearch-no-upper-case-p #[(string regexp-flag) "À ƒ Ä‚ Å\")?‡" [nil case-fold-search string-match regexp-flag "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]" "[A-Z]" string] 3 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias isearch-char-to-string #[(c) "¨ƒ\nÁÂ\"‡9ƒÃNƒÁÂÃN\"‡ÁÂÄ!\"‡" [c make-string 1 ascii-character event-to-character] 4] isearch-text-char-description #[(c) "À !‡" [isearch-char-to-string c] 2] isearch-unread #[(&rest char-or-events) "ƒ Á\n \"‰‡\nAƒ#\nAƒ\nA‰‚\n@Ä\\‚%\n@ƒ2 ‰‚6 ‰)‡" [isearch-gnu-emacs-events append char-or-events unread-command-events 128 char isearch-event-data-type unread-command-event unread-command-char] 4] isearch-last-command-char #[nil "ƒ ‡\n‡" [isearch-event-data-type last-command-event last-command-char] 1]] 3) emacs-19.22/lisp/iso-acc.elc100666 12120 1 7755 5474032450 14102 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 21 22:42:31 1993 ;;; from file /home/fsf/rms/e19/lisp/iso-acc.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (provide (quote iso-acc)) (defvar iso-accents-list (quote (((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 97) 227) ((126 99) 231) ((126 100) 240) ((126 110) 241) ((126 111) 245) ((126 62) 187) ((126 60) 171) ((47 65) 197) ((47 69) 198) ((47 79) 216) ((47 97) 229) ((47 101) 230) ((47 111) 248))) "\ Association list for ISO accent combinations.") (defvar iso-accents-minor-mode nil "\ *Non-nil enables ISO Accents mode. Setting this variable makes it local to the current buffer. See `iso-accents-mode'.") (make-variable-buffer-local (quote iso-accents-minor-mode)) (defalias 'iso-accents-accent-key #[(prompt) "ƒÁ\n!‡Ã !‡" [iso-accents-minor-mode iso-accents-compose prompt char-to-string last-input-char] 2 "\ Modify the following character by adding an accent to it."]) (defalias 'iso-accents-compose-key #[(prompt) "À ! ƒ ÅÆÇÈ\nÉH!È @!#ˆ)\n)‡" [iso-accents-compose prompt combined unread-command-events unread nil error "Characters %s and %s cannot be composed" single-key-description 0] 5 "\ Modify the following character by adding an accent to it."]) (defalias (quote iso-accents-compose) #[(prompt) "\n„ÃÄ!Å=„ÆÇ\n†È #ˆÉ ‚' cˆÉ `S`|ˆ\nË \nD \"‰ ƒA A@C°‚I\nCÏ !+‡" [last-input-char first-char prompt key-binding "a" self-insert-command message "%s%c" "Compose with " read-event second-char assoc iso-accents-list entry unread-command-events vector] 5]) (defvar iso-accents-enable (quote (39 96 94 34 126 47)) "\ *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.") (byte-code "„Á  >ƒÄÅÆ#ˆÇ >ƒÄÈÆ#ˆÉ >ƒ+ÄÊÆ#ˆË >ƒ7ÄÌÆ#ˆÍ >ƒCÄÎÆ#ˆÏ >ƒOÄÐÆ#ˆÁ‡" [key-translation-map make-sparse-keymap 39 iso-accents-enable define-key "'" iso-accents-accent-key 96 "`" 94 "^" 34 "\"" 126 "~" 47 "/"] 4) (defalias 'iso-accents-mode #[(&optional arg) "ƒ Á!ÂX‚ ƒĉ‡Å‰‡" [arg prefix-numeric-value 0 iso-accents-minor-mode nil t] 2 "\ 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 a d with dash. \"s gives German sharp s. /a gives a with ring. /e gives an a-e ligature. ~< and ~> give guillemets. With an argument, a positive argument enables ISO Accents mode, and a negative argument disables it." "P"]) emacs-19.22/lisp/iso-ascii.elc100666 13437 1 4576 5416170174 14600 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:24:43 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-ascii.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file 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.22/lisp/iso-insert.elc100666 13437 1 22221 5416170234 15014 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:25:16 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-insert.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file 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\"ˆÀ{|\"ˆÀ}~\"ˆÀ€\"ˆÀ‚\"ˆÀƒ„\"ˆÀ…†\"ˆÀ‡ˆ\"ˆÀ‰Š\"ˆÀ‹Œ\"ˆÀŽ\"ˆÀ\"ˆÀ‘’\"ˆÀ“”\"ˆÀ•–\"ˆÀ—˜\"ˆÀ™š\"ˆÀ›œ\"ˆÀž\"ˆÀŸ \"ˆÀ¡¢\"ˆÀ£¤\"ˆÀ¥¦\"ˆÀ§¨\"ˆÀ©ª\"ˆÀ«¬\"ˆÀ­®\"ˆÀ¯°\"ˆÀ±²\"ˆÀ³´\"ˆÀµ¶\"ˆÀ·¸\"ˆÀ¹º\"ˆÀ»¼\"ˆÀ½¾\"ˆÀ¿À\"‡" [defalias insert-no-break-space #[nil "Àc‡" [160] 1 nil "*"] insert-inverted-exclamation-mark #[nil "Àc‡" [161] 1 nil "*"] insert-cent-sign #[nil "Àc‡" [162] 1 nil "*"] insert-pound-sign #[nil "Àc‡" [163] 1 nil "*"] insert-general-currency-sign #[nil "Àc‡" [164] 1 nil "*"] insert-yen-sign #[nil "Àc‡" [165] 1 nil "*"] insert-broken-vertical-line #[nil "Àc‡" [166] 1 nil "*"] insert-section-sign #[nil "Àc‡" [167] 1 nil "*"] insert-diaeresis #[nil "Àc‡" [168] 1 nil "*"] insert-copyright-sign #[nil "Àc‡" [169] 1 nil "*"] insert-ordinal-indicator-feminine #[nil "Àc‡" [170] 1 nil "*"] insert-angle-quotation-mark-left #[nil "Àc‡" [171] 1 nil "*"] insert-not-sign #[nil "Àc‡" [172] 1 nil "*"] insert-soft-hyphen #[nil "Àc‡" [173] 1 nil "*"] insert-registered-sign #[nil "Àc‡" [174] 1 nil "*"] insert-macron #[nil "Àc‡" [175] 1 nil "*"] insert-degree-sign #[nil "Àc‡" [176] 1 nil "*"] insert-plus-or-minus-sign #[nil "Àc‡" [177] 1 nil "*"] insert-superscript-two #[nil "Àc‡" [178] 1 nil "*"] insert-superscript-three #[nil "Àc‡" [179] 1 nil "*"] insert-acute-accent #[nil "Àc‡" [180] 1 nil "*"] insert-micro-sign #[nil "Àc‡" [181] 1 nil "*"] insert-pilcrow #[nil "Àc‡" [182] 1 nil "*"] insert-middle-dot #[nil "Àc‡" [183] 1 nil "*"] insert-cedilla #[nil "Àc‡" [184] 1 nil "*"] insert-superscript-one #[nil "Àc‡" [185] 1 nil "*"] insert-ordinal-indicator-masculine #[nil "Àc‡" [186] 1 nil "*"] insert-angle-quotation-mark-right #[nil "Àc‡" [187] 1 nil "*"] insert-fraction-one-quarter #[nil "Àc‡" [188] 1 nil "*"] insert-fraction-one-half #[nil "Àc‡" [189] 1 nil "*"] insert-fraction-three-quarters #[nil "Àc‡" [190] 1 nil "*"] insert-inverted-question-mark #[nil "Àc‡" [191] 1 nil "*"] insert-A-grave #[nil "Àc‡" [192] 1 nil "*"] insert-A-acute #[nil "Àc‡" [193] 1 nil "*"] insert-A-circumflex #[nil "Àc‡" [194] 1 nil "*"] insert-A-tilde #[nil "Àc‡" [195] 1 nil "*"] insert-A-umlaut #[nil "Àc‡" [196] 1 nil "*"] insert-A-ring #[nil "Àc‡" [197] 1 nil "*"] insert-AE #[nil "Àc‡" [198] 1 nil "*"] insert-C-cedilla #[nil "Àc‡" [199] 1 nil "*"] insert-E-grave #[nil "Àc‡" [200] 1 nil "*"] insert-E-acute #[nil "Àc‡" [201] 1 nil "*"] insert-E-circumflex #[nil "Àc‡" [202] 1 nil "*"] insert-E-umlaut #[nil "Àc‡" [203] 1 nil "*"] insert-I-grave #[nil "Àc‡" [204] 1 nil "*"] insert-I-acute #[nil "Àc‡" [205] 1 nil "*"] insert-I-circumflex #[nil "Àc‡" [206] 1 nil "*"] insert-I-umlaut #[nil "Àc‡" [207] 1 nil "*"] insert-D-stroke #[nil "Àc‡" [208] 1 nil "*"] insert-N-tilde #[nil "Àc‡" [209] 1 nil "*"] insert-O-grave #[nil "Àc‡" [210] 1 nil "*"] insert-O-acute #[nil "Àc‡" [211] 1 nil "*"] insert-O-circumflex #[nil "Àc‡" [212] 1 nil "*"] insert-O-tilde #[nil "Àc‡" [213] 1 nil "*"] insert-O-umlaut #[nil "Àc‡" [214] 1 nil "*"] insert-multiplication-sign #[nil "Àc‡" [215] 1 nil "*"] insert-O-slash #[nil "Àc‡" [216] 1 nil "*"] insert-U-grave #[nil "Àc‡" [217] 1 nil "*"] insert-U-acute #[nil "Àc‡" [218] 1 nil "*"] insert-U-circumflex #[nil "Àc‡" [219] 1 nil "*"] insert-U-umlaut #[nil "Àc‡" [220] 1 nil "*"] insert-Y-acute #[nil "Àc‡" [221] 1 nil "*"] insert-THORN #[nil "Àc‡" [222] 1 nil "*"] insert-ss #[nil "Àc‡" [223] 1 nil "*"] insert-a-grave #[nil "Àc‡" [224] 1 nil "*"] insert-a-acute #[nil "Àc‡" [225] 1 nil "*"] insert-a-circumflex #[nil "Àc‡" [226] 1 nil "*"] insert-a-tilde #[nil "Àc‡" [227] 1 nil "*"] insert-a-umlaut #[nil "Àc‡" [228] 1 nil "*"] insert-a-ring #[nil "Àc‡" [229] 1 nil "*"] insert-ae #[nil "Àc‡" [230] 1 nil "*"] insert-c-cedilla #[nil "Àc‡" [231] 1 nil "*"] insert-e-grave #[nil "Àc‡" [232] 1 nil "*"] insert-e-acute #[nil "Àc‡" [233] 1 nil "*"] insert-e-circumflex #[nil "Àc‡" [234] 1 nil "*"] insert-e-umlaut #[nil "Àc‡" [235] 1 nil "*"] insert-i-grave #[nil "Àc‡" [236] 1 nil "*"] insert-i-acute #[nil "Àc‡" [237] 1 nil "*"] insert-i-circumflex #[nil "Àc‡" [238] 1 nil "*"] insert-i-umlaut #[nil "Àc‡" [239] 1 nil "*"] insert-d-stroke #[nil "Àc‡" [240] 1 nil "*"] insert-n-tilde #[nil "Àc‡" [241] 1 nil "*"] insert-o-grave #[nil "Àc‡" [242] 1 nil "*"] insert-o-acute #[nil "Àc‡" [243] 1 nil "*"] insert-o-circumflex #[nil "Àc‡" [244] 1 nil "*"] insert-o-tilde #[nil "Àc‡" [245] 1 nil "*"] insert-o-umlaut #[nil "Àc‡" [246] 1 nil "*"] insert-division-sign #[nil "Àc‡" [247] 1 nil "*"] insert-o-slash #[nil "Àc‡" [248] 1 nil "*"] insert-u-grave #[nil "Àc‡" [249] 1 nil "*"] insert-u-acute #[nil "Àc‡" [250] 1 nil "*"] insert-u-circumflex #[nil "Àc‡" [251] 1 nil "*"] insert-u-umlaut #[nil "Àc‡" [252] 1 nil "*"] insert-y-acute #[nil "Àc‡" [253] 1 nil "*"] insert-thorn #[nil "Àc‡" [254] 1 nil "*"] insert-y-umlaut #[nil "Àc‡" [255] 1 nil "*"]] 3) (defvar 8859-1-map nil "\ Keymap for ISO 8859/1 character insertion.") (byte-code "„âÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ #ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆÂßà#ˆÂáÈ #ˆÂâã#ˆÂäå#ˆÂæç#ˆÂèé#ˆÂêë#ˆÂìí#ˆÂîï#ˆÂðñ#ˆÂòó#ˆÂôõ#ˆÂö÷#ˆÂøù#ˆÂúû#ˆÂüý#ˆÂþÿ#ˆÂ@È #ˆÂAB#ˆÂCD#ˆÂEF#ˆÂGH#ˆÂIJ#ˆÂKÈ #ˆÂLM#ˆÂNO#ˆÂPQ#ˆÂRÈ #ˆÂSÈ #ˆÂTU#ˆÂVW#ˆÂXÈ #ˆÂYÈ #ˆÂZ[#ˆÂ\\]#ˆÂ^_#ˆÂ`a#ˆÂbc#ˆÂdÈ #ˆÂef#ˆÂgh#ˆÂij#ˆÂkl#ˆÂmn#ˆÂop#ˆÂqr#ˆÂst#ˆÂuv#ˆÂwx#ˆÂyÈ #ˆÂz{#ˆÂ|}#ˆÂ~#ˆÂ€#ˆÂ‚ƒ#ˆÂ„…#ˆÂ†‡#ˆÂˆ‰#ˆÂŠ‹#ˆÂŒ#ˆÂŽ#ˆÂ‘#ˆÂ’“#ˆÂ”È #ˆÂ•–#ˆÂ—˜#ˆÂ™È #ˆÂš›#ˆÂœ#ˆÂžŸ#ˆÂ ¡#ˆÂ¢£#ˆÂ¤¥#ˆÂ¦§#ˆÂ¨©#ˆÂª«#ˆÂ¬­#ˆÂ®È #ˆÂ¯°#ˆÂ±²#ˆÂ³´#ˆÂµ¶#ˆÂ·¸#ˆÂ¹º#ˆÂ»¼#ˆÂ½¾#ˆÂ¿À#ˆÂÁÂ#ˆÂÃÈ #ˆÂÄÅ#ˆÂÆÇ#ˆÂÈÉ#ˆÂÊË#ˆÂÌÍ#ˆÂÎÏ#ˆÂÐÑ#ˆÒÓÔ\"„âÂÓÔ#ˆÕÖ!‡" [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" "AA" insert-A-ring "AE" 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" "aa" insert-a-ring "ae" 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.22/lisp/iso-swed.elc100666 13437 1 4545 5416170250 14441 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:25:27 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-swed.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file 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.22/lisp/iso-syntax.elc100666 13437 1 2776 5416170256 15037 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:25:34 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/iso-syntax.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂ @°ÄÅÆ #ˆÄÇÈ #ˆÄÉÊ #ˆÄËÊ #ˆÄÌÊ #ˆÄÍÊ #ˆÄÎÏ #ˆÄÐÊ #ˆÄÑÊ #ˆÄÒÏ #ˆÄÓÊ #ˆÔÕÖ #ˆÄ×Ï #ˆÄØÏ #ˆÄÙÏ #ˆÄÚÊ #ˆÄÛÏ #ˆÄÜÏ #ˆÄÝÊ #ˆÄÞÊ #ˆÄßÊ #ˆÄàÏ #ˆÄáÊ #ˆÄâÏ #ˆÄãÊ #ˆÄäÊ #ˆÄåÊ #ˆÄæÏ #ˆÄçÏ #ˆÄèÏ #ˆÄéÈ #ˆêëì #ˆêíî #ˆêïð #ˆêñò #ˆêóô #ˆêõö #ˆê÷ø #ˆêùú #ˆêûü #ˆêýþ #ˆêÿ@ #ˆêAB #ˆêCD #ˆêEF #ˆêGH #ˆêIJ #ˆêKL #ˆêMN #ˆêOP #ˆêQR #ˆêST #ˆêUV #ˆêWX #ˆÄYÏ #ˆêZ[ #ˆê\\] #ˆê^_ #ˆê`a #ˆêbc #ˆêde #ˆêfg #ˆÄhÊ #ˆÄiÏ #ˆÄjÊ #ˆk l‰‰F!ˆ)mn!‡" [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 set-standard-case-table nil provide iso-syntax] 5) emacs-19.22/lisp/ispell.elc100666 13437 1 37346 5470157106 14231 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Nov 10 07:27:49 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/ispell.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (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 use this to specify the name of your private dictionary. 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.") (defvar ispell-bad-words nil "\ A list of markers reflecting the output of the Ispell `:file' command.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÅÆÇ\"‡" [boundp ispell-recently-accepted nil ispell-window-configuration ispell-dump-needed defalias ispell-flush-bad-words #[nil "ƒÁ@!ƒ@‰“ˆA‰„‰‡" [ispell-bad-words markerp nil ispell-recently-accepted] 4]] 3) (defalias 'kill-ispell #[nil "ƒÁ!ˆÂà ‡" [ispell-process delete-process nil ispell-flush-bad-words] 2 "\ Kill the Ispell process. Any changes in your private dictionary that have not already been dumped will be lost." nil]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÆÇÈ\"ˆÆÉÊ\"ˆÆËÌ\"ˆÆÍÎ\"ˆÆÏÐ\"ˆÆÑÒ\"ˆÆÓÔ\"ˆÆÕÖ\"ˆ×Ø!„?ÙÚ!ÆØ\"ˆÛÜÝ#ˆÛÞß#ˆÛàá#ˆÛâã#ˆÛäå#ˆÛæç#ˆÛèé#ˆÛêë#‡" [put ispell-startup-error error-conditions (ispell-startup-error error) error-message "Problem starting ispell - see buffer *ispell*" defalias start-ispell #[nil "ÀÁ!ˆÂÃ!‰ƒÅ !ˆ)ÆÇȈÉ\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 "ÀÁÂà Å<ƒ‚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] ispell-sync #[(intr) "ƒ Á!Â=„à ˆ ƒÅ!ˆÆÈ!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] 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] ispell-dump #[nil "… ÁÂÃ!‡" [ispell-dump-needed nil ispell-cmd ":dump"] 2] ispell-insert #[(word) "ÀÁ\n\"ˆ ƒ \n Bʼn‡" [ispell-cmd ":insert " word ispell-bad-words ispell-recently-accepted t ispell-dump-needed] 3] ispell-accept #[(word) "ÀÁ\n\"ˆ …\n B‰‡" [ispell-cmd ":accept " word ispell-bad-words ispell-recently-accepted] 3] ispell-next-message #[nil "ŠÀ !qˆÂp!ˆŒ bˆ`ÄÅ!ˆ`}ˆ`ebˆÆp!*‡" [process-buffer ispell-process bury-buffer ispell-next-message forward-sexp 1 read] 3] ispell-tex-buffer-p #[nil "Á>‡" [major-mode (plain-TeX-mode LaTeX-mode)] 2] boundp ispell-menu-map make-sparse-keymap "Spell" 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-region] ("Check Region" . ispell-region) [ispell-buffer] ("Check Buffer" . ispell) [ispell-word] ("Check Word" . ispell-word)] 4) (defalias 'ispell #[(&optional buf start end) "„Á\n„ Á „pÄ !‰„ÅÆ!ˆÇÉÊ!ˆŠ qˆ Ç  ÎŽ ƒ>Ï !ƒPÐÑ! Ò Óed #ˆ‚cÔ !ƒcÕÖ× \"!ƒcØ ˆÙÚ!ˆƒxÜ ƒxÝÞ!ˆ‚|Ýß!ˆÝÖà \n$!ˆ+Ùá!ˆâ ˆÇ‰#$å ‰$§ƒº\nÁU„ª$\nWƒ”æ $ç\\Ç“#B#‚”$#B‰#Ÿ(+é(@!„×Ç(Ùê!ˆÒ‡Ùë!ˆì ‡" [start 0 end buf get-buffer error "Can't find buffer" 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 "\ 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 (kept in `$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]." nil]) (defalias (quote ispell-buffer) (quote ispell)) (defalias 'ispell-next #[nil "ÀÂŽÃÄ)Å ˆ‡" [nil ispell-window-configuration ((byte-code "ƒÁ!ˆ\n„ÃÄ!ˆ‚IÅ\n@!ƒ#ÆÇÈ!!ˆ‚I\n@É=ƒ3ÉÆÊ!ˆ‚I\n@Ë=ƒCÉÆÌ!ˆ‚IÉÆÍ!ˆÉ‡" [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 "\ Resume command loop for most recent Ispell command. Return value is t unless exit is due to typing `q'." nil]) (defalias 'ispell-word #[(&optional resume) "ƒÁ ‡ÂÃć" [resume ispell-next err (byte-code "ÀÁ‡" [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 "\ 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." "P"]) (define-key esc-map "$" (quote ispell-word)) (defalias 'ispell-region #[(start &optional end) "Àp \n#‡" [ispell start end] 4 "\ Check the spelling for all of the words in the region." "r"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"‡" [defalias ispell-letterp #[(c) "…ÁYƒÂX†ÃYƒÄX†ÅY‡" [c 65 90 97 122 128] 2] ispell-letter-or-quotep #[(c) "…%ÁYƒÂX†%ÃYƒÄX†%ÅU†%ÆY‡" [c 65 90 97 122 39 128] 2] ispell-find-word-start #[nil "À`f!„o„À`ÁZf!„ ˆ‚Ã`ÁZf!ƒ) ˆ‚ÄÅw‡" [ispell-letterp 1 backward-char ispell-letter-or-quotep "'" nil] 3] ispell-find-word-end #[nil "À`f!ƒ Áuˆ‚ÂÁx‡" [ispell-letter-or-quotep nil "'"] 2] ispell-next-word #[nil "m?…À`f!?…Áuˆ‚‡" [ispell-letterp nil] 2] ispell-point #[(start message) "À Á‰ bˆÆ ˆÇ È ˆÇ  \nWƒ‹ \nWƒ‹ bˆÈ ˆ `Á“ˆÁ { Ê !ƒyËÌÍ \"!ˆÎ !ˆÏ ‰ Ð=ƒ[ËÑ \"ˆ‚x ƒf :ƒrÒ  $‚xÓÔ \"ˆ) „ bˆÕ ˆ `Á“ˆ‚Ö×!‰ƒ›qˆÙ ˆ) Á‰“ˆ\nÁ‰“ˆ Á‰“+‡" [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] ispell-still-bad #[(word) "Á‰‰ƒ Å @\"Ç=ƒÈÈ A‰„\n +‡" [ispell-recently-accepted t case-fold-search ret words string-match word 0 nil] 4] 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] ispell-command-loop #[(word start end message) "ÀÁ‰ „ÆÈQ‚ÉÈQ ƒõÊ \n#ˆÅË!ˆÌ ˆÍ —Á‰ÐYƒZÑXƒZÐZ 8‰ƒZÒ#ˆÁ‚ñÕUƒiÖ×Á\"ˆ‚ñØÙ 8UƒyÚ ˆ‚ñÛUƒ…Á‚ñÜUƒÒÝÞ!#ˆÀÁ‚ñßUƒ®à!ˆÁ‚ñáUƒ¿â!ˆÁ‚ñãUƒ×ä!‰%@%A)‚ñæUƒéÅç!ˆèé!ˆ‚ñÅê!ˆèé!ˆ*‚ +‡" [t nil first-line rescan flag message "No near misses for '" word "'" "Near misses for '" ispell-show-choices "Ispell command: " undo-boundary read-char replacement c 48 57 ispell-replace start end 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] ispell-do-look #[(bad-word) "À‰‰ „ÅÆ!‚ÅÇÈ\"ÉÊ!Š\nqˆed|ˆ ƒ4Ë À\nÀÍ &ˆ‚=Ë À\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] ispell-replace #[(start end new) "bˆ cˆ`\n|‡" [start new end] 2]] 3) (defalias 'reload-ispell #[nil "ÀÁ!‡" [ispell-cmd ":reload"] 2 "\ Tell Ispell to re-read your private dictionary." nil]) (defalias (quote batch-make-ispell) #[nil "ÀÁ!ˆÂÃ!ˆ ÅÇ ˆ*È ˆÉÊ!ƒËÌ!ˆÍ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]) (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.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÅÄ!ˆÆÄÇÈ#ˆÀÉ!„+ ÅÉ!ˆÆÉÇÈ#‡" [boundp ispell-lookup-completions-alist nil ispell-lookup-last-word ispell-lookup-last-interior-p make-variable-buffer-local put permanent-local t ispell-lookup-last-bow] 4) (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...still. Please move on." "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 "\ 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'." "P"]) (defalias 'ispell-complete-word-interior-frag #[nil "ÀÁ!‡" [ispell-complete-word t] 2 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias ispell-lookup-build-list #[(string regexp) "ŠÀÁ!ˆÂÃ!qˆÄ ˆ ;ƒ7ƒ'ÇÉÊÉË &ˆ‚WÇÉÊÉÍ &ˆ‚WƒKÇÉÊÉË &ˆ‚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] ispell-non-empty-string #[(string) "ƒ\nÁ˜ƒ ‡Ã!‡" [string "" "\\'\\`" regexp-quote] 2]] 3) (defvar ispell-message-cite-regexp "^ \\|^ " "\ *Regular expression to match lines cited from one message into another.") (defalias 'ispell-message #[nil "ŠÀ ÀebˆÄ ÀÆ#ƒÇyˆ‚*ÈÉ!ƒ(m„(Çyˆ‚ÆÊË!ƒ>ÌÍ ÎÏÐ!°‚¦ÊÒ!ƒRÌ ÎÏÐ!°‚¦ ƒ`ÓÏÔÏÕ°‚¦ךƒ{ØσuÐ!‚wQ‚¦ÛÜ!ƒ‹ÝÏÐ!Q‚¦ÛÞ!ƒ˜Ð!‚¦ƒ¤Ð!‚¦Æ m?…î…îÈá P!ƒÈm„ÈÇyˆ‚µm„«`\"ãä ÎQÀå#ƒÞæyˆ\nŠç\"Ç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 continue cite-regexp "^[ ]*$\\|" start re-search-forward "^\\(" end 0 ispell-region] 6 "\ Check the spelling of a mail message or news post. Don't check spelling of message headers 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)))))" nil]) (provide (quote ispell)) emacs-19.22/lisp/kermit.elc100666 13437 1 4764 5416170330 14204 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:26:15 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/kermit.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote shell)) (defvar kermit-esc-char "" "\ *Kermit's escape char") (defalias 'kermit-esc #[nil "ÀÁp!\nÃÄ !P\"‡" [process-send-string get-buffer-process kermit-esc-char char-to-string read-char] 5 "\ For sending escape sequences to a kermit running in shell mode." nil]) (defalias 'kermit-send-char #[nil "ÀÁp!Âà !\"‡" [process-send-string get-buffer-process char-to-string read-char] 4 "\ Send an arbitrary character to a program in shell mode." nil]) (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÃ#‡" [define-key shell-mode-map "" kermit-esc "" kermit-send-char "\\"] 4) (defalias 'kermit-send-input-cr #[nil "À ˆÁÂp!Ã\"‡" [comint-send-input comint-send-string get-buffer-process " "] 3 "\ Like \\[comint-send-input] but end the line with carriage-return." nil]) (define-key shell-mode-map "\n" (quote kermit-send-input-cr)) (defalias 'kermit-default-cr #[nil "À ÂÃ#ˆÀ ÄÅ#‡" [define-key shell-mode-map " " kermit-send-input-cr "\n" comint-send-input] 4 "\ 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." nil]) (defalias 'kermit-default-nl #[nil "À ÂÃ#ˆÀ ÄÅ#‡" [define-key shell-mode-map "\n" kermit-send-input-cr " " comint-send-input] 4 "\ 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." nil]) (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 "\ Strip ^M and ^@ characters from process output."]) (defalias 'kermit-clean-on #[nil "ÀÁp!Â\"‡" [set-process-filter get-buffer-process kermit-clean-filter] 3 "\ 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''." nil]) (defalias 'kermit-clean-off #[nil "ÀÁp!Â\"‡" [set-process-filter get-buffer-process nil] 3 "\ Cancel a previous kermit-clean-shell-on command." nil]) emacs-19.22/lisp/ledit.elc100666 13437 1 7451 5416170335 14013 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:26:20 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/ledit.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„‡" [boundp ledit-mode-map nil] 2) (defconst ledit-zap-file (byte-code "ÀÁ ÂQ‡" ["/tmp/" user-login-name ".l1"] 3) "\ File name for data sent to Lisp by Ledit.") (defconst ledit-read-file (byte-code "ÀÁ ÂQ‡" ["/tmp/" user-login-name ".l2"] 3) "\ File name for data sent to Ledit by Lisp.") (defconst ledit-compile-file (byte-code "ÀÁ ÂQ‡" ["/tmp/" user-login-name ".l4"] 3) "\ 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.") (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.") (defalias 'ledit-save-defun #[nil "ŠÀ ˆ` ˆÃ ` #ˆ)ÅÆ!)‡" [end-of-defun end beginning-of-defun append-to-buffer ledit-buffer message "Current defun saved for Lisp"] 4 "\ Save the current defun in the ledit buffer" nil]) (defalias 'ledit-save-region #[(beg end) "À \n #ˆÄÅ!‡" [append-to-buffer ledit-buffer beg end message "Region saved for Lisp"] 4 "\ Save the current region in the ledit buffer" "r"]) (defalias 'ledit-zap-defun-to-lisp #[nil "À ˆÁ ‡" [ledit-save-defun ledit-go-to-lisp] 1 "\ Carry the current defun to Lisp." nil]) (defalias 'ledit-zap-defun-to-liszt #[nil "À ˆÁ ‡" [ledit-save-defun ledit-go-to-liszt] 1 "\ Carry the current defun to liszt." nil]) (defalias 'ledit-zap-region-to-lisp #[(beg end) "À \n\"ˆÃ ‡" [ledit-save-region beg end ledit-go-to-lisp] 3 "\ Carry the current region to Lisp." "r"]) (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 "\ Suspend Emacs and restart a waiting Lisp job." nil]) (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 "\ Suspend Emacs and restart a waiting Liszt job." nil]) (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 "\ Set up key bindings for the Lisp/Emacs interface."]) (ledit-setup) (defalias 'ledit-mode #[nil "À ˆÁ ‡" [lisp-mode ledit-from-lisp-mode] 1 "\ \\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)" nil]) (defalias (quote 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.22/lisp/levents.elc100666 12120 1 16462 5416170356 14263 0ustar rmsdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:26:37 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/levents.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÉÊ#ˆÇËÊ#ˆÇÌÊ#ˆÀÊÍ\"ˆÎÏÐÑ#ˆÎÒÐÓ#ˆÎÔÐÕ#‡" [defalias next-command-event #[(event) "ÀÁ!‡" [error "You must rewrite to use `read-command-event' instead of `next-command-event'"] 2] next-event #[(event) "ÀÁ!‡" [error "You must rewrite to use `read-event' instead of `next-event'"] 2] dispatch-event #[(event) "ÀÁ!‡" [error "`dispatch-event' not supported"] 2] define-key global-map [menu] execute-eval-event [timeout] [eval] #[(event) "A@Á8!‡" [event 2] 3 nil "e"] put eval event-symbol-elements (eval) menu (eval) timeout (eval)] 4) (defalias 'eventp #[(obj) "¨†9ƒÁN†:…@9…@ÁN‡" [obj event-symbol-elements] 2 "\ True if the argument is an event object."]) (put (quote eventp) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defun allocate-event nil "\ Returns an empty event structure. In this emulation, it returns nil." nil) (defalias 'button-press-event-p #[(obj) ":…@9…Á@ÂN>‡" [obj down event-symbol-elements] 3 "\ True if the argument is a mouse-button-press event object."]) (defalias 'button-release-event-p #[(obj) ":…@9…Á@ÂN>†Ã@ÂN>‡" [obj click event-symbol-elements drag] 3 "\ True if the argument is a mouse-button-release event object."]) (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) (defalias 'enqueue-eval-event: #[(function object) "Á\n EC¤‰‡" [unread-command-events eval function object] 4 "\ Add an eval event to the back of the queue. It will be the next event read after all pending events."]) (defalias 'eval-event-p #[(obj) "¢Á=‡" [obj eval] 2 "\ True if the argument is an eval or menu event object."]) (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 "\ Return the button-number of the given mouse-button-press event."]) (defalias 'event-function #[(event) "A@‡" [event] 1 "\ Return the callback function of the given timeout, menu, or eval event."]) (defalias 'event-key #[(event) "9ƒ\nÁN@‡ÂÃÄÅ\"S\"‰ÇWƒ\"ÈÉ\"‚$—)‡" [event event-symbol-elements logand lsh 1 18 base 32 logior 64] 6 "\ Returns the KeySym of the given key-press event. The value is an ASCII printing character (not upper case) or a symbol."]) (defalias 'event-object #[(event) "À 8‡" [2 event] 2 "\ Returns the function argument of the given timeout, menu, or eval event."]) (defalias 'event-point #[(event) "Á8:ƒ Á‚Â8)‰A@)‡" [event 2 1 position] 3 "\ 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-process #[(event) "A@‡" [event] 1 "\ Returns the process of the given process-output event."]) (defalias 'event-timestamp #[(event) "<…Á8:ƒÁ‚Â8)Ä 8)‡" [event 2 1 position 3] 2 "\ 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-to-character #[(event &optional lenient) "9ƒ …žA‡¨…‡" [event lenient ((backspace . 8) (delete . 127) (tab . 9) (return . 10) (enter . 10))] 2 "\ 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-window #[(event) "Á8:ƒ Á‚Â8)‰@)‡" [event 2 1 position] 3 "\ Returns the window of the given mouse-related event object."]) (defalias 'event-x #[(event) "Á8:ƒ Á‚Â8)Á 8)@ÄÅÆ!!!¥‡" [event 2 1 position frame-char-width window-frame event-window] 5 "\ Returns the X position in characters of the given mouse-related event."]) (defalias 'event-x-pixel #[(event) "Á8:ƒ Á‚Â8)Á 8)@‡" [event 2 1 position] 2 "\ Returns the X position in pixels of the given mouse-related event."]) (defalias 'event-y #[(event) "Á8:ƒ Á‚Â8)Á 8)AÄÅÆ!!!¥‡" [event 2 1 position frame-char-height window-frame event-window] 5 "\ Returns the Y position in characters of the given mouse-related event."]) (defalias 'event-y-pixel #[(event) "Á8:ƒ Á‚Â8)Á 8)A‡" [event 2 1 position] 2 "\ Returns the Y position in pixels of the given mouse-related event."]) (defalias 'key-press-event-p #[(obj) "¨† 9… ÁN‡" [obj event-symbol-elements] 2 "\ True if the argument is a keyboard event object."]) (defalias 'menu-event-p #[(obj) "¢Á=‡" [obj menu] 2 "\ True if the argument is a menu event object."]) (defalias 'motion-event-p #[(obj) "¢Á=‡" [obj mouse-movement] 2 "\ True if the argument is a mouse-motion 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 "\ 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 'process-event-p #[(obj) "¢Á=‡" [obj process] 2 "\ True if the argument is a process-output event object. GNU Emacs 19 does not currently generate process-output events."]) (defalias 'timeout-event-p #[(obj) "¢Á=‡" [obj timeout] 2 "\ True if the argument is a timeout event object. GNU Emacs 19 does not currently generate timeout events."]) emacs-19.22/lisp/life.elc100666 13437 1 12411 5427115433 13641 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 2 00:42:02 1993 ;;; from file /home/fsf/rms/e19/lisp/life.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (defconst life-patterns [("@@@" " @@" "@@@") ("@@@ @@@" "@@ @@ " "@@@ @@@") ("@@@ @@@" "@@ @@" "@@@ @@@") ("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@") ("@@@@@@@@@@") (" @@@@@@@@@@ " " @@@@@@@@@@ " " @@@@@@@@@@ " "@@@@@@@@@@ " "@@@@@@@@@@ ") ("@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@") ("@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @" "@ @") ("@@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@ " " @@") ("@@@@@@@@@" "@ @ @" "@ @@@@@ @" "@ @ @ @" "@@@ @@@" "@ @ @ @" "@ @@@@@ @" "@ @ @" "@@@@@@@@@")] "\ Vector of rectangles containing some Life startup patterns.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÛÛÛÛÀàá\"‡" [defalias life-life-char (macro lambda nil 64) life-death-char (macro lambda nil 65) life-birth-char (macro lambda nil 3) life-void-char (macro lambda nil 32) life-life-string (macro . #[nil "ÀÁ!‡" [char-to-string 64] 2]) life-death-string (macro . #[nil "ÀÁ!‡" [char-to-string 65] 2]) life-birth-string (macro . #[nil "ÀÁ!‡" [char-to-string 3] 2]) life-void-string (macro . #[nil "ÀÁ!‡" [char-to-string 32] 2]) life-not-void-regexp (macro . #[nil "ÀÁÂQ‡" ["[^" " " "\n]"] 3]) goto-beginning-of-buffer (macro . #[nil "À‡" [(goto-char 1)] 1]) maxint (macro . #[nil "À‰ÁÂ\"Á\"‡" [lsh -1 1] 4]) goto-end-of-buffer (macro . #[nil "À‡" [(goto-char (maxint))] 1]) increment (macro . #[(variable) "À  DE‡" [setq variable 1+] 4]) nil life-neighbor-deltas life-window-start life-current-generation life-generation-string abs #[(n) "ÁWƒ [‡‡" [n 0] 2]] 3) (defalias 'life #[(&optional sleeptime) "„Á ˆÃ!ˆÄŇ" [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 "\ 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)." "p"]) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#ˆÆÇ!ˆÀÈÉ\"ˆÀÊË\"ˆÀÌÍ\"ˆÀÎÏ\"ˆÀÐÑ\"ˆÀÒÓ\"ˆÀÔÕ\"ˆÀÖ×\"ˆÃØÙÚ#ˆÃØÛÜ#ˆÝÂ!‡" [defalias life-mode life put mode-class special random t life-setup #[nil "ÀÂÃÄ!Å\"ˆÆ ˆÇ ˆÀÉ\nË Å ÎÐÒÔ SÖØp!ˆÙ ˆÖbˆÚÛÀÅ#ƒGÜÝʼn#ˆ‚6ÖbˆŠÀˆ`)ZÞ¥m„c jˆÀyˆ‚Vß Sàed\"ZÞ¥Öbˆá !ˆâbˆá !ˆÖbˆ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 8388607 move-to-column untabify life-expand-plane-if-needed life-compute-neighbor-deltas] 4] life-compute-neighbor-deltas #[nil "À [ T[ Â\\[à ‰T Â\\¯‰‡" [-1 fill-column 2 1 life-neighbor-deltas] 9] life-insert-random-pattern #[nil "À  G!œ!ˆÃc‡" [insert-rectangle life-patterns random 10] 4] life-increment-generation #[nil "TÁ!‰‡" [life-current-generation int-to-string life-generation-string] 2] life-grim-reaper #[nil "ÀÁ!ˆÂbˆÁ‰‰‰‰ÈÉÁÊ#ƒ’ Ì`S ƒ€ @\\‰f‰Í=ƒDΉTÍÂÊ%ˆ‚yÏWƒZΉT‰TÊ%ˆ‚yÐWƒoΉTÐÊ%ˆ‚yÑYƒy T A‰„' Ò>„Î ‰TÑÓÊ%ˆ‚-Ì”„›Ô ˆÎÂdÐÍÊ%ˆÎÂdÂÍÊ%ˆÎÂdÕÍÊ%ˆÎÂdÏÑÊ%ˆÎÂdÓÍÊ%‡" [store-match-data nil 1 list living-neighbors pivot char point search-forward "@" t life-neighbor-deltas 0 32 subst-char-in-region 3 9 64 (2 3) 65 life-extinct-quit 2] 7] life-expand-plane-if-needed #[nil "ÀÁˆÂbˆÃÄ` ‰Æ\\\\\\Ç#ƒ0ÂbˆÈÉ \"ˆÊcˆÈÉ \"ˆÊcˆ Â\\\\ ÌbˆÍÄ` Z ZÆZÇ#…]ÌbˆÈÉ \"ˆÊcˆÈÉ \"ˆÊcˆ Â\\\\‰ ‡" [done (byte-code "Àbˆm„BgÁ=„ˆhÁ=ƒ<Àbˆm„,ÃcˆÂˆÃcˆÂuˆ‚ Å\\ÆÀ!ˆÇ ˆÈÉÊ\"ˆÂyˆ‚‡" [1 64 nil 32 fill-column 2 scroll-left life-compute-neighbor-deltas throw done t] 3) 1 search-forward "@" fill-column 2 t insert-char 32 10 life-window-start 8388607 search-backward] 6] life-display-generation #[(sleeptime) "bˆÁÂ!ˆÃ !Å=†ÆÇÈ\"‡" [life-window-start recenter 0 sit-for sleeptime t throw life-exit nil] 3] life-extinct-quit #[nil "ÀÁ!ˆÂÃÄ\"‡" [life-display-generation 0 signal life-extinct nil] 3] life-extinct error-conditions (life-extinct quit) error-message "All life has perished" provide] 4) emacs-19.22/lisp/lisp-mnt.elc100666 13437 1 11515 5426662637 14505 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 1 02:41:34 1993 ;;; from file /home/fsf/rms/e19/lisp/lisp-mnt.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!ˆÃÄÅ\"ˆÃÆÇ\"ˆÃÈÉ\"ˆÃÊË\"ˆÃÌÍ\"ˆÃÎÏ\"ˆÃÐÑ\"ˆÃÒÓ\"ˆÃÔÕ\"ˆÃÖ×\"ˆÃØÙ\"ˆÃÚÛ\"ˆÃÜÝ\"ˆÃÞß\"ˆÃàá\"ˆâ#À‡" [require picture emacsbug defalias lm-section-mark #[(hd &optional after) "ŠÀebˆÂà ÅQÆÀ#…ÇyˆƒÉyˆ`*‡" [t case-fold-search re-search-forward "^;;; " hd ":$" nil 0 after 1] 4] lm-code-mark #[nil "ÀÁ!‡" [lm-section-mark "Code"] 2] lm-header #[(hd) "ebˆÀÂà ÅQÆ À#…ǔǕ{)‡" [t case-fold-search re-search-forward "^;; " hd ": \\(.*\\)" lm-code-mark 1] 4] lm-header-multiline #[(hd) "ŠebˆŠÀ !)‰ƒ(Ãyˆ\nCÄÅ!ƒ(ÔÕ{\nBÃyˆ‚\n*‡" [lm-header hd res 1 looking-at "^;; \\(.*\\)"] 3] lm-summary #[(&optional file) "Šƒ Á!ˆebˆÂÃ!…Ĕĕ{ƒÅp!ˆ)‡" [file find-file looking-at "^;;; [^ ]+ --- \\(.*\\)" 1 kill-buffer] 3] 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] lm-authors #[(&optional file) "Šƒ Á!ˆÂÃ!ÅÆ \"ƒÇp!ˆ*‡" [file find-file lm-header-multiline "author" authorlist mapcar lm-crack-address kill-buffer] 3] lm-maintainer #[(&optional file) "Šƒ Á!ˆÂÃ!‰ƒÅ !‚Æ @)ƒ#Çp!ˆ)‡" [file find-file lm-header "maintainer" maint lm-crack-address lm-authors kill-buffer] 4] lm-creation-date #[(&optional file) "Šƒ Á!ˆÂÃ!ƒÄp!ˆ)‡" [file find-file lm-header "created" kill-buffer] 3] 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] 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] lm-keywords #[(&optional file) "Šƒ Á!ˆÂÃ!‰… —)ƒÅp!ˆ)‡" [file find-file lm-header "keywords" keywords kill-buffer] 4] lm-adapted-by #[(&optional file) "Šƒ Á!ˆÂÃ!ƒÄp!ˆ)‡" [file find-file lm-header "adapted-by" kill-buffer] 3] lm-commentary #[(&optional file) "Šƒ Á!ˆÂÃÄ\"ÂÅ!ÂÆ!‰ …/ƒ* {‚/ {+ƒ8Êp!ˆ)‡" [file find-file lm-section-mark "Commentary" t "Change Log" "Code" code change-log commentary kill-buffer] 5] insert-at-column #[(col &rest pieces) "iVƒ ÁcˆÂ!ˆÃÄ \"‡" [col "\n" move-to-column-force apply insert pieces] 3] 16 lm-comment-column] 3) (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űˆÆ È#‚, …,\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 "\ 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-synopsis #[(&optional file showall) "ƒÁ!ƒÂÃÄ!!ˆÅ ˆÆÇÈ!\"‡Šƒ#É!ˆÊ ƒ-Ëp!ˆ)‡" [file file-directory-p switch-to-buffer get-buffer-create "*lm-verify*" erase-buffer mapcar #[(f) "ÀÁ\n\"…-Ã\n!‰ƒ\nűˆÆ È#‚, …,\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 "\ 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-report-bug #[(topic) "À Á  ÆÇ † #ˆ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."] 4 "\ Report a bug in the package currently being visited to its maintainer. Prompts for bug subject. Leaves you in a mail buffer." "sBug Subject: "]) (provide (quote lisp-mnt)) emacs-19.22/lisp/lisp-mode.elc100666 13437 1 26622 5474032502 14621 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 21 22:42:57 1993 ;;; from file /home/fsf/rms/e19/lisp/lisp-mode.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar lisp-mode-syntax-table nil "\ ") (defvar emacs-lisp-mode-syntax-table nil "\ ") (defvar lisp-mode-abbrev-table nil "\ ") (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 "> " 12 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 defalias lisp-mode-variables #[(lisp-syntax) "ƒÁ\n!ˆ ÅÆ!ˆÇPÅÉ!ˆ ÅÊ!ˆË\nÅÌ!ˆÍ ÅÎ!ˆÏÅÐ!ˆËÅÑ!ˆÒÅÓ!ˆÔÅÕ!ˆÖÅ×!ˆØ‰‡" [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 indent-line-function lisp-indent-line indent-region-function lisp-indent-region parse-sexp-ignore-comments comment-start ";" comment-start-skip ";+ *" comment-column 40 comment-indent-function lisp-comment-indent] 2]] 5) (defvar shared-lisp-mode-map nil "\ Keymap for commands shared by all sorts of Lisp modes.") (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÁ‡" [shared-lisp-mode-map make-sparse-keymap define-key "" indent-sexp "ñ" lisp-fill-paragraph "" backward-delete-char-untabify " " lisp-indent-line] 4) (defvar emacs-lisp-mode-map nil "\ Keymap for Emacs Lisp mode. All commands in shared-lisp-mode-map are inherited by this map.") (byte-code "„Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÁ‡" [emacs-lisp-mode-map make-sparse-keymap shared-lisp-mode-map define-key " " lisp-complete-symbol "" eval-defun] 4) (defalias 'emacs-lisp-mode #[nil "À ˆÁ\n!ˆÃ !ˆÅÇÉÊ!ˆËÌ!‡" [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 "\ 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." nil]) (defvar lisp-mode-map nil "\ Keymap for ordinary Lisp mode. All commands in `shared-lisp-mode-map' are inherited by this map.") (byte-code "„Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÁ‡" [lisp-mode-map make-sparse-keymap shared-lisp-mode-map define-key "" lisp-eval-defun "" run-lisp] 4) (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 "\ 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." nil]) (defalias 'lisp-eval-defun #[nil "ÀÁ!‡" [error "Process lisp does not exist"] 2 "\ Send the current defun to the Lisp process made by \\[run-lisp]." nil]) (defvar lisp-interaction-mode-map nil "\ Keymap for Lisp Interaction moe. All commands in `shared-lisp-mode-map' are inherited by this map.") (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) (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 "\ 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." nil]) (defalias 'eval-print-last-sexp #[nil "pÁ ˆÂÃ!ˆÁ )‡" [standard-output terpri eval-last-sexp t] 2 "\ Evaluate sexp before point; print value into current buffer." nil]) (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 "\ Evaluate sexp before point; print value in minibuffer. With argument, print output into current buffer." "P"]) (defalias 'eval-defun #[(eval-defun-arg-internal) "ƒp‚ ÁÃÄŠÅ ˆÆ ˆÇp!)!!)‡" [eval-defun-arg-internal t standard-output prin1 eval end-of-defun beginning-of-defun read] 4 "\ Evaluate defun that point is in or before. Print value in minibuffer. With argument, insert value in current buffer after the defun." "P"]) (defalias (quote lisp-comment-indent) #[nil "ÀÁ!ƒi‡ÀÂ!ƒà ‰<ƒ @‚ )‡ÅÆxˆnƒ*Ç‚,iT]‡" [looking-at "\\s<\\s<\\s<" "\\s<\\s<" calculate-lisp-indent tem " " nil 0 comment-column] 3]) (defconst lisp-indent-offset nil "\ ") (defconst lisp-indent-function (quote lisp-indent-function) "\ ") (defalias 'lisp-indent-line #[(&optional whole-exp) "À Á‰‰d`ZÇyˆ`ÈÁwˆÉÊ!ƒ$d\nZb‚ŽÉË!ƒ9ÉÌ!„9Í ˆÎuˆ‚W<ƒD@iZ‰ÇU„W `|ˆjˆd\nZ`Vƒdd\nZbˆ…Ž ÇU?…ŽŠ bˆÐÑ!ˆ` bˆÑyˆ` V)…ŽÒ #-‡" [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 "\ Indent current line as Lisp code. With argument, indent any additional lines of the same expression rigidly along with this one." "P"]) (defalias 'calculate-lisp-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰ÂÁ‰ \nƒ\"\nbˆ‚%Ë ˆ` Wƒ7Ì` À#‚% ƒ~ƒ~Àœ‰ÀVƒ~Á͜Μ‰Tbˆ ƒ7 `Vƒ7Ì  À#‰A@‰ƒz)‚7 „Ï Tbˆ „i‚ÏÌ` ÀÂ$ˆÐÑ!„ÏŠÎyˆ`) Vƒ¿` U„¹ÒÎ!ˆÌ` ÀÂ$ˆÓ ˆ‚Ï bˆÀyˆÌ` ÀÂ$ˆÓ ˆiÕœƒå bˆÖÁwˆi‚¨ƒù ƒù bˆi\\‚†ØÙ!ƒƒ „ \"†‚. ‡" [0 nil t containing-sexp 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 "\ 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 (quote lisp-indent-function) #[(indent-point state) "i ÂœTbˆÃ` ÅÆ$ˆ Çœƒ:ÈÉ!„:ŠÂyˆ`) V„3 bˆÅyˆÃ` ÅÆ$ˆÊ ˆi‚—`ËÂ!ˆ`{Ì Ï!ÐN†UÏ!ÑN‰ Ò=„r „zGÓVƒzÔÕ\"ƒzÖ \"‚– ¨ƒ‹Ø $‚– …– \"*)‡" [normal-indent state 1 parse-partial-sexp 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]) (defconst lisp-body-indent 2 "\ Number of columns to indent the second line of a `(def...)' form.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆÇÈ#ˆÅÉÇÈ#ˆÅÊÇË#ˆÅÌÇÍ#ˆÅÎÇÏ#ˆÅÐÇË#ˆÅÑÇË#ˆÅÒÇË#ˆÅÓÇË#ˆÅÔÇÍ#ˆÅÕÇÍ#ˆÅÖÇÍ#ˆÅ×ÇÏ#ˆÅØÇÍ#ˆÅÙÇÏ#ˆÅÚÇÍ#ˆÅÛÇÍ#‡" [defalias lisp-indent-specform #[(count state indent-point normal-indent) "Áœ\nɉbˆi \\ÁuˆÉÁ!ˆÊ` ÁÌ$ˆ` Wƒ3ÃÍ΄%\nÏVƒV\nZÁXƒN ‰\\\\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ÁÂ!ˆÃ` ÂÅ$‡" [count forward-sexp 1 parse-partial-sexp indent-point t] 5) ((error)) 0 normal-indent] 6] lisp-indent-defform #[(state indent-point) "A@bˆÁyˆ`AA@V…A@bˆ\ni\\‡" [state 1 lisp-body-indent] 2] put lambda lisp-indent-function defun autoload progn 0 prog1 1 prog2 2 save-excursion save-window-excursion save-restriction save-match-data let let* while if catch condition-case unwind-protect with-output-to-temp-buffer] 4) (defalias 'indent-sexp #[(&optional endpos) "ÀCÁ``À‰‰‰‰‰ \n ŠÌÍ!ˆ)ŠÀƒ0`W‚2 ?…]\nÀ „€m‰„€Ï`Àˆ`À‰ %‰@\nÐ ›@ƒgÑ ˆÀˆÐ ›À ˆÒ ›@ƒzÍyˆÓ ›À ˆ‚;Ô‰ƒ?ƒ¢\nÁXƒ¢Õ Ö\n[À\"\" \nZÁ\n „«\nÁX ƒµÍyˆ‚J\nVƒË A S‰‚·\nWƒâÀ B T‰‚ÍÍyˆ`×Àwˆm„JØÙ!„J @ƒ  @ÁYƒ  @‚<Ú @ƒ @[‚ !‰¨ƒ. ‰ ˆ‚; A@[ ˆ@)i\nU„J`|ˆ\njˆ „$`U‰„$`‚$. ‡" [nil 0 this-indent state inner-loop-done outer-loop-done bol last-depth last-point starting-point next-depth indent-stack forward-sexp 1 endpos parse-partial-sexp 4 indent-for-comment 3 5 t append make-list " " looking-at "\\s<\\|\n" calculate-lisp-indent val] 11 "\ Indent each line of the list starting just after point. If optional arg ENDPOS is given, indent each line, stopping when ENDPOS is encountered." nil]) (defalias (quote lisp-indent-region) #[(start end) "Šbˆnƒl„Á ˆÂ !Å !ˆ Ɖ“*‡" [start lisp-indent-line copy-marker end endmark indent-sexp nil] 3]) (defalias 'lisp-fill-paragraph #[(&optional justify) "À‰ŠÃyˆÄÅ!ƒÆÔÕ{‚QÄÇ!„>ÈÀwˆ`fÉ=ƒ0Êuˆ‚`fË>ƒÌÍ!ˆ‚ÄÎ!ƒQÆÏiÐ\"ÔÕ{P)\n„]Ñ!‚™ŒŠÓyÃUƒlÄÔ!„_ÄÔ!„uÍyˆ`)ŠÍyˆÄÔ!„x`)}ˆÖ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 "\ 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." "P"]) (defalias 'indent-code-rigidly #[(start end arg &optional nochange-regexp) "ÀŠ\nbˆÃ  bˆ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 "\ 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." "r\np"]) (provide (quote lisp-mode)) emacs-19.22/lisp/lisp.elc100666 13437 1 15132 5416170516 13675 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:28:14 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/lisp.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar defun-prompt-regexp nil "\ Non-nil => regexp to ignore, before the `(' that starts a defun.") (defvar parens-require-spaces t "\ Non-nil => `insert-parentheses' should insert whitespace as needed.") (defalias 'forward-sexp #[(&optional arg) "„ÁÂ`\"†Ã!bˆÄW…Å ‡" [arg 1 scan-sexps buffer-end 0 backward-prefix-chars] 3 "\ Move forward across one balanced expression (sexp). With argument, do it that many times. Negative arg -N means move backward across N balanced expressions." "p"]) (defalias 'backward-sexp #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-sexp] 2 "\ Move backward across one balanced expression (sexp). With argument, do it that many times. Negative arg -N means move forward across N balanced expressions." "p"]) (defalias 'mark-sexp #[(arg) "ÀŠÁ\n!ˆ`)ÃÄ#‡" [push-mark forward-sexp arg nil t] 4 "\ Set mark ARG sexps from point. The place mark goes is the same place \\[forward-sexp] would move to with the same argument." "p"]) (defalias 'forward-list #[(&optional arg) "„ÁÂ`Ã#†Ä!b‡" [arg 1 scan-lists 0 buffer-end] 4 "\ 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." "p"]) (defalias 'backward-list #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-list] 2 "\ 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." "p"]) (defalias 'down-list #[(arg) "ÁVƒ\n‚ ÃÁU?…(Å` Ã#†Æ!bˆ Z‰‚ )‡" [arg 0 1 -1 inc scan-lists buffer-end] 5 "\ 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." "p"]) (defalias 'backward-up-list #[(arg) "À [!‡" [up-list arg] 2 "\ 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." "p"]) (defalias 'up-list #[(arg) "ÁVƒ\n‚ ÃÁU?…(Å` Â#†Æ!bˆ Z‰‚ )‡" [arg 0 1 -1 inc scan-lists buffer-end] 5 "\ 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." "p"]) (defalias 'kill-sexp #[(arg) "`Á\n!ˆÃ`\")‡" [opoint forward-sexp arg kill-region] 3 "\ 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." "p"]) (defalias 'backward-kill-sexp #[(arg) "À [!‡" [kill-sexp arg] 2 "\ 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." "p"]) (defalias 'beginning-of-defun #[(&optional arg) "ƒ ÁWƒ ÂuˆÃ ƒÅÆ ÇR‚ÈÉʆ\"Â$…*ÁyˆË‡" [arg 0 1 re-search-backward defun-prompt-regexp "^\\s(\\|" "\\(" "\\)\\s(" "^\\s(" nil move t] 5 "\ 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." "p"]) (defalias (quote buffer-end) #[(arg) "ÁVƒd‡e‡" [arg 0] 2]) (defalias 'end-of-defun #[(&optional arg) "ƒ\nÁUƒ ÂÃÁVƒZ`dWƒZ`Å ƒ-ÂuˆÈÂ!„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 -1 forward-list " " looking-at "\\s<\\|\n" forward-sexp 2 "[;\n]"] 3 "\ 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'." "p"]) (defalias 'mark-defun #[nil "À`!ˆÁ ˆÀ`ÂÃ#ˆÄ ˆÅÆ`ÇZÃ#‡" [push-mark end-of-defun nil t beginning-of-defun re-search-backward "^\n" 1] 4 "\ Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point." nil]) (defalias 'insert-parentheses #[(arg) "ƒ Á!‚ ÂÂ=„ÃÄwˆ ƒ%hzÆ>ƒ%ÇcˆÈcˆŠÂ=„3É!ˆÊcˆ …CgzË>…CÇc)‡" [arg prefix-numeric-value 0 " " nil parens-require-spaces (119 95 41) " " 40 forward-sexp 41 (119 95 40)] 2 "\ Put parentheses around next ARG sexps. Leave point after open-paren. No argument is equivalent to zero: just insert `()' and leave point between. This command also sometimes inserts a space before and after, depending on the surrounding characters." "P"]) (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 "\ Move past next `)', delete indentation before it, then indent after it." nil]) (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 list nil new intern " " " *Completions*" display-completion-list "Making completion list...%s" "done"] 5 "\ 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." nil]) emacs-19.22/lisp/lmenu.elc100666 13437 1 23754 5416170545 14061 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:28:37 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/lmenu.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÀÂ\"ˆÃÄ!„Å Æž„Æ BBÁÈÉ\"ˆÃÊ!„-Ë\nÁÌÍ\"‡" [recompute-lucid-menubar defalias #[nil "À ÂÃÄÅ#ˆÃ‰‡" [define-key lucid-menubar-map [menu-bar] nil (make-lucid-menu-keymap "menu-bar" current-menubar) ((error (byte-code "ÀÁ!ˆÂÃ!ˆ Ɖ‡" [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] boundp lucid-menubar-map make-sparse-keymap current-menubar minor-mode-map-alist set-menubar-dirty-flag #[nil "À ˆÁ‰‡" [force-mode-line-update t lucid-menu-bar-dirty-flag] 2] add-menu-item-count 0 make-lucid-menu-keymap #[(menu-name menu-items) "À !à !‰ƒ« @Æ !… ÇHÉ\nÉ É ;ƒ1É\n  ‚ :ƒEÍ @ A\"\n @ ‚Æ !ƒÎÏÐ\"!\nÎÏÒ\"! TÓ\nÔ #ˆ ÕHLˆ ÖH 9ƒ…\nMˆ‚\n×ÉØFMˆ ƒ£Ù\nÚÛ !! \nB#ˆ- A‰„ \n)‡" [make-sparse-keymap menu-name menu reverse menu-items item vectorp 1 callback nil command enabler name make-lucid-menu-keymap make-symbol format "menu-function-%d" add-menu-item-count "menu-function-%d-enabler" put menu-enable 2 0 lambda (interactive) define-key vector intern] 6]] 3) (defalias 'popup-menu #[(menu-desc) "À @ A\" ÃÇ A@ AAD @D\"ÈÉ !\"‰\n…-Ë\n!+‡" [make-lucid-menu-keymap menu-desc mouse-position nil answer pos menu x-popup-menu lookup-key vector cmd call-interactively] 5 "\ 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 of three or four elements: - the name of the menu item (a string); - the `callback' of that item; - whether this item is active (selectable); - and an optional string to append to the name. 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'. The fourth element of a menu item is a convenient way of adding the name of a command's ``argument'' to the menu, like ``Kill Buffer NAME''. 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 := argument := menu-item := '[' name callback active-p [ argument ] ']' menu := '(' name [ menu-item | menu | text ]+ ')' "]) (byte-code "ÀÀ‡" [nil default-menubar] 1) (defalias 'set-menubar #[(menubar) "ÀÁ !\"ˆÄ ‡" [set-default current-menubar copy-sequence menubar set-menubar-dirty-flag] 4 "\ Set the default menubar to be menubar."]) (defalias 'set-buffer-menubar #[(menubar) "ÀÁ!ˆÂ !Ä ‡" [make-local-variable current-menubar copy-sequence menubar set-menubar-dirty-flag] 2 "\ Set the buffer-local menubar to be menubar."]) (defalias 'find-menu-item #[(menubar item-path-list &optional parent) "„ Á \" :??…’ ʼ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 "\ 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 'disable-menu-item #[(path) " \"‰@ A „\"ÇÈƒÉ‚Ê 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 "\ 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 'enable-menu-item #[(path) " \"‰@ A „\"ÇÈƒÉ‚Ê 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 "\ 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 (quote add-menu-item-1) #[(item-p menu-path item-name item-data enabled-p before) "ƒ— ÃÄʼn<ƒ ÇAC\"@‚'ÉÊË D\" „” \n‰ƒ“\n=ƒLÇ@C\"@‚VÇA@C\"@‰„†‰AƒuA@ƒuA‰‚a@C‰CA¤¡ˆ)A‰„9*„œ\n „ƒ³Ò# ‚ºB ƒÆÇC\"@Ã÷A@=ƒî AB¡ˆÃÖ‚ÍA‰„Ò„\n=ƒ@=ƒ B‰‚ C¤ˆ*ƒ7 ×Iˆ Ø??Iˆ‚C  ˆ ¡ˆÙ ˆ +‡" [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 item-p vector item-data enabled-p added-before t 1 2 set-menubar-dirty-flag] 5]) (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 "\ 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 'delete-menu-item #[(path) " \"‰@ A†  ??…2=ƒ(Ç \"‚.Ç \"ˆÈ ˆ ,‡" [current-menubar menubar find-menu-item path pair item menu delq set-menubar-dirty-flag] 4 "\ 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 'relabel-menu-item #[(path new-name) ";„ ÁÂÃD\" Æ \"‰@ 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 "\ 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 '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 "\ 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 t or nil, 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."]) (byte-code "ÀÁ!„Âà ‰ƒÅ @Æ\"ˆ A‰„)Çž„*ÉBÊ !ˆÌÍ!‡" [boundp put-buffer-names-in-file-menu t frame-list frames modify-frame-parameters ((menu-bar-lines . 1)) menu-bar-lines default-frame-alist (menu-bar-lines . 1) set-menubar default-menubar provide menubar] 4) emacs-19.22/lisp/loadhist.elc100666 13437 1 5430 5416170556 14521 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:28:46 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/loadhist.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'symbol-file #[(sym) "ÀÁ‡" [foundit (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(x) " A>… Âà @\"‡" [sym x throw foundit] 3] load-history nil] 3)] 2 "\ 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 'feature-symbols #[(feature) "ÀÁ‡" [foundit (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(x) "À B\nA… ÃÄ\n\"‡" [provide feature x throw foundit] 3] load-history nil] 3)] 2 "\ Return the file and list of symbols associated with a given FEATURE."]) (defalias 'feature-file #[(feature) "À !„ ÂÃÄ !\"‡Å !@‡" [featurep feature error "%s is not a currently loaded feature." symbol-name feature-symbols] 4 "\ 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 'file-provides #[(file) "À \n\"AÃÆÇ \"ˆ *‡" [assoc file load-history nil provides symbols mapcar #[(x) ":…@Á=…A\nB‰‡" [x provide provides] 2]] 3 "\ Return the list of features provided by FILE."]) (defalias 'file-requires #[(file) "À \n\"AÃÆÇ \"ˆ *‡" [assoc file load-history nil requires symbols mapcar #[(x) ":…@Á=…A\nB‰‡" [x require requires] 2]] 3 "\ Return the list of features required by FILE."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias set-intersect #[(p q) "ÀÂà \"ˆ )‡" [nil ret mapcar #[(x) " >… \nB‰‡" [x q ret] 2] p] 3] file-dependents #[(file) "À !ÂÅÆ\"ˆ *‡" [file-provides file nil dependents provides mapcar #[(x) "À  @!\"… @ B‰‡" [set-intersect provides file-requires x dependents] 4] load-history] 3]] 3) (defalias 'unload-feature #[(feature &optional force) "À !„ ÂÃÄ !\"ˆ „+Æ !È!‰ ƒ*ÂÊË !#ˆ*Ì !‰ @ÎÏ A\"*‡" [featurep feature error "%s is not a currently loaded feature." symbol-name force feature-file file file-dependents dependents "Loaded libraries %s depend on %s." prin1-to-string feature-symbols flist mapcar #[(x) ";ƒÁ‡Â!ƒÃ!‡Ä!…)Å!ˆÆN‰…(M)‡" [x nil boundp makunbound fboundp fmakunbound autoload aload] 3]] 5 "\ 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." "SFeature: "]) (provide (quote loadhist)) emacs-19.22/lisp/ls-lisp.elc100666 13437 1 5777 5416170576 14315 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:29:02 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/ls-lisp.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'insert-directory #[(file &optional switches wildcard full-directory-p) "À !‰ƒ\nà %‚ØÇ È\" ƒ$É !Ê ! „-ƒÌË !‰  ÎÈÈÒ È #ÈÈÈ× >ƒ_ØÙ\"‚lÚ >„lØÛ\"ÜÝ\"Þcˆß \"ƒ±@‰@AA Pà8\\á #cˆ‚}Šâã!ˆÎ•bˆäå!ˆæçè¥T\"c.\n‚ØÉ !á é ! #c)‡" [find-file-name-handler file handler insert-directory 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 "\ 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"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÍÎ!‡" [defalias ls-lisp-delete-matching #[(regexp list) "À\nƒà \n@\"„\n@ B\nA‰„ )‡" [nil result list string-match regexp] 4] 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] ls-lisp-time-lessp #[(time0 time1) "@ @A@ A@‰ W† U… \nW,‡" [time0 time1 lo1 lo0 hi1 hi0] 5] ls-lisp-format #[(file-name file-attr &optional switches) "@ >…ÄÅÆ8\"Ç >…ÄÈÉ8Ê¥T\"Ë8ÄÌA@Í Î8Uƒ4Ï ‚7Î8Ñ=ƒBÒ‚EÓ8É8%Ô \"Õ ;ƒ[× P‚\\ØÙ° )‡" [file-attr file-type 105 switches format "%6d " 10 115 "%4d " 7 1024 8 " %3d %-8d %-8d %8d " user-uid 2 user-login-name system-type ms-dos "root" 3 ls-lisp-format-time " " file-name " -> " "" "\n"] 10] ls-lisp-time-index #[(switches) "À >ƒ‡à >ƒćŇ" [99 switches 6 117 4 5] 2] ls-lisp-format-time #[(file-attr switches) "ÀÁ‡" [error-data (byte-code "ÀÁ\n! 8!‰ÅÆO ÆÈO ÊËO‰ À ÊËOš  ƒ/ ‚1 P-‡" [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 ls-lisp] 3) emacs-19.22/lisp/lselect.elc100666 13437 1 12464 5416170613 14364 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:29:15 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/lselect.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file 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) (defalias 'x-get-secondary-selection #[nil "ÀÁÂ\"‡" [x-get-selection-internal SECONDARY STRING] 3 "\ Return text selected from some X window."]) (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.") (defalias (quote 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]) (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 "\ 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." (byte-code "„ ÁÂ!C‡ÃÄ !ÃÅ !BC‡" [current-prefix-arg read-string "Store text for pasting: " copy-marker point-marker mark-marker] 3)]) (defalias 'x-own-secondary-selection #[(selection &optional type) "À Â\"‡" [x-own-selection selection SECONDARY] 3 "\ 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.)" (byte-code "„ ÁÂ!C‡ÃÄ !ÃÅ !BC‡" [current-prefix-arg read-string "Store text for pasting: " copy-marker point-marker mark-marker] 3)]) (defalias 'x-own-clipboard #[(string) "À Â\"‡" [x-own-selection string CLIPBOARD] 3 "\ Paste the given string to the X Clipboard."]) (defalias 'x-disown-selection #[(&optional secondary-p) "À ƒ ‚\nÃ!‡" [x-disown-selection-internal secondary-p SECONDARY PRIMARY] 2 "\ Assuming we own the selection, disown it. With an argument, discard the secondary selection instead of the primary selection."]) (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 "\ for use as a value of x-lost-selection-hooks."]) (byte-code "ÀÀ‡" [x-dehilight-selection x-lost-selection-hooks] 1) (defalias 'x-notice-selection-requests #[(selection type successful) "„\nÁ #‡ÁÅ #‡" [successful message "Selection request failed to convert %s to %s" selection type "Sent selection %s as %s"] 4 "\ for possible use as the value of x-sent-selection-hooks."]) (defalias 'x-notice-selection-failures #[(selection type successful) "† Á #‡" [successful message "Selection request failed to convert %s to %s" selection type] 4 "\ for possible use as the value of x-sent-selection-hooks."]) (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 "\ If there is a selection, delete the text it covers, and copy it to both the kill ring and the Clipboard." nil]) (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 "\ If there is a selection, delete the text it covers *without* copying it to the kill ring or the Clipboard." nil]) (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 "\ If there is a selection, copy it to both the kill ring and the Clipboard." nil]) (defalias 'x-yank-clipboard-selection #[nil "À ‰„ ÄÅ!ˆÆ ˆ c)‡" [nil last-command x-get-clipboard clip error "there is no clipboard selection" push-mark] 3 "\ If someone owns a Clipboard selection, insert it at point." nil]) emacs-19.22/lisp/lucid.elc100666 13437 1 10164 5471142046 14024 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 13 06:25:25 1993 ;;; from file /home/fsf/rms/e19/lisp/lucid.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias add-timeout #[(secs function object &optional resignal) "À \n $‡" [run-at-time secs resignal function object] 5] disable-timeout #[(timeout) "À !‡" [cancel-timer timeout] 2] copy-tree #[(tree) ":ƒÁ@!ÁA!B‡Â!ƒ6Ã!‰GS‰ÆYƒ3 Á H!Iˆ S‰‚ *‡‡" [tree copy-tree vectorp copy-sequence new i 0] 6] current-time-seconds current-time keymap-parent #[(keymap) "A‰ƒ @À=„ A‰„ )‡" [keymap tail] 3] set-keymap-parent #[(keymap new-parent) "A‰ƒ Aƒ A@À=„ A‰„ …\" \n¡)‡" [keymap tail new-parent] 3] remprop #[(symbol prop) "À !\n@ =ƒÄ \nAA‰\"ˆ‚\n…3Å\n8 =ƒ*\nAÆ\n›¡ˆ\nAA‰„Ç)‡" [symbol-plist symbol plist prop setplist 2 4 nil] 5]] 3) (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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias real-path-name #[(name &optional default) "ÀÁ\n \"!‡" [file-truename expand-file-name name default] 4] read-mouse-position #[(frame) "À ‰@\n=… A)‡" [mouse-position pos frame] 3]] 3) (defalias 'switch-to-other-buffer #[(arg) "Á=ƒ\nÂp!ˆÃÄXƒÅp!‚\"TÆÇÈÉÊ \"\"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 "\ 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." "p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆÀõö\"ˆÀ÷ø\"ˆÀùú\"ˆÀûü\"ˆÀýþ\"ˆÀÿ@\"ˆÀAB\"ˆÀCD\"ˆÀEF\"ˆÀGH\"ˆIJ!‡" [defalias find-face internal-find-face get-face internal-get-face try-face-font internal-try-face-font 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 new-frame provide lucid] 3) emacs-19.22/lisp/lunar.elc100666 13437 1 14422 5431771737 14061 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Aug 10 15:15:43 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/lunar.el ;;; emacs version 19.18.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ƒ ÂÃ!ˆ‚ÄÅ!ˆÂÆ!‡" [fboundp atan require lisp-float-type error "Lunar calculations impossible since floating point is unavailable." solar] 2) (defalias 'lunar-phase-list #[(month year) "   Æ_ Ç\\\\‰ƦTÆ¥)\nÆ_ É\\\\‰ƦTÆ¥) Ê EC \n̦ÍUƒZ\nΦÍUƒP\nϦÍUƒZ ÇUƒZЂ^Ñ SH\nECÓ Ê E@‰Ê EA@Ê EAA@SÕ_\\ÇVƒ³Ì_×\\Ø¥Z ̦ÍUƒ³ ΦÍUƒ® ϦÍUƒ³T,Ù¥Ú\\\\Û_!Ì_Ý!ß á \"ƒôá\"ƒæâ 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 day 31 day-of-year 23 10 3.66000000000000000000e+002 -1900 1.23684999999999991616e+001 index lunar-phase new-moon nil list calendar-date-compare append] 6 "\ List of lunar phases for three months starting with Gregorian MONTH, YEAR."]) (defalias 'lunar-phase #[(index) "Á¦Ã¥‰Ä¥ÆÈ Ê Æ  SÌ_\\  ÎVƒV  Á_Ï\\Ð¥Z Á¦ÑUƒVÒ¦ÑUƒQÓ¦ÑUƒV T  ,SÔ_SÁ¥SÒ¥[SÓ¥\\\\\\\\)Õ_ ‰Ö__ ‰‰×___Ø Ù_ ‰Ú__Û\\\\!Ü_Ý\\\\\\\\\\ßà_ ‰á__ ‰‰â___ã\\\\\\ä\"%ßæ_ ‰ç__ ‰‰è___é\\\\\\ê\"+ßì_ ‰í__ ‰‰î___ï\\\\\\ð\"1\nò>ƒsó ô_ZØ%!_Ø%‰\\!õ_Ø+!ö_Ø+‰\\!÷_Ø+ø_!ù_Ø1‰\\!ú_Ø%+\\!û_Ø%+Z!ü_Ø1‰\\%\\!ý_Ø1‰\\%Z!þ_Ø1‰\\+\\!ÿ_Ø1‰\\+Z!@_Ø+‰\\%\\!A_\\\\\\\\\\\\\\\\\\\\\\\\‚0B C_ZØ%!_Ø%‰\\!D_Ø+!E_Ø+‰\\!F_Ø+ø_!G_Ø1‰\\!H_Ø%+\\!I_Ø%+Z!J_Ø1‰\\%\\!K_Ø1‰\\%Z!L_Ø1‰\\+\\!M_Ø1‰\\+Z!N_Ø+‰\\%\\!O_Ø%+‰\\Z!P_Ø%‰\\+\\!Q_\\\\\\\\\\\\\\\\\\\\\\\\\\\\RS%!T_S+!U_V\\\\W\nÈUƒ[RW\\‚k\nÎUƒiRWZ‚kRRR\\‰XYZ!!AA@![¥[\\‰Z!Z\\_YZ!!‰] \"\nE.‡" [index 4 phase 4.00000000000000000000e+000 1.23684999999999990905e+003 time 1900 year 1 month 5.00000000000000000000e-001 day 31 day-of-year 2 23 10 0 100 400 365 2.95305886800000010339e+001 1.17799999999999993605e-004 -1.55000000000000000000e-007 solar-sin-degrees 1.32870000000000004547e+002 -9.17300000000000004263e-003 1.66560000000000002274e+002 3.30000000000000026645e-004 7.59329999999999927240e-001 date mod 2.91053560000000004493e+001 -3.33000000000000007105e-005 -3.47000000000000019540e-006 3.59224199999999996180e+002 3.60000000000000000000e+002 sun-anomaly 3.85816918059999977686e+002 1.07305999999999990280e-002 1.23599999999999976552e-005 3.06025300000000015643e+002 3.60000000000000000000e+002 moon-anomaly 3.90670506460000012794e+002 -1.65280000000000004690e-003 -2.38999999999999968026e-006 2.12963999999999984425e+001 3.60000000000000000000e+002 moon-lat (0 2) 1.73399999999999998579e-001 3.93000000000000007105e-004 2.09999999999999964473e-003 -4.06799999999999961631e-001 1.61000000000000014211e-002 3 -4.00000000000000000000e-004 1.04000000000000003553e-002 -5.09999999999999964473e-003 -7.40000000000000124345e-003 4.00000000000000000000e-004 -4.00000000000000000000e-004 -5.99999999999999822364e-004 1.00000000000000000000e-003 5.00000000000000000000e-004 1.72100000000000008527e-001 4.00000000000000000000e-004 2.09999999999999964473e-003 -6.28000000000000024869e-001 8.89999999999999857891e-003 -4.00000000000000000000e-004 7.90000000000000124345e-003 -1.19000000000000017764e-002 -4.69999999999999928946e-003 2.99999999999999911182e-004 -4.00000000000000000000e-004 -5.99999999999999822364e-004 2.09999999999999964473e-003 2.99999999999999911182e-004 4.00000000000000000000e-004 -2.99999999999999911182e-004 adjustment solar-cosine-degrees -4.00000000000000000000e-004 2.99999999999999911182e-004 2.80000000000000035527e-003 adj solar-ephemeris-correction calendar-gregorian-from-absolute truncate 1.44000000000000000000e+003 24 solar-time-string] 18 "\ 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-name #[(phase) "ÁUƒ‡ÃUƒćÅUƒƇÇU…ȇ" [phase 0 "New Moon" 1 "First Quarter Moon" 2 "Full Moon" 3 "Last Quarter Moon"] 2 "\ Name of lunar PHASE. 0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter."]) (defalias 'calendar-phases-of-moon #[nil "ÀÁ!ˆ\n \n Ä Ê_ Ë\\\\‰ ʦT  Ê¥)Ê_\\‰ ʦT Ê¥)Í !qˆÎÐÑÒÓ !Ó!%!ˆÔ ˆÕÖ× \"Ø#cˆebˆÙÎ!ˆÚÛ !ˆÀÜ!-‡" [message "Computing phases of the moon..." displayed-month displayed-year "*Phases of Moon*" lunar-phases-buffer y2 m2 y1 m1 12 -2 macro-y get-buffer-create nil buffer-read-only calendar-set-mode-line format "Phases of the moon from %s, %d to %s, %d%%-" calendar-month-name 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 "\ Create a buffer with the lunar phases for the current calendar window." nil]) (defalias 'phases-of-moon #[(&optional arg) "ŠÀ  ƒ#ÅÆÇÈÉÊË Í\"\"ÍÀ$!Î !\"A‚% @ ƒ9ÐÑÒÓ AA@!#‚= AA@Õ -‡" [t completion-ignore-case calendar-current-date date arg assoc capitalize completing-read "Month name: " mapcar list append calendar-month-name-array nil calendar-make-alist displayed-month calendar-read "Year (>0): " (lambda (x) (> x 0)) int-to-string displayed-year calendar-phases-of-moon] 9 "\ 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." "P"]) (defalias 'diary-phases-of-moon #[nil "À AA@ @ A@ AA@ \nSÅ_\\\nÇVƒH\nÈ_É\\Ê¥Z ȦËUƒH ̦ËUƒC ͦËUƒHT,Î¥Ï\\\\Ð_!È_Ò!Ô C\"ƒtTÒ!‚]Õ@ \"…ŠÖAA@!×A@Q*‡" [truncate date month day year 31 day-of-year 2 4 23 10 0 100 400 3.66000000000000000000e+002 -1900 1.23684999999999991616e+001 index lunar-phase phase calendar-date-compare calendar-date-equal lunar-phase-name " "] 5 "\ Moon phases diary entry."]) (provide (quote lunar)) emacs-19.22/lisp/macros.elc100666 74777 1 12430 5426662652 14237 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 1 02:41:44 1993 ;;; from file /home/fsf/rms/e19/lisp/macros.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (defalias 'name-last-kbd-macro #[(symbol) "„ÁÂ!ˆÃ !ƒ K;„ Å K!„ ÁÆ \"ˆ M‡" [last-kbd-macro error "No keyboard macro defined" fboundp symbol vectorp "Function %s is already defined and not a keyboard macro."] 3 "\ 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." "SName for last kbd macro: "]) (defalias 'insert-kbd-macro #[(macroname &optional keys) "À !ĘƒÅ Æcˆ‚ KÇcˆÈ p\"ˆÉcˆ`À\n È p\"ˆÌ \n bˆ`\nWƒµg‰ ÎWƒU``T|ˆÏ Ð\\±ˆ‚± ÑWƒbÒuˆ‚± ÑUƒt``T|ˆÓcˆ‚± ÔWƒ‹``T|ˆÕ ÎZ±ˆ‚± ÖWƒ¢``T|ˆ× ØZ±ˆ‚± ÖUƒ±``T|ˆÙcˆ)‚5*Úcˆ…èÜ À\"‰…çÝcˆÈ@p\"ˆÞcˆÈ p\"ˆÚcˆA‰„ÈÀ))‡" [nil definition symbol-name macroname "" last-kbd-macro "(setq " "(fset '" prin1 "\n " end beg point-marker char 32 "\\C-" 96 127 1 "\\C-?" 160 "\\M-C-" 255 "\\M-" 128 "\\M-C-?" ")\n" keys where-is-internal "(global-set-key " " '"] 4 "\ 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." "CInsert kbd macro (name): \nP"]) (defalias 'kbd-macro-query #[(flag) "„ „ ÂÃ!ˆ ƒʼnÆ *‡??…¹ÇÈÉ!\n  …¸Å‰Ì\n!ˆÍ *ÅÐ!Ñ\"‰Ó=ƒVÅ ‚´Ô=ƒeÅ Õ‚´Ö=ƒtÅ Ç‚´×=ƒ‚×Å!ˆ‚´Ø=ƒ”ʼnÆ ˆ*‚´Ù=ƒ¡Ç‚´Û=„«Ü ˆÝÞÈß!!‘ˆ*‚&*‡" [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."] 5 "\ 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." "P"]) (defalias 'apply-macro-to-region-lines #[(top bottom &optional macro) "„ „ ÂÃ!ˆ Š bˆÅ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 "\ 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. " "r"]) (define-key ctl-x-map "q" (quote kbd-macro-query)) emacs-19.22/lisp/mail-extr.elc100666 13437 1 34764 5416171062 14641 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:32:01 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/mail-extr.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÃÅÇÉ\nË ÍÏÐ $ÒÓQÒ PÒPÏ× $ÏÙ\"ÛÏ݉#ß á\"Ïã ‰ & $å&ç(Ïé $*Ïë \",í*îQ/ð1ò3Ïô \n$5ö5÷,ø5ù°:Àû!„·ü ;Àý!„Áü =Àþ!„Ëü >Àÿ!„Õü ?À@!„áü @ABC\"ˆDEF\"ˆDGH\"ˆDIJ\"ˆDKL\"ˆDMN\"‡" [boundp mail-@-binds-tighter-than-! nil 32 mail-space-char " \n" mail-whitespace "A-Za-z---{|}'~0-9`." mail-all-letters "A-Za-z{|}'~0-9`" mail-all-letters-but-separators "A-Za-z" mail-first-letters "A-Za-z`'." mail-last-letters format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)" mail-bad-initials-pattern "^" "." mail-non-name-chars mail-non-begin-name-chars mail-non-end-name-chars "\\([%s][%s]\\)\\.+\\([%s]\\)" mail-bad-\.-pattern "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] " mail-nickname-pattern "\\` *\\(Prof\\|Dr\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.? " mail-full-name-prefixes "\\(,? ?\\([JjSs]r\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)" mail-full-name-suffix-pattern "V?I+V?\\b" mail-roman-numeral-pattern "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)" mail-weird-acronym-pattern "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)" mail-mixed-case-name-pattern "[a-zA-Z.]+[!@][a-zA-Z.]" mail-alternative-address-pattern " [-{]\\|--\\|[+@#> (car temp) end-symbol < (car temp) beg-symbol no-replace (mail-nuke-char-at (car temp)) (setcar temp nil) (setq temp (cdr temp)) delq nil] 10]) mail-demarkerize #[(marker) "…Á!ƒÂ!ĉ“ˆ )‡‡" [marker markerp marker-position temp nil] 3] mail-markerize #[(pos) "…Á!ƒ ‡Â!‡" [pos markerp copy-marker] 2]] 10) (defalias 'mail-last-element '(macro . #[(list) "ÀÁ DCÂÃF‡" [let list (while (not (null (cdr list))) (setq list (cdr list))) (car list)] 4 "\ Return last element of LIST."])) (defalias 'mail-safe-move-sexp '(macro . #[(arg) "ÀÁÂÃÄÅEDÇEÈF‡" [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 "\ Safely skip over one balanced sexp, if there is one. Return t if success."])) (defalias 'mail-extract-address-components #[(address) "ÀÁ!ÀÂ!Ãĉ‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰‰ \n    !\"#$%&'()*+,-.Š-qˆï-!ˆð1!ˆ~ˆò ˆÄ345±ˆebˆö÷Äø#ƒ²ùúø\"ˆ‚¢ebˆ;Äwˆm„`f+„Ñ+ü=„Ñ`+ü=ƒð=!ˆ„öŠþuˆ;Äwˆ`f)ÿ=„ö`@AB„þuˆð1!ˆƒ„`‚+C=ƒ_„?Šþuˆ;Äwˆ`f)C=„?`@DE„Oþuˆƒ„`‚+F=ƒ…ðG!ˆ@HI„}þuˆð1!ˆ‚+J=ƒÅ)ƒµ(ƒÅ)‰KAƒªKA‰K‚K@)(@VƒÅø*Lþ!ˆe`}ˆ‚+MžA‰ƒá`JBLˆþuˆ‚+N=ƒðþuˆ‚+O>ƒŠ`bˆLþ!ˆ4cˆ)þuˆ‚þvˆ+ü=„µ`‚µ)Aƒ>Š)@bˆLþ!ˆ4cˆ))A‰)‚ (Aƒ`Š(A@bˆLþ!ˆ4cˆ)(‰AA¡ˆ‚>'GþVƒ„&ƒ„)„„ebˆLþ!ˆ`C)Pcˆ)ƒš(„šdbˆ`C(Qcˆ(ƒ¸)„¸Š(@bˆLþ!ˆ4cˆ)Ä((@()@‰)ƒY'‰ƒî@(V„à@)WƒåÄ ˆA‰„ÎRÄ'\"'$‰ƒ@(V„@)WƒÄ ˆA‰„ÿRÄ$\"$#‰ƒP@(V„B@)WƒGÄ ˆA‰„0RÄ#\"#&ƒ×&@&A&)ƒ¾(ƒ¾)Vƒ¾(Wƒ¾„¤'GSW„¤'@V„¤'A@Wƒ·ŠbˆLþ!ˆ4cˆ)‚Y‚Y)ƒÐ)ƒY)WƒY!‚Y\"ƒ,\"@\"A\")ƒ(ƒ)Vƒ(WƒŠbˆLþ!ˆ4cˆ)‚×!ƒ !Vƒ× „× ‚× ƒO$‰ƒY@ V„K@!WƒPÄ ˆA‰„9RÄ$\"‰$ƒO'‰ƒŽ@ V„€@!Wƒ…Ä ˆA‰„nRÄ'\"‰'ƒO#‰ƒÃ@ V„µ@!WƒºÄ ˆA‰„£RÄ#\"‰#ƒO%‰ƒø@ V„ê@!WƒïÄ ˆA‰„ØRÄ%\"‰%ƒOƒO TVƒO T‰ƒOƒO VƒOÄĉƒOƒO VƒOÄĉƒOe }ˆ%‰ƒ†@þV„g@þWƒ}Š@bˆLþ!ˆ4cˆ)Ä ˆA‰„WRÄ%\"%)ƒ¸)bˆ;Äxˆ`ebˆ;Äwˆ`Wƒµ`‚¸ÄƒeÄ$Ä#T(!(T!(bˆUV!ˆ'@bˆ'A‰'ƒ(Lþ!ˆW #B#Xcˆ(SbˆŠY-'@#ˆ'@|ˆ)'A„ä`C‚ä'(bˆLZ!ˆŠbˆLþ!ˆ4cˆ)[!ˆÄ[(!(\\[#\"#'@'.qˆï.!ˆð1!ˆÄ3~ˆò ˆY-!ˆ)ƒž)Tbˆ;Äwˆ`(}ˆ‚¤}ˆ'ƒï#ƒï#‰ƒæ@'V„Ç@eWƒÝŠ@bˆLþ!ˆ4cˆ)Ä ˆA‰„¶RÄ#\"##ƒ;$ƒ;$‰ƒ2@#@V„@eWƒ)Š@bˆLþ!ˆ4cˆ)Ä ˆA‰„RÄ$\"$'ƒ‹$ƒ‹#„‹$‰ƒ‚@'V„c@eWƒyŠ@bˆLþ!ˆ4cˆ)Ä ˆA‰„RRÄ$\"$$ƒÑŒ'ƒ¸]ƒ¸'bˆ`#B#Ä'Lþ!ˆXcˆd‚ ]ƒÂd‚ #ƒ÷#‰KAƒÙKA‰K‚ÌK@)\\^#\"\nÄ#^'!'‚ 'ƒ\n'^'!'‚ de }ˆ$@ $ƒ¬dbˆ'„6$A„6`'U_!ˆ‚D`#B#U`!ˆaþ!ˆYp$A@ƒ]$A@T‚^e$@#ˆLþ!ˆŠ@bcˆ;Äxˆh)N=„£UŠ;Äxˆh)N=ƒ›d‚žef\"ˆ$A‰$„)\nƒÃg\\[\n\"#\"#['!' Td}ˆ#ƒó'„ó#@bˆLþ!ˆ`'hcˆ#A##Ÿ#i#@† '† dd\"ˆ#ƒ #jkˆe#ƒ) #@‚/ '†/ d-qˆƒr =ƒr Xƒr TS}ˆŠŒed}ˆebˆölÄø#ƒn ùm!ˆ‚[ *‚Æ\nƒ€ }ˆ‚Æ\nƒ­ TS}ˆŠŒed}ˆebˆölÄø#ƒ© ùm!ˆ‚– *‚Æ\ned|ˆY.#ˆebˆnoÄø#ebˆ;Äwˆm„Æ\n`f‰+C=ƒF\n`@pq„õ þuˆ`SZŠaþ!ˆLþ!ˆbˆLþ!ˆ)ŠŒ}ˆebˆölÄø#ƒ2\nùm!ˆ‚\n*4`f=„@\nrcˆø‚Í +N=ƒƒ\n`Tfs=ƒi\nþuˆLþ!ˆ4cˆ‚Í ƒu\ne`}ˆ‚Í Lþ!ˆrcˆ‚Í +zt>ƒ›\nLþ!ˆrcˆ‚Í `þvˆ`Œ}ˆebˆöuÄø#ƒ¿\nùú!ˆ‚®\ndbˆ)‚Í ðv!ˆwx !yed|ˆycˆebˆZz=ƒL ebˆ{|!ƒL }”f z”f Š.qˆø3~ f\"ƒ- ~ Sf\"ƒ- Tf * ƒL  z=ƒL z”bˆ –€±ˆx .qˆx .+D‡" [get-buffer-create "*canonical address*" "*extract address components*" bar nil insert-point \.-pos domain-pos saved-@-pos saved-!-pos saved-%-pos li mi fi saved-point name-suffix temp \.-ends-name mbox-end mbox-beg atom-end atom-beg quote-end quote-beg comment-end comment-beg 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 multiple-addresses char foo extraction-buffer canonicalization-buffer buffer-disable-undo set-syntax-table address-syntax-table erase-buffer case-fold-search mail-space-char address re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ ]" t replace-match "\\1 " mail-whitespace 40 address-comment-syntax-table 1 41 error (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 address-domain-literal-syntax-table (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) 44 list delete-char ((60 . <-pos) (62 . >-pos) (64 . @-pos) (58 . :-pos) (44 . \,-pos) (33 . !-pos) (37 . %-pos) (59 . \;-pos)) 46 (41 93 92) 60 62 delq 2 copy-marker insert-before-markers 88 point-marker "%" insert-buffer-substring -1 mail-demarkerize mapcar mail-@-binds-tighter-than-! mail-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 "ƒ\\A@† bˆ\nÃxˆŠÄÅƈ`\nÃxˆhÈ= ) ƒUÊ`{!ËNƒUe`}ˆ@bˆÌÍ!ˆ`áˆÎ \"ÐcˆÑÒÓ\"ˆA‰„Ç" [temp @-pos mail-whitespace 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 domain-name delete-char 1 delq %-pos "@" throw truncated t] 4) "\\\\\\(.\\)" "\\1" search-forward "_" (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) " " 95 (46 92) "\\([^_]+\\)_" address-text-syntax-table mail-variant-method buffer-string xxx 3 looking-at mail-two-name-pattern 0 char-equal 119 ". "] 43 "\ Given an rfc 822 ADDRESS, extract full name and canonical address. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS)."]) (byte-code "ÀÁÂ\"ˆÃÄÅ\"ˆÀÆÇ\"ˆÀÈÉ\"ˆÀÊË\"ˆÀÌÍ\"‡" [defalias mail-variant-method #[(string) "ÀÁ!Âɉ‰‰‰‰‰‰‰ \n   ŠqˆÐ!ˆÑ!ˆ~ˆÓ ˆÃcˆebˆÖÃØ#ƒRÙÚ!ˆ‚BebˆÃwˆÜÃxˆ`d}ˆÝÞˆe`}ˆ\n„ebˆÖßÃØ#ƒe”}ˆ ƒ¬ebˆàá!ˆ`S\n†”dbˆ\"h=„¡\"cˆãpe #ˆ Td}ˆdbˆ$Ãxˆgå=ƒ½æuˆ`ebˆÃwˆ`}ˆebˆÖçÃØ#ƒÛÙè!ˆ‚Ìed{. ‡" [get-buffer-create "*variant method buffer*" 0 nil end beg initial comment-end comment-beg last-name-comma-flag suffix-flag upper-case-flag lower-case-flag mixed-case-flag word-count variant-buffer buffer-disable-undo set-syntax-table address-text-syntax-table erase-buffer case-fold-search string re-search-forward mail-bad-\.-pattern t replace-match "\\1 \\2" mail-non-begin-name-chars "& \"" stop (byte-code "Áwˆ\nÃ=ƒÄ !ƒÕbˆ`d}ˆ‚\nÆYƒxÄ!ƒxÁxˆ`gÉ=ƒ;Êuˆ‚>Écˆ g=„I cˆÁwˆgÌ>ƒiÍÊ!ˆgÎ=ƒcÊuˆ‚mÎcˆ‚mÏÊ!ˆ\nTÐÑÒ\"ˆ‚ÄÓ!ƒ‹ÃÊ”bˆ`d}ˆ‚\nÆYƒ©„›ƒ©Ä!ƒ©Ä!ƒÔ\nÆYƒ¿„¹ƒ¿ÄÙ!„ÔÄ!„ÔÄ!„ÔÄ!ƒÜÐÑÒ\"ˆ‚gÉ=ƒü\nÊ=ƒüÊuˆÒ g=„ cˆ‚gÉ=ƒ\nÐÑÒ\"ˆ‚gÞ>ƒ°`à!!ˆgâ>ƒ6gã=ƒ'ÊuˆäåÁÒ#„@æÊ!ˆ‚@çèé„@dbˆà*!ˆ`+\nÃ=ƒlÄì!ƒl+ZÆYƒlT+S}ˆebˆ‚+ZíU„Š+ZîUƒ™Æ\\fÎ=ƒ™Äì!„™Tf/‚œÁ/+|ˆ/ƒ/𱈂Ä1!ƒÀÔÕ|ˆ‚o„Ë h=ƒæÄò!ƒææÊ!ˆó`ô567#ˆ`\"ˆ‚Ä8!ƒgg–=„÷ÒÊuˆgÎ=ƒÊuˆ‚ Îcˆ g=„ cˆ\nT‚Ä9!ƒT`:Õ;üý;Ò#ƒF:bˆüþ;Ò#ƒBÔ‚GÕ‚GØÒLˆ;bˆ\nT‚ÐÑÒ\"ˆ‚" [mail-whitespace nil word-count 0 looking-at mail-full-name-prefixes 2 mail-full-name-suffix-pattern suffix-flag 44 1 mail-space-char (106 74 115 83) capitalize-word 46 upcase-word throw stop t "MKA \\(.+\\)" mixed-case-flag lower-case-flag mail-weird-acronym-pattern mail-roman-numeral-pattern upper-case-flag "[a-z][a-z][a-z][a-z]+\\b" mail-alternative-address-pattern mail-trailing-comment-start-pattern mail-telephone-extension-pattern last-name-comma-flag (40 123 91 34 39 96) comment-beg set-syntax-table address-text-comment-syntax-table (39 96) 39 search-forward "'" delete-char error (byte-code "À`Á\"bˆÂ‡" [scan-sexps 1 t] 3) ((error (byte-code "A@Á˜?…Â@A\"ˆ‚ ‡" [error "Unbalanced parentheses" signal] 3))) address-text-syntax-table comment-end " *\\'" 3 4 initial ". " mail-ham-call-sign-pattern "&\\( \\|\\'\\)" capitalize-region insert-buffer-substring canonicalization-buffer mbox-beg mbox-end mail-initial-pattern mail-name-pattern beg end re-search-forward "[a-z]" "[A-Z]"] 6) "\\b[A-Za-z][A-Za-z]+\\. *\\'" search-forward "," mail-space-char insert-buffer-substring mail-non-end-name-chars 46 1 "[ \n]+" " "] 12] mapcar #[(x) "9ƒ ÁÂÃ#‡Á@ÂA@#‡" [x put domain-name t] 4] ((ag "Antigua") (ar "Argentina") arpa (at "Austria") (au "Australia") (bb "Barbados") (be "Belgium") (bg "Bulgaria") bitnet (bo "Bolivia") (br "Brazil") (bs "Bahamas") (bz "Belize") (ca "Canada") (ch "Switzerland") (cl "Chile") (cn "China") (co "Columbia") com (cr "Costa Rica") (cs "Czechoslovakia") (de "Germany") (dk "Denmark") (dm "Dominica") (do "Dominican Republic") (ec "Ecuador") edu (eg "Egypt") (es "Spain") (fi "Finland") (fj "Fiji") (fr "France") gov (gr "Greece") (hk "Hong Kong") (hu "Hungary") (ie "Ireland") (il "Israel") (in "India") int (is "Iceland") (it "Italy") (jm "Jamaica") (jp "Japan") (kn "St. Kitts and Nevis") (kr "South Korea") (lc "St. Lucia") (lk "Sri Lanka") mil (mx "Mexico") (my "Malaysia") (na "Namibia") nato net (ni "Nicaragua") (nl "Netherlands") (no "Norway") (nz "New Zealand") org (pe "Peru") (pg "Papua New Guinea") (ph "Philippines") (pl "Poland") (pr "Puerto Rico") (pt "Portugal") (py "Paraguay") (se "Sweden") (sg "Singapore") (sr "Suriname") (su "Soviet Union") (th "Thailand") (tn "Tunisia") (tr "Turkey") (tt "Trinidad and Tobago") (tw "Taiwan") (uk "United Kingdom") unter-dom (us "U.S.A.") uucp (uy "Uruguay") (vc "St. Vincent and the Grenadines") (ve "Venezuela") (yu "Yugoslavia") (za "South Africa") (zw "Zimbabwe")) time-extract #[nil "À‰à \nB ‰ƒÅ @@!ˆ A‰„à \nB‰Ÿ*‡" [nil list times current-time-string problem-address-alist mail-extract-address-components] 3] test-extract #[(&optional starting-point) "ÀÁ!qˆÂ ˆÃÄ!ˆÅƃ>‚\"‡" [get-buffer-create "*Testing*" erase-buffer sit-for 0 mapcar test-extract-internal starting-point problem-address-alist] 4 nil nil] test-extract-internal #[(item) "@A@Ä8Æ\n!‰@A@ ?†' ——˜\n ?†2  ˜ \nƒ> „tÌÍ!ˆÎÏp!!ˆdbˆÐ\nѱˆ\n„_Ò ÓÔ±ˆ „mÕ Ó Ô±ˆÑcˆÖ×!ˆ.؉‡" [item failed-item address correct-name 2 correct-canon mail-extract-address-components result name canon name-correct canon-correct pop-to-buffer "*Testing*" select-window get-buffer-window "Address: " "\n" " Correct Name: [" "]; Result: [" "]\n" " Correct Canon: [" sit-for 0 nil] 6] test-continue-extract #[nil "À !‡" [test-extract failed-item] 2 nil nil]] 3) emacs-19.22/lisp/man.elc100666 74777 1 42747 5474621734 13543 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:05:30 1993 ;;; from file /home/fsf/rms/e19/lisp/man.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (require (quote assoc)) (defvar Man-notify (quote friendly) "\ *Selects the behavior when manpage is ready. This variable may have one of the following values: newframe -- put the manpage in its own frame (see `Man-frame-parameters') bully -- make the manpage the current buffer and only window aggressive -- make the manpage the current buffer in the other window friendly -- display manpage in other window but don't make current polite -- don't display manpage, but prints message when ready (beeps) quiet -- like `polite', but don't beep meek -- make no indication that manpage is ready Any other value of `Man-notify' is equivalent to `meek'.") (defvar Man-frame-parameters nil "\ *Frame parameter list for creating a new frame for a manual page.") (defvar Man-reuse-okay-p t "\ *Reuse a manpage buffer if possible. When t, and a manpage buffer already exists with the same invocation, man just indicates the manpage is ready according to the value of `Man-notify'. When nil, it always fires off a background process, putting the results in a uniquely named buffer.") (defvar Man-downcase-section-letters-p 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-p t "\ *If t, the manpage list is treated as circular for traversal.") (defvar Man-auto-section-alist nil "\ *Association list of major modes and their default section numbers. List is of the form: (MAJOR-MODE . [SECTION | (SECTION*)]). If current major mode is not in list, then the default is to check for manpages in all sections.") (defvar Man-section-translations-alist (quote (("3C++" . "3") ("3X" . "3") ("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 Man-filter-list (quote (("sed " ("-e '/[Nn]o such file or directory/d'" "-e '/Reformatting page. Wait... done/d'" "-e '/^\\([A-Z][A-Z.]*([0-9A-Za-z][-0-9A-Za-z+]*)\\).*\\1$/d'" "-e '/^[ \\t]*Hewlett-Packard Company[ \\t]*- [0-9]* -.*$/d'" "-e '/^[ \\t]*Hewlett-Packard[ \\t]*- [0-9]* -.*$/d'" "-e '/^ *Page [0-9]*.*(printed [0-9\\/]*)$/d'" "-e '/^Printed [0-9].*[0-9]$/d'" "-e '/^[ \\t]*X Version 1[01].*Release [0-9]/d'" "-e '/^[A-za-z].*Last change:/d'" "-e '/^Sun Release [0-9].*[0-9]$/d'" "-e '/^\\n$/D'")) ("awk '\n" ("BEGIN { blankline=0; anonblank=0; }\n" "/^$/ { if (anonblank==0) next; }\n" "{ anonblank=1; }\n" "/^$/ { blankline++; next; }\n" "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" "'")))) "\ *Manpage cleaning filter command phrases. This variable contains an association 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.") (defvar Man-mode-line-format (quote ("" mode-line-modified mode-line-buffer-identification " " global-mode-string " " Man-page-mode-string " %[(" mode-name minor-mode-alist mode-line-process ")%]----" (-3 . "%p") "-%-")) "\ *Mode line format for manual mode buffer.") (defvar Man-mode-map nil "\ *Keymap for Man mode.") (defvar Man-mode-hooks nil "\ *Hooks for Man mode.") (defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]" "\ *Regular expression describing a manpage section within parentheses.") (defvar Man-heading-regexp "^ ?[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 "^ ?NAME$\\|^ ?No manual entry for .*$" "\ *Regular expression describing first heading on a manpage. This regular expression should start with a `^' character.") (defvar Man-reference-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*\\(([0-9][a-zA-Z+]*)\\)?" "\ *Regular expression describing a reference in the SEE ALSO section.") (defvar Man-switches "" "\ *Switches passed to the man command, as a single string.") (defvar Man-specified-section-option "" "\ *Option that indicates a specified a manual section name. On most Unix systems, no option is needed for this. On Solaris, you need to set this to \"-s \".") (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!ˆÀÄ!ˆÀÅ!ˆÆÁÇ\"ˆÆÂÇ\"ˆÆÃÇ\"ˆÆÄÈ\"ˆÆÅÉ\"ˆ\n„¤Ë \nÌ\n!ˆÍ\nÎÏ#ˆÍ\nÐÑ#ˆÍ\nÒÓ#ˆÍ\nÔÕ#ˆÍ\nÖ×#ˆÍ\nØÙ#ˆÍ\nÚÛ#ˆÍ\nÜÝ#ˆÍ\nÞß#ˆÍ\nàá#ˆÍ\nâã#ˆÍ\näå#ˆÍ\næç#ˆÍ\nèé#ˆÍ\nêë#ˆÇ‡" [make-variable-buffer-local Man-sections-alist Man-refpages-alist Man-page-list Man-current-page Man-page-mode-string set-default nil 0 "1 (of 1)" 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 "," beginning-of-buffer "." end-of-buffer "r" Man-follow-manual-reference "t" toggle-truncate-lines "g" Man-goto-section "s" Man-goto-see-also-section "q" Man-quit "m" manual-entry "?" describe-mode] 4) (defalias 'Man-page-mode-string #[nil "ÀÁ\n G#‡" [format "%d (of %d)" Man-current-page Man-page-list] 4 "\ Formats part of the mode line for manual mode."]) (defalias (quote Man-delete-trailing-newline) #[(str) "‰GSÁO˜ƒÃGSO‡‡" [str nil "\n" 0] 3]) (defalias 'Man-build-man-command #[nil "À ÂQ  ƒ9 @@ @A@ A;ƒ%<„)ÈÉ!ˆ ÊËÌÍ#R*‚ *‡" ["man " Man-switches " %s 2>&1" Man-filter-list flist command pargs pcom error "malformed Man-filter-list." " | " mapconcat (lambda (phrase) phrase) " "] 7 "\ Builds the entire background manpage and cleaning command."]) (defalias 'Man-downcase #[(man-args) "ÀÁ‰ G WƒAÉ\n #‰ƒAÁ• OP‰  O—P ‰‚  OP-‡" ["" 0 nil man-args len mend mstart s newargs string-match Man-section-regexp] 6 "\ Downcases section letters in MAN-ARGS."]) (defalias 'Man-translate-references #[(ref) "ÀÁ\nÃQ \"ƒŠÀÁ \"ˆ ʼn•SOÇ\nÈQ À \"ƒ. ʔʕO‚/Ë  ƒ@Ð ! ƒ€@@@AAƒaÐ! ˜ƒ|ƒuÐ!‚w Ó*‚@ ÕR,‡ ‡" [string-match "(" Man-section-regexp ")$" ref 0 word "(\\(" "\\))" section-re 1 "" section Man-section-translations-alist slist Man-downcase-section-letters-p Man-downcase s2 s1 nil Man-specified-section-option " "] 4 "\ Translates REF from \"chmod(2V)\" to \"2v chmod\" style."]) (defalias 'Man-linepos #[(&optional position col-p) "`À Ä=ƒÅyˆ‚7 Æ=ƒÇ ˆ‚7 È=ƒ(ebˆ‚7 É=ƒ4dbˆ‚7Àˆ\nƒ@i‚A`\nbˆ *‡" [nil rval tpnt position bol 0 boi back-to-indentation bob eob col-p] 2 "\ Return the character position at various line/buffer positions. Preserves the state of point, mark, etc. Optional arg POSITION can be one of the following symbols: bol == beginning of line boi == beginning of indentation eol == end of line [default] bob == beginning of buffer eob == end of buffer Optional arg COL-P, if non-nil, means to return the current column instead of character position."]) (defalias 'Man-default-man-args #[(manword) " žA‰„ ‚\n:ƒÄÅ\nÆ#‚\nÆ Q)‡" [major-mode Man-auto-section-alist sections manword mapconcat #[(n) "Á\nQ‡" [n " " manword] 3] " "] 5 "\ Build the default man args from MANWORD and buffer's major mode."]) (defalias 'Man-default-man-entry #[nil "ÀŠÂÃ!„ ÄÀxˆÅÀxˆÂÆ!ƒÇuˆ`ÈÀwˆ`{ÂÉ!ƒ:ÊÀwˆ`ËÀwˆ`{Ì Q‚>Í ! *‡" [nil default-title looking-at "[a-zA-Z_]" "^a-zA-Z_" "(a-zA-Z_0-9" "(" 1 "a-zA-Z0-9_" "[ ]*([ ]*[0-9][a-zA-Z]?[ ]*)" "^0-9" "0-9a-zA-Z" " " Man-default-man-args] 3 "\ 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 (quote man) (quote manual-entry)) (defalias 'manual-entry #[(arg) "À ÂÃÄ Å˜ƒÅ‚ÃÆ \"\"!‰Řƒ. Řƒ+ÈÉ!ˆ‚. Ê!Ë :\"*‡" [Man-default-man-entry default-entry read-string format "Manual-entry: %s" "" "(default: %s) " man-args error "No man args given." Man-translate-references Man-getpage-in-background arg] 7 "\ Get a Un*x manual page and put it in a buffer. This command is the top-level command in the man package. It runs a Un*x command to retrieve and clean a manpage in the background and places the results in a Man mode (manpage browsing) buffer. See variable `Man-notify' for what happens when the buffer is ready. Universal argument ARG, is passed to `Man-getpage-in-background'." "P"]) (defalias 'Man-getpage-in-background #[(TOPIC &optional override-reuse-p) " ÃQÅ !ƒ\"„\"ƒ\"É!‚GÊË \"ˆÌ !Í!ÏÐÑ\"ˆÒÓÔÕÖ×Ø \"%Ù\")+‡" [TOPIC man-args "*man " "*" bufname get-buffer buffer Man-reuse-okay-p override-reuse-p Man-notify-when-ready message "Invoking man %s in background..." generate-new-buffer copy-sequence process-environment setenv "TERM" "dumb" set-process-sentinel start-process "man" "sh" "-c" format Man-build-man-command Man-bgproc-sentinel] 9 "\ Uses TOPIC to build and fire off the manpage and cleaning command. Optional OVERRIDE-REUSE-P, when non-nil, means to start a background process even if a buffer already exists and `Man-reuse-okay-p' is non-nil."]) (defalias 'Man-notify-when-ready #[(man-buffer) "Á=ƒ \nqˆÃ !‡Å=ƒÆ\n!ˆÇ ‡È=ƒ$Æ\n!‡É=ƒ/Ê\nË\"‡Ì=ƒ?Í ˆÎÏÐ\n!\"‡Ñ=ƒLÎÏÐ\n!\"‡ÎÒ!‡" [Man-notify newframe man-buffer new-frame Man-frame-parameters bully 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 "\ Notify the user when MAN-BUFFER is ready. See the variable `Man-notify' for the different notification behaviors."]) (defalias (quote Man-set-fonts) #[nil "ebˆÀÁÂÃ#…NĔĕ‰bˆƒ7È dUƒ' ‚) TÉÊË!ƒ4Ì‚5Í$ˆ` WƒJÊÎ!ƒJÏÐ!ˆ‚7*‚‡" [re-search-forward "\\(.\\)+" nil t 0 en st window-system put-text-property face looking-at "_" underline bold "." replace-match ""] 7]) (defalias 'Man-bgproc-sentinel #[(process msg) "À !‰Æ !„Ç Â\"‚‰Š qˆebˆÈÉ!„(ÈÊ!ƒ3`ËÌ!{Í‚oÎ !Ï=ƒCÐ !ÑU„oÆ !ÒGSHÕUƒ`ÑO‚b)QdbˆÖ×\"cˆ) ƒ{Ø !ˆ‚‚Ù‹ˆÚ !ˆ …‰Û !+‡" [process-buffer process nil err-mess delete-buff Man-buffer buffer-name set-process-buffer looking-at "No \\(manual \\)*entry for" "[^\n]*: nothing appropriate$" Man-linepos eol t process-status exit process-exit-status 0 ": process " msg eos 10 format "\nprocess %s" kill-buffer ((byte-code "ŠqˆÁ ˆÂ ˆÃÄ!ˆ)ć" [Man-buffer Man-set-fonts Man-mode set-buffer-modified-p nil] 2)) Man-notify-when-ready error] 5 "\ Manpage background process sentinel."]) (defalias 'Man-mode #[nil "ÀÂÄÈ È\nËp!ˆÌÍ!ˆÎ!ˆebˆÐ ˆÑÒ!ˆÓÔ!‡" [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-goto-page 1 run-hooks Man-mode-hook] 2 "\ A mode for browsing Un*x manual pages. The following man commands are available in the buffer. Try \"\\[describe-key] RET\" for more information: \\[manual-entry] 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, its buffer, and window. \\[describe-mode] Prints this help text. The following variables may be of some use. Try \"\\[describe-variable] RET\" for more information: Man-notify What happens when manpage formatting is done. Man-reuse-okay-p Okay to reuse already formatted buffer? Man-downcase-section-letters-p Force section letters to lower case? Man-circular-pages-p Multiple manpage list treated 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-hooks Hooks for 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}" nil]) (defalias 'Man-build-section-alist #[nil "ÀebˆÂ dÄ#…ÅÁÆÇ!Æ {\"ˆÈyˆ‚‡" [nil Man-sections-alist re-search-forward Man-heading-regexp t aput Man-linepos bol 1] 4 "\ Build the association list of manpage sections."]) (defalias 'Man-build-references-alist #[nil "ÀŠÂ !…„Äyˆ`ÅÄ!ˆ`ÀÆ ‰\n }ˆebˆË ˆm?…ƒ`U?…ƒ`Ì  Î#ДЕ{‰GSƒ{ƒ`PÀHÓUƒ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 eow 0 word len 45 aput " \n,"] 5 "\ Build the association list of references (in the SEE ALSO section)."]) (defalias 'Man-build-page-list #[nil "ÀŠÂÃ!ÂÄ! ebˆÉdÊ#ˆm?…JÉdÊ#ƒ3ÂË!Àˆ‚9dbˆ`Ì BC\"‚,‡" [nil Man-page-list Man-linepos bob eob Man-first-heading-regexp regexp page-end page-start re-search-forward t bol append] 4 "\ Build the list of separate manpages in the buffer."]) (defalias 'Man-next-section #[(n) "À !ƒ ÂyˆÃ dÄ $ƒÆyˆÇ‡db‡" [looking-at Man-heading-regexp 1 re-search-forward t n 0 nil] 5 "\ Move point to Nth next section (default 1)." "p"]) (defalias 'Man-previous-section #[(n) "À !ƒ ÂyˆÃ eÄ $ƒÆyˆÇ‡eb‡" [looking-at Man-heading-regexp -1 re-search-backward t n 0 nil] 5 "\ Move point to Nth previous section (default 1)." "p"]) (defalias 'Man-find-section #[(section) "`ebˆÁ PdÄ#ƒÅyˆÄ‚bˆÆ)‡" [curpos re-search-forward "^\\s-?" section t 0 nil] 4 "\ Move point to SECTION if it exists, otherwise don't move point. Returns t if section is found, nil otherwise."]) (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 "\ Query for section to move point to." nil]) (defalias 'Man-goto-see-also-section #[nil "À !?… Âà ÄQ!‡" [Man-find-section Man-see-also-regexp error "No " " section found in current manpage."] 4 "\ Move point the the \"SEE ALSO\" section. Actually the section moved to is described by `Man-see-also-regexp'." nil]) (defalias 'Man-follow-manual-reference #[(arg) "„\nÁ°!‡ÃÀÄ!ÆÈ ÉQ\nË\nÆÌ$‰ƒ-͘ƒ1 ‚3+\"ˆÎÏÄ!!:\"‡" [Man-refpages-alist error "No references found in current manpage." aput aheadsym default nil chosen "Refer to: (default " ") " prompt completing-read t "" Man-getpage-in-background Man-translate-references arg] 8 "\ Get one of the manpages referred to in the \"SEE ALSO\" section. Queries you for the page to retrieve. Of course it does this in the background. Universal argument ARG is passed to `Man-getpage-in-background'." "P"]) (defalias 'Man-quit #[nil "pÁ!ˆÂ!)‡" [buff delete-windows-on kill-buffer] 2 "\ Kill the buffer containing the manpage." nil]) (defalias 'Man-goto-page #[(page) "ÁW„ \nGVƒÃÄ\"ˆS\n8‰@ AÉ  ~ˆbˆ}ˆÊ ˆËÌ͈~ˆ}ˆeb+‡" [page 1 Man-page-list error "No manpage %d found" page-range page-start page-end Man-current-page Man-page-mode-string Man-build-section-alist nil (Man-build-references-alist) ((error))] 4 "\ Go to the manual page on page PAGE." (byte-code "„ÁÂ!‡ÃÄG\"‡" [Man-page-list error "You're looking at the only manpage in the buffer." format "nGo to manpage [1-%d]: "] 3)]) (defalias 'Man-next-manpage #[nil "GÁUƒ ÂÃ!ˆ GWƒÅ T!‡ƒ ÅÁ!‡ÂÇ!‡" [Man-page-list 1 error "This is the only manpage in the buffer." Man-current-page Man-goto-page Man-circular-pages-p "You're looking at the last manpage in the buffer."] 2 "\ Find the next manpage entry in the buffer." nil]) (defalias 'Man-previous-manpage #[nil "GÁUƒ ÂÃ!ˆ ÁVƒÅ S!‡ƒ ÅG!‡ÂÇ!‡" [Man-page-list 1 error "This is the only manpage in the buffer." Man-current-page Man-goto-page Man-circular-pages-p "You're looking at the first manpage in the buffer."] 2 "\ Find the previous manpage entry in the buffer." nil]) (provide (quote man)) emacs-19.22/lisp/mail-utils.elc100666 13437 1 7565 5474032512 14776 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 21 22:43:05 1993 ;;; from file /home/fsf/rms/e19/lisp/mail-utils.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote lisp-mode)) (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.") (defalias 'mail-string-delete #[(string start end) "„  O‡  O ÄOP‡" [end string 0 start nil] 4 "\ Returns a string containing all of STRING except the part from START (inclusive) to END (exclusive)."]) (defalias 'mail-strip-quoted-names #[(address) "??…ß ƒÂÃ!ˆÄÅÆ!Ç#‡È ÊË\"ˆÌ•ÊÍÌ•#OÊÎ\"ƒkŠÏÐ!qˆÑ ˆcˆÒ!ˆÔbˆÕÖÈ×#ƒaØuˆÙÈxˆ`ŠÈÚÛˆ`)|ˆ‚DÜ Ñ ˆ)‚€ÊÝ\"‰ ƒ€Þ Ì•#‚kÌ Êß #‰ ƒ²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 "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)" 2 close junk-end junk-beg] 6 "\ 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."]) (byte-code "ÀÁ!ƒ\n „ ÂÀ‡" [boundp rmail-default-dont-reply-to-names "info-"] 2) (defalias 'rmail-dont-reply-to #[(userids) "„ ƒ ÂP‚ÃÄÅ !ÆPPÇÈQÉʉ   Ï\"‰ ƒ_ ÑVƒ> T ÏÒÑ•#ƒMÑ•‚PG Ó  #‚&ÏÔ\"‰ ƒrÑ OÏÕ\"ƒƒÑ•ÊO‚…,‡" [rmail-dont-reply-to-names rmail-default-dont-reply-to-names "\\|" "" regexp-quote user-original-login-name "\\>" "\\(^\\|,\\)[ \n]*\\([^,\n]*!\\|\\)\\(" "\\)" t nil epos pos case-fold-search match string-match userids 0 "[ \n,]+" mail-string-delete "[ , \n]*\\'" "\\s *"] 4 "\ 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 'mail-fetch-field #[(field-name &optional last all) "ŠebˆÀÁ !ÄQƒ_È Ê ËÀ#ƒQ` ÍyˆÎÏ!„!Ðuˆhу9Ðuˆ‚- ‰È˜ƒEÈ‚FÒ `{Q )‚ Ș?…[ )‚”Ê ËÀ#…”ƒtÊ ËÀ#„l` ÍyˆÎÏ!„wÐuˆhÔƒÐuˆ‚ƒ `{)+‡" [t "^" regexp-quote field-name "[ ]*:[ ]*" name case-fold-search all "" value re-search-forward nil opoint 1 looking-at "[ ]" -1 (32 9) ", " last (32 9)] 4 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊ!‡" [defalias mail-parse-comma-list #[nil "À‰ÃÀwˆm„'`ÄÀwˆÃÀxˆ `{\nBÄÀwˆÅÀwˆ‚\n*‡" [nil beg accumulated " " "^," ", "] 2] mail-comma-list-regexp #[(labels) "ÀÂà \"†\nÅ ÂÆ #OÂÇ \"‰ƒ, Å OÈ Å•ÀOQ‚) ‡" [nil pos string-match "[^ ]" labels 0 "[ ]*$" "[ ]*,[ ]*" "\\|"] 6] mail-rfc822-time-zone #[(time) "À !@†ÂÄ !Å¥ÇÈ ÂWƒÉ‚ÊÅ¥Ŧ$*‡" [current-time-zone time 0 sec abs 60 absmin format "%c%02d%02d" 45 43] 6] 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 mail-utils] 3) emacs-19.22/lisp/mailabbrev.elc100666 13437 13 22635 5453474631 14604 0ustar jimbuser;ELC ;;; compiled by jonathan@kauai on Sun Oct 3 03:04:53 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/mailabbrev.el ;;; emacs version 19.19.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 "This file was compiled for Emacs 19")) (require (quote sendmail)) (defvar mail-abbrev-mailrc-file nil "\ Name of file with mail aliases. If nil, ~/.mailrc is used.") (defalias (quote mail-abbrev-mailrc-file) (quote (macro . #[nil "À‡" [(or mail-abbrev-mailrc-file (setq mail-abbrev-mailrc-file (or (getenv "MAILRC") "~/.mailrc")))] 1]))) (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.)") (defalias (quote mail-abbrevs-setup) #[nil "À !„ †ÄÅ!†Ɖ!ƒÇ ˆÈÉ!ˆ <ƒ4 @Ê=„4Ë B‚8Ë D ÌÍ!‡" [vectorp mail-abbrevs file-exists-p mail-abbrev-mailrc-file getenv "MAILRC" "~/.mailrc" build-mail-abbrevs make-local-variable pre-abbrev-expand-hook lambda sendmail-pre-abbrev-expand-hook abbrev-mode 1] 3]) (defalias 'build-mail-abbrevs #[(&optional file recursivep) "À †\n†ÃÄ!†ʼn!Æ!„#ÈÉÇÈ\"ˆÊË \"ˆÈp  ÎŽÏÐ! Ñ !ˆ qˆÒ !ƒSŠÒ !qˆed{)cˆ‚]Ó !ƒ]Ô !ˆdbˆhÕ=„iÖ ˆebˆ×ØÈÙ#ƒ…`ÚZȈ`|ˆ)‚lebˆm„©ÈˆhÜUƒ£ÝÞ!ˆÝß!ˆàcˆ‚ˆßuˆ‚ˆebˆáâÈÙ#ƒðãyˆäå!ƒÍȈæçߔߕ{!!ˆ‚¬áè!ˆß”ß•{)êÈwˆ`+Ȉì)+`{Ù#ˆ*‚¬-„øî ˆ+Êï \"‡" [expand-file-name file mail-abbrev-mailrc-file getenv "MAILRC" "~/.mailrc" 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 "\ Read mail aliases from `~/.mailrc' file and set `mail-abbrevs'."]) (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.") (byte-code "ÀÁ!„ÂÀ‡" [boundp mail-abbrev-aliases-need-to-be-resolved t] 2) (defalias 'define-mail-abbrev #[(name definition &optional from-mailrc-file) "À !„\"ÂÃÁÂ\"ˆÄ †ÆÇ!†ȉ!ƒ\"É ˆÊË \"ƒ2 Í•ÂO ÊÎ \"ƒB ͉”O ÂÍ Gƒ¬ƒ HÔ=ƒuTÊÕ #‚ŠÊÖ #‚ŠÊ× # OB…¦Í•U?…¦Í•‰„UØÙŸ# ,Û—ß  à$)‡" [vectorp mail-abbrevs nil define-abbrev-table file-exists-p mail-abbrev-mailrc-file getenv "MAILRC" "~/.mailrc" build-mail-abbrevs string-match "\\`[ \n,]+" definition 0 "[ \n,]+\\'" end L start result 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 "\ Define NAME as a mail-abbrev that translates to DEFINITION. If DEFINITION contains multiple addresses, separate them with commas." "sDefine mail alias: \nsDefine %s as mail alias for: "]) (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 "\ Resolve all forward references in the mail aliases table."]) (defalias (quote mail-resolve-all-aliases-1) #[(sym &optional so-far) " >ƒÂÃÄÅ BÆ#\"ˆÇ!…J‰ƒ\\ÉÊ   ƒLÍÎ # O B …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 \" B\"† \n‡" [mail-resolve-all-aliases-1 intern-soft x mail-abbrevs sym so-far] 4] mail-alias-separator-string] 7]) (defalias 'mail-abbrev-expand-hook #[nil "Š`À‰‰Åyˆ` bˆ…TiY…TÈÉ Ê#…T`ËuˆÌcˆÍ ˆ`Î ˆ `{Àˆ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 "\ For use as the fourth arg to define-abbrev. After expanding a mail-abbrev, if fill-mode is on and we're past the fill-column, break the line at the previous comma, and indent the next line."]) (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\):" "\ *Regexp to select mail-headers in which mail-abbrevs should be expanded. This string it will be handed to `looking-at' with the 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-syntax-table (copy-syntax-table text-mode-syntax-table) "\ The syntax table which is used in send-mail mode message bodies.") (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) "\ 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 (byte-code "À !‰GSÄ ÅHÄ ÇH ÉYƒ0\n HUƒ)\n Iˆ S‰‚\n,‡" [copy-syntax-table mail-mode-header-syntax-table tab i standard-syntax-table 95 _ 119 w 0] 4) "\ 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.") (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 "\ Whether point is in a mail-address header field."]) (defalias (quote sendmail-pre-abbrev-expand-hook) #[nil "…RÁ=?…R ƒE ƒÄ ˆÆ!ˆ¨ƒ,zÉ=„=Ê Æ !ˆÍ ˆÆ!ˆ)`p‰‡ÐÑ!…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]) (defalias 'merge-mail-abbrevs #[(file) "À !‡" [build-mail-abbrevs file] 2 "\ Merge mail aliases from the given file with existing ones." (list (let ((insert-default-directory t) (default-directory (expand-file-name "~/")) (def (mail-abbrev-mailrc-file))) (read-file-name (format "Read additional aliases from file: (default %s) " def) default-directory (expand-file-name def default-directory) t)))]) (defalias 'rebuild-mail-abbrevs #[(file) "À !‡" [nil mail-abbrevs build-mail-abbrevs file] 2 "\ Rebuild all the mail aliases from the given file." (list (let ((insert-default-directory t) (default-directory (expand-file-name "~/")) (def (mail-abbrev-mailrc-file))) (read-file-name (format "Read mail aliases from file: (default %s) " def) default-directory (expand-file-name def default-directory) t)))]) (defalias 'mail-interactive-insert-alias #[(&optional alias) "À !„  ˆ ƒÄ \"J†Åc‡" [vectorp mail-abbrevs mail-abbrevs-setup alias intern-soft ""] 3 "\ Prompt for and insert a mail alias." (byte-code "À !„  ˆÃÄ ÅÆ$C‡" [vectorp mail-abbrevs mail-abbrevs-setup completing-read "Expand alias: " nil t] 5)]) (defalias 'mail-abbrev-next-line #[(&optional arg) "ÀÁ!ƒ  ˆÃà !‡" [looking-at "[ ]*\n" expand-abbrev next-line this-command arg] 2 "\ 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.)." "p"]) (defalias 'mail-abbrev-end-of-buffer #[(&optional arg) "ÀÁ!ƒ  ˆÃà !‡" [looking-at "[ ]*\n" expand-abbrev end-of-buffer this-command arg] 2 "\ 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." "P"]) (byte-code "À ÂÃ#ˆÄÅ!‡" [define-key mail-mode-map "" mail-interactive-insert-alias provide mailabbrev] 4) emacs-19.22/lisp/mailalias.elc100666 13437 1 5521 5416171141 14636 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:32:49 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/mailalias.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar mail-aliases t "\ Alias of mail address aliases, or t meaning should be initialized from `~/.mailrc'.") (defalias 'expand-mail-aliases #[(beg end &optional exclude) "Á=ƒ Âà ˆ bˆÅ “ÂÁÈÉÁ#)ƒÊÂwˆ`‰‰‰‰   ÈÑÒ#ˆÓyˆÔÂxˆÕ bˆ`Wƒ` ƒw @AZVƒw A‰ „aÈÖÁ#ƒÓ” ` Z ‚–×! Ó Â {Ú \"„Ú\"A‰ƒ ZB B bˆcˆƒôÜÝQÕ bˆÈÁ#ƒïßà!ˆ‚Þbˆ*`` Z\\|ˆbˆ‚  bˆ uˆ*‚R‰“ˆ.‚‰“)‡" [mail-aliases t nil build-mail-aliases beg make-marker end case-fold-search re-search-forward "^\\(to\\|cc\\|bcc\\|resent-to\\|resent-cc\\|resent-bcc\\):" " " disabled-aliases seplen epos pos end1 beg1 "^[^ ]" move 0 " \n" point-marker "[ ]*[\n,][ ]*" marker-position string translation assoc exclude "\\b\\(" "\\)\\b" regexp replace-match ""] 7 "\ 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."]) (defalias 'build-mail-aliases #[(&optional file) "À †Â!ÃpÆŽÇÈ!É !ˆ qˆÊ !ƒ.ŠÊ !qˆed{)cˆ‚8Ë !ƒ8Ì !ˆdbˆhÍ=„DÎ ˆebˆm„hÈhÏUƒbÐÑ!ˆÐÒ!ˆÓcˆ‚GÒuˆ‚GebˆÔÕÃÖ#„{Ô×ÃÖ#ƒÔØ!ˆÙ”Ù•{ÛÃwˆ`ÈÝ`{\"ˆ*‚k+‡" [expand-file-name file "~/.mailrc" 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 "^a\\(lias\\|\\)[ ]+" t "^g\\(roup\\|\\)[ ]+" "[^ ]+" 0 name " " start define-mail-alias mail-aliases] 4 "\ Read mail aliases from `~/.mailrc' and set `mail-aliases'."]) (defalias 'define-mail-alias #[(name definition) "Á=ƒÂÃÄ!ƒÅ ˆÆÇ\"ƒ!É•ÂOÆÊ\"ƒ1ɉ”OÉH‰GSH  ‰  Uƒ] Î>ƒ]ÏGSO‚™ÆÐ #‰ ƒ™É•GUƒÉ TO‚]É TOÑÉ•ÂOQ Ò\\ ‚]Ó\"‰ ƒ¬ ¡‚µBB‰+‡" [mail-aliases t nil file-exists-p "~/.mailrc" build-mail-aliases string-match "\\`[ \n,]+" definition 0 "[ \n,]+\\'" tem last first (39 34) 1 "[^ ,][ ,]+" ", " 3 assoc name] 6 "\ Define NAME as a mail alias that translates to DEFINITION. This means that sending a message to NAME will actually send to DEFINITION. DEFINITION can be one or more mail addresses separated by commas." "sDefine mail alias: \nsDefine %s as mail alias for: "]) (provide (quote mailalias)) emacs-19.22/lisp/mailpost.elc100666 13437 1 3312 5416171151 14527 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:32:57 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/mailpost.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require mailalias sendmail] 2) (defalias 'post-mail-send-it #[nil "ƒ\nÁÂ!‚ ÃÄÁÅ!Ɖp \n  ÍŽŠ\nqˆÎ ˆÏ!ˆdbˆhÐU„9ÐcˆebˆÑÒÒQ!ˆÔÕ!ˆÖ×!ˆØ ƒ[Úe\"ˆebˆÛÜÝ#ƒu`WƒuÔÒ!ˆ‚^Ý ebˆÛÞÝ#ƒ‰ß!ˆebˆÛàÝ#ƒ­ŠebˆÛáÝ#)„­×yˆâã Ò±ˆebˆÛäÝ#ƒ½Ôå!ˆƒÊŠ qˆÎ ˆ))æç !‰ !ˆè é\"ˆêëìíî!ƒé.‚êïÆ Æðñ¯ƒúò‚ûó C#\"ˆ…+Š qˆ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 "\ The MH -post interface for `rmail-mail' to call. To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in site-init."]) emacs-19.22/lisp/makefile.elc100666 13437 1 63146 5416171222 14506 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:33:38 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/makefile.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (provide (quote makefile)) (defconst makefile-mode-name "makefile" "\ The \"pretty name\" of makefile-mode, as it appears in the modeline.") (defvar makefile-browser-buffer-name "*Macros and Targets*" "\ Name of the macro- and target browser buffer.") (defvar makefile-target-colon ":" "\ The string that gets appended to all target names inserted by makefile-insert-target. \":\" or \"::\" are quite common values.") (defvar 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 \" := \" .") (defvar makefile-use-curly-braces-for-macros-p nil "\ Controls the style of generated macro references. Set this variable to a non-nil value if you prefer curly braces in macro-references, so it looks like ${this}. A value of nil will cause makefile-mode to use parentheses, making macro references look like $(this) .") (defvar makefile-tab-after-target-colon t "\ If you want a TAB (instead of a space) to be appended after the target colon, then set this to a non-nil value.") (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-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, the cursor will automagically advance to the next line after an item has been selected in the browser.") (defvar makefile-pickup-everything-picks-up-filenames-p nil "\ If non-nil, makefile-pickup-everything also 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, 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'.") (defvar makefile-browser-hook nil "\ A function or list of functions to be called just before the browser is entered. This is executed in the makefile buffer.") (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"))) "\ 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 (quote (("@") ("&") (">") ("<") ("*") ("^") ("?") ("%"))) "\ 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 ( ).") (defconst makefile-dependency-regex "^[^ #:]+\\([ ]+[^ #:]+\\)*[ ]*:\\([ ]*$\\|\\([^=\n].*$\\)\\)" "\ Regex used to find dependency lines in a makefile.") (defconst makefile-macroassign-regex "^[^ ][^:#=]*[\\*:\\+]?:?=.*$" "\ 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.") (defvar makefile-brave-make "make" "\ A make that can handle the '-q' option.") (defvar makefile-query-one-target-method (quote makefile-query-by-make-minus-q) "\ A function symbol [one that can be used as the first argument to funcall] that provides a function that must conform to the following interface: * 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.") (defvar makefile-mode-map nil "\ The keymap that is used in makefile-mode.") (byte-code "„OÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÁ‡" [makefile-mode-map make-sparse-keymap define-key "$" makefile-insert-macro-ref ":" makefile-insert-target-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-previous-dependency "î" makefile-next-dependency] 4) (defvar makefile-browser-map nil "\ The keymap that is used in the macro- and target browser.") (byte-code "„IÁ ÂÃÄ#ˆÂÅÄ#ˆÂÆÇ#ˆÂÈÇ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÔ#ˆÁ‡" [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 ""] 4) (defvar makefile-mode-syntax-table nil "\ The syntax-table used in makefile mode.") (byte-code "„7Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÁ‡" [makefile-mode-syntax-table make-syntax-table modify-syntax-entry 40 "() " 41 ")( " 91 "(] " 93 "([ " 123 "(} " 125 "){ " 35 "< " 10 "> "] 4) (defvar makefile-target-table nil "\ Table of all targets that have been inserted in this Makefile buffer using makefile-insert-target or picked up using makefile-pickup-targets.") (defvar makefile-macro-table nil "\ Table of all macros that have been iserted in this Makefile buffer using makefile-insert-macro or picked up using makefile-pickup-macros.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ÄÀÆ!„!ÇÀÈ!„*ÇÀÉ!„3Ä ć" [boundp makefile-browser-client "A buffer in makefile-mode that is currently using the browser." makefile-browser-selection-vector nil makefile-has-prereqs makefile-need-target-pickup t makefile-need-macro-pickup makefile-mode-hook] 2) (defconst makefile-gnumake-functions-alist (quote (("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"))) "\ A list of GNU make 3.62 function names associated with the prompts for each function. This is used in the function makefile-insert-gmake-function .") (defalias 'makefile-mode #[nil "À ˆÁ\n>„Ã\nÁC\"ÄÅ!ˆÄÆ!ˆÄÇ!ˆÄÈ!ˆÄÉ!ˆÊ Ì ÎÐÔ!ˆÖ!ˆØÙ!‡" [kill-all-local-variables makefile-cleanup-continuations write-file-hooks append make-variable-buffer-local makefile-target-table makefile-macro-table makefile-has-prereqs makefile-need-target-pickup makefile-need-macro-pickup "#" comment-start "" comment-end "#[ ]*" comment-start-skip makefile-mode major-mode makefile-mode-name mode-name use-local-map makefile-mode-map set-syntax-table makefile-mode-syntax-table run-hooks makefile-mode-hook] 3 "\ Major mode for editing Makefiles. Calling this function invokes the function(s) \"makefile-mode-hook\" before doing anything else. \\{makefile-mode-map} In the browser, use the following keys: \\{makefile-browser-map} makefile-mode can be configured by modifying the following variables: makefile-mode-name: The \"pretty name\" of makefile-mode, as it appears in the modeline. 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." nil]) (defalias 'makefile-next-dependency #[nil "`ÁˆÂ dÄ#ƒÅyˆÄ‚bˆÁ)‡" [here nil re-search-forward makefile-dependency-regex t 0] 4 "\ Move (point) to the beginning of the next dependency line below (point)." nil]) (defalias 'makefile-previous-dependency #[nil "`ÁyˆÂ eÄ#ƒÁyˆÄ‚bˆÅ)‡" [here 0 re-search-backward makefile-dependency-regex t nil] 4 "\ Move (point) to the beginning of the next dependency line above (point)." nil]) (defalias 'makefile-electric-dot #[nil "nƒÀ ‡Ác‡" [makefile-insert-special-target "."] 1 "\ At (bol), offer completion on makefile-special-targets-list. Anywhere else just insert a dot." nil]) (defalias 'makefile-insert-special-target #[nil "À ˆÁ ĉ‰%‰GÆU?…ÇÈ \"cˆÉ )‡" [makefile-pickup-targets completing-read "Special target: " makefile-special-targets-list nil special-target 0 format ".%s:" makefile-forward-after-target-colon] 7 "\ Complete on makefile-special-targets-list, insert result at (point)." nil]) (defalias 'makefile-electric-equal #[nil "À ˆnƒ ÁÂ!‡Ãc‡" [makefile-pickup-macros call-interactively makefile-insert-macro "="] 2 "\ At (bol) do makefile-insert-macro. Anywhere else just self-insert." nil]) (defalias 'makefile-insert-macro #[(macro-name) "À ˆ GÂU?…ÂyˆÃÄ #cˆÆÈ !‡" [makefile-pickup-macros macro-name 0 format "%s%s" makefile-macro-assign t makefile-need-macro-pickup makefile-remember-macro] 4 "\ Prepare definition of a new macro." "sMacro Name: "]) (defalias 'makefile-insert-macro-ref #[(macro-name) "GÁU?… \"ƒÄÅ\"c‡Æ!DZ‡" [macro-name 0 assoc makefile-runtime-macros-list format "$%s " makefile-format-macro-ref " "] 3 "\ Complete on a list of known macros, then insert complete ref at (point)." (list (progn (makefile-pickup-macros) (completing-read "Refer to macro: " makefile-macro-table nil nil nil)))]) (defalias 'makefile-insert-target #[(target-name) "GÁU?…ÁyˆÂà #cˆÅ ˆÆˆÇÉ!‡" [target-name 0 format "%s%s" makefile-target-colon makefile-forward-after-target-colon nil t makefile-need-target-pickup makefile-remember-target] 4 "\ Prepare definition of a new target (dependency line)." "sTarget: "]) (defalias 'makefile-insert-target-ref #[(target-name) "GÁU?… ÂÃ\"c‡" [target-name 0 format "%s "] 3 "\ Complete on a list of known targets, then insert target-ref at (point) ." (list (pogn (makefile-pickup-targets) (completing-read "Refer to target: " makefile-target-table nil nil nil)))]) (defalias 'makefile-electric-colon #[nil "nƒÀÁ!‡Âc‡" [call-interactively makefile-insert-target ":"] 2 "\ At (bol) defines a new target, anywhere else just self-insert ." nil]) (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 "\ Scan a buffer that contains a makefile for target definitions (dependencies) and add them to the list of known targets." nil]) (defalias (quote makefile-add-this-line-targets) #[nil "ŠÀyˆÁÂe`\"T ?…JÅÁwˆl†Æ`fÇ\"‰„ `ÉÁwˆ`{\nËÌ!? Î\n \"ƒFÏÐ\n #ˆ+‚ +‡" [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]) (defalias 'makefile-pickup-macros #[nil "??…#ÁÁŠebˆÃ dÅ#ƒÆ ˆÇ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 "\ Scan a buffer that contains a makefile for macro definitions and add them to the list of known macros." nil]) (defalias (quote 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]) (defalias 'makefile-pickup-everything #[nil "À ˆÁ ˆ\n… à ‡" [makefile-pickup-macros makefile-pickup-targets makefile-pickup-everything-picks-up-filenames-p makefile-pickup-filenames-as-targets] 1 "\ Calls makefile-pickup-targets and makefile-pickup-macros. See their documentation for what they do." nil]) (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 "\ Scan the current directory for filenames, check each filename against makefile-ignored-files-in-pickup-regex and add all qualifying names to the list of known targets." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias makefile-browser-format-target-line #[(target selected) "ÀÁ\nÃ\" ƒ ‚Ç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] makefile-browser-format-macro-line #[(macro selected) "ÀÁ\nÃ\" ƒ ‚Ç!Q!‡" [format make-string makefile-browser-leftmost-column 32 selected makefile-browser-selected-mark makefile-browser-unselected-mark makefile-format-macro-ref macro] 5] makefile-browser-fill #[(targets macros) "ÀebˆÂ ˆÃÄ Æ#ˆÃÇÆ#ˆÉÀed#ˆdSbˆÊË!ˆebˆ uˆÍ‰‡" [nil buffer-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 delete-char 1 makefile-browser-cursor-column t] 4]] 3) (defalias 'makefile-browser-next-line #[nil "À ?… Áyˆ\nu‡" [makefile-last-line-p 1 makefile-browser-cursor-column] 1 "\ Move the browser selection cursor to the next line." nil]) (defalias 'makefile-browser-previous-line #[nil "À ?… Áyˆ\nu‡" [makefile-first-line-p -1 makefile-browser-cursor-column] 1 "\ Move the browser selection cursor to the previous line." nil]) (defalias 'makefile-browser-quit #[nil "ÂÃÂ!ˆÄp!ˆÅ !)‡" [makefile-browser-client my-client nil set-buffer-modified-p kill-buffer pop-to-buffer] 2 "\ Leave the makefile-browser-buffer and return to the buffer from that it has been entered." nil]) (defalias 'makefile-browser-toggle #[nil "Àe`\" ]à !ˆÄ !ˆÅÇyˆÈ ƒ0É \nË ˆÌ\nÍ !\"cˆ)‚AÎ Ë ˆÐÍ !\"cˆ)ÑÇyˆuˆ…RÔ )‡" [count-lines this-line 1 makefile-browser-toggle-state-for-line goto-line nil buffer-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 t makefile-browser-cursor-column makefile-browser-auto-advance-after-selection-p makefile-browser-next-line] 4 "\ Toggle the selection state of the browser item at the cursor position." nil]) (defalias 'makefile-browser-insert-continuation #[nil "ŠqˆÁˆÂc)‡" [makefile-browser-client nil "\\\n "] 1 "\ Insert a makefile continuation. In the browser's client 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." nil]) (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 "\ Insert all browser-selected targets and/or macros in the browser's client buffer. Insertion takes place at (point)." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias makefile-browser-insert-selection-and-quit #[nil "À ˆÁ ‡" [makefile-browser-insert-selection makefile-browser-quit] 1 nil nil] 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] makefile-browser-start-interaction #[nil "À !ˆÂ‰‡" [use-local-map makefile-browser-map t buffer-read-only] 2] 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] 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]] 3) (defalias 'makefile-create-up-to-date-overview #[nil "ÀÁ!…c\npà !Å Æ ˆ\n \n    qˆÎÐ ˆÑ\n #ˆÒ ÓUƒAÔp!ˆÕÖ!ˆ qˆ × !…aØ× !!ˆÙ ˆÚÎ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 "\ 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." nil]) (defalias 'makefile-save-temporary #[nil "À Âed ÃÄ%ˆ )‡" [makefile-generate-temporary-filename filename write-region nil 0] 6 "\ Create a temporary file from the current makefile buffer."]) (defalias 'makefile-generate-temporary-filename #[nil "À Á !Å GÆVƒ ÇÆO‚ È GÆVƒ' ÇÆO‚( R*‡" [user-login-name int-to-string user-uid my-uid my-name "mktmp" 3 0 "."] 6 "\ 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-query-targets #[(filename target-table prereq-list) "ÀÁ\nÃ#cˆebˆÄ !‡" [mapconcat #[(item) "@‰\n?‰† \"ÇÈ ƒÉ‚'ƒ&Ê‚'Ë#+‡" [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 "\ This function fills the up-to-date-overview-buffer. It checks each target in target-table using makefile-query-one-target-method and generates the overview, one line per target name."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias makefile-query-by-make-minus-q #[(target &optional filename) "À ‰‰Ã Å&ÇU?‡" [call-process makefile-brave-make nil "-f" filename "-q" target 0] 9] 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]] 3) (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 "\ This function is intended to help you using the numerous macro-like 'function calls' of GNU make. It will ask you for the name of the function you wish to use (with completion), then, after you selected the function, it will prompt you for all required parameters. This function 'knows' about the required parameters of every GNU make function and will use meaningfull prompts for the various args, making it much easier to take advantage of this powerful GNU make feature." nil]) (defalias (quote makefile-prompt-for-gmake-funargs) #[(function-name prompt-list) "ÀÁ\nÃ#‡" [mapconcat #[(one-prompt) "ÀÁ #Å\"‡" [read-string format "[%s] %s: " function-name one-prompt nil] 5] prompt-list ","] 4]) (defalias 'makefile-remember-target #[(target-name &optional has-prereqs) "GÁU?… \"„C B … B‰‡" [target-name 0 assoc makefile-target-table has-prereqs makefile-has-prereqs] 3 "\ Remember a given target 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 "\ Remember a given macro if it is not already remembered for this buffer."]) (defalias 'makefile-forward-after-target-colon #[nil "ƒÁc‡Âc‡" [makefile-tab-after-target-colon " " " "] 1 "\ Move point forward after the terminating colon of a target has been inserted. This accts according to the value of makefile-tab-after-target-colon ."]) (defalias 'makefile-browser-on-macro-line-p #[nil "ŠÀyˆÁÂà Ä#)‡" [0 re-search-forward "\\$[{(]" makefile-end-of-line-point t] 4 "\ Determine if point is on a macro line in the browser."]) (defalias 'makefile-browser-this-line-target-name #[nil "ŠÀˆÁÀxˆ` S{)‡" [nil "^ " makefile-end-of-line-point] 2 "\ Extract the target 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 "\ Extract the macro name from a line in the browser."]) (defalias 'makefile-format-macro-ref #[(macro-name) "ƒ Á \"‡ÁÄ \"‡" [makefile-use-curly-braces-for-macros-p format "${%s}" macro-name "$(%s)"] 3 "\ Format a macro reference according to the value of the configuration variable makefile-use-curly-braces-for-macros-p ."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias makefile-browser-get-state-for-line #[(n) " SH‡" [makefile-browser-selection-vector n] 2] makefile-browser-set-state-for-line #[(n to-state) " S\nI‡" [makefile-browser-selection-vector n to-state] 3] makefile-browser-toggle-state-for-line #[(n) "À  !?\"‡" [makefile-browser-set-state-for-line n makefile-browser-get-state-for-line] 4] makefile-beginning-of-line-point #[nil "ŠÀyˆ`)‡" [0] 1] makefile-end-of-line-point #[nil "ŠÀˆ`)‡" [nil] 1] makefile-last-line-p #[nil "À dU‡" [makefile-end-of-line-point] 2] makefile-first-line-p #[nil "À eU‡" [makefile-beginning-of-line-point] 2]] 3) emacs-19.22/lisp/makeinfo.elc100666 13437 1 7601 5422200277 14474 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Sun Jul 18 03:50:22 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/makeinfo.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote 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 (quote 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'.") (defalias 'makeinfo-region #[(region-beginning region-end) "À‰‰ÄÅ ÆÇÈÅ \"†Å GO!ÉP\nŠŒ~ˆebˆŠËyˆ`) ÍÎ Ï#ƒ=ДЕ{‚AÒÓ!ˆebˆÔ Ï#Æyˆ`ƒpÔÀÏ#Æyˆ`ƒp×\n^ \nÀ‰%ˆ‚ebˆÔÙ Ï#ˆÆ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 texinfo-start-of-header texinfo-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 "\ 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'." "r"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias makeinfo-compile #[(command error-message parse-errors) "À \nà ?…\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] 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]] 3) (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 "\ Make Info file from current buffer. Use the \\[next-error] command to move to the next error (if there are errors)." 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 "\ 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." "P"]) (provide (quote makeinfo)) emacs-19.22/lisp/makesum.elc100666 13437 1 2766 5416171246 14362 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:33:58 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/makesum.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'make-command-summary #[nil "ÀÁ!ˆÂ‹ˆÃŠ qˆÇ ˆÈÉ!ˆ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 "\ Make a summary of current key bindings in the buffer *Summary*. Previous contents of that buffer are killed first." nil]) (defalias (quote double-column) #[(start end) "À‰‰‰‰d ZÈ \"‰ÊX„j TË¥ bˆŠyˆ WƒNT`ŠÀˆ`){‰ B`Êyˆ`|ˆ‚+) Ÿ‰ƒjÀˆÌjˆ @cˆÊyˆ A‰„Vd\nZb.‡" [nil end from-end nlines lines line cnt half count-lines start 1 2 41] 8 nil "r"]) emacs-19.22/lisp/map-ynp.elc100666 12062 1 10305 5470367025 14121 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 11 02:47:33 1993 ;;; from file /home/fsf/rms/e19/lisp/map-ynp.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defalias 'map-y-or-n-p #[(prompter actor list &optional help action-alist no-cursor-in-echo-area) "ƒÁÂÃ#ÄP‚ÅÇÈÉÊ\" \"B ÍÏÏÏÏÏσ=9„Y×!„YØ!„Y:ƒ]@Ù=ƒ]Ú‚^ÛÝŽ;ƒrÙßàáEE ƒi!‰;ƒTÏ\"#?$åæçè)!!$ˆê )åëçè)!!ì!%ˆí è!\"‰î=ƒÈtð=ƒÝ1!ˆT‚rò=„ró=ƒý1!ˆTô‰‚tõ=ƒö\"ÙÏ÷ÜøDEøDF‰‚tù=ƒUú!!ƒ71!ˆT ƒrú!!ƒ71!ˆT‚7û=ƒÐüý;ƒj;@‚kþ;ƒw;A@‚xÿ;ƒ†@;8‚‰ABC!àDB!‰BC&ÁEF#…®FàGB!#R+!‘ˆÙÏ÷ÜøDEøDF‰‚tH!ƒÿÍH!ƒëT‚rÙÏ÷ÜøDEøDF‰‚t:ƒ'@I=ƒ'ÙÏ÷ÜøDEøDF‰‚tåJçè)!!\"ˆK ˆLM!ˆÙÏ÷ÜøDEøDF‰‚tú!ƒr1!ˆT‚r)åÅ!ˆ.\n‡" [action-alist mapconcat #[(elt) "ÀÁ\n@!!‡" [key-description char-to-string elt] 3] ", " " " "" user-keys keymap append mapcar #[(elt) "@ÁA@!B‡" [elt vector] 3] query-replace-map map 0 actions nil 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 ((byte-code "ƒ B‡" [delayed-switch-frame unread-command-events nil] 2)) prompter (object) format object quit-flag no-cursor-in-echo-area 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 (lambda nil) act actor skip act-and-exit (lambda nil) quit t setq quote automatic eval help "*Help*" princ "object" "objects" 2 "act on" action objects "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." vectorp switch-frame "Type %s for help." beep sit-for 1] 10 "\ 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 is eval'd to get the answer; it may be nil to ignore the object, t to act on the object without asking the user, or a form to do a more complex prompt. 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."]) emacs-19.22/lisp/medit.elc100666 13437 1 5462 5416171340 14011 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:34:56 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/medit.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote mim-mode)) (defconst medit-zap-file (byte-code "ÀÁ ÂQ‡" ["/tmp/" user-login-name ".medit.mud"] 3) "\ File name for data sent to MDL by Medit.") (defconst medit-buffer "*MEDIT*" "\ Name of buffer in which Medit accumulates data to send to MDL.") (defconst medit-save-files t "\ If non-nil, Medit offers to save files on return to MDL.") (defalias 'medit-save-define #[nil "ŠÀ ˆ`ÂÃ!ˆÄ `#ˆ bˆÆ Lj`{!*‡" [beginning-of-DEFINE start forward-mim-object 1 append-to-buffer medit-buffer message nil] 4 "\ Mark the previous or surrounding toplevel object to be sent back to MDL." nil]) (defalias 'medit-save-region #[(start end) "À \n #ˆÄÅ!‡" [append-to-buffer medit-buffer start end message "Current region saved for MDL."] 4 "\ Mark the current region to be sent to back to MDL." "r"]) (defalias 'medit-save-buffer #[nil "À ed#ˆÂÃ!‡" [append-to-buffer medit-buffer message "Current buffer saved for MDL."] 4 "\ Mark the current buffer to be sent back to MDL." nil]) (defalias 'medit-zap-define-to-mdl #[nil "À ˆÁ ‡" [medit-save-define medit-goto-mdl] 1 "\ Return to MDL with surrounding or previous toplevel MDL object." nil]) (defalias 'medit-zap-region-mdl #[(start end) "À \n\"ˆÃ ‡" [medit-save-region start end medit-goto-mdl] 3 "\ Return to MDL with current region." nil]) (defalias 'medit-zap-buffer #[nil "À ˆÁ ‡" [medit-save-buffer medit-goto-mdl] 1 "\ Return to MDL with current buffer." nil]) (defalias 'medit-goto-mdl #[nil "À !‰ƒ Š\nqˆÃ\n!ƒÄed #ˆÆÇ!ˆÈ ˆ) ƒ(Ê ˆË )‡" [get-buffer medit-buffer buffer buffer-modified-p write-region medit-zap-file set-buffer-modified-p nil erase-buffer medit-save-files save-some-buffers suspend-emacs] 5 "\ Return from Emacs to superior MDL, sending saved code. Optionally, offers to save changed files." nil]) (byte-code "À !Ä ÅÆ#ˆÄ ÇÈ#ˆÄ ÉÊ#ˆÄ ËÌ#ˆÀ‡" [nil medit-mode-map copy-keymap mim-mode-map define-key "z" medit-save-define "" medit-save-buffer "z" medit-goto-mdl "s" medit-zap-buffer] 4) (defconst medit-mode-hook (byte-code "ÀÁ!… ‡" [boundp mim-mode-hook] 2) "\ ") (byte-code "À‡" [(lambda nil (medit-mode)) mim-mode-hook nil] 1) (defalias 'medit-mode #[(&optional state) "À !ˆÂÃ!ˆÄƉ‡" [use-local-map medit-mode-map run-hooks medit-mode-hook medit-mode major-mode "Medit" mode-name] 2 "\ Major mode for editing text and returning it to a superior MDL. Like Mim mode, plus these special commands: \\{medit-mode-map}" nil]) (mim-mode) emacs-19.22/lisp/meese.elc100666 13437 1 1435 5416171342 14003 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:34:58 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/meese.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÁ >„Á BÀ‡" [defalias protect-innocence-hook #[nil "À !š…)ÃÄ!?…)Å ˆÆ !ÇPÈ Ê ˆË Ì\"ˆ)ÍÀ !!‡" [file-name-nondirectory buffer-file-name "sex.6" y-or-n-p "Are you over 18? " clear-visited-file-modtime file-name-directory "celibacy.1" nil buffer-read-only erase-buffer insert-file-contents t rename-buffer] 3] find-file-hooks] 3) emacs-19.22/lisp/menu-bar.elc100666 12120 1 15720 5474621760 14311 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:05:49 1993 ;;; from file /home/fsf/rms/e19/lisp/menu-bar.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "À Â\"„à ÄÅÆ!#ˆÇÈ!„ÅÉ!Ê à ÌÉB#ˆÇÍ!„1ÅÎ! à ÏÎ B#ˆÇÐ!„EÅÑ!à ÒÑB#ˆÃÓÔ#ˆÃÕÖ#ˆÃ×Ø#ˆÃÙÚ#ˆÃÛÜ#ˆÃÝÞ#ˆÃßà#ˆÃáâ#ˆÃãä#ˆÃåæ#ˆÃçè#ˆÃ éê#ˆÃ ëì#ˆÃ íî#ˆÃ ïð#ˆÃ ñò#ˆÃ óô#ˆÃ õö#ˆÃ ÷ø#ˆÃ ùú#ˆÃ ûü#ˆÃ ýþ#ˆÃ ÿ@#ˆABCD#ˆAECD#ˆAFCD#ˆAGCH#ˆAICD#ˆAJCK#ˆLMNOPQ%ˆÃRS#ˆÃTU#ˆÃVW#ˆÃXY#ˆÃZ[#ˆÃ\\]#ˆÃ^_#ˆÃ`a#ˆÃbc#ˆÃde#‡" [lookup-key global-map [menu-bar] define-key [menu-bar] make-sparse-keymap "menu-bar" boundp menu-bar-help-menu "Help" (help) menu-bar-final-items [menu-bar help] menu-bar-edit-menu "Edit" [menu-bar edit] menu-bar-file-menu "File" [menu-bar file] [exit-emacs] ("Exit Emacs" . save-buffers-kill-emacs) [kill-buffer] ("Kill Buffer" . kill-this-buffer) [delete-frame] ("Delete Frame" . delete-frame) [bookmark] ("Bookmarks..." . menu-bar-bookmark-map) [print-buffer] ("Print Buffer" . print-buffer) [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) [new-frame] ("New Frame" . new-frame) [spell] ("Spell..." . ispell-menu-map) [fill] ("Fill" . fill-region) [clear] ("Clear" . delete-region) [re-search-back] ("Regexp Search Backwards" . re-search-backward) [search-back] ("Search Backwards" . search-backward) [re-search-fwd] ("Regexp Search" . re-search-forward) [search-fwd] ("Search" . search-forward) [choose-next-paste] ("Choose Next Paste" . mouse-menu-choose-yank) [paste] ("Paste" . yank) [copy] ("Copy" . kill-ring-save) [cut] ("Cut" . kill-region) [undo] ("Undo" . undo) put fill-region menu-enable mark-active kill-region kill-ring-save yank (x-selection-exists-p) delete-region undo (if (eq last-command (quote undo)) pending-undo-list (consp buffer-undo-list)) autoload ispell-menu-map "ispell" nil t keymap [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] ("Info" . info) [emacs-news] ("Emacs News" . view-emacs-news)] 6) (defalias 'kill-this-buffer #[nil "Àp!‡" [kill-buffer] 2 "\ Kills the current buffer." nil]) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#ˆÃÇÅÈ#ˆÃÉÅÊ#ˆÃËÅÌ#ˆÃÍÅÎ#‡" [defalias kill-this-buffer-enabled-p #[nil "ÀÁ \nƒÄÅÆ\n@!\"„ T\nA‰„ ÇV*‡" [0 buffer-list buffers count string-match "^ " buffer-name 1] 5] put save-buffer menu-enable (buffer-modified-p) 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 (let ((frames (frame-list)) (count 0)) (while frames (if (cdr (assq (quote visibility) (frame-parameters (car frames)))) (setq count (1+ count))) (setq frames (cdr frames))) (> count 1)) kill-this-buffer (kill-this-buffer-enabled-p) advertised-undo (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))] 4) (defvar yank-menu-length 100 "\ *Maximum length of an item in the menu for \\[mouse-menu-choose-yank].") (defalias 'mouse-menu-choose-yank #[(event) "ÀÂà \"ÆÈÉ BD\"‰\n…(Ë\n!ˆtƒ%ÌÍ!‚(ÎÀ!+‡" [0 count mapcar #[(string) "G Vƒ  O B T‡" [string yank-menu-length 0 count] 3] kill-ring menu x-popup-menu event "Yank Menu" "Choose Next Yank" arg rotate-yank-pointer message "The next yank will insert the selected text." current-kill] 6 "\ Pop up a menu of the kill-ring for selection with the mouse. The kill-ring-yank-pointer is moved to the selected element. A subsequent \\[yank] yanks the choice just selected." "e"]) (byte-code "ÀÁÂÃ#ˆÄ ÆÇ#‡" [put mouse-menu-choose-yank menu-enable kill-ring define-key global-map [menu-bar buffer] ("Buffers" . mouse-menu-bar-buffers)] 4) (defvar complex-buffers-menu-p nil "\ *Non-nil says, offer a choice of actions after you pick a buffer. This applies to the Buffers menu from the menu bar.") (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.") (byte-code "ÀÁ!„‡" [boundp list-buffers-directory nil] 2) (defalias 'mouse-menu-bar-buffers #[(event) "À Á ¨ƒ ÅVƒ G Vƒ ›Á¡ˆÆ ljÁ \n‰ ƒNÌ @!ÇHÍ=„E\nÌ @!G]\n A‰ „. ‰ ƒÇ @ÏÐÌ!\"„¦Ñ‰Ò\n\"Ì!Ó!ƒyÔ‚zÕŠqˆƒˆ×‚‰Õ)Ø!†Šqˆ)†Ú%BBƒ½@@G Vƒ½@@G ) A‰ „UŸÛ Ü¥ÝZÇ]Í\"ÞPßBC¤,B‰Cà Aƒñáâãà \"B\nBä\nBå&<ƒ&‚çè B\n\"&<…&‰&A@)‰)@)*+ì+!ƒ6í+!ˆî+!ˆï+!‚Š+ß=ƒBß ‚Š+…Š0ƒzå&<ƒX&‚\\ñè Bò\"‰3ô=ƒqŠ+qˆô )‚v3+!)‚Šõ*!ƒ†ö*!ˆ÷+!,‡" [buffer-list nil menu buffers buffers-menu-max-size 1 "Select Buffer" 0 head maxlen 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 "" make-string 2 8 "List All Buffers" list-buffers frame-list "Select Frame" mapcar #[(frame) "ÀÁ\n!žA\nB‡" [name frame-parameters frame] 3] "Buffer and Frame Menu" x-popup-menu event (0 0) selected-frame position window buf framep make-frame-visible raise-frame select-frame complex-buffers-menu-p (0 0) ("Buffer Action" ("" ("Save Buffer" . save-buffer) ("Kill Buffer" . kill-buffer) ("Select Buffer" . switch-to-buffer))) action save-buffer windowp select-window switch-to-buffer] 9 "\ 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." "e"]) (defalias 'menu-bar-mode #[(flag) "ƒÁ! ž‰ƒ A‚Å)ÅU?„&?‚/§?†/ÅY ž‰:ƒLƒFÈ‚GÅ¡ˆ‚[ƒVÈ‚WÅB B)É ‰\n…Ë\n@ƒrÈ‚sÅBC\"ˆ\nA‰\n„dÌ*‡" [flag prefix-numeric-value menu-bar-lines default-frame-alist assq 0 menu-bar-mode parameter 1 frame-list frames modify-frame-parameters nil] 5 "\ 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." "P"]) (byte-code "ƒÁÂ!ˆÃÄ!‡" [window-system menu-bar-mode t provide menu-bar] 2) emacs-19.22/lisp/metamail.elc100666 13437 1 3467 5433753575 14522 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Mon Aug 16 14:52:45 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/metamail.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (defvar metamail-program-name "metamail" "\ *Metamail program name.") (defvar metamail-environment (quote ("KEYHEADS=*")) "\ *Environment variables passed to `metamail'. It must ba a list of strings that have the format ENVVARNAME=VALUE.") (defvar metamail-switches (quote ("-m" "emacs" "-x" "-d" "-z")) "\ *Switches for `metamail' program. -z is required to remove zap file.") (defalias 'metamail-buffer #[(&optional buffer nodisplay) "Àed \n$‡" [metamail-region buffer nodisplay] 5 "\ 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." nil]) (defalias 'metamail-region #[(beg end &optional buffer nodisplay) "pÀÁÂ!ŠÆ ÀÉ%ˆ\nƒ\nqˆÀ p=ƒ-|ˆ‚1ed|ˆË  \" ÎÏÀÑ?Ë 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 "\ 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." "r"]) (provide (quote metamail)) emacs-19.22/lisp/mh-e.elc100666 13437 1 200654 5431313162 13572 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 8 20:12:33 1993 ;;; from file /home/fsf/rms/e19/lisp/mh-e.el ;;; emacs version 19.17.7. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÂć" ["Time-stamp: <93/05/30 18:37:43 gildea>" mh-e-time-stamp "$Header: /home/fsf/rms/e19/lisp/RCS/mh-e.el,v 1.16 1993/08/09 00:08:55 rms Exp $" mh-e-RCS-id nil] 1) (defvar mh-redist-full-contents nil "\ Non-nil if the `dist' command needs whole letter for redistribution. This is the case when `send' is compiled with the BERK option.") (defvar mh-folder-mode-hook nil "\ Invoked in `mh-folder mode' on a new folder.") (defvar mh-letter-mode-hook nil "\ Invoked in `mh-letter-mode' on a new letter.") (defvar mh-compose-letter-function nil "\ Invoked in `mh-compose-and-send-mail' on a draft letter. 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-inc-folder-hook nil "\ Invoked after incorporating mail into a folder with \\[mh-inc-folder].") (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 quitting mh-e by \\[mh-quit]. See also mh-before-quit-hook") (defvar mh-ins-string nil "\ Temporarily set by `mh-insert-prefix' prior to running `mh-yank-hooks'.") (defvar mh-yank-hooks (quote (lambda nil (save-excursion (goto-char (point)) (or (bolp) (forward-line 1)) (while (< (point) (mark t)) (insert mh-ins-string) (forward-line 1))))) "\ Hook to run citation function. Expects POINT and MARK to be set to the region to cite.") (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 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.") (defvar mh-lpr-command-format "lpr -p -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 message text is piped to this command.") (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-summary-height 4 "\ *Number of lines in summary window (including the mode line).") (defvar mh-recenter-summary-p nil "\ *Recenter summary window when the show window is toggled off if non-nil.") (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 in an outgoing letter.") (defvar mh-do-not-confirm nil "\ *Non-nil means do not prompt for confirmation before some commands. Only affects certain innocuous commands.") (defvar mh-bury-show-buffer t "\ *Non-nil means that the displayed show buffer for a folder is buried.") (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-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\", or \"cc\".") (defvar mh-recursive-folders nil "\ *If non-nil, then commands which operate on folders do so recursively.") (defvar mh-unshar-default-directory "" "\ *Default for directory name prompted for by mh-unshar-msg.") (defvar mh-signature-file-name "~/.signature" "\ *Name of file containing the user's signature. Inserted into message by \\\\[mh-insert-signature].") (defvar mh-cmd-note 4 "\ Offset to insert notation.") (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-good-msg-regexp "^....[^D^]" "\ Regexp specifying 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-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 mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%" "\ Regexp matching flagged scan lines. Matches lines marked as deleted, refiled, in a sequence, or the cur message.") (defvar mh-cur-scan-msg-regexp "^....\\+" "\ Regexp matching scan line for the cur message.") (defvar mh-show-buffer-mode-line-buffer-id "{%%b} %s/%d" "\ Format string to produce `mode-line-buffer-id' for show buffers. First argument is folder name. Second is message number.") (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.") (defvar mh-invisible-headers "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^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-rejected-letter-start (concat "^ ----- Unsent message follows -----$" "\\|^------- Unsent Draft$" "\\|^ --- The unsent message follows ---$") "\ 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-to-field-choices (quote ((116 . "To:") (115 . "Subject:") (99 . "Cc:") (98 . "Bcc:") (102 . "Fcc:"))) "\ A-list of (character . field name) strings for mh-to-field.") (defvar mh-user-path "" "\ User's mail folder.") (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-letter-mode-map (copy-keymap text-mode-map) "\ Keymap for composing mail.") (defvar mh-pick-mode-map (make-sparse-keymap) "\ Keymap for searching folder.") (defvar mh-searching-folder nil "\ Folder this pick is searching.") (defvar mh-letter-mode-syntax-table nil "\ Syntax table used while in mh-e letter mode.") (byte-code "„Á\n!Ã!ˆÄÅÆ#ˆÁ‡" [mh-letter-mode-syntax-table make-syntax-table text-mode-syntax-table set-syntax-table modify-syntax-entry 37 "."] 4) (defvar mh-folder-list nil "\ List of folder names for completion.") (defvar mh-draft-folder nil "\ Name of folder containing draft messages. NIL means do not use draft folder.") (defvar mh-unseen-seq nil "\ Name of the unseen sequence.") (defvar mh-previous-window-config nil "\ Window configuration before mh-e command.") (defvar mh-previous-seq nil "\ Name of the sequence to which a message was last added.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias mh-push (macro . #[(v l) "À  EE‡" [setq l cons v] 5]) mh-when (macro . #[(pred &rest body) "À \nBD‡" [cond pred body] 3]) with-mh-folder-updating (macro . #[(save-modification-flag-p &rest body) "@ÁÂÃÄÅ\"ƒÇ‚ÈEE‡" [save-modification-flag-p let ((folder-updating-mod-flag (buffer-modified-p))) prog1 append (let ((buffer-read-only nil) (buffer-file-name nil))) body (mh-set-folder-modified-p folder-updating-mod-flag) (mh-set-folder-modified-p nil)] 6]) mh-mapc #[(func list) "… @!ˆA‰„‡" [list func nil] 3]] 3) (defalias 'mh-rmail #[(&optional arg) "À ˆ ƒ ÂÃ!‡Ä ‡" [mh-find-path arg call-interactively mh-visit-folder mh-inc-folder] 2 "\ Inc(orporate) new mail (no arg) or scan a MH mail box (arg given). This front end uses the MH mail system, which uses different conventions from the usual mail system." "P"]) (defalias 'mh-smail #[nil "À ˆÁÂ!‡" [mh-find-path call-interactively mh-send] 2 "\ Compose and send mail with the MH mail system." nil]) (defalias 'mh-smail-other-window #[nil "À ˆÁÂ!‡" [mh-find-path call-interactively mh-send-other-window] 2 "\ Compose and send mail in other window with the MH mail system." nil]) (defalias 'mh-burst-digest #[nil "ÀÁ!à !ˆÅÁ!ˆÆÇ!ˆÈÉ \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" mh-scan-folder format "%d-last" mh-first-msg-num "Bursting digest...done"] 5 "\ Burst apart the current message, which should be a digest. The message is replaced by its table of contents and the letters from the digest are inserted into the folder after that message." nil]) (defalias 'mh-copy-msg #[(prefix-provided msg-or-seq dest) "ÀÁ\nÃÄ &ˆƒÈ\nÉ\n#‡Ë\nÉ\n#‡" [mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest prefix-provided mh-notate-seq 67 mh-cmd-note mh-notate] 7 "\ Copy 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." (list current-prefix-arg (if current-prefix-arg (mh-read-seq-default "Copy" t) (mh-get-msg-num t)) (mh-prompt-for-folder "Copy to" "" t))]) (defalias 'mh-delete-msg #[(msg-or-seq) "§ƒ Á!ˆ‚ÂÁ\"ˆÃ ‡" [msg-or-seq mh-delete-a-msg mh-map-to-seq-msgs mh-next-msg] 3 "\ 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." (list (if current-prefix-arg (mh-read-seq-default "Delete" t) (mh-get-msg-num t)))]) (defalias 'mh-delete-msg-no-motion #[(msg-or-seq) "§ƒ Á!‡ÂÁ\"‡" [msg-or-seq mh-delete-a-msg mh-map-to-seq-msgs] 3 "\ 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." (list (if current-prefix-arg (mh-read-seq-default "Delete" t) (mh-get-msg-num t)))]) (defalias 'mh-delete-msg-from-seq #[(prefix-provided msg-or-seq &optional from-seq) "ƒÁ\n!‡Ã\n \"‡" [prefix-provided mh-remove-seq msg-or-seq mh-remove-msg-from-seq from-seq] 3 "\ Delete MESSAGE (default: displayed message) from SEQUENCE. If optional prefix argument provided, then delete all messages from a sequence." (byte-code "‰‰ƒÂÃÄ\"‚ÅÄ! ?…ÂÆÄ\"E)‡" [current-prefix-arg argp mh-read-seq-default "Delete" t mh-get-msg-num "Delete from"] 6)]) (defalias 'mh-edit-again #[(msg) "  ƒ& šƒ&ÅÆÇ!!É\"ˆÊËÌ\"!ˆÍ ‚.ÎÏÇ!Ð#Ò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 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Delivery-Date:" set-buffer-modified-p mh-compose-and-send-mail ""] 11 "\ Clean-up a draft or a message previously sent and make it resendable." (list (mh-get-msg-num t))]) (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 "\ Process outstanding delete and refile requests." nil]) (defalias 'mh-extract-rejected-mail #[(msg) "Á ÂÃÄ !Æ# ebˆÊ ÆÌ#ƒ,Íuˆe`|ˆÎeÏÆ#ˆ‚0ÐÑ!ˆ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 1 mh-clean-msg-header "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Return-Path:" message "Does not appear to be a rejected letter." set-buffer-modified-p mh-compose-and-send-mail "" mh-get-field "To" "From" "cc"] 11 "\ Extract a letter returned by the mail system and make it resendable. Default is the displayed message." (list (mh-get-msg-num t))]) (defalias 'mh-first-msg #[nil "eb‡" [] 1 "\ Move to the first message." nil]) (defalias 'mh-forward #[(prefix-provided msg-or-seq to cc) " ÄÅ\"È!ƒÉÊ!ƒ7ËÌÍ$ˆÏÐÑ#ÒÓÕ$ˆ×Ø!ˆ‚=ÏÐØ#ebˆÚÛ!ˆÜyˆ`d}ˆŠÝÞ!)àá\"\"ŠÝã!)$\"ƒpå\"SO~ˆŠÒãæç$#\"ˆ)è ˆ)ƒ“êë!ìÑ#ˆ‚šêìÑ#ˆíÐ .ï &\n.‡" [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" msg-or-seq mh-read-draft "" t mh-insert-fields "To:" to "Cc:" cc set-buffer-modified-p nil draft re-search-forward "^------- Forwarded Message" -1 mh-get-field "From:" subject string-match "<" trim "Subject:" forw-subject 0 format "[%s: %s]" delete-other-windows prefix-provided mh-add-msgs-to-seq mh-seq-to-msgs forwarded mh-compose-and-send-mail mh-note-forw "Forwarded:"] 11 "\ Forward MESSAGE(s) (default: displayed message). If optional prefix argument provided, then prompt for the message sequence." (list current-prefix-arg (if current-prefix-arg (mh-read-seq-default "Forward" t) (mh-get-msg-num t)) (read-string "To: ") (read-string "Cc: "))]) (defalias 'mh-goto-msg #[(number &optional no-error-if-no-message dont-show) "ÀÁ!` !‰ƒ U„Iƒ* Wƒ*Ç ÁÈ#„Iƒ> Vƒ>É ÁÈ#„IdbˆÉ ÁÈ#ƒYÊyˆ „UÌ !ˆÈ‚g bˆ „fÎÏ \"ˆÁ+‡" [mh-get-msg-num nil mh-msg-search-pat number msg-pattern starting-place cur-msg re-search-forward t re-search-backward 0 dont-show mh-maybe-show no-error-if-no-message error "No message %d"] 5 "\ Position the cursor at message NUMBER. Non-nil second argument means do not signal an error if message does not exist. Non-nil third argument means not to show the message. Return non-nil if cursor is at message." "NGoto message: "]) (defalias 'mh-inc-folder #[(&optional maildrop-name) "À \n„&ÃÄ!„ÅÄ!ˆ ‚&pÃÄ!=„&ÇÄ!ˆ )È\n!ˆÉÊ!‡" [current-window-configuration config maildrop-name get-buffer "+inbox" mh-make-folder mh-previous-window-config switch-to-buffer mh-get-new-mail run-hooks mh-inc-folder-hook] 3 "\ Inc(orporate) new mail into +inbox. Optional prefix argument specifies an alternate maildrop from the default. If this is given, incorporate mail into the current folder, rather than +inbox. Run `mh-inc-folder-hook' after incorporating new mail." (list (if current-prefix-arg (expand-file-name (read-file-name "inc mail from file: " mh-user-path))))]) (defalias 'mh-kill-folder #[nil "„ ÁÂà \"!ƒ6 ÆÇ!ˆÈÉ \"ˆÊ !ˆËÌ \"ˆÆÍ!ˆÎ!ƒ1Ð!ˆÐ !)‡ËÑ!‡" [mh-do-not-confirm yes-or-no-p format "Remove folder %s? " mh-current-folder folder mh-set-folder-modified-p t mh-exec-cmd-daemon "rmf" mh-remove-folder-from-folder-list message "Folder %s removed" nil get-buffer mh-show-buffer kill-buffer "Folder not removed"] 4 "\ Remove the current folder." nil]) (defalias 'mh-last-msg #[nil "dbˆo?…ÀÁ!…Âyˆ‚‡" [looking-at "^$" -1] 2 "\ Move to the last message." nil]) (defalias 'mh-list-folders #[nil "ÀŠÁÀ!ˆÂ ˆÃÄ!ˆÅÆǃɂÊ#ˆebˆÃË!)‘‡" [" *mh-temp*" switch-to-buffer erase-buffer message "Listing folders..." mh-exec-cmd-output "folders" t mh-recursive-folders "-recurse" "-norecurse" "Listing folders...done"] 5 "\ List mail folders." nil]) (defalias 'mh-msg-is-in-seq #[(msg) "ÀÁ\nÃÄÅÆ\n!!Ç##‡" [message "Message %d is in sequences: %s" msg mapconcat concat mh-list-to-string mh-seq-containing-msg " "] 8 "\ Display the sequences that contain MESSAGE (default: displayed message)." (list (mh-get-msg-num t))]) (defalias 'mh-narrow-to-seq #[(seq) "dÁ ÉÆ!ƒ-È\"ˆd}ˆÉÊ!!ˆËÃ!ˆ‰ ‚4ÍÎÊ!\"*Ï\n!ˆ*‡" [eob buffer-modified-p folder-updating-mod-flag nil buffer-file-name buffer-read-only mh-seq-to-msgs seq mh-copy-seq-to-point mh-make-folder-mode-line symbol-name mh-recenter mh-narrowed-to-seq error "No messages in sequence `%s'" mh-set-folder-modified-p] 4 "\ Restrict display of this folder to just messages in a sequence. Reads which sequence. Use \\[mh-widen] to undo this command." (list (mh-read-seq "Narrow to" t))]) (defalias 'mh-next-undeleted-msg #[(&optional arg) "À !yˆÂÄ ÆÇ $ƒÇyˆÈ ‡ÉyˆÊ !…$Ì !‡" [prefix-numeric-value arg forward mh-next-direction re-search-forward mh-good-msg-regexp nil 0 mh-maybe-show -1 get-buffer mh-show-buffer delete-windows-on] 5 "\ Move to next undeleted message in window." "P"]) (defalias 'mh-pack-folder #[(range) "À !ˆÂ ˆÃÄ!‡" [mh-pack-folder-1 range mh-goto-cur-msg message "Packing folder...done"] 2 "\ 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." (list (if current-prefix-arg (mh-read-msg-range "Range to scan after packing [all]? ") "all"))]) (defalias 'mh-pipe-msg #[(prefix-provided command) "ŠÀÁÂ! \"ˆebˆ „ÅÆ!ˆÇ`dÉ$)‡" [mh-display-msg mh-get-msg-num t mh-current-folder prefix-provided search-forward "\n\n" shell-command-on-region command nil] 5 "\ Pipe the current message through the given shell COMMAND. If optional prefix argument is provided, send the entire message. Otherwise just send the message's body." (list current-prefix-arg (read-string "Shell command on message: "))]) (defalias 'mh-refile-msg #[(prefix-provided msg-or-seq dest) "À B ƒÄÅ #ˆ‚Å \"ˆÇ ‡" [refile dest mh-last-destination prefix-provided mh-map-to-seq-msgs mh-refile-a-msg msg-or-seq mh-next-msg] 4 "\ Refile MESSAGE(s) (default: displayed message) in FOLDER. If optional prefix argument provided, then prompt for message sequence." (list current-prefix-arg (if current-prefix-arg (mh-read-seq-default "Refile" t) (mh-get-msg-num t)) (intern (mh-prompt-for-folder "Destination" (if (eq (quote refile) (car mh-last-destination)) (symbol-name (cdr mh-last-destination)) "") t)))]) (defalias 'mh-refile-or-write-again #[(msg) "„ÁÂ!ˆ@Ã=ƒÄ A\"ˆÆÇA\"ˆ‚*È A\"ˆÆÉA\"ˆÊ ‡" [mh-last-destination error "No previous refile or write" refile mh-refile-a-msg msg message "Destination folder: %s" mh-write-msg-to-file "Destination: %s" mh-next-msg] 3 "\ 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." (list (mh-get-msg-num t))]) (defalias 'mh-reply #[(prefix-provided msg) "À\n† ÃÄÅÆÇ$ Ê    ÏÐ!ˆÑš„,ÒšƒFÓÔÕÖ×ØÚÛ…@ÝÞD&\nˆ‚ŽßšƒgÓÔÕÖ×Øàß…aÝÞD&\nˆ‚Žáš„uÛšƒŽÓÔÕÖ×ØàÛÚâ…‹ÝÞD& ˆãäåä&\"Ç#'è ˆéÆ!ˆêë!êì!êí!./0ebˆñò!ˆ„Âó \"ˆôõÇ#ˆÏö!ˆ÷'Ò 0/.8ù &\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..." "from" "" apply mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder" msg "-nocc" "all" prefix-provided "-filter" "mhl.reply" "to" "-cc" "cc" "me" mh-read-draft "reply" expand-file-name mh-user-path draft delete-other-windows set-buffer-modified-p mh-get-field "To:" "Subject:" "Cc:" cc subject to mh-goto-header-end 1 mh-display-msg mh-add-msgs-to-seq answered "Composing a reply...done" mh-compose-and-send-mail mh-note-repl "Replied:"] 14 "\ Reply to a MESSAGE (default: displayed message). If optional prefix argument provided, then include the message in the reply using filter mhl.reply in your MH directory." (list current-prefix-arg (mh-get-msg-num t))]) (defalias 'mh-quit #[nil "ÀÁ!ˆ\nƒ Ã\n!ˆÀÄ!‡" [run-hooks mh-before-quit-hook mh-previous-window-config set-window-configuration mh-quit-hook] 2 "\ Quit mh-e. Start by running mh-before-quit-hook. Restore the previous window configuration, if one exists. Finish by running mh-quit-hook." nil]) (defalias 'mh-page-digest #[nil "ŠÀ ˆÁÂ!ˆÃÅÆÃÇ#ƒÅÈÃÇ#„\"ÉÊ!ˆËÌ!ˆ)ÍÆÃÇ#ˆÎyˆÏÂ!ˆÉÊ!)‡" [mh-show-message-in-other-window move-to-window-line 0 nil case-fold-search search-forward "\n\n" t "From:" other-window -1 error "No more messages" search-backward 2 mh-recenter] 4 "\ Advance displayed message to next digested message." nil]) (defalias 'mh-page-digest-backwards #[nil "ŠÀ ˆÁÂ!ˆÃÂyˆÅÆÃÇ#ƒÅÈÃÇ#„%ÉÊ!ˆËÌ!ˆ)ÅÆÃÇ#ˆÍyˆÎÂ!ˆÉÊ!)‡" [mh-show-message-in-other-window move-to-window-line 0 nil case-fold-search search-backward "\n\n" t "From:" other-window -1 error "No more messages" 2 mh-recenter] 4 "\ Back up displayed message to previous digested message." nil]) (defalias 'mh-page-msg #[(&optional arg) "À !‡" [scroll-other-window arg] 2 "\ Page the displayed message forwards. Scrolls ARG lines or a full screen if no argument is supplied." "P"]) (defalias 'mh-previous-page #[(&optional arg) "ŠÀ ˆÁŽÂ !*‡" [mh-show-message-in-other-window ((other-window -1)) scroll-down arg] 2 "\ Page the displayed message backwards. Scrolls ARG lines or a full screen if no argument is supplied." "P"]) (defalias 'mh-previous-undeleted-msg #[(&optional arg) "ÀÂyˆÃ ÅÂ$ƒÇ ‡È !…Ê !‡" [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 "\ Move to previous undeleted message in window." "p"]) (defalias 'mh-print-msg #[(prefix-provided msg-or-seq) "ƒ ÁÂ!ˆ‚ÁÃ!ˆƒOÄÅÆÇÉ#ÊË \" ;ƒ.ÄÎ \"‚/ÏÐ!ăBÄÒ\"‚IÄÔ#\"&‚ÄÕÊË \"Ö! ;ƒhÄÎ \"‚iÏăxÄÒ\"‚ÄÔ#\"%ƒ“ÙÛ#ˆ‚ŸÜ݉‰Û&ˆƒ®Þß #ˆ‚¶áß #ˆâãä#ˆƒÇÁå!‚ÊÁæ!)‡" [prefix-provided message "Printing sequence..." "Printing message..." format "(scan -clear %s ; %s -nobell -clear %s %s) | %s" mapconcat (lambda (msg) msg) msg-or-seq " " expand-file-name "mhl" mh-lib mhl-formfile "-form %s" "" mh-msg-filenames mh-lpr-command-format "Sequence from %s" mh-current-folder "%s/%d" "%s -nobell -clear %s %s | %s" mh-msg-filename print-command mh-print-background mh-exec-cmd-daemon shell-file-name "-c" call-process nil mh-notate-seq 80 mh-cmd-note mh-notate mh-add-msgs-to-seq printed t "Printing sequence...done" "Printing message...done"] 12 "\ Print MESSAGE(s) (default: displayed message) on a line printer. If optional prefix argument provided, then prompt for the message sequence." (list current-prefix-arg (if current-prefix-arg (reverse (mh-seq-to-msgs (mh-read-seq-default "Print" t))) (mh-get-msg-num t)))]) (defalias 'mh-put-msg-in-seq #[(prefix-provided from to) " \"‡" [to mh-previous-seq mh-add-msgs-to-seq from] 3 "\ Add MESSAGE(s) (default: displayed message) to SEQUENCE. If optional prefix argument provided, then prompt for the message sequence." (list current-prefix-arg (if current-prefix-arg (mh-seq-to-msgs (mh-read-seq-default "Add messages from" t)) (mh-get-msg-num t)) (mh-read-seq-default "Add to" nil))]) (defalias 'mh-rescan-folder #[(&optional range) "À † Å\"‡" [forward mh-next-direction mh-scan-folder mh-current-folder range "all"] 3 "\ 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." (list (if current-prefix-arg (mh-read-msg-range "Range to scan [all]? ") nil))]) (defalias 'mh-redistribute #[(to cc msg) "À‹‡" [((byte-code "Á …\nÄ !Æ#ÉÊ!ˆË ͱˆÏš„)ÐͱˆÑeÒÆ#ˆÓ ˆÔÕ!ˆ ƒRÖ×ÆÊÆØÙÚÛ ÜÝ\"Û $&ˆ‚jÖ×ÆÊÆØÙßÄ \"ÜÝ\"Û $&ˆà !âãäÙå #&ˆæ!ˆÔç!*‡" [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 "send" 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))] 1 "\ 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." (list (read-string "Redist-To: ") (read-string "Redist-Cc: ") (mh-get-msg-num t))]) (defalias 'mh-write-msg-to-file #[(msg file) "À ! !Æ BŠÈÉ!qˆÊ ˆË !ˆÌed #+‡" [mh-msg-filename msg mh-expand-file-name file output-file file-name write mh-last-destination get-buffer-create " *mh-temp*" erase-buffer insert-file-contents append-to-file] 4 "\ Append MESSAGE to the end of a FILE." (list (mh-get-msg-num t) (let ((default-dir (if (eq (quote write) (car mh-last-destination)) (file-name-directory (cdr mh-last-destination)) default-directory))) (read-file-name "Save message in file: " default-dir (expand-file-name "mail.out" default-dir))))]) (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 "\ Search FOLDER for messages matching a pattern." (list (mh-prompt-for-folder "Search" mh-current-folder t))]) (defalias 'mh-send #[(to cc subject) "À  ˆÃ  $)‡" [current-window-configuration config delete-other-windows mh-send-sub to cc subject] 5 "\ Compose and send a letter. 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." "sTo: \nsCc: \nsSubject: "]) (defalias 'mh-send-other-window #[(to cc subject) "ÀÂ Æ $)‡" [t pop-up-windows mh-send-sub to cc subject current-window-configuration] 5 "\ Compose and send a letter in another window.." "sTo: \nsCc: \nsSubject: "]) (defalias 'mh-send-sub #[(to cc subject config) "ÁÂ!ÅÆ!ˆÇÈÉÊË \"!ƒÊË \"‚3ÉÊË \"!ƒ0ÊË \"‚3ÎÏ!Â#ÑÒÔÖ&ˆØÂ!ˆdbˆÅÙ!ˆÚÛ ‰&\n+‡" [mh-current-folder mh-get-msg-num nil msg-num folder message "Composing a message..." mh-read-draft "message" file-exists-p expand-file-name "components" mh-user-path mh-lib error "Can't find components file" draft mh-insert-fields "To:" to "Subject:" subject "Cc:" cc set-buffer-modified-p "Composing a message...done" mh-compose-and-send-mail "" config] 11 "\ 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."]) (defalias 'mh-show #[(&optional msg) "„ÁÂ!ÂÄÅ!ˆÆÇ !È =„É ˆ\n Ì ˆÍ \"ˆ)ÎÏ!ˆÐ TÑ U„>ÒÐ Z!ˆÔÕ!ˆ>?…QB‰‡" [msg mh-get-msg-num t mh-showing mh-set-mode-name "mh-e show" next-window minibuffer-window selected-window delete-other-windows mh-current-folder folder mh-show-message-in-other-window mh-display-msg other-window -1 window-height screen-height shrink-window mh-summary-height mh-recenter nil mh-seen-list] 3 "\ Show MESSAGE (default: displayed message). Forces a two-window display with the folder window on top (size mh-summary-height) and the show buffer below it." nil]) (defalias 'mh-sort-folder #[nil "À !ˆÂÄÅ!ˆÆÇ!ˆÈÉ \"ˆÆÊ!ˆË Ì\"‡" [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" "Sorting folder...done" mh-scan-folder "all"] 3 "\ Sort the messages in the current folder by date." nil]) (defalias 'mh-toggle-showing #[nil "ƒÁ ‡Â ‡" [mh-showing mh-set-scan-mode mh-show] 1 "\ Toggle the scanning mode/showing mode of displaying messages." nil]) (defalias 'mh-undo #[(prefix-provided msg-or-seq) "ƒÁÂà !\"ˆ‚o`ÆyˆÇ!„MÇ !„M\nË=ƒ,o„M\nÌ=ƒ<ŠÍyˆm)„M\nË=ƒG΂HÏyˆ‚Ç!„[Ç !ƒgÂÐÑ!!ˆÒ ˆ‚n bˆÓÔ!ˆ)ÁÕ\"ˆ× ?…~ØÍ!‡" [prefix-provided mh-mapc mh-undo-msg mh-seq-to-msgs 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-get-msg-num t mh-maybe-show error "Nothing to undo" #[(elt) "À !?…  \"‰‡" [mh-seq-to-msgs elt delq mh-refile-list] 3] mh-refile-list mh-outstanding-commands-p mh-set-folder-modified-p] 4 "\ Undo the 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." (list current-prefix-arg (if current-prefix-arg (mh-read-seq-default "Undo" t) (mh-get-msg-num t)))]) (defalias (quote mh-undo-msg) #[(msg) " >ƒÂ \"ÃÄÅ#ˆ‚ÆÇ\"ˆÉÊ #‡" [msg mh-delete-list delq mh-remove-msg-from-seq deleted t mh-mapc #[(dest) "À \nÃ#‡" [mh-remove-msg-from-seq msg dest t] 4] mh-refile-list mh-notate 32 mh-cmd-note] 4]) (defalias 'mh-undo-folder #[(&rest ignore) "„\nÁÂ!ƒ(ÃÃÃÇÉ \nÉ  ÍÎ!*ÏÃ!ˆ)‡ÐÑ!ˆÒÓ!‡" [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 folder-updating-mod-flag buffer-file-name buffer-read-only mh-unmark-all-headers t mh-set-folder-modified-p message "Commands not undone." sit-for 2] 3 "\ Undo all commands in current folder." nil]) (defalias 'mh-unshar-msg #[(dir) "ÀÁÂ! \"ˆÄ !‡" [mh-display-msg mh-get-msg-num t mh-current-folder mh-unshar-buffer dir] 3 "\ Unpack the shar file contained in the current message into directory DIR." (list (read-file-name "Unshar message in directory: " mh-unshar-default-directory mh-unshar-default-directory nil))]) (defalias (quote mh-unshar-buffer) #[(dir) "ebˆÀÁÂÃ#„(ÀÄÂÃ#ƒÅy„(ÀÆÂÃ#„(ÀÇÂÃ#ƒÈ !Êyˆ`ËÌ! Š qˆÈ !Ð ˆÑ!ƒXÒ Ó±ˆ‚iÔ Ó±ˆÕÖ Ã%ˆ)×Ø !Ê\"ˆÙdÚ Ã&+‡ÛÜ!‡" [re-search-forward "^#![ ]*/bin/sh" nil t "^[^a-z0-9\"]*cut here" 1 "^#" "^: " expand-file-name dir 0 get-buffer-create "*Unshar Output*" log-buffer start default-directory erase-buffer file-directory-p "cd " "\n" "mkdir " call-process "mkdir" set-window-start display-buffer call-process-region "sh" error "Cannot find start of shar."] 7]) (defalias 'mh-visit-folder #[(folder &optional range) "À  †\nÅ\"ˆ )LJ" [current-window-configuration config mh-scan-folder folder range "all" mh-previous-window-config nil] 3 "\ Visit FOLDER and display RANGE of messages. Assumes mh-e has already been initialized." (list (mh-prompt-for-folder "Visit" "+inbox" t) (mh-read-msg-range "Range [all]? "))]) (defalias 'mh-widen #[nil "ƒÁ Éed|ˆ~ˆÆ ˆ*Ç\n!ˆ)ɇ" [mh-narrowed-to-seq buffer-modified-p folder-updating-mod-flag nil buffer-file-name buffer-read-only mh-make-folder-mode-line mh-set-folder-modified-p] 2 "\ Remove restrictions from the current folder, thereby showing all messages." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"‡" [defalias mh-delete-a-msg #[(msg) "ŠÀ ÂÃ#ˆÄ !ƒÆÇ \"ˆÄ!?…0ÉÃ!ˆ \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 68 mh-cmd-note] 4] mh-refile-a-msg #[(msg destination) "ŠÀ ÂÃ#ˆÄ !ƒÆÇ \"‚gÄ!ƒ>ÉÊË  #!ƒ8ÍÎÏÃ!ÐÑÓ !&‚gÔÕ!‚gÖÃ!ˆ >„Q B Ø !>„aÙ  Ã#ˆÚ Û#)‡" [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 94 mh-cmd-note] 8] mh-display-msg #[(msg-num folder) "qˆ \n Å! \n   Ï\n!„)ÐÑ\"ˆÒ !ˆƒ7Ôp!ˆ\nš?…´Ö ˆ× ˆØÙ ˆƒq;ƒfÚÛÜÝÞ\n&ˆ‚vÚÛÜÝ\n$ˆ‚vß\n!ˆebˆ ƒŒàe  #ˆebˆ‚á\"ãäØá#ˆåyˆæå!ˆ)çØ!ˆ\nèØ!ˆé*#C‰+.‡" [folder mhl-formfile mh-clean-message-header mh-invisible-headers mh-visible-headers mh-msg-filename msg-num mh-show-buffer mh-current-folder show-buffer msg-filename visible-headers invisible-headers clean-message-header formfile file-exists-p error "Message %d does not exist" switch-to-buffer mh-bury-show-buffer bury-buffer buffer-file-name clear-visited-file-modtime unlock-buffer nil erase-buffer mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" "-form" insert-file-contents mh-clean-msg-header t case-fold-search re-search-forward "^To:\\|^From:\\|^Subject:\\|^Date:" 0 mh-recenter set-buffer-modified-p set-mark format mh-show-buffer-mode-line-buffer-id mode-line-buffer-identification] 7] mh-invalidate-show-buffer #[nil "À !…Š qˆÂ‰)‡" [get-buffer mh-show-buffer nil buffer-file-name] 2] mh-show-message-in-other-window #[nil "À !ˆ\n… Ãp!‡" [switch-to-buffer-other-window mh-show-buffer mh-bury-show-buffer bury-buffer] 2] mh-clean-msg-header #[(start invisible-headers visible-headers) "ÀŒ\nbˆÃÄÅÀ#ƒÆÇ!ˆ\n`}ˆebˆƒQ`dWƒqÉyˆÊ!ƒ=ÇyˆÊË!ƒÇyˆ‚1ÌÇ!ˆÊË!ƒÉyˆÌÇ!ˆ‚AÍÅÀ#ƒqÉyˆÌÇ!ˆÊË!ƒQÉyˆÌÇ!ˆ‚aÏ *‡" [t case-fold-search start search-forward "\n\n" nil backward-char 1 visible-headers 0 looking-at "^[ ]+" mh-delete-line re-search-forward invisible-headers unlock-buffer] 4] mh-delete-line #[(lines) "`Šyˆ`)|‡" [lines] 2] mh-read-draft #[(use initial-contents delete-contents-file) "ƒ ÃÄÅ !Æ\"ˆÇÈÉÊ \"!ˆ\n)‚aËÌ \"ÃÌ!ˆÏ ƒ=ÐÑ!ƒ9ÒÓ!ˆ‚=ÔÕ!ˆ× ˆØ ˆÙ!ƒ`š„`Û!ˆÜ!ˆ)ƒ‰Ý ÞU„wÐÈß \"!„‰á ˆÛ!ˆ\"ƒ‰Ü!ˆãä!ˆƒ”å ˆÊ ‡" [mh-draft-folder default-directory orig-default-dir pop-to-buffer find-file-noselect mh-new-draft-name t rename-buffer format "draft-%s" buffer-name 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 nil 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 erase-buffer delete-contents-file auto-save-mode 1 save-buffer] 4] mh-new-draft-name #[nil "ŠÀÁ!qˆÂ ˆÃÄÅÇ$ˆ`ÈÉ!S{)‡" [get-buffer-create " *mh-temp*" erase-buffer mh-exec-cmd-output "mhpath" nil mh-draft-folder "new" mark t] 5] mh-next-msg #[nil "Á=ƒ\nÂÃ!‡ÄÃ!‡" [mh-next-direction forward mh-next-undeleted-msg 1 mh-previous-undeleted-msg] 2] mh-set-scan-mode #[nil "À !ƒ\n !ˆÃÄ!ˆÅ…ÈÅ!‡" [get-buffer mh-show-buffer delete-windows-on mh-set-mode-name "mh-e scan" nil mh-showing mh-recenter-summary-p mh-recenter] 2] mh-maybe-show #[(&optional msg) "…Á\n!‡" [mh-showing mh-show msg] 2] mh-set-mode-name #[(mode-name-string) "ŠÂ qˆ)ÃÄ !‡" [mode-name-string mode-name other-buffer set-buffer-modified-p buffer-modified-p] 2]] 3) (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-showing nil "\ If non-nil, show the message in a separate window.") (defvar mh-next-seq-num nil "\ Index of free sequence id.") (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-seq-list nil "\ Alist of (seq . msgs) numbers.") (defvar mh-seen-list nil "\ List of displayed messages.") (defvar mh-next-direction (quote forward) "\ Direction to move to next message.") (defvar mh-narrowed-to-seq nil "\ Sequence display is narrowed to.") (defvar mh-first-msg-num nil "\ Number of first msg in buffer.") (defvar mh-last-msg-num nil "\ Number of last msg in buffer.") (byte-code "ÀÁÂ\"ˆÃÄÅÆ#‡" [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-set-mode-name "mh-e scan"] 2] put mh-folder-mode mode-class special] 4) (defalias 'mh-folder-mode #[nil "À ˆÁ\n!ˆÃÅÆ!ˆÇÈÉ ÊËÌÉ \"ÍÎÏÉ !!ÐÑÒÓÔÑÕÑÖÑ×ÑØÙÚÑÛÑÜÑÝÑ&ˆÞàá!ˆÞ\"ãä!ˆå$ãæ!ˆç&èé!‡" [kill-all-local-variables use-local-map mh-folder-mode-map mh-folder-mode major-mode mh-set-mode-name "mh-e folder" 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-next-seq-num 0 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-previous-window-config t truncate-lines auto-save-mode -1 buffer-offer-save make-local-variable write-file-hooks (mh-execute-commands) revert-buffer-function mh-undo-folder run-hooks mh-folder-mode-hook] 29 "\ Major mode for \"editing\" an MH folder scan listing. Messages can be marked for refiling and deletion. However, both actions are deferred until you request execution with \\[mh-execute-commands]. \\{mh-folder-mode-map} A prefix argument (\\[universal-argument]) to delete, refile, list, or undo applies the action to a message sequence. Variables controlling mh-e operation are (defaults in parentheses): 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-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. mh-ins-buf-prefix (\"> \") String to insert before each non-blank line of a message as it is inserted in a draft letter. The value of mh-folder-mode-hook is called when a new folder is set up."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"‡" [defalias make-local-vars #[(&rest pairs) "…Á@!ˆ@A@LˆAA‰„‡" [pairs make-variable-buffer-local nil] 3] 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] mh-regenerate-headers #[(range) "Âà \"ˆÄ ƉÉ ˆÊËÆÌÍÎÏ &ˆebˆÑÒ!ƒ2Ó!ˆ‚=ÑÕ!„=Ó!ˆÖ×!ˆØ Æ\"Ú ˆÛÜš?…U!ˆ*ÞÆ!ˆ)Âß \")‡" [mh-current-folder folder message "Scanning %s..." buffer-modified-p folder-updating-mod-flag nil buffer-file-name buffer-read-only erase-buffer mh-exec-cmd-output "scan" "-noclear" "-noheader" "-width" window-width range looking-at "scan: no messages in" keep-lines mh-valid-scan-line "scan: " mh-delete-seq-locally cur mh-read-folder-sequences mh-seq-list mh-notate-user-sequences mh-make-folder-mode-line "all" mh-partial-folder-mode-line-annotation mh-set-folder-modified-p "Scanning %s...done"] 9] mh-get-new-mail #[(maildrop-name) "`ÁÅ lj Ê ƒÌÍ  #‚#ÌÎ \"!ˆÏÇ!ˆÐdbˆ` ƒJÓÔÇ ÕÖ !×Ø Ù&ˆ‚RÓÔÇ×Ø $ˆÊ ƒaÌÚ  #‚eÌÛ \"!ˆbˆÜÝ!ƒ•Þ!ˆ bˆÊà ƒ„á‚…â ƒ ‚â#ˆ‚¾ãäÇÁ#ƒ¤åæ!ˆ‚¾çè!ˆé Á\"*ë ˆÞ!ˆì ˆí ˆÁ)\n*î!ˆ,‡" [mh-current-folder t return-value folder point-before-inc buffer-modified-p folder-updating-mod-flag nil buffer-file-name buffer-read-only message maildrop-name format "inc %s -file %s..." "inc %s..." mh-unmark-all-headers forward mh-next-direction start-of-inc mh-exec-cmd-output "inc" "-file" expand-file-name "-width" window-width "-truncate" "inc %s -file %s...done" "inc %s...done" looking-at "inc: no mail" keep-lines mh-valid-scan-line "No new mail%s%s" " in " "" re-search-forward "^inc:" error "inc error" mh-delete-seq-locally cur 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] mh-make-folder-mode-line #[(&optional annotation) "ŠÀ ˆÁÂ!Ä ˆÁÂ!Æ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 lines format "{%%b%s} %d msg%s" annotation "/%s" "" 0 "s" 1 "s (%d-%d)" " (%d)" mode-line-buffer-identification] 8] mh-unmark-all-headers #[(remove-all-flags) "ŠÀd ZÀÅ ˆ` X…A uˆgƒ.\nÇ=„4\nÈ=„4\nÉ=„4\nÊ=ƒ;ËÌ!ˆÍcˆÀyˆ‚ ,‡" [nil mh-cmd-note char last-line case-fold-search mh-first-msg remove-all-flags 68 94 37 43 delete-char 1 " "] 3] mh-goto-cur-msg #[nil "ÀÁ!@‰ƒ\"Ã\nÄÅ#ƒ\"ÆÅÇ#ˆÉÊ!ˆË\n!‚(Ì ˆÍÎ!)‡" [mh-seq-to-msgs cur cur-msg mh-goto-msg t nil mh-notate 43 mh-cmd-note mh-recenter 0 mh-maybe-show mh-last-msg message "No current message"] 5] mh-pack-folder-1 #[(range) "À !ˆÂÃ!ˆÄÅ!ˆŠÆÇÈ É$ˆ)Ê !‡" [mh-process-or-undo-commands mh-current-folder message "Packing folder..." mh-set-folder-modified-p t mh-exec-cmd-quiet " *mh-temp*" "folder" "-pack" mh-regenerate-headers range] 5] 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-invalidate-show-buffer] 2] mh-process-commands #[(folder) "ÀÁ\n\"ˆ\nqˆÃ ʼnƒ$É\n!ƒ$Ë\n\"ˆÌÍ\"ˆƒ<ÐÑÒ\n$ˆÓ!ˆÔ ÕVƒOÖ×ØÅ!†LÙC\"ˆÚ ˆÅÅÛÅ\"ÅÞß!ˆà ˆÀá\n\"*âÅ!ˆ)‡" [message "Processing deletes and refiles for %s..." folder buffer-modified-p folder-updating-mod-flag nil buffer-file-name buffer-read-only mh-seen-list mh-seq-to-msgs mh-unseen-seq mh-undefine-sequence mh-mapc #[(dest) "À !‰…ÃÄÅÆÈ !\n&ˆÉ\n!)‡" [mh-seq-to-msgs dest msgs apply mh-exec-cmd "refile" "-src" folder symbol-name mh-delete-scan-msgs] 8] mh-refile-list mh-delete-list apply mh-exec-cmd "rmm" mh-delete-scan-msgs buffer-size 0 mh-define-sequence cur mh-get-msg-num "last" 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] 5] mh-delete-scan-msgs #[(msgs) "À Â\"ŠÃ ˆ …2`dW…2ÄÅ! @šƒ,`ŠÅyˆ`)|ˆ A‰‚\nÅyˆ‚ )‡" [sort msgs < mh-first-msg mh-get-msg-num nil] 4]] 3) (defalias 'mh-set-folder-modified-p #[(flag) "À !‡" [set-buffer-modified-p flag] 2 "\ Mark current folder as modified or unmodified according to FLAG."]) (defalias (quote mh-outstanding-commands-p) #[nil "† ‡" [mh-delete-list mh-refile-list] 1]) (defvar mh-sent-from-folder nil "\ Folder of msg associated with this letter.") (defvar mh-sent-from-msg nil "\ Number of msg associated with this letter.") (defvar mh-send-args nil "\ Extra arguments 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.") (defalias 'mh-letter-mode #[nil "À ˆÁÂ!ˆÃ\nPÁÄ!ˆÃ PÁÅ!ˆÁÆ!ˆÁÇ!ˆÁÈ!ˆÁÉ!ˆÁÊ!ˆË !ˆÍÏÐ!ˆÑ!ˆÓÔÕ\"ˆÖ×!ƒSƒSÁ×!ˆØÖÙ!…f…fÁÙ!ˆØ‰‡" [kill-all-local-variables 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 use-local-map mh-letter-mode-map mh-letter-mode major-mode mh-set-mode-name "mh-e letter" set-syntax-table mh-letter-mode-syntax-table run-hooks text-mode-hook mh-letter-mode-hook boundp auto-fill-hook mh-auto-fill-for-letter auto-fill-function] 3 "\ Mode for composing letters in mh-e. When you have finished composing, type \\[mh-send-letter] to send the letter. 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-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. \\{mh-letter-mode-map}" nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias mh-auto-fill-for-letter #[nil "À ˆÁ …ŠÂyˆÃÄÅ\")‡" [do-auto-fill mh-in-header-p 0 insert-char 9 1] 3] mh-in-header-p #[nil "Š`ebˆÁÂÃÄ#ˆ`W*‡" [cur-point re-search-forward "^--------" nil t] 4]] 3) (defalias 'mh-to-field #[nil "À ˆÁ Ä\" \"AÆÉÆ\"ƒD`\nËÌxˆ`\n|ˆ) Ä\"Í=„?ŠÎÏ!ˆÐÑ!)„?Òc‚dÓc‚debˆÔÕ!ˆÏyˆÐÖ!ƒZÏyˆ‚N×Ø\"cˆÎÏ!*‡" [expand-abbrev assoc logior last-input-char 96 mh-to-field-choices t case-fold-search target mh-position-on-field eol " " nil 115 backward-char 1 looking-at "[:,]" ", " " " re-search-forward "^To:" "^[ ]" format "%s \n"] 4 "\ Move point to the end of a specified header field. The field is indicated by the previous keystroke. Create the field if it does not exist. Set the mark to point before moving." nil]) (defalias 'mh-to-fcc #[nil "ÀÁÂÃÄ#Ç ˆŠÈ ˆ ÉÊOc+‡" [6 mh-prompt-for-folder "Fcc" "" t folder last-input-char expand-abbrev mh-to-field 1 nil] 5 "\ Insert an Fcc: field in the current message. Prompt for the field name with a completion list of the current folders." nil]) (defalias 'mh-insert-signature #[nil "À !ˆÂà !‡" [insert-file-contents mh-signature-file-name set-buffer-modified-p buffer-modified-p] 2 "\ Insert the file named by mh-signature-file-name at the current point." nil]) (defalias 'mh-check-whom #[nil "À ÂÃ!ˆÄ ˆÅÆ!ˆÇÈ!ˆÉp!ˆÊ ˆËÌà #ˆÍÎ!ˆÅÏ!)‡" [buffer-file-name file-name set-buffer-modified-p t save-buffer message "Checking recipients..." switch-to-buffer-other-window "*Mail Recipients*" bury-buffer erase-buffer mh-exec-cmd-output "whom" other-window -1 "Checking recipients...done"] 4 "\ Verify recipients of the current letter." nil]) (defvar mh-searching-folder nil "\ Folder this pick is searching.") (defalias (quote mh-make-pick-template) #[nil "À ˆÁ ˆÂÃ!ˆÄÅÆÇÈɱˆÊ ˆË !ˆebˆÍ‡" [erase-buffer kill-all-local-variables make-local-variable mh-searching-folder "From: \n" "To: \n" "Cc: \n" "Date: \n" "Subject: \n" "---------\n" mh-letter-mode use-local-map mh-pick-mode-map nil] 6]) (defalias 'mh-do-pick-search #[nil "À ‰‰‰ŠÉ!ƒ(qˆÊË  #‚2Î!ˆÏÐ)ÑÒ!ˆebˆÓ!‰ƒ\\ÔÕÖ B×ØÙ¯¤#Ø‚:ÑÚ!ˆ ƒmÛ \"ˆ‚rÜ!ˆÝ ˆÞÕß T#.‡" [buffer-name mh-searching-folder nil new-buffer pattern msgs range searching-buffer pattern-buffer get-buffer format "%d-%d" mh-first-msg-num mh-last-msg-num mh-make-folder "all" t message "Searching..." mh-next-pick-field mh-seq-from-command search "pick" "-sequence" "search" "-list" "Searching...done" mh-scan-folder switch-to-buffer delete-other-windows mh-notate-seq 37 mh-cmd-note] 9 "\ Find messages that match the qualifications in the current pattern buffer. Messages are searched for in the folder named in mh-searching-folder. Put messages found in a sequence named `search'." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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].*\\):[ ]*\\([a-z0-9].*\\)$" format "--%s" 1 component 2 pat "^-*$" body 0 "\n" "-search"] 5] mh-compose-and-send-mail #[(draft send-args sent-from-folder sent-from-msg to subject cc annotate-char annotate-field config) "À !ˆÂ ˆ   \n   ÏCÑÒ!…_ÒJ…_ÒJ‰<ƒ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]] 3) (defalias 'mh-send-letter #[(&optional arg) "ÀÁ!ˆÂÃ!ˆÄ ˆÅÆ!ˆpÇ  \n  ƒTÍÎ!ˆÏ ˆƒ;ÑÒÃÓÔÕ\n&ˆ‚FÑÒÃÓÔÕ\n&ˆdbˆÖ×!ˆ qˆ‚nƒfØÒÕÙ\n%ˆ‚nØÒÕÙ\n$ˆƒŠÛÞàáâãä!ãå!#&ˆ ƒ•æç!ƒ¤è !ˆ ƒ¤é !ˆÅê!+‡" [run-hooks mh-before-send-letter-hook set-buffer-modified-p t 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-send-args mh-exec-cmd-output "send" "-watch" "-nopush" "-nodraftfolder" 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-field "To:" "Cc:" y-or-n-p "Kill draft buffer? " kill-buffer set-window-configuration "Sending...done"] 12 "\ 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." "P"]) (defalias 'mh-insert-letter #[(prefix-provided folder msg) "Œ``}ˆe šƒà !ÅÆÇÈÉ Ê !\"$ˆ ?…4Í#ˆÐ!ˆÑ!*‡" [start msg "" int-to-string mh-sent-from-msg mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" expand-file-name mh-expand-file-name folder prefix-provided mh-clean-msg-header mh-invisible-headers mh-visible-headers set-mark mh-insert-prefix-string mh-ins-buf-prefix] 8 "\ Insert a message from any folder into the current letter. Removes the message's headers using mh-invisible-headers. Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \"). If optional prefix argument provided, do not indent and do not delete headers. Leaves the mark before the letter and point after it." (list current-prefix-arg (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) ""))))]) (defalias 'mh-yank-cur-msg #[nil "ƒh ƒh`pqˆ ƒÅ!ˆqˆƒ)È É {‚M\nË=ƒ?ŠebˆÌÍ!ˆ`)d{‚M\nƒJed{‚M`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 mark-active 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 "\ 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." nil]) (defalias (quote mh-insert-prefix-string) #[(mh-ins-string) "ŠÀd!ˆebˆÁÂ!)‡" [set-mark run-hooks mh-yank-hooks] 2]) (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 "\ Kill the draft message file and the draft message buffer. Use \\[kill-buffer] if you don't want to delete the draft message file." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias mh-recenter #[(arg) "Àp!Á =… ƒ ‚Ä!‡" [get-buffer-window selected-window recenter arg (t)] 2] mh-make-seq #[(name msgs) " B‡" [name msgs] 2] mh-seq-name (macro . #[(pair) "À D‡" [car pair] 2]) mh-seq-msgs (macro . #[(pair) "À D‡" [cdr pair] 2]) mh-find-seq #[(name) "À \n\"‡" [assoc name mh-seq-list] 3]] 3) (defalias 'mh-seq-to-msgs #[(seq) "À !A‡" [mh-find-seq seq] 2 "\ Return a list of the messages in SEQUENCE."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"‡" [defalias mh-seq-containing-msg #[(msg) "Á‰ƒ @A>ƒ @@\nB A‰„\n*‡" [mh-seq-list nil seqs l msg] 3] mh-msg-to-seq #[(msg) "À !@‡" [mh-seq-containing-msg msg] 2] mh-read-seq-default #[(prompt not-empty) "À \n † #‡" [mh-read-seq prompt not-empty mh-narrowed-to-seq mh-previous-seq] 4] mh-read-seq #[(prompt not-empty &optional default) "ÀÁÂ Ä ƒÁÆ \"‚Ç$È !\"‰\nËšƒ'ÌÍÎ!!‚6\nÇšƒ2 ‚6Ï\n!Ñ!‰„OƒOÔÁÕ\"!ˆ+‡" [completing-read format "%s %s %s" prompt "sequence:" default "[%s] " "" mh-seq-names mh-seq-list input "%" mh-msg-to-seq mh-get-msg-num t intern seq mh-seq-to-msgs msgs not-empty error "No messages in sequence `%s'"] 9] mh-read-folder-sequences #[(folder define-sequences) "À\nƒà !ˆÅÆ \"ˆŠÇÈÉ\nË$ˆebˆÌÍÀÎ#ƒ4ÏÐєѕ{!Ò \" B‚e`|ˆ) )‡" [nil seqs define-sequences mh-define-sequences mh-seq-list mh-mapc #[(seq) "À @!… \nB‰‡" [mh-folder-name-p seq seqs] 2] mh-exec-cmd-quiet " *mh-temp*" "mark" folder "-list" re-search-forward "^[^: ]+" t mh-make-seq intern 0 mh-read-msg-list] 5] mh-seq-names #[(seq-list) "ÀÁ\n\"‡" [mapcar #[(entry) "À @!C‡" [symbol-name entry] 2] seq-list] 3] mh-seq-from-command #[(folder seq seq-command) "À‰ÁŠÅ‹ˆqˆ ŸÇ \" B ,‡" [nil t case-fold-search msgs msg ((byte-code "ÀÁ #ˆebˆÄ @‰ƒ BÇyˆ‚ À‡" [apply mh-exec-cmd-quiet " *mh-temp*" seq-command mh-read-msg-list msg msgs 1] 4)) folder mh-make-seq seq mh-seq-list] 3] mh-read-msg-list #[nil "ÀŠÀˆ`)ÀÄÅ\nÆ#ƒcÇȔȕ{!ÉÊ!ƒVËuˆÄÅ\nÆ#ˆÇȔȕ{!‰ Wƒ@ÍÎ  #ˆ  Xƒ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] mh-remove-seq #[(seq) "ÀÁ\nà T\n%ˆÅ\nÆC\"ˆÇ\n!‡" [mh-map-to-seq-msgs mh-notate-if-in-one-seq seq 32 mh-cmd-note mh-undefine-sequence "all" mh-delete-seq-locally] 6] mh-delete-seq-locally #[(seq) "À !Ã\n \"‰)‡" [mh-find-seq seq entry delq mh-seq-list] 3] mh-remove-msg-from-seq #[(msg seq &optional internal-flag) "À !‰…$à ÅT\n@$ˆ„È C\"ˆ\nÉ \nA\"¡)‡" [mh-find-seq seq entry mh-notate-if-in-one-seq msg 32 mh-cmd-note internal-flag mh-undefine-sequence delq] 6] mh-add-msgs-to-seq #[(msgs seq &optional internal-flag) "À ! ƒ :„ C\n„Ä \" B‚* ƒ*\nÆ \nA\"¡ˆ?…<È \"ˆÉ Ê T#)‡" [mh-find-seq seq entry msgs mh-make-seq mh-seq-list append internal-flag mh-add-to-sequence mh-notate-seq 37 mh-cmd-note] 4]] 3) (defalias 'mh-rename-seq #[(seq new-name) "À !‰ƒ\n  ˆ‚ÄÅ \"ˆÆ \nA\"ˆÇ \nA\")‡" [mh-find-seq seq old-seq new-name error "Sequence %s does not exists" mh-undefine-sequence mh-define-sequence] 4 "\ Rename a SEQUENCE to have a new NAME." "SOld sequence name: \nSNew name: "]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"‡" [defalias mh-notate-user-sequences #[nil "Á‰…\" @@Ä\n!„Å\nÆT#ˆ A‰„Á*‡" [mh-seq-list nil name seqs mh-internal-seq mh-notate-seq 37 mh-cmd-note] 5] mh-internal-seq #[(name) "Á>†\n=†Ã!‡" [name (answered cur deleted forwarded printed) mh-unseen-seq mh-folder-name-p] 2] mh-folder-name-p #[(name) "9ƒ Á!ÂHÃ=‡ÂHÃ=‡" [name symbol-name 0 43] 2] mh-notate-seq #[(seq notation offset) "ÀÁ\n $‡" [mh-map-to-seq-msgs mh-notate seq notation offset] 5] mh-notate-if-in-one-seq #[(msg notation offset seq) "À ! \n@=…\nA?…Ä #)‡" [mh-seq-containing-msg msg in-seqs seq mh-notate notation offset] 4] 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] mh-map-over-seqs #[(func seq-list) "… @@@A\"ˆA‰„‡" [seq-list func nil] 4] mh-define-sequences #[(seq-list) "ÀÁ\n\"‡" [mh-map-over-seqs mh-define-sequence seq-list] 3] mh-add-to-sequence #[(seq msgs) "À !?…\n…ÃÄÅÇÈ !É\n&‡" [mh-folder-name-p seq msgs apply mh-exec-cmd "mark" mh-current-folder "-sequence" symbol-name "-add"] 8] mh-define-sequence #[(seq msgs) "…Á\n!?…ŠÃÄÅÇÈ\n!ÉÊË!&)‡" [msgs mh-folder-name-p seq apply mh-exec-cmd "mark" mh-current-folder "-sequence" symbol-name "-add" "-zero" mh-list-to-string] 10] mh-undefine-sequence #[(seq msgs) "ÀÁ ÄÅ!Ç&‡" [apply mh-exec-cmd "mark" mh-current-folder "-sequence" symbol-name seq "-delete" msgs] 8] mh-copy-seq-to-point #[(seq location) "ÀÁ\n #‡" [mh-map-to-seq-msgs mh-copy-line-to-point seq location] 4] mh-copy-line-to-point #[(msg location) "Àyˆ`ÂyˆÃ `\"ˆ bˆÅ ˆ b)‡" [0 beginning-of-line 1 copy-region-as-kill location yank] 3] mh-exec-cmd #[(command &rest args) "ŠÀqˆÁ ˆÂÃÄ \"ÇÈÇÉ\n!&ˆË ÌV…!Í‹)‡" [" *mh-temp*" 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*" sit-for 5] 2))] 8] mh-exec-cmd-quiet #[(buffer command &rest args) ";ƒ qˆÁ ˆÂÃÄ \"ÇÇ&‡" [buffer erase-buffer apply call-process expand-file-name command mh-progs nil args] 7] 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] mh-exec-cmd-daemon #[(command &rest args) "ŠÀÁ!qˆÂ ˆ)ÃÅÆÃÈ \"Ê !% Í Î\"*‡" [get-buffer-create " *mh-temp*" 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] mh-process-daemon #[(process output) "ÀÁ!qˆÂ !ˆÄÁ!‡" [get-buffer-create " *mh-temp*" insert-before-markers output display-buffer] 2] mh-exec-lib-cmd-output #[(command &rest args) "À`Á\"ˆÂÃÄ \"ÇÁÇÈ !&ˆÊ ‡" [push-mark t apply call-process expand-file-name command mh-lib nil mh-list-to-string args exchange-point-and-mark] 8] mh-list-to-string #[(l) "À\nƒ^\n@ƒW\n@9ƒÃ\n@! B‚W\n@§ƒ+Ä\n@! B‚W\n@Åš„W\n@;ƒ@\n@ B‚W\n@<ƒQÆ\n@!Ÿ ¤‚WÇÈ\n@\"ˆ\nA‰„ Ÿ)‡" [nil new-list l symbol-name int-to-string "" mh-list-to-string error "Bad element in mh-list-to-string: %s"] 4] mh-annotate-msg #[(msg buffer note &rest args) "ÀÁ %ˆŠÆ !…* qˆ 9ƒ\"Ç  T#‚*Ê  T#)‡" [apply mh-exec-cmd "anno" buffer msg args get-buffer mh-notate-seq note mh-cmd-note mh-notate] 6] mh-notate #[(msg notation offset) "Šƒ Á‰#…*à ʼnÈyˆ uˆÊË!ˆ c*Í !ˆ))‡" [msg mh-goto-msg t buffer-modified-p folder-updating-mod-flag nil buffer-file-name buffer-read-only 0 offset delete-char 1 notation mh-set-folder-modified-p] 4] mh-prompt-for-folder #[(prompt default can-create) "ÀÁ\n Äšƒ Å‚ÀÆ \"#Ç „Ê ˆË\n ljÌ%‰ƒ9Äšƒ9 Äš„Äš„GÌšƒM ‚[Í!„[ÀÎ\"ÏÐ!!?‰ƒ”ÒÀÓ\"!ƒ”ÔÕ\"ˆÖ×lj‰Ð!%ˆÔØ\"ˆC B ‚³ƒ¢ÙÚ\"ˆ‚³Û \"„³C B )*‡" [format "%s folder%s" prompt default "" "? " " [%s]? " nil name mh-folder-list mh-set-folder-list completing-read "+" mh-folder-name-p "+%s" 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" error "Folder %s is not created" assoc] 8]] 3) (defalias 'mh-set-folder-list #[nil "À ‰‡" [mh-make-folder-list mh-folder-list] 2 "\ Sets mh-folder-list correctly. A useful function for the command line or for when you need to sync by hand."]) (defalias 'mh-make-folder-list #[nil "ÀÁ!ˆÂ‹‡" [message "Collecting folder names..." ((byte-code "ÀÁÂà ƒ Å‚ Æ$ˆebˆÇ‰ m„3`ÊyˆËÌ`S{\"C B ‚ÍÎ!ˆ *‡" [mh-exec-cmd-quiet " *mh-temp*" "folders" "-fast" mh-recursive-folders "-recurse" "-norecurse" nil start list 1 format "+%s" message "Collecting folder names...done"] 5))] 2 "\ Return a list of the user's folders. Result is in a form suitable for completing read." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"‡" [defalias mh-remove-folder-from-folder-list #[(folder) "ÀÁ\n \" \"‰‡" [delq assoc folder mh-folder-list] 4] mh-read-msg-range #[(prompt) "À !‰GÄÆ Wƒ(È\n #‰ @B A)‚ Ÿ,‡" [read-string prompt buf buf-size 0 start nil input read-from-string next] 5] 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] mh-msg-search-pat #[(n) "À \n\"‡" [format mh-msg-search-regexp n] 3] mh-msg-filename #[(msg &optional folder) "ÀÁ\n! ƒÄ !‚ \"‡" [expand-file-name int-to-string msg folder mh-expand-file-name mh-folder-filename] 4] mh-msg-filenames #[(msgs &optional folder) "ÀÁ\nÃ#‡" [mapconcat #[(msg) "À \n\"‡" [mh-msg-filename msg folder] 3] msgs " "] 4]] 3) (defalias 'mh-expand-file-name #[(filename &optional default) "À !ƒ ÃÄO \"‡Â \"‡" [mh-folder-name-p filename expand-file-name 1 nil mh-user-path default] 4 "\ Just like `expand-file-name', but also handles MH folder names. Assumes that any filename that starts with '+' is a folder name."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆË !ˆÍ ÎÏ#ˆÍ ÐÏ#ˆÍ ÑÒ#ˆÍ ÓÔ#ˆÍ ÕÖ#ˆÍ ×Ø#ˆÍ ÙÚ#ˆÍ ÛÜ#ˆÍ ÝÞ#ˆÍ ßà#ˆÍ áâ#ˆÍ ãä#ˆÍ åæ#ˆÍ çè#ˆÍ éê#ˆÍ ëì#ˆÍ íî#ˆÍ ïð#ˆÍ ñò#ˆÍ óô#ˆÍ õö#ˆÍ ÷ø#ˆÍ ùú#ˆÍ ûü#ˆÍ ýþ#ˆÍ ÿò#ˆÍ @A#ˆÍ BC#ˆÍ DC#ˆÍ EF#ˆÍ GH#ˆÍ IJ#ˆÍ KJ#ˆÍ LM#ˆÍ NO#ˆÍ PQ#ˆÍ RO#ˆÍ ST#ˆÍ UV#ˆÍ WX#ˆÍ YZ#ˆÍ [\\#ˆÍ ]^#ˆÍ _`#ˆÍ ab#ˆÍ cd#ˆÍ ef#ˆÍ g^#ˆÍhij#ˆÍhkj#ˆÍhlm#ˆÍhnj#ˆÍhoj#ˆÍhpj#ˆÍhqj#ˆÍhrm#ˆÍhsj#ˆÍhtj#ˆÍhuv#ˆÍhwx#ˆÍhyz#ˆÍh{|#ˆÍh}~#ˆÍh€#ˆÍ‚#ˆÍij#ˆÍkj#ˆÍlj#ˆÍnj#ˆÍoj#ˆÍpj#ˆÍqj#ˆÍrj#ˆÍsj#ˆÍtj#ˆÍwx#ˆƒ„!‡" [defalias mh-find-path #[nil "ŠÀÁÂ!† Ã!Å !„ÆÇ \"ˆÈÉ!qˆÊ ˆË !ˆÌÍ!‰Ïšƒ3ЂAÑ!„AÒÓ\"ÌÔ!‰ÏšƒOÖ×ÀÀØ!\"!ƒnÅÙ!!„nÆÚ\"ˆÌÛ!‰Ïšƒ€Ý‰‚‡Þ!‰*‡" [expand-file-name getenv "MH" "~/.mh_profile" profile file-exists-p error "Cannot find MH profile %s" get-buffer-create " *mh-temp*" erase-buffer insert-file-contents mh-get-field "Draft-Folder:" mh-draft-folder "" nil mh-folder-name-p format "+%s" "Path:" mh-user-path "Mail" file-name-as-directory "~" mh-expand-file-name "Draft folder %s does not exist. Create it and try again." "Unseen-Sequence:" mh-unseen-seq unseen intern] 6] mh-get-field #[(field) "ÀebˆÂÃÄ \"ÆÀ#„Ç‚=ÈÉ!ƒÇ‚=ÂÊÆÀ#ˆË” ËyˆÈÍ!ƒ7Ëyˆ‚+ `S{))‡" [t case-fold-search re-search-forward format "^%s" field nil "" looking-at "[ ]*$" "[ ]*\\([^ \n].*\\)$" 1 start "[ ]"] 4] mh-insert-fields #[(&rest name-values) "À\n…?\n@\nA@ Åš„7ebˆÆÇÈ \"ÉÀ#„/ÊË!ˆ Ì Í±ˆ‚7ÉˆÌ ±ˆ\nAA*‚)‡" [t case-fold-search name-values value field-name "" re-search-forward format "^%s" nil mh-goto-header-end 0 " " "\n"] 4] mh-position-on-field #[(field set-mark) "À\nƒ à ˆebˆÄÅ!ˆÆÇÈ \"ÊÀ#… ʈÀ)‡" [t case-fold-search set-mark push-mark mh-goto-header-end 0 re-search-backward format "^%s" field nil] 4] mh-goto-header-end #[(arg) "ÀÁ‰#…\n y‡" [re-search-forward "^$\\|^-+$" nil arg] 4] suppress-keymap mh-folder-mode-map define-key "q" mh-quit "b" "?" mh-msg-is-in-seq "%" mh-put-msg-in-seq "|" mh-pipe-msg "a" mh-edit-again "%" mh-delete-msg-from-seq "n" mh-narrow-to-seq "w" mh-widen "b" mh-burst-digest "u" mh-undo-folder " " mh-page-digest "" mh-page-digest-backwards "e" mh-extract-rejected-mail "f" mh-visit-folder "k" mh-kill-folder "l" mh-list-folders "n" mh-unshar-msg "o" mh-write-msg-to-file "p" mh-pack-folder "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" "r" mh-redistribute "f" mh-forward "s" mh-send "m" "a" mh-reply "j" mh-goto-msg "<" mh-first-msg "g" "" mh-previous-page " " mh-page-msg "." mh-show "u" mh-undo "!" mh-refile-or-write-again "^" mh-refile-msg "d" mh-delete-msg "" mh-delete-msg-no-motion "p" mh-previous-undeleted-msg "n" mh-next-undeleted-msg "o" mh-letter-mode-map "" mh-to-field "" "" mh-to-fcc "" "" "b" "c" "f" "s" "t" "" mh-fully-kill-draft "" mh-check-whom " " mh-insert-letter "" mh-yank-cur-msg "" mh-insert-signature "" mh-send-letter mh-pick-mode-map mh-do-pick-search provide mh-e] 4) emacs-19.22/lisp/mhspool.elc100666 13437 1 20333 5416171657 14415 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:38:23 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/mhspool.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote nntp)) (defvar mhspool-list-folders-method (quote mhspool-list-folders-using-sh) "\ *Function to list files in folders. The function should accept a directory as its argument, and fill the current buffer with file and directory names. The output format must be the same as that of 'ls -R1'. Two functions mhspool-list-folders-using-ls and mhspool-list-folders-using-sh are provided now. I suppose the later is faster.") (defvar mhspool-list-directory-switches (quote ("-R")) "\ *Switches for mhspool-list-folders-using-ls to pass to `ls' for getting file lists. One entry should appear on one line. You may need to add `-1' option.") (defconst mhspool-version "MHSPOOL 1.8" "\ Version numbers of this version of MHSPOOL.") (defvar mhspool-spool-directory "~/Mail" "\ Private mail directory.") (defvar mhspool-current-directory nil "\ Current news group directory.") (defalias 'mhspool-retrieve-headers #[(sequence) "ŠqˆÁ\nGÃÁÃÁ‰‰‰ÃÁ‰ \n   \nƒ\n@ Ñ !PÒ!ƒbÓ!„bÔ ˆÕ!ˆebˆÖ×ÁØ#ˆe`}ˆebˆÙÚÁÛ#ƒoÜÝÛ‰#ˆ‚^ebˆÞcˆebˆÖßÁÛ#ƒ`ŠÁˆ`){‚àebˆÖáÁÛ#ƒ¨`ŠÁˆ`){\n‚«â\nebˆÖãÁÛ#ƒÃ`ŠÁˆ`){ ‚ÆÁ ebˆÖäÁÛ#ƒÝ`ŠÁˆ`){‚ßÁebˆÖåÁÛ#ƒùæ`ŠÁˆ`){!‚Œdbˆ~ˆç`d\")ebˆÖèÁÛ#ƒ`ŠÁˆ`){‚!ÁebˆÖéÁÛ#„4ÖêÁÛ#ƒ@`ŠÁˆ`){‚BÁ ƒb ƒbë \n  & B \nA T ,§ƒ',Vƒ' í¦ÃUƒ'îï ð_¥\"ˆ‚',§ƒ¡,Vƒ¡îñ!ˆ Ÿ. ‡" [nntp-server-buffer nil sequence 0 references date lines xref from message-id subject article headers count number file mhspool-current-directory prin1-to-string file-exists-p file-directory-p erase-buffer insert-file-contents search-forward "\n\n" move re-search-forward "\\( ?\n[ ]+\\)+" t replace-match " " "\n" "\nFrom: " "(Unknown User)" "\nSubject: " "(None)" "\nMessage-ID: " "\nDate: " "\nLines: " string-to-int count-lines "\nXref: " "\nReferences: " "\nIn-Reply-To: " vector nntp-large-newsgroup 20 message "MHSPOOL: Receiving headers... %d%%" 100 "MHSPOOL: Receiving headers... done"] 12 "\ Return list of article headers specified by SEQUENCE of article id. The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. If there is no References: field, In-Reply-To: field is used instead. Reader macros for the vector are defined as `nntp-header-FIELD'. Writer macros for the vector are defined as `nntp-set-header-FIELD'. Newsgroup must be selected before calling this."]) (defalias 'mhspool-open-server #[(host &optional service) "†ÁÂ!ÃÅÆ\"ƒ'ÇÈɔɕOÈÊÃ\"\"! Ì ‚*à Í;ƒO ;ƒOÏ !ƒOÌ ˜ƒOÐ\"‚pÌ ˜ƒ`ÒÓ \"‚p„jÔ‚pÒÕ\" *‡" [host getenv "NNTPSERVER" nil status string-match ":\\(.+\\)$" file-name-as-directory expand-file-name 1 "~/" mhspool-spool-directory system-name "" nntp-status-string file-directory-p mhspool-open-server-internal service format "No such directory: %s. Goodbye." "NNTP server is not specified." "MHSPOOL: cannot talk to %s."] 6 "\ Open news server on HOST. If HOST is nil, use value of environment variable `NNTPSERVER'. If optional argument SERVICE is non-nil, open by the service name."]) (defalias 'mhspool-close-server #[nil "À ‡" [mhspool-close-server-internal] 1 "\ Close news server."]) (byte-code "ÀÁKM‡" [mhspool-request-quit mhspool-close-server] 2) (defalias 'mhspool-server-opened #[nil "…Á!‡" [nntp-server-buffer get-buffer] 2 "\ Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL."]) (defun mhspool-status-message nil "\ Return server status response as string." nntp-status-string) (defalias 'mhspool-request-article #[(id) "Á\n!P‰;…Ä !…Å !?…ŠÆ !))‡" [mhspool-current-directory prin1-to-string id file file-exists-p file-directory-p mhspool-find-file] 4 "\ Select article by message ID (or number)."]) (defalias 'mhspool-request-body #[(id) "À !…Š\nqˆebˆÃÄÅÆ#ƒe`|ˆ)Ƈ" [mhspool-request-article id nntp-server-buffer search-forward "\n\n" nil t] 4 "\ Select article body by message ID (or number)."]) (defalias 'mhspool-request-head #[(id) "À !…Š\nqˆebˆÃÄÅÆ#ƒ`Sd|ˆ)Ƈ" [mhspool-request-article id nntp-server-buffer search-forward "\n\n" nil t] 4 "\ Select article head by message ID (or number)."]) (defalias 'mhspool-request-stat #[(id) "À‡" ["MHSPOOL: STAT is not implemented." nntp-status-string nil] 1 "\ Select article by message ID (or number)."]) (defalias 'mhspool-request-group #[(group) "ÀÁ\n!!ƒÁ\n!‰‡ÀÁÄ\nÅÆ#!!…#ÁÄ\nÅÆ#!‰‡" [file-directory-p mhspool-article-pathname group mhspool-current-directory mhspool-replace-chars-in-string 46 47] 6 "\ Select news GROUP."]) (defalias 'mhspool-request-list #[nil "ŠÀÀÃÄ À\"!ÇÈ!ÉQ\nËÌ! qˆÏ ˆ qˆÏ ˆ!ˆebˆÑ\nÀÒ#ƒ‚ÓÔ”Ô•{ÕÖ#ÀÔyˆm„j×Ø!„j×Ù!ƒdÚÛ”Û•{!\nBÔyˆ‚J\nƒ2ÜÝÞ ßà\n\"ßá\n\"$\"ˆ‚2â !ˆqˆã .‡" [nil newsgroup articles file-name-as-directory expand-file-name mhspool-spool-directory directory "^" regexp-quote "\\(.+\\):$" folder-regexp get-buffer-create " *MHSPOOL File List*" buffer nntp-server-buffer erase-buffer mhspool-list-folders-method re-search-forward t mhspool-replace-chars-in-string 1 47 46 looking-at "^$" "^[0-9]+$" string-to-int 0 princ format "%s %d %d n\n" apply max min kill-buffer buffer-size] 8 "\ List active newsgoups."]) (defalias 'mhspool-request-list-newsgroups #[nil "À‡" ["MHSPOOL: LIST NEWSGROUPS is not implemented." nntp-status-string nil] 1 "\ List newsgoups (defined in NNTP2)."]) (defalias 'mhspool-request-list-distributions #[nil "À‡" ["MHSPOOL: LIST DISTRIBUTIONS is not implemented." nntp-status-string nil] 1 "\ List distributions (defined in NNTP2)."]) (defalias 'mhspool-request-last #[nil "À‡" ["MHSPOOL: LAST is not implemented." nntp-status-string nil] 1 "\ Set current article pointer to the previous article in the current news group."]) (defalias 'mhspool-request-next #[nil "À‡" ["MHSPOOL: NEXT is not implemented." nntp-status-string nil] 1 "\ Advance current article pointer."]) (defalias 'mhspool-request-post #[nil "À‡" ["MHSPOOL: POST: what do you mean?" nntp-status-string nil] 1 "\ Post a new news in current buffer."]) (defalias 'mhspool-open-server-internal #[(host &optional service) "ŠÁ ˜„ ÂÃ\"ˆÄÅ!‰qˆÇp!ˆÈ ˆÉ ˆÊ Ì ÏÐ!ˆ)ʇ" [host system-name error "MHSPOOL: cannot talk to %s." get-buffer-create " *nntpd*" nntp-server-buffer buffer-flush-undo erase-buffer kill-all-local-variables t case-fold-search nil nntp-server-process nntp-server-name run-hooks nntp-server-hook] 4 "\ Open connection to news server on HOST by SERVICE (default is nntp)."]) (defalias 'mhspool-close-server-internal #[nil "ƒÁ!ˆÂ‰‡" [nntp-server-buffer kill-buffer nil nntp-server-process] 2 "\ Close connection to news server."]) (defalias 'mhspool-find-file #[(file) "qˆÁ ˆÂÃć" [nntp-server-buffer erase-buffer nil (byte-code "À !ˆebˆÂÃÄÅ#ƒ`d{ƘƒÇÈ!ˆÅ‡" [insert-file-contents file search-forward "\n\n" nil t " " delete-char 1] 4) ((file-error))] 3 "\ Insert FILE in server buffer safely."]) (defalias 'mhspool-article-pathname #[(group) "À !\nÃQ‡" [file-name-as-directory mhspool-spool-directory group "/"] 3 "\ Make pathname for GROUP."]) (defalias 'mhspool-replace-chars-in-string #[(string from to) "ÁÂOGÁ Wƒ% H Uƒ Iˆ T‰‚ +‡" [string 0 nil idx len from to] 4 "\ Replace characters in STRING from FROM to TO."]) (defalias 'mhspool-list-folders-using-ls #[(directory) "ÀÁÂÃÄÃÅC\"&‡" [apply call-process "ls" nil t append mhspool-list-directory-switches directory] 9 "\ List files in folders under DIRECTORY using 'ls'."]) (defalias 'mhspool-list-folders-using-sh #[(directory) "pÀÁ!ŠŒ\nqˆÄ ˆÅDZˆÈedÉÊ Ê&ˆ*Ë\n!*‡" [get-buffer-create " *MHSPOOL Shell Script Buffer*" script buffer erase-buffer "PS2=\n ffind() {\n cd $1; echo $1:\n ls -1\n echo\n for j in `echo *[a-zA-Z]*`\n do\n if [ -d $1/$j ]; then\n ffind $1/$j\n fi\n done\n }\n cd " directory "; ffind `pwd`; exit 0\n" call-process-region "sh" nil kill-buffer] 7 "\ List files in folders under DIRECTORY using '/bin/sh'."]) (provide (quote mhspool)) emacs-19.22/lisp/mim-mode.elc100666 13437 1 40015 5416171754 14435 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:39:23 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/mim-mode.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (autoload (quote fast-syntax-check-mim) "mim-syntax" "\ Checks Mim syntax quickly. Answers correct or incorrect, cannot point out the error context." t) (autoload (quote slow-syntax-check-mim) "mim-syntax" "\ Check Mim syntax slowly. Points out the context of the error, if the syntax is incorrect." t) (defvar mim-mode-hysterical-bindings t "\ *Non-nil means bind list manipulation commands to Meta keys as well as Control-Meta keys for historical reasons. Otherwise, only the latter keys are bound.") (byte-code "ÀÁ!„ÂÀÃ!„ „òÄÆ  ÇWƒ+È T‰É #ˆ‚ ÊWƒ=È T‰Ë #ˆ‚+Ì ÍWƒQÈ T‰Î #ˆ‚?Ï ÐWƒeÈ T‰Î #ˆ‚SÑ ÒWƒyÈ T‰Î #ˆ‚gÈÓÔ #ˆÈÕÖ #ˆÈ×Ö #ˆÈØÖ #ˆÈÌÖ #ˆÈÙÖ #ˆÈÚÖ #ˆÈÛÖ #ˆÈÜÖ #ˆÈÝÖ #ˆÈÞß #ˆÈàá #ˆÈâã #ˆÈäå #ˆÈæç #ˆÈèé #ˆÈêë #ˆÈìí #ˆÈîï #ˆÈðñ #ˆ)ò3‡" [boundp mim-mode-map nil mim-mode-syntax-table -1 i make-syntax-table 32 modify-syntax-entry " " 127 "_ " 96 122 "w " 64 90 47 57 58 " " 44 "' " 46 39 126 59 35 37 33 34 "\" " 92 "\\ " 40 "() " 60 "(> " 123 "(} " 91 "(] " 41 ")( " 62 ")< " 125 "){ " 93 ")[ " "- " mim-whitespace] 4) (defvar mim-mode-hook nil "\ *User function run after mim mode initialization. Usage: (setq mim-mode-hook '(lambda () ... your init forms ...)).") (define-abbrev-table (quote mim-mode-abbrev-table) nil) (defconst indent-mim-function (quote indent-mim-function) "\ Controls (via properties) indenting of special forms. (put 'FOO 'indent-mim-function n), integer n, means lines inside will be indented n spaces from start of form. (put 'FOO 'indent-mim-function 'DEFINE) is like above but means use value of mim-body-indent as offset from start of form. (put 'FOO 'indent-mim-function ) where is a list or pointed list of integers, means indent each form in by the amount specified in . When is exhausted, indent remaining forms by `mim-body-indent' unless is a pointed list, in which case the last cdr is used. Confused? Here is an example: (put 'FROBIT 'indent-mim-function '(4 2 . 1)) ...> Finally, the property can be a function name (read the code).") (defvar indent-mim-comment t "\ *Non-nil means indent string comments.") (defvar mim-body-indent 2 "\ *Amount to indent in special forms which have DEFINE property on `indent-mim-function'.") (defvar indent-mim-arglist t "\ *nil means indent arglists like ordinary lists. t means strings stack under start of arglist and variables stack to right of them. Otherwise, strings stack under last string (or start of arglist if none) and variables stack to right of them. Examples (for values 'stack, t, nil): (FOO \"OPT\" BAR (FOO \"OPT\" BAR (FOO \"OPT\" BAR BAZ MUMBLE BAZ MUMBLE BAZ MUMBLE \"AUX\" \"AUX\" \"AUX\" BLETCH ... BLETCH ... BLETCH ...") (byte-code "ÀÁÂÁ#ˆÀÃÂÁ#ˆÀÄÂÁ#ˆÀÅÂÁ#ˆÀÆÂÁ#ˆÀÇÂÁ#ˆÀÈÂÁ#ˆÀÉÂÁ#ˆÀÊÂÁ#ˆÀË ‰\\ B#‡" [put DEFINE indent-mim-function DEFMAC BIND PROG REPEAT CASE FUNCTION MAPF MAPR UNWIND mim-body-indent] 5) (defvar mim-down-parens-only t "\ *nil means treat ADECLs and ATOM trailers like structures when moving down a level of structure.") (defvar mim-stop-for-slop t "\ *Non-nil means {next previous}-mim-object consider any non-whitespace character in column 0 to be a toplevel object, otherwise only open paren syntax characters will be considered.") (defalias (quote mdl-mode) (quote mim-mode)) (defalias 'mim-mode #[nil "À ˆ „Õ à ÄÅ#ˆÃ ÆÇ#ˆÃ ÈÉ#ˆÃ ÊË#ˆÃ ÌÍ#ˆÃ ÎÏ#ˆÃ ÐÑ#ˆÃ ÒÓ#ˆÃ ÔÕ#ˆÃ Ö×#ˆÃ ØÙ#ˆÃ ÚÛ#ˆÃ ÜÝ#ˆÃ Þß#ˆÃ àá#ˆÃ âã#ˆÃ äå#ˆÃ æç#ˆÃ èé#ˆÃ êë#ˆÃ ìÇ#ˆ-ƒÕà îï#ˆÃ ðÅ#ˆÃ ñÉ#ˆÃ òË#ˆÃ óÍ#ˆÃ ôÏ#ˆÃ õÑ#ˆÃ öÓ#ˆÃ ÷Õ#ˆÃ øÙ#ˆÃ ùÛ#ˆÃ úÝ#ˆû !ˆü=!ˆþÿ!ˆ@AP?þB!ˆ?BþC!ˆDCþE!ˆFEþG!ˆFGþH!ˆIHþJ!ˆKJþL!ˆMLþN!ˆëNþO!ˆPOþQ!ˆDQRSTUVWXY!‡" [kill-all-local-variables mim-mode-map make-sparse-keymap define-key "" open-mim-line "" indent-mim-object "" previous-mim-object "" next-mim-object "" beginning-of-DEFINE "" end-of-DEFINE "" transpose-mim-objects "" backward-up-mim-object "" forward-down-mim-object "" mark-mim-object " " forward-kill-mim-object "" forward-mim-object "" backward-mim-object "^" raise-mim-line "\\" fixup-whitespace "" backward-delete-char-untabify "" backward-kill-mim-object "\n" newline-and-mim-indent ";" begin-mim-comment " " indent-mim-line " " mim-mode-hysterical-bindings "!" line-to-top-of-window "o" "p" "n" "a" "e" "t" "u" "d" "k" "f" "b" use-local-map set-syntax-table mim-mode-syntax-table make-local-variable paragraph-start "^$\\|" page-delimiter paragraph-separate paragraph-ignore-fill-prefix t comment-start ";\"" comment-start-skip comment-end "\"" comment-column 40 comment-indent-function indent-mim-comment indent-line-function blink-matching-paren-distance nil indent-tabs-mode mim-mode-abbrev-table local-abbrev-table mim-mode major-mode "Mim" mode-name run-hooks mim-mode-hook] 4 "\ Major mode for editing Mim (MDL in MDL) code. Commands: If value of `mim-mode-hysterical-bindings' is non-nil, then following commands are assigned to escape keys as well (e.g. ESC f = ESC C-f). The default action is bind the escape keys. \\{mim-mode-map} Other Commands: Use \\[describe-function] to obtain documentation. replace-in-mim-object find-mim-definition fast-syntax-check-mim slow-syntax-check-mim backward-down-mim-object forward-up-mim-object Variables: Use \\[describe-variable] to obtain documentation. mim-mode-hook indent-mim-comment indent-mim-arglist indent-mim-function mim-body-indent mim-down-parens-only mim-stop-for-slop mim-mode-hysterical-bindings Entry to this mode calls the value of mim-mode-hook if non-nil." nil]) (defalias 'line-to-top-of-window #[nil "ÀÁ!‡" [recenter 0] 2 "\ Move current line to top of window." nil]) (defalias 'forward-mim-object #[(arg) "‰ÂYƒ ‚ [)ÃUƒ\"Ä ƒÅ!‡ÆÇ\"‡Æ!‡" [arg n 0 1 inside-atom-p forward-sexp forward-mim-objects t] 4 "\ Move forward across Mim object. With ARG, move forward that many objects." "p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias inside-atom-p #[nil "hg‰zÂU„ zÃU„ ÄU…)zÂU†)zÃU†)ÄU*‡" [c2 c1 119 95 33] 3] forward-mim-objects #[(arg &optional skip-bracket-p) "À !ÃÄň`Æ\n!U…Ç\n[!)‡" [sign arg direction conditions (byte-code "ÁU„ !ˆÄ !„ Z‰‚Á‡" [arg 0 forward-sexp direction inside-adecl-or-trailer-p] 3) ((error (byte-code "„ Á A\"ˆ‚Ä !ˆ` \\bˆÁ‡" [skip-bracket-p signal error conditions skip-mim-whitespace direction] 3))) buffer-end skip-mim-whitespace] 3]] 3) (defalias 'backward-mim-object #[(&optional arg) "À ƒ\n [‚ Â!‡" [forward-mim-object arg -1] 2 "\ Move backward across Mim object. With ARG, move backward that many objects." "p"]) (defalias 'mark-mim-object #[(&optional arg) "ÀŠÁ\n†Ã!ˆ`)!‡" [push-mark forward-mim-object arg 1] 3 "\ Mark following Mim object. With ARG, mark that many following (preceding, ARG < 0) objects." "p"]) (defalias 'forward-kill-mim-object #[(&optional arg) "À`Á\n†Ã!ˆ`\"‡" [kill-region forward-mim-object arg 1] 4 "\ Kill following Mim object. With ARG, kill that many objects." "*p"]) (defalias 'backward-kill-mim-object #[(&optional arg) "À †Â[!‡" [forward-kill-mim-object arg 1] 2 "\ Kill preceding Mim object. With ARG, kill that many objects." "*p"]) (defalias 'raise-mim-line #[(&optional arg) "À †‰! ÄVƒ‚ÄŠ ÄU?…1 yˆ``S|ˆÆ ˆ Z‰‚+‡" [sign arg 1 increment 0 direction fixup-whitespace] 4 "\ Raise following line, fixing up whitespace at join. With ARG raise that many following lines. A negative ARG will raise current line and previous lines." "*p"]) (defalias 'forward-down-mim-object #[(&optional arg) "À †‰! ‰ÅYƒ ‚ [)ÂUƒe„eŠÇ !ˆ ÅVƒ2ÈÉ!ˆÊ !‰ zÌU†C zÍU)ƒUÎ !ˆÏ !ƒU`†`Ð` Ñ#†`Ò !)b‚ ÅU?…Ð` Ñ#†wÒ !bˆ Z‰‚f)‡" [sign arg 1 direction n 0 mim-down-parens-only skip-mim-whitespace re-search-forward "\\s'*" next-char c 95 119 forward-sexp inside-adecl-or-trailer-p scan-lists -1 buffer-end] 5 "\ Move down a level of Mim structure forwards. With ARG, move down that many levels forwards (backwards, ARG < 0)." "p"]) (defalias 'backward-down-mim-object #[(&optional arg) "À ƒ\n [‚ Â!‡" [forward-down-mim-object arg -1] 2 "\ Move down a level of Mim structure backwards. With ARG, move down that many levels backwards (forwards, ARG < 0)." "p"]) (defalias 'forward-up-mim-object #[(&optional arg) "À †‰! ÄU„%Å` Â#†Æ !bˆ Z‰‚ ÄW…-Ç )‡" [sign arg 1 direction 0 scan-lists buffer-end backward-prefix-chars] 5 "\ Move up a level of Mim structure forwards With ARG, move up that many levels forwards (backwards, ARG < 0)." "p"]) (defalias 'backward-up-mim-object #[(&optional arg) "À ƒ\n [‚ Â!‡" [forward-up-mim-object arg -1] 2 "\ Move up a level of Mim structure backwards With ARG, move up that many levels backwards (forwards, ARG > 0)." "p"]) (defalias 'replace-in-mim-object #[(old new) "Œ`ŠÀÁ!ˆ`)}ˆÂ \")‡" [forward-mim-object 1 replace-string old new] 3 "\ Replace string in following Mim object." "*sReplace in object: \nsReplace %s with: "]) (defalias 'transpose-mim-objects #[(&optional arg) "ÀÁ\n†Ã\"‡" [transpose-subr forward-mim-object arg 1] 3 "\ Transpose Mim objects around point. With ARG, transpose preceding object that many times with following objects. A negative ARG will transpose backwards." "*p"]) (defalias 'beginning-of-DEFINE #[(&optional arg move) "À †‰! „Å ÆWƒ`Tbˆ ÆU„1ÇÈÉ $ƒ1 Z‰‚ ÆW…:`Sb)‡" [sign arg 1 direction move t 0 re-search-backward "^<" nil] 6 "\ Move backward to beginning of surrounding or previous toplevel Mim form. With ARG, do it that many times. Stops at last toplevel form seen if buffer end is reached." "p"]) (defalias 'end-of-DEFINE #[(&optional arg) "„ÁÂWƒÃS[!ˆ‚(ÄÅ!„TÃ[Æ\"ˆÃÁ!ˆÇÁ!ˆÁy‡" [arg 1 0 beginning-of-DEFINE looking-at "^<" move forward-mim-object] 3 "\ Move forward to end of surrounding or next toplevel mim form. With ARG, do it that many times. Stops at end of last toplevel form seen if buffer end is reached." "p"]) (defalias 'next-mim-object #[(&optional arg) "ƒÁ‚ Âà †ʼn!ÈVƒ!`Tbˆ ÈU„;ÉÊË$ƒ; Z‰‚\"ÈVƒF`SbˆÈW†VŠÌÅ!ˆÍ`!)?…]ÎÈ!*‡" [mim-stop-for-slop "^\\S " "^\\s(" sign arg 1 direction search-string 0 re-search-forward nil t forward-mim-object pos-visible-in-window-p recenter] 6 "\ Move to beginning of next toplevel Mim object. With ARG, do it that many times. Stops at last object seen if buffer end is reached." "p"]) (defalias 'previous-mim-object #[(&optional arg) "À †Â[!‡" [next-mim-object arg 1] 2 "\ Move to beginning of previous toplevel Mim object. With ARG do it that many times. Stops at last object seen if buffer end is reached." "p"]) (defalias 'calculate-mim-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰‰‰‰‰‰‰ \n  ƒ* bˆ‚.ÍΈ` Wƒ@Ï` À# ‚.Ð\n\nƒû @‰ƒû\nÀVƒûÁ\n AA@ A@‰TbˆƒŠ`VƒŠÏ À#‰A@‰\nƒŠ  \n„CT‰bˆ„¡i‚ChÑUƒÿÒÓ!ˆ`Vƒ¸ bˆ‚CŠÓyˆ`)VƒÍÔÁwˆ`‚CbˆÀyˆÏ`ÀÐ$ˆ`U„ñŠÏ`À#@ÀU)ƒùÕ ˆ`‚C bˆ‚Cƒ±h×Uƒ±ŠÀØuˆ T‰ÙWƒ ÁÚÛ„ ÙW…)ÜÝ!)ƒ±ÀÁ`Wƒƒ wˆ`‰VƒV ^Áˆ` bˆgáUƒ|`ÒÓ!ˆUƒq‚3 wˆ`‚3ÒÓ!ˆ‚3 bˆÔdwˆgáUƒ§ƒ£К„£‚§T* bˆi‚CŠÓyˆ`)VƒÆÔÁwˆ`‚õbˆÀyˆÏ`ÀÐ$ˆ`U„êŠÏ`À#@ÀU)ƒòÕ ˆ`‚õ bˆi‚Câ ›@ƒKƒbˆÒÓ!ˆãä!ˆØuˆ‚% bˆåæ!ˆÓuˆ`ÔÁxˆÕ ˆÜç!ƒ@(ƒ@ Tbˆ‚H bˆÔÁwˆi„j)ƒg\n„g)  \"‰„ji bˆ. ‡" [0 nil paren-depth where peek start desired-indent last-sexp containing-sexp state retry indent-point parse-start from-the-top (byte-code "ÀÂÃĈÅÆ!ƒbˆÈÉÂÊË$ˆÌÍÂ\"ˆ …%iÎU?‰„Âxˆo„6ÐuˆÑ ‡" [t retry nil (forward-sexp -1) ((error (byte-code "ÀÀ‡" [nil retry] 1))) looking-at ".?[ ]*\"" indent-point re-search-backward "^\\s(" move 1 throw from-the-top 0 mim-whitespace -1 backward-prefix-chars] 6) parse-partial-sexp t 60 forward-sexp 1 " " backward-prefix-chars indent-mim-arglist 40 -1 6 (byte-code "ÀÁ!ˆÂ‡" [forward-sexp -1 t] 2) ((error)) looking-at "DEFINE\\|DEFMAC\\|FUNCTION" last-string eol mim-whitespace 34 3 search-forward "\"" re-search-backward "[^\\]\"" ";[ ]*\"" indent-mim-comment indent-mim-function] 11 "\ Calculate indentation for Mim line. Returns column."]) (defalias 'indent-mim-function #[(state indent-point) "A@`Š\nTbˆÃ ˆÄÅ!…tiÇ`ÈÉ!ˆ`{!‰\nËN‰ Íšƒ5‰ „; ¨ƒOÉyˆ`AA@V…s \\‚s bˆ :ƒ`Ï\"‚s 9…sÑ !…s \"++‡" [state current-indent containing-sexp backward-prefix-chars looking-at "\\sw\\|\\s_" start intern-soft forward-sexp 1 function indent-mim-function method DEFINE mim-body-indent indent-mim-offset indent-point fboundp] 5 "\ Compute indentation for Mim special forms. Returns column or nil."]) (defalias (quote indent-mim-offset) #[(state indent-point) " ÂN A@ AA@ÄTbˆ` WƒKÄÊ˃KÌÄxˆÍ ˆgÎU„@A‰¨ƒÄ‚Tbˆi †V\\-‡" [mim-body-indent function indent-mim-function state nil indentation last-sexp containing-sexp indentations indent-point (byte-code "ÀÁ!ˆÂ` ÁÄ$‡" [forward-sexp 1 parse-partial-sexp indent-point t] 5) ((error)) " " backward-prefix-chars 59] 5]) (defalias 'indent-mim-comment #[(&optional start) "`Áˆ`ÁÁÅyˆÆLjb,‡" [old-point nil eol state last-sexp 0 no-comment (byte-code "À` \"‰AA@‰ƒÄ\n›@ƒÅÆÇ\"ˆÈyˆÀ` ÈÉ$ˆ` Uƒ/ÅÆÉ\"ˆ bˆÊÇxˆË ˆÌÍ!„DÅÆÇ\"ˆÎ ˆiWƒUjˆ‚XÐ ˆÇ‡" [parse-partial-sexp eol state last-sexp 3 throw no-comment nil 0 t " " backward-prefix-chars looking-at ";[ ]*\"" delete-horizontal-space comment-column tab-to-tab-stop] 6)] 2 "\ Indent a one line (string) Mim comment following object, if any."]) (defalias 'indent-mim-line #[nil "d`ZÁyˆ`à ÅÆwˆi U„\n`|ˆ jˆdZ`V…)dZb+‡" [position 0 bol calculate-mim-indent indent " " nil] 2 "\ Indent line of Mim code." "*"]) (defalias 'newline-and-mim-indent #[nil "À ˆÁ ‡" [newline indent-mim-line] 1 "\ Insert newline at point and indent." "*"]) (defalias 'open-mim-line #[(&optional lines) "ÀyˆÁ  ÀV…Ä ˆÅyˆ\njˆ S‰‚)‡" [0 calculate-mim-indent indent lines newline -1] 3 "\ Insert newline before point and indent. With ARG insert that many newlines." "*p"]) (defalias 'indent-mim-object #[(&optional dont-indent-first-line) "À‰‰‰ŠÅ`dÆÇ$ˆ`ÈÉ!ˆd`Z)Š\n„$Ë ˆÉyˆd`Z V…QÌ !`ÍÀwˆ\niU„F `|ˆ\njˆƒ$Î ˆ‚$-‡" [nil start indent bol end parse-partial-sexp 0 t forward-sexp 1 dont-indent-first-line indent-mim-line calculate-mim-indent " " indent-mim-comment] 5 "\ Indent object following point and all lines contained inside it. With ARG, idents only contained lines (skips first line)." "*P"]) (defalias 'find-mim-definition #[(name) "ÀŠebˆÀÂÈ) …Ä ˆ bˆÅyˆÆÅ!)‡" [nil where (byte-code "ÀÁ\nP!ˆ`À‡" [re-search-forward "^<\\(DEFINE\\|\\DEFMAC\\|FCN\\|GFCN\\)\\([ ]*\\)" name where] 3) ((error (error "Can't find %s" name))) push-mark 0 recenter] 3 "\ Search for definition of function, macro, or gfcn. You need type only enough of the name to be unambiguous." "sName: "]) (defalias 'begin-mim-comment #[nil "Àˆ`Âyˆ`ÄÅ Æ#ƒ(…d`ZÇ ˆdZb)‚À‰ \n bˆË` Â#‰\n@šƒQ\nAA@ƒQ\nAA@ ‚1Ì\n›@?…Œ` |ˆ „r\n@šƒrÍ jˆ‚ƒiVƒÏ ˆ‚ƒjˆcˆŠc)**‡" [nil eol 0 bol re-search-forward ";[ ]*\"" t indent-mim-comment where last-sexp state parse-partial-sexp 3 calculate-mim-indent comment-column tab-to-tab-stop comment-start comment-end] 4 "\ Move to existing comment or insert empty comment." "*"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias skip-mim-whitespace #[(direction) "ÁYƒ\n\ndw‡\nex‡" [direction 0 mim-whitespace] 2] inside-adecl-or-trailer-p #[(direction) "ÁYƒ\nÂÃ!‡hÄU†ÂÅ!‡" [direction 0 looking-at ":\\|!-" 58 "!-"] 2]] 3) (defalias 'sign #[(n) "ÁYƒ‡Ç" [n 0 1 -1] 2 "\ Returns -1 if N < 0, else 1."]) (defalias 'abs #[(n) "ÁYƒ‡[‡" [n 0] 2 "\ Returns the absolute value of N."]) (defalias 'next-char #[(direction) "ÁYƒg‡h‡" [direction 0] 2 "\ Returns preceding-char if DIRECTION < 0, otherwise following-char."]) (provide (quote mim-mode)) emacs-19.22/lisp/mim-syntax.elc100666 13437 1 3024 5416171764 15017 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:39:32 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/mim-syntax.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote mim-mode)) (defalias 'slow-syntax-check-mim #[nil "ÀÁ!ˆd‰‰‰‰Šebˆ „ŒÉÊË#ƒŒh‰ÌUƒ5ÂÍΈ‚ÏUƒDÂÐш‚zÒUƒz ƒ`ÓÔÕ HÖ\"×\"U„f`‰‚@‰…q SfA‚ ƒ„ B`‚) „› „›ÀØ!‚á ƒØ bˆÌšƒ¯ÙÚ!‚á „½ÙÛÜ!\"‚áÙÝŠ`S Sbˆ`ˆ` ^{)Ü!#‚á bˆÙÞÜ !\".‡" [message "checking syntax..." nil last-point whoops last-bracket current point-stack stop re-search-forward "\\s(\\|\\s)\\|\"\\|[\\]" t 34 (byte-code "ÀÁ!ˆÂ‡" [re-search-forward "[^\\]\"" nil current] 2) ((error (byte-code "`Á‡" [whoops nil] 1))) 92 (forward-char 1) ((error)) 41 logand lsh syntax-table -8 127 "Syntax correct" error "Unterminated string" "Extraneous %s" char-to-string "Mismatched %s with %s" "Unmatched %s"] 7 "\ Check Mim syntax slowly. Points out the context of the error, if the syntax is incorrect." nil]) (defalias 'fast-syntax-check-mim #[nil "ŠebˆÀm„Â`dÃ#‰@Ú„ @Úƒ$ÄÅ!‚'ÆÇ!*‡" [nil state parse-partial-sexp 0 message "Syntax correct" error "Syntax incorrect"] 4 "\ Checks Mim syntax quickly. Answers correct or incorrect, cannot point out the error context." nil]) emacs-19.22/lisp/misc.elc100666 13437 1 1703 5416171766 13650 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:39:34 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/misc.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'copy-from-above-command #[(&optional arg) "iÀÁŠÅyˆÆÇ!ˆÈÀxˆÉ !ˆ\nƒ\"Ë\n!‚#d iWƒHhÌUƒDÍ i Z^Î\" ‰i Z^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 "\ 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." "P"]) emacs-19.22/lisp/mlconvert.elc100666 13437 1 15553 5422716645 14754 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 20 03:24:21 1993 ;;; from file /home/fsf/rms/e19/lisp/mlconvert.el ;;; emacs version 19.16.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"))) (error "This file was compiled for Emacs 19")) (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 "\ Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run." nil]) (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\"ˆÅ{|\"ˆÅ}~\"ˆÅ€\"ˆÅ‚\"ˆÅƒ„\"ˆÅ…†\"ˆÅ‡ˆ\"ˆÅ‰Š\"ˆÅ‹Š\"ˆÅŒ\"ˆÅŽ\"ˆÅ‘\"ˆÅ’“\"ˆÅ”•\"ˆÅ–—\"ˆÅ˜™\"ˆÅš›\"ˆÅœ\"ˆÅžŸ\"ˆÅ ¡\"ˆÅ¢£\"ˆÅ¤¥\"ˆÅ¦§\"ˆÅ¨©\"ˆÅª«\"ˆÅ¬­\"ˆÅ®¯\"ˆÅ°±\"ˆÅ²³\"ˆÅ´µ\"ˆÅ¶·\"ˆÅ¸¹\"ˆÅº»\"ˆÅ¼½\"ˆÅ¾¿\"ˆÅÀÁ\"ˆÅÂÃ\"ˆÅÄÅ\"ˆÅÆÇ\"ˆÅÈÉ\"ˆÅÊË\"ˆÅÌÍ\"ˆÅÎÍ\"ˆÅÏÐ\"ˆÅÑÒ\"ˆÅÓÔ\"ˆÅÕÖ\"ˆÅ×Ø\"ˆÅÙÚ\"ˆÅÛÜ\"ˆÅÝÞ\"ˆÅßà\"ˆÅáâ\"ˆÅãä\"ˆÅåæ\"ˆÅçè\"ˆÅéê\"ˆÅëì\"ˆÅíî\"ˆÅïð\"ˆÅñò\"ˆÅóô\"ˆÅõö\"ˆÅ÷ø\"ˆÅùú\"ˆÅûü\"ˆÅýþ\"ˆÅÿ\"ˆÅ\"ˆÅ\"ˆÅ\"ˆÅ\"‡" [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] 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] ml-expansion #[(ml-name lisp-string) "À  #‡" [put ml-name mocklisp lisp-string] 4] 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" 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.22/lisp/mlsupport.elc100666 13437 1 22201 5416172056 14767 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:40:29 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/mlsupport.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÓMˆÔMˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆÀåæ\"ˆÀçè\"ˆÀéê\"ˆÀëì\"ˆÀíî\"ˆÀïð\"ˆÀñò\"ˆÀóô\"ˆÀõö\"ˆÀ÷ø\"ˆÀùú\"ˆÀûü\"ˆÀýþ\"ˆÀÿ@\"ˆÀ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\"ˆÀ{|\"ˆÀ}~\"ˆ€!„Í€À‚ƒ\"ˆÀ„…\"ˆÀ†‡\"ˆÀˆ‰\"ˆÀŠ‹\"ˆÀŒ\"ˆÀŽ\"ˆÀ‘\"ˆÀ’“\"ˆÀ”•\"ˆÀ–—\"ˆÀ˜™\"ˆÀš›\"‡" [defalias ml-defun (macro . #[(&rest defs) "ÀÁ\nDD‡" [ml-defun-1 quote defs] 3]) ml-defun-1 #[(args) "…@@Á@ABMˆA‰„‡" [args mocklisp nil] 4] declare-buffer-specific (macro . #[(&rest vars) "ÀÁ \"B‡" [progn mapcar #[(var) "ÀÁ\nDD‡" [make-variable-buffer-local quote var] 3] vars] 4]) ml-set-default #[(varname value) "ÀÁ\n! \"‡" [set-default intern varname value] 3] >> #[(val count) "À \n[\"‡" [lsh val count] 3] novalue (lambda nil) ml-not #[(arg) "ÁUƒ‡Á‡" [arg 0 1] 2] provide-prefix-arg #[(arg form) "@ !‡" [form arg] 2] define-keymap #[(name) "À ! M‡" [intern name make-keymap] 2] esc-map ctl-x-map ml-use-local-map #[(name) "ÀÁ\nÃP!!‡" [use-local-map intern name "-map"] 4] ml-use-global-map #[(name) "ÀÁ\nÃP!!‡" [use-global-map intern name "-map"] 4] local-bind-to-key #[(name key) "À „\nÁ !ˆÃÀ ¨ƒ+ ÅYƒ%Æ!Æ ÅZ!P‚,Æ !‚, È !#‡" [current-local-map use-local-map make-keymap define-key key 128 char-to-string meta-prefix-char intern name] 6] bind-to-key #[(name key) "À \n¨ƒ Ã\n!‚\nÄ !#‡" [define-key global-map key char-to-string intern name] 5] ml-autoload #[(name file) "ÀÁ\n! \"‡" [autoload intern name file] 3] ml-define-string-macro #[(name defn) "À !\nM‡" [intern name defn] 2] push-back-character #[(char) "C‰‡" [char unread-command-events] 2] to-col #[(column) "À Â\"‡" [indent-to column 0] 3] is-bound (macro . #[(&rest syms) "ÀÁ \"B‡" [and mapcar #[(sym) "ÀÁ\nDD‡" [boundp quote sym] 3] syms] 4]) declare-global (macro . #[(&rest syms) "ÀÁ \"B‡" [progn mapcar #[(sym) "À ÂE‡" [defvar sym nil] 3] syms] 4]) error-occurred (macro . #[(&rest body) "ÀÁÂà Å\"BÆF‡" [condition-case nil progn append body (nil) (error t)] 6]) return-prefix-argument #[(value) "‰‡" [value prefix-arg] 2] ml-prefix-argument #[nil "„Á‡<ƒ@‡Â=ƒÇ‡" [current-prefix-arg 1 - -1] 2] ml-print #[(varname) "À !ƒÂÃÄ ! J#‡ÂÅÄ !\"‡" [boundp varname message "%s => %s" symbol-name "%s has no value"] 4 nil "vPrint variable: "] ml-set #[(str val) "À !\nL‡" [intern str val] 2] ml-message #[(&rest args) "ÀÁÂà \"\"‡" [message "%s" apply concat args] 5] kill-to-end-of-line #[nil "Àlƒ Á``T\"‚Á`ÂÃÄÅ#ƒ`S‚d\"!‡" [ml-prefix-argument-loop kill-region search-forward 10 nil t] 7] set-auto-fill-hook #[(arg) "À !‰‡" [intern arg auto-fill-function] 2] auto-execute #[(function pattern) "ÁHÂU„ ÃÄ!ˆÅÆÇOÈQ B\nB‰\n‡" [pattern 0 42 error "Only patterns starting with * supported in auto-execute" "\\." 1 nil "$" function auto-mode-alist] 4] move-to-comment-column #[nil "j‡" [comment-column] 1] erase-region #[nil "`À |‡" [mark] 2] delete-region-to-buffer #[(bufname) "À ` #ˆ` |‡" [copy-to-buffer bufname mark] 4] copy-region-to-buffer #[(bufname) "À ` #‡" [copy-to-buffer bufname mark] 4] append-region-to-buffer #[(bufname) "À ` #‡" [append-to-buffer bufname mark] 4] prepend-region-to-buffer #[(bufname) "À ` #‡" [prepend-to-buffer bufname mark] 4] delete-next-character #[nil "ÀÁ !‡" [delete-char ml-prefix-argument] 2] delete-next-word #[nil "`À vˆ`|‡" [ml-prefix-argument] 2] delete-previous-word #[nil "`ÀÁ !ˆ`|‡" [backward-word ml-prefix-argument] 3] delete-previous-character #[nil "ÀÁ !‡" [delete-backward-char ml-prefix-argument] 2] forward-character #[nil "À u‡" [ml-prefix-argument] 1] backward-character #[nil "ÀÁ !‡" [backward-char ml-prefix-argument] 2] ml-newline #[nil "ÀÁ !‡" [newline ml-prefix-argument] 2] ml-next-line #[nil "ÀÁ !‡" [next-line ml-prefix-argument] 2] ml-previous-line #[nil "ÀÁ !‡" [previous-line ml-prefix-argument] 2] delete-to-kill-buffer #[nil "À`Á \"‡" [kill-region mark] 3] narrow-region #[nil "`À }‡" [mark] 2] ml-newline-and-indent #[nil "À Âà !ˆ j)‡" [current-indentation column newline ml-prefix-argument] 2] newline-and-backup #[nil "ÀÁ !‡" [open-line ml-prefix-argument] 2] quote-char #[nil "ÀÁ !‡" [quoted-insert ml-prefix-argument] 2] ml-current-column #[nil "iT‡" [] 1] ml-current-indent #[nil "À T‡" [current-indentation] 1] region-around-match #[(&optional n) "À ”!ˆ •b‡" [set-mark n] 2] region-to-string #[nil "`À ^`À ]{‡" [mark] 3] use-abbrev-table #[(name) "À ÂP!Ä !„Å Æ\"ˆ J)‡" [intern name "-abbrev-table" symbol boundp define-abbrev-table nil] 3] define-hooked-local-abbrev #[(name exp hook) "À \nà !#‡" [define-local-abbrev name exp intern hook] 5] define-hooked-global-abbrev #[(name exp hook) "À \nà !#‡" [define-global-abbrev name exp intern hook] 5] case-word-lower #[nil "ÀÁ!‡" [ml-casify-word downcase-region] 2] case-word-upper #[nil "ÀÁ!‡" [ml-casify-word upcase-region] 2] case-word-capitalize #[nil "ÀÁ!‡" [ml-casify-word capitalize-region] 2] ml-casify-word #[(fun) "ŠÀuˆÁvˆ\n`à vˆ`\")‡" [1 -1 fun ml-prefix-argument] 3] case-region-lower #[nil "À`Á \"‡" [downcase-region mark] 3] case-region-upper #[nil "À`Á \"‡" [upcase-region mark] 3] case-region-capitalize #[nil "À`Á \"‡" [capitalize-region mark] 3] boundp saved-command-line-args nil argc #[nil "„  G‡" [saved-command-line-args command-line-args nil] 1] argv #[(i) "„  8‡" [saved-command-line-args command-line-args nil i] 2] invisible-argc #[nil "† G‡" [saved-command-line-args command-line-args] 1] invisible-argv #[(i) " †\n8‡" [i saved-command-line-args command-line-args] 2] exit-emacs #[nil "ÀÁ‡" [nil (exit-recursive-edit) ((error (kill-emacs)))] 3 nil nil] ml-buffer-size #[nil "deZ‡" [] 2] previous-command (lambda nil last-command) beginning-of-window #[nil "À b‡" [window-start] 1] end-of-window #[nil "À bˆÁ ÃZ!‡" [window-start vertical-motion window-height 2] 3] ml-search-forward #[(string) "À ‰à $‡" [search-forward string nil ml-prefix-argument] 5] ml-re-search-forward #[(string) "À ‰à $‡" [re-search-forward string nil ml-prefix-argument] 5] ml-search-backward #[(string) "À ‰à $‡" [search-backward string nil ml-prefix-argument] 5] ml-re-search-backward #[(string) "À ‰à $‡" [re-search-backward string nil ml-prefix-argument] 5]] 3) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆãä!‡" [defalias filter-region #[(command) "ÁU„\n\n‚ ÃÄ !ÆšÈ`É Ê‰Ëƒ) ƒ)Í‚*ÎÏ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] 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] use-syntax-table #[(name) "ÀÁ\nÃP!J!‡" [set-syntax-table intern name "-syntax-table"] 4] line-to-top-of-window #[nil "ÀÁ S!‡" [recenter ml-prefix-argument] 2] ml-previous-page #[(&optional arg) "†Á ‰ÃVƒÄÅ!ˆ\nS‰‚\nÃW…)ÆÅ!ˆ\nT‰‚)‡" [arg ml-prefix-argument count 0 scroll-down nil scroll-up] 3] ml-next-page #[nil "ÀÁ [!‡" [previous-page ml-prefix-argument] 2] page-next-window #[(&optional arg) "†Á ‰ÃVƒÄÅ!ˆ\nS‰‚\nÃW…)ÄÆ!ˆ\nT‰‚)‡" [arg ml-prefix-argument count 0 scroll-other-window nil -] 3] ml-next-window #[nil "ÀÁ !‡" [select-window next-window] 2] ml-previous-window #[nil "ÀÁ !‡" [select-window previous-window] 2] scroll-one-line-up #[nil "ÀÁ !‡" [scroll-up ml-prefix-argument] 2] scroll-one-line-down #[nil "ÀÁ !‡" [scroll-down ml-prefix-argument] 2] split-current-window #[nil "ÀÁ !‡" [split-window selected-window] 2] last-key-struck (lambda nil last-command-char) execute-mlisp-line #[(string) "ÀÁ\n!!‡" [eval read string] 3] move-dot-to-x-y #[(x y) "ÀÁ !bˆÂ S!ˆÄ S!‡" [window-start selected-window vertical-motion y move-to-column x] 2] ml-modify-syntax-entry #[(string) "À G ÂÃO ÂHÇUƒ ÂÈIˆ ÃHÉUƒ4 ÊHÈUƒ0 ÂËIˆ‚4ÌÍ!ˆ ÎHÏUƒP ÊHÈUƒL ÂÐIˆ‚PÌÍ!ˆ W…¡Ñ H \"ˆT‰ WƒP HÇUƒP SH TH‰Xƒ—Ñ \"ˆ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] ml-substr #[(string from to) "G\nÃWƒ \n \\ ÃWƒ \\\n‰ \\O)‡" [string length from 0 to] 4] provide mlsupport] 3) emacs-19.22/lisp/modula2.elc100666 13437 1 21361 5416172106 14267 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:40:53 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/modula2.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (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) (defvar m2-mode-map nil "\ Keymap used in Modula-2 mode.") (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 " " m2-link "" m2-compile] 4) (defvar m2-indent 5 "\ *This variable gives the indentation in Modula-2-Mode") (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 "\ 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." nil]) (defalias 'm2-newline #[nil "À  ˆ j)‡" [current-indentation hpos newline] 1 "\ Insert a newline and indent following line like previous line." nil]) (defalias 'm2-tab #[nil "À ¥T _j‡" [current-indentation m2-indent] 2 "\ Indent to next tab stop." nil]) (defalias 'm2-begin #[nil "ÀcˆÁ ˆÂ ‡" ["BEGIN" m2-newline m2-tab] 1 "\ Insert a BEGIN keyword and indent for the next line." nil]) (defalias 'm2-case #[nil "ÀÁ!Ã\nıˆÅ ˆÅ ˆÆ\nDZˆ)ÈˆÉ ‡" [read-string "Case-Expression: " name "CASE " " OF" m2-newline "END (* case " " *);" 0 m2-tab] 3 "\ Build skeleton CASE statment, prompting for the ." nil]) (defalias 'm2-definition #[nil "ÀcˆÁÂ!‰Ä űˆ)ÆÇ!‡" ["DEFINITION MODULE " read-string "Name: " name ";\n\n\n\nEND " ".\n" previous-line 3] 5 "\ Build skeleton DEFINITION MODULE, prompting for the ." nil]) (defalias 'm2-else #[nil "À ˆÁ\nÃ\"ˆÄcˆÀ ˆÅ ‡" [m2-newline backward-delete-char-untabify m2-indent nil "ELSE" m2-tab] 3 "\ Insert ELSE keyword and indent for next line." nil]) (defalias 'm2-for #[nil "ÀcˆÁÂ!ɉDZˆÁÈ!‰cˆÁÉ!‰ʘ„'Ë ±ˆÌcˆÍ ˆÍ ˆÎÏ Ð±ˆ+ÑˆÒ ‡" ["FOR " read-string "Loop Initialiser: " nil by limit name " TO " "Limit: " "Step: " "" " BY " " DO" m2-newline "END (* for " " to " " *);" 0 m2-tab] 6 "\ Build skeleton FOR loop statment, prompting for the loop parameters." nil]) (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 "\ Insert a comment block containing the module title, author, etc." nil]) (defalias 'm2-if #[nil "ÀcˆÁÂ!‰ıˆÅ ˆÅ ˆÆ DZˆ)ÈˆÉ ‡" ["IF " read-string ": " thecondition " THEN" m2-newline "END (* if " " *);" 0 m2-tab] 4 "\ Insert skeleton IF statment, prompting for ." nil]) (defalias 'm2-loop #[nil "ÀcˆÁ ˆÁ ˆÂcˆÃˆÄ ‡" ["LOOP" m2-newline "END (* loop *);" 0 m2-tab] 1 "\ Build skeleton LOOP (with END)." nil]) (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 "\ Build skeleton IMPLEMENTATION MODULE, prompting for ." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"‡" [defalias m2-or #[nil "À ˆÁ\n!ˆÃcˆÀ ˆÄ ‡" [m2-newline backward-delete-char-untabify m2-indent "|" m2-tab] 2 nil nil] m2-procedure #[nil "ÀcˆÁÂ!ÉƱˆÁÇ!ȱˆÁÉ!‰ʘ„$Ë ±ˆÌ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] m2-with #[nil "ÀcˆÁÂ!‰cˆÄcˆÅ ˆÅ ˆÆ DZˆ)ÈˆÉ ‡" ["WITH " read-string "Record-Type: " name " DO" m2-newline "END (* with " " *);" 0 m2-tab] 4 nil nil] m2-record #[nil "ÀcˆÁ ˆÁ ˆÂcˆÃˆÄ ‡" ["RECORD" m2-newline "END (* record *);" 0 m2-tab] 1 nil nil] 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] m2-type #[nil "ÀcˆÁ ˆÂ ‡" ["TYPE" m2-newline m2-tab] 1 nil nil] m2-until #[nil "ÀcˆÁ ˆÁ ˆÂcˆÃÄ!űˆÆˆÇ ‡" ["REPEAT" m2-newline "UNTIL " read-string ": " ";" 0 m2-tab] 2 nil nil] m2-var #[nil "À ˆÁcˆÀ ˆÂ ‡" [m2-newline "VAR" m2-tab] 1 nil nil] m2-while #[nil "ÀcˆÁÂ!‰ıˆÅ ˆÅ ˆÆ DZˆ)ÈˆÉ ‡" ["WHILE " read-string ": " name " DO" m2-newline "END (* while " " *);" 0 m2-tab] 4 nil nil] m2-export #[nil "Àc‡" ["EXPORT QUALIFIED "] 1 nil nil] m2-import #[nil "ÀcˆÁÂ!cˆÃc‡" ["FROM " read-string "Module: " " IMPORT "] 2 nil nil] m2-begin-comment #[nil "n„ À Â\"ˆÃc‡" [indent-to comment-column 0 "(* "] 3 nil nil] m2-end-comment #[nil "n„jˆÁc‡" [end-comment-column "*)"] 1 nil nil] m2-compile #[nil "À Â Ä Q!‡" [buffer-name modulename compile m2-compile-command " "] 4 nil nil] m2-link #[nil "À \nƒà Å\nQ!‡Ã ÅÆÇ \"‰Q!‡" [buffer-name modulename m2-link-name compile m2-link-command " " read-string "Name of executable: "] 6 nil nil] execute-monitor-command #[(command) " !ÚÅ ÆljÈÉ\nP&*‡" [shell-file-name shell file-name-nondirectory "csh" csh call-process nil t "-cf" "exec " command] 8] 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*" 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]] 3) (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 "\ Toggle between .mod and .def files for the module." nil]) emacs-19.22/lisp/mouse-sel.elc100666 12120 1 15157 5470557642 14523 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 11 19:58:09 1993 ;;; from file /home/fsf/rms/e19/lisp/mouse-sel.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!ˆÂÄ!‡" [provide mouse-sel require mouse thingatpt] 2) (defconst mouse-sel-version (substring "$Revision: 1.1 $" 11 -2) "\ The revision number of mouse-sel (as string). The complete RCS id is: $Id: mouse-sel.el,v 1.1 1993/11/08 14:27:16 rms Exp $") (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-retain-highlight nil "\ *Retain highlight on mouse-drag-overlay. If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will remain highlighted. If nil, highlighting will be turned off when the mouse is lifted.") (defvar mouse-sel-cycle-clicks t "\ *If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks. Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.") (defvar mouse-sel-default-bindings t "\ Set to nil before loading mouse-sel to prevent default mouse bindings.") (defvar mouse-sel-selection-type nil "\ Type of current selection") (make-variable-buffer-local (quote mouse-sel-selection-type)) (defvar mouse-sel-selection "" "\ This variable is used to store the selection value when mouse-sel is used on windowing systems other than X Windows.") (defvar mouse-sel-set-selection-function (byte-code "Á=ƒ‡Ç" [window-system x #[(s) "ÀÁ\n\"‡" [x-set-selection PRIMARY s] 3] #[(s) "‰‡" [s mouse-sel-selection] 2]] 2) "\ Function to call to set selection. Called with one argument, the text to select.") (defvar mouse-sel-get-selection-function (byte-code "Á=ƒ‡Ç" [window-system x x-get-selection (lambda nil mouse-sel-selection)] 2) "\ Function to call to get the selection. Called with no argument, it should return the selected text.") (defvar mouse-sel-check-selection-function (byte-code "Á=…‡" [window-system x x-selection-owner-p] 2) "\ Function to check whether emacs still owns the selection. Called with no arguments.") (defalias 'mouse-sel-determine-selection-type #[(NCLICKS) "`f‰… z\nƒ SĦT‚ ‰ÆUƒ\"Ç‚Q ÄYƒ,È‚Q É>ƒ6Ê‚QË>ƒ@Ì‚Q Í=ƒJ΂Q Ï=…QÐ+‡" [next-char char-syntax mouse-sel-cycle-clicks NCLICKS 3 nclicks 1 nil line (40 41 34 39) sexp (32 9 10) whitespace 95 symbol 119 word] 3 "\ Determine what `thing' \\[mouse-select] and \\[mouse-extend] should select by. The first argument is NCLICKS, is the number of consecutive mouse clicks at the same position."]) (defalias 'mouse-select #[(EVENT) "À !ˆÂ Ä 8¨ƒÄ 8‚Å)!Ç!‰ƒ4É\n@bˆËA!ˆ‚;Ì\nÍÎ!ˆ)Ï ‡" [mouse-set-point EVENT mouse-sel-determine-selection-type event 2 1 mouse-sel-selection-type bounds-of-thing-at-point object-bounds t mark-active set-mark nil run-hooks deactivate-mark-hook mouse-extend] 4 "\ Set region/selection using the mouse. On click, point & mark are set to click position, and mark is disabled. Dragging extends region/selection. 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. Clicking mouse-2 while selecting copies the region to the kill-ring. Clicking mouse-1 or mouse-3 kills the region. This should be bound to a down-mouse event." "e"]) (defalias 'mouse-extend #[(&optional EVENT) "ƒÁÃ\n8:ƒÂÄ\n8)‰@)!ˆƒ&Ç ‚'`ƒ3É ‚4`\nË  Í !Ï !A@ÑÏ !8ÓÔÕÖ !\"AØØØÚ\np$ˆÜÝÞÝ\"#ˆßÖ à\"ˆáŽâ ˆã!ä!$‰#$=ƒŸØåæ!ˆ‚À'ƒ·Ä=ƒ·è#!ˆ$bˆ‚Àè$!ˆ#bˆƒÓ)ƒÓ)#${!ˆ*¢ë=ƒêì#$\"ˆí ˆí ‚*¢î>…ï#$\"ˆØåæ!ˆí ˆí . ‡" [EVENT select-window event 2 1 position mark-active region-beginning min region-end max selected-window orig-window window-frame orig-window-frame window-edges top 3 bottom assoc cursor-type frame-parameters selected-frame orig-cursor-type nil direction move-overlay mouse-drag-overlay overlay-put face overlay-get modify-frame-parameters ((cursor-type . bar)) ((byte-code "ÀÁ  BC\"ˆ „Å!ˆÀ‡" [modify-frame-parameters selected-frame cursor-type orig-cursor-type mouse-sel-retain-highlight delete-overlay mouse-drag-overlay] 4)) (lambda nil (track-mouse (byte-code "ƒ ‰Â‚à ‰:… @Ä>… Å 8:ƒ(Å‚)Æ 8) ¢È=„æ‰ @)ƒPʉ @)!Ê !=ƒæ‰ @) =„¤Ì AA‰ ƒ‚o„‚ Wƒ‚Ï Z#ˆ‚  ƒ m„  Yƒ Ï ZT#ˆ)‚æ‰ A@:ƒ· A@@‚» A@)Ô=ƒÌÏÆ#ˆ‚æ‰ A@:ƒß A@@‚ã A@)bˆ„ =„ `\\Å¥WƒÖ‚Æ‚.Ö=„`XƒÖ‚.Æ=„.`Yƒ.ƃ]Æ=ƒAm„AÆuˆ`ÂÆ=ƒS‚UbˆÂÚÛˆ*ÜÆ=ƒl‚m`Ö=ƒy‚z`p$ˆ)‚‡" [EVENT event nil read-event (mouse-movement switch-frame) 2 1 end switch-frame position window-frame orig-window mouse-position end-row top mouse-scroll-subr mouse-drag-overlay max bottom min mode-line direction -1 mouse-sel-selection-type last goal (byte-code " `Z_ÂVƒ`Ä \"ˆ‚`Ä [\"ˆ `Z_ÂVƒ,‚- bˆ)‡" [direction goal 0 last forward-thing mouse-sel-selection-type end] 3) ((error)) move-overlay] 6))) overlay-start overlay-end run-hooks deactivate-mark-hook mouse-sel-leave-point-near-mouse set-mark mouse-sel-set-selection-function last-input-event down-mouse-2 copy-region-as-kill read-event (down-mouse-1 down-mouse-3) kill-region] 7 "\ Extend region/selection using the mouse. See documentation for mouse-select for more details. This should be bound to a down-mouse event." "e"]) (defalias 'mouse-insert-selection #[(click) "À !ˆÂÄÅ!ˆ… †Çc‡" [mouse-set-point click nil mark-active run-hooks deactivate-mark-hook mouse-sel-get-selection-function ""] 2 "\ Insert the contents of the selection at mouse click." "e"]) (defalias 'mouse-sel-validate-selection #[nil "?†  † Á\n!‡" [mouse-sel-check-selection-function delete-overlay mouse-drag-overlay] 2 "\ Remove selection highlight if emacs no longer owns the primary selection."]) (byte-code "ÀÁÂ\"ˆ ƒ0ÄÅ!ˆÄÆ!ˆÄÇ!ˆÈÉÊ\"ˆÈËÌ\"ˆ Í=„0ÈÎÏ\"ˆÐÐЇ" [add-hook pre-command-hook mouse-sel-validate-selection 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 interprogram-cut-paste [mouse-2] mouse-insert-selection nil interprogram-cut-function interprogram-paste-function] 3) emacs-19.22/lisp/mouse.elc100666 13437 13 53666 5475604162 13636 0ustar jimbuser;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 02:57:33 1993 ;;; from file /home/fsf/rms/e19/lisp/mouse.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (put (quote track-mouse) (quote lisp-indent-function) 0) (defalias 'mouse-delete-window #[(click) "À ‰A@)‰@)!‡" [delete-window click event position] 3 "\ Delete the window you click on. This must be bound to a mouse click." "e"]) (defalias 'mouse-tear-off-window #[(click) "‰A@)‰@)Ä !Æ È!ˆÉ !ˆÊ !+‡" [click event position window window-buffer buf new-frame frame select-frame switch-to-buffer delete-window] 3 "\ Delete the window clicked on, and create a new frame displaying its buffer." "e"]) (defalias 'mouse-delete-other-windows #[nil "À ‡" [delete-other-windows] 1 "\ Delete all window except the one you click on." "@"]) (defalias 'mouse-split-window-vertically #[(click) "‰A@)Ã\n‰@)!ˆ\n‰A@:ƒ A@@‚\" A@)Å=ƒ6Æ\nÇ 8)È S\"‚NÇ 8:ƒCÇ‚DÉ 8)Ç 8)AT\nÈ \nZ     WƒiÎÏ!‚sÐ  ] ^!,‡" [click event start select-window position vertical-scroll-bar scroll-bar-scale 2 window-height 1 window-min-height last-line first-line new-height error "window too short to split" split-window-vertically] 5 "\ 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." "@e"]) (defalias 'mouse-split-window-horizontally #[(click) "‰A@)Ã\n‰@)!ˆÅ 8:ƒÅ‚Æ 8)Å 8)@TÈ Z \n  \nWƒBÌÍ!‚LÎ \n] ^!,‡" [click event start select-window position 2 1 window-min-width window-width last-col first-col new-width error "window too narrow to split" split-window-horizontally] 5 "\ 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." "@e"]) (defalias 'mouse-set-point #[(event) "Á8:ƒ Á‚Â8)ÄÅ !!ƒ&ÆÅ !!„&ÇÈ!ˆÉ ‰\n@)!ˆ ‰\nA@:ƒA\nA@@‚E\nA@)§…b ‰\nA@:ƒ\\\nA@@‚`\nA@)b)‡" [event 2 1 posn window-minibuffer-p posn-window minibuffer-window-active-p error "Minibuffer window is not active" select-window position] 4 "\ Move point to the position clicked on with the mouse. This should be bound to a mouse click event type." "e"]) (defalias 'mouse-set-region #[(click) "‰A@) 8:ƒ‚à 8)Æ ‰@)!ˆ ‰A@:ƒ4A@@‚8A@)§ƒV ‰A@:ƒOA@@‚SA@)bˆƒdÉÊ !Ë=„hÌÃ!ˆÍ ˆÎ`!ˆ ‰A@:ƒA@@‚…A@)§ƒ£ ‰A@:ƒœA@@‚ A@)bˆÏÑÒ `\"+‡" [click event 2 1 end posn select-window position transient-mark-mode framep selected-frame x sit-for push-mark set-mark nil this-command copy-region-as-kill mark] 4 "\ Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event." "e"]) (defvar mouse-scroll-delay .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.") (defalias 'mouse-scroll-subr #[(jump &optional overlay start) "À bˆÁ\n!ÃU„DÄÅ `\"ˆÆ\n!ƒ&ÇÅ !bˆÁ\nS!ˆ‚,ÀÅ !bˆƒ9É\n`#ˆm„DË !„`‡" [window-start vertical-motion jump 0 set-window-start selected-window natnump window-end overlay move-overlay start sit-for mouse-scroll-delay] 4 "\ Scroll the selected 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."]) (byte-code "ÀÁ!„ ÂÉ\"Ä ÅÆ#ˆÀÇ!„ÈÀ‡" [boundp mouse-drag-overlay make-overlay 1 overlay-put face region mouse-selection-click-count 0] 4) (defalias 'mouse-drag-region #[(start-event) "‰A@)‰‰A@:ƒ A@@‚ A@)\n‰@)Æ !È !‰ A@\nË !ƒ>Ì 8‚CÌ 8S Î 8¨ƒTÎ 8‚UÏ)S‰Ò!ˆÓ ‰#Õ@A@× !$ˆ)ØÚÛ!ˆØ‰‰Þ ˆß !àNá=ƒ& Î 8:ƒ¡Î‚¢Ï 8)‰@) =ƒ& Î 8:ƒ»Î‚¼Ï 8)‰A@:ƒÎ A@@‚Ñ A@)§ƒ&âã @!!‰$å>ƒæ!ç!U„ Ø(éæ!ê‰#ˆç!bˆë`ìê!\"ˆ)‚%ç!bˆÒ(‚%í$!ƒ%$ !ˆ)î!. ‡" [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-set-point mouse-start-end range move-overlay mouse-drag-overlay window-buffer nil mark-active run-hooks deactivate-mark-hook end-point end (lambda nil (track-mouse (byte-code "À ‰‰:…\n@Ã=)„ ¢Ä=… ¢Ä=„ Å 8:ƒ-Å‚.Æ 8)‰‰A@:ƒEA@@‚IA@) ¢Ä=„‰@)\n=ƒ„Ë !ƒ„ bˆÌ `#Ð@A@#ˆ)‚Ò‰@)!ƒêÓ‰@)!=ƒêÕ‰@)!A@Å8)A\\‰WƒÍØZ #ˆ‚æm„æYƒæØZT #ˆ)‚Ú AAÛÜ žA†÷݉¨ƒWƒØZ #ˆ*‚‡" [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 move-overlay mouse-drag-overlay windowp window-frame start-frame window-edges mouse-row top mouse-scroll-subr bottom mouse-position menu-bar-lines frame-parameters 0 mouse-y] 5))) event-basic-type event-kind mouse-click key-binding vector fun (mouse-set-region mouse-set-point) overlay-start overlay-end this-command push-mark t copy-region-as-kill mark fboundp delete-overlay] 7 "\ 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." "e"]) (defalias 'mouse-skip-word #[(dir) "gÁz!‰Ø„\nĘƒ% ÆWƒÇ\n!‚MÈ\n!‚M ÆWƒ<o?…MhU…MÉuˆ‚+m?…MgU…MÊuˆ‚<*‡" [char char-to-string syntax "w" " " dir 0 skip-syntax-backward skip-syntax-forward -1 1] 3 "\ Skip over word, over whitespace, or over identical punctuation. If DIR is positive skip forward; if negative, skip backward."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias mouse-start-end #[(start end mode) " Vƒ  \n)à Å\"‰ÆUƒ D‡ ÇUƒ> Uƒ>m„>fzÈUƒ>ŠÉÇ!ˆ`)D‡ ÇUƒe Uƒem„efzÊUƒeŠTbˆËÇ!ˆ`)TD‡ ÇUƒŠbˆÌÍ!ˆ`)Š bˆÌÇ!ˆ`)D‡ Î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] mouse-set-mark-fast #[(click) "‰A@)Ã\n‰@)!ˆ\n‰A@:ƒ A@@‚\" A@)§…?Å\n‰A@:ƒ8 A@@‚; A@)Ɖ#)‡" [click event posn select-window position push-mark t] 5] mouse-show-mark #[nil "†ŠÁÂ!bˆÃÄ!)‡" [transient-mark-mode mark t sit-for 1] 2]] 3) (defalias 'mouse-set-mark #[(click) "`ÁŽÂ !ˆÄÅƉ#ˆ†ÈÉ!*‡" [point-save ((goto-char point-save)) mouse-set-point click push-mark nil t transient-mark-mode sit-for 1] 4 "\ 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." "e"]) (defalias 'mouse-kill #[(click) "‰A@)‰A@:ƒ\nA@@‚\nA@)‰§…'Ä` ^` ]\")‡" [click event position click-posn kill-region] 5 "\ Kill the region between point and the mouse click. The text is saved in the kill ring, as with \\[kill-region]." "e"]) (defalias 'mouse-yank-at-click #[(click arg) "À !ˆÂ !‡" [mouse-set-point click yank this-command arg] 2 "\ Insert the last stretch of killed text at the position clicked on. Prefix arguments are interpreted as with \\[yank]." "e\nP"]) (defalias 'mouse-kill-ring-save #[(click) "À !ˆÂ`ÃÄ!\"ˆÅ ‡" [mouse-set-mark-fast click kill-ring-save mark t mouse-show-mark] 4 "\ 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]." "e"]) (byte-code "ÀÁ!„ÂÃÄÅ\"‡" [boundp mouse-save-then-kill-posn nil defalias mouse-save-then-kill-delete-region #[(beg end) "À ˆ \nU„ Ä=ƒ \n|ˆ‚p ‰\n Vƒ\"Å‚#Æ\\|ˆ ÇÅ \"ˆÄ@G\n ]\n ^ZU„BÉÊ!ˆ \n|ˆ) ‰ ƒ_ @@;„_ A‰ „N ƒo @ \n^B ˆ)À ‡" [undo-boundary beg end buffer-undo-list t 1 -1 primitive-undo kill-ring error "Lossage in mouse-save-then-kill-delete-region" tail] 5]] 3) (defalias 'mouse-save-then-kill #[(click) "‰A@)‰A@:ƒ\nA@@‚\nA@) ÅÇ\"ÈVƒ‘ Ê=ƒ7  ££@š„Ì ‰# Î ÏÐ!Z!Î `Z!WƒXÑ @!ˆ‚^ A@bˆ`ÏÐ!{ ˆƒs@!ˆ@` E Ô )‚cÕ`Ï \"ˆÈÖ‰ ‚c Ê=ƒ¾ ƒ¾ @@=ƒ¾ A` Dšƒ¾Õ`Ï \"ˆÖ‰ ‚c Ê=ƒÊ „åƒÔ„å Ù=ƒL„å„L‰A@)‰‰A@:ƒý\nA@@‚\nA@)݉@)!ˆ§ƒ3Î`Z!ÎÏÐ!Z!Wƒ+bˆ‚0Ñ!ˆÖ`ÏÐ!{ ˆƒH@!ˆ*‚Zß!ˆà`ÏÐ!\"ˆÔ ˆ@` E‰ *‡" [click event position this-command click-posn mod mouse-selection-click-count 3 0 last-command mouse-save-then-kill mouse-save-then-kill-posn mouse-start-end range abs mark t set-mark kill-ring interprogram-cut-function mouse-show-mark mouse-save-then-kill-delete-region nil mark-active transient-mark-mode mouse-drag-region mark-even-if-inactive posn new select-window deactivate-mark mouse-set-mark-fast kill-ring-save] 6 "\ 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." "e"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆËÌ!„\"Í ËÎ!„+Í͇" [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 mouse-secondary-start] 3) (defalias 'mouse-start-secondary #[(click) "‰A@)ŠÃ\n‰@)!qˆ ƒÆ !ˆ\n‰A@:ƒ) A@@‚, A@)§…R„:È \n‰A@:ƒL A@@‚O A@)É“*‡" [click event posn window-buffer position mouse-secondary-overlay delete-overlay mouse-secondary-start make-marker nil] 4 "\ 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." "e"]) (defalias 'mouse-set-secondary #[(click) "‰A@)Âà 8:ƒÂÄ 8)ŠÈ‰ @)!qˆ‰ A@:ƒ< A@@‚@ A@)§ƒ_‰ A@:ƒX A@@‚\\ A@)\nƒ…Ë\n ‰ A@:ƒ{ A@@‚ A@)#ˆ‚¢Ì ‰ A@:ƒš A@@‚ž A@)\"\nÍ\nÎÏ#,‡" [click event nil 2 1 end beg posn window-buffer position mouse-secondary-overlay move-overlay make-overlay overlay-put face secondary-selection] 5 "\ Set the secondary selection to the text that the mouse is dragged over. This must be bound to a mouse drag event." "e"]) (defalias 'mouse-drag-secondary #[(start-event) "‰A@)‰‰A@:ƒ A@@‚ A@)\n‰@)Æ !È !‰ A@\nË !ƒ>Ì 8‚CÌ 8S Î 8¨ƒTÎ 8‚UÏ)SŠÑ !qˆ„nÔ``\"ÕÖ×#ˆØÌ\"ÙVƒªÚ ‰#݉“ˆÞÏ‰Ñ !$ˆÞ@A@Ñ !$ˆ)‚¾„³ß  Ý“ˆà!ˆÝ‰‰!\"ã ˆä !åNæ=…- Î 8:ƒà΂áÏ 8)‰@) =…- Î 8:ƒú΂ûÏ 8)‰A@:ƒ  A@@‚ A@)§…-ç!ƒ!è‹‚-éêë!ì!{\". ‡" [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-selection-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„u Ή“ˆÏ  #Ò@A@#ˆ)‚Ô‰@)!ƒõÕ‰@)!=ƒõ׉@)!A@Å8)A\\‰WƒØÚZ #ˆ‚ñm„ñYƒñÚZT #ˆ)‚Ý AAÞß žA†à‰!¨ƒ!WƒÚ!Z #ˆ*‚‡" [read-event event object mouse-movement switch-frame 2 1 end position end-point start-window integer-or-marker-p start-point mouse-secondary-start nil mouse-start-end click-count range move-overlay mouse-secondary-overlay windowp window-frame start-frame window-edges mouse-row top mouse-scroll-subr bottom mouse-drag-overlay mouse-position menu-bar-lines frame-parameters 0 mouse-y] 5))) event-basic-type event-kind mouse-click 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 "\ 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." "e"]) (defalias 'mouse-yank-secondary #[(click) "ŠÀ ‰A@)‰@)!qˆ ‰A@)‰A@:ƒ$ A@@‚' A@)bˆÄÅ!c)‡" [window-buffer click event position x-get-selection SECONDARY] 3 "\ Insert the last stretch of killed text at the position clicked on. Prefix arguments are interpreted as with \\[yank]." "e"]) (defalias 'mouse-kill-secondary #[(click) "À !\n<ƒÃÄÅ\n!!!‚p=„ÆÇ!ˆŠÀ !qˆÈÉ !Ê !\"ˆ)Ë !ˆÌÍÎ\"ˆÎ‰‡" [overlay-buffer mouse-secondary-overlay click window-buffer posn-window event-start error "Select or click on the buffer where the secondary selection is" kill-region overlay-start overlay-end delete-overlay x-set-selection SECONDARY nil] 5 "\ 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." "e"]) (defalias 'mouse-secondary-save-then-kill #[(click) "‰A@)‰A@)‰A@:ƒ\nA@@‚\nA@) ÆÇ !!ƒ4É!†=\n…=Ë\n!=„EÌÍ!ˆŠÆ ‰@)!qˆÎÐ\"ÑVƒàÓ=ƒj ££@š„ÇÕ ‰#× Ø!Z!× Ù!Z!Wƒ•Ú@Ù!#ˆ‚¢ÚØ!A@#ˆØ!Ù!{ ˆƒ»@!ˆ@` E)‚¢ÝØ!Ù!\"ˆÞÑß!ˆ‚¢Ó=ƒƒ@@=ƒA` DšƒÝØ!Ù!\"ˆÞß!ˆ‚¢Ø!ƒl §ƒP× Ø!Z!× Ù!Z!WƒCÚ Ù!#ˆ‚MÚØ! #ˆÞ Ø!Ù!{ ˆƒš@!ˆ‚š\nƒš\n!â! \"ˆƒ‹Ú! #ˆ‚’ã! \"äåæ#ˆ)@` EçèÉ!…´Ø!Ù!{\",‡" [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-selection-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-ring interprogram-cut-function mouse-save-then-kill-delete-region nil delete-overlay deactivate-mark start kill-ring-save make-overlay overlay-put face secondary-selection x-set-selection SECONDARY] 6 "\ 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." "e"]) (defalias 'mouse-buffer-menu #[(event) "ÀÁ Ãĉƒ/È@!ÃHÉ=„&È@!G]A‰„ ‰ƒ…@\nËÌÈ\n!\"„{͉Î\"È\n!Ï\n!ƒ[Ђ\\ÑŠ\nqˆƒjÓ‚kÑ)Ô\n!†tÕ%\nB B)A‰„7Ö !+BDØ\"‰A@)‰@)‰…¸Ý!„´Þ!ˆß!+‡" ["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 "" reverse menu x-popup-menu event position window buf framep select-window switch-to-buffer] 10 "\ 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." "e"]) (defalias (quote mouse-delete-max-match) #[(string) "GdeZ^e`GZ]bˆ ÂVƒ.`` \\{‰ O˜)„. SÄuˆ‚Å !)‡" [string len 0 tail 1 delete-char] 5]) (defalias 'mouse-choose-completion #[(event) "À ÁŠÀ ‰A@)‰@)!qˆŠ ‰A@)‰A@:ƒ* A@@‚- A@)bˆÆÁxˆ`ÆÁwˆ`{+ qˆÈ\n!ˆ\ncˆ ÀÉ !š…VÊ *‡" [window-buffer nil choice buffer event position "^ \n" beg mouse-delete-max-match minibuffer-window minibuffer-complete-and-exit] 4 "\ Click on an alternative in the `*Completions*' buffer to choose it." "e"]) (defalias (quote font-menu-add-default) #[nil "ÀÁ !žA ÆÇ \"† A@ÆÉ\"ƒ(ÊÆÉ\"\"ˆÉÀÁ !žADAB¡+‡" [font frame-parameters selected-frame default x-fixed-font-alist font-alist assoc "Misc" elt "Default" delete] 5]) (defvar x-fixed-font-alist (quote ("Font menu" ("Misc" ("6x10" "-misc-fixed-medium-r-semicondensed--10-110-75-75-c-60-*-1") ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1") ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1") ("lucida 13" "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1") ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1") ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1") ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1") ("") ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1") ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1") ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1") ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1") ("") ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1") ("") ("fixed" "fixed") ("10x20" "10x20") ("11x18" "11x18") ("12x24" "12x24")) ("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")))) "\ X fonts suitable for use in Emacs.") (defalias 'mouse-set-font #[(&optional font) "…”Á ÀBC\"ˆÃÄ ;ƒ!Ç #ÈÀÉ %ˆ+ÊàË#ˆÌÄ ;ƒFÇ #ÈÀÉ %ˆ+ÍÌ Ë#ˆÎÄ ;ƒkÇ #ÈÀÉ %ˆ+ÏΠË#ˆ‰…“ÄÒÓˆA‰„„Ä)‡" [font modify-frame-parameters selected-frame bold nil frame face x-resolve-font-name internal-set-face-1 3 make-face-bold t italic make-face-italic bold-italic make-face-bold-italic global-face-data rest (byte-code "@AÁÄ \n\"ÅH*<ƒeÆ@AÁÄ \n\"ÅH*>Ç@AÁÄ \n\"ÅH*>‰ƒGƒGÈ@@É \"ˆ‚dƒWÊ@@É \"ˆ‚dƒdË@@É \"ˆ*Á‡" [rest nil frame face internal-get-face 3 bold italic make-face-bold-italic selected-frame make-face-bold make-face-italic] 6) ((error))] 7 "\ Select an emacs font from a list of known good fonts" (x-popup-menu last-nonmenu-event x-fixed-font-alist)]) (byte-code "À ÂÃ#ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÆ\"ˆÄÊÆ\"ˆÄËÌ\"ˆÄÍÎ\"ˆÄÏÐ\"ˆÄÑÒ\"ˆÄÓÔ\"ˆÄÕÖ\"ˆÄ×Ø\"ˆÙÚ!„FÛÄÜ\"ˆÙÝ!„WÞß!Ùà!„bÞá! Ùâ!„mÞã!\"Ùä!„xÞå!$Ùæ!„ƒÞç!&Ùè!„ŽÞé!(ÀêëB#ˆÀìí B#ˆÀîï\"B#ˆÀðñ$B#ˆÀòó&B#ˆÀôõ(B#ˆÀö÷#ˆÀøù#ˆÀ úû#ˆÀ öü#ˆÀ ýþ#ˆÀ ÿ@#ˆÀ AB#ˆÀ\"CD#ˆÀ\"EF#ˆÀ$GH#ˆÀ$IJ#ˆÀ&KL#ˆÀ&úM#ˆÀ(NO#ˆÀ(GP#ˆÀ(QR#ˆÀ(AS#ˆTU!‡" [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 [C-down-mouse-3] mouse-set-font [mode-line mouse-1] mouse-delete-other-windows [mode-line mouse-3] mouse-delete-window [mode-line S-mouse-2] mouse-split-window-horizontally boundp help-menu-map (keymap "Help") [C-down-mouse-2] help-apropos-map make-sparse-keymap "Is there a command that..." help-keys-map "Key Commands <==> Functions" help-manual-map "Manual and tutorial" help-misc-map "Odds and ends" help-modes-map "Modes" help-admin-map "Administrivia" [apropos] "@Is there a command that..." [keys] "@Key Commands <==> Functions" [manuals] "@Manual and tutorial" [misc] "@Odds and ends" [modes] "@Modes" [admin] "@Administrivia" "c" ("Command Apropos" . command-apropos) "a" ("Apropos" . apropos) "b" ("List all keystroke commands" . describe-bindings) ("Describe key briefly" . describe-key-briefly) "k" ("Describe key verbose" . describe-key) "f" ("Describe Lisp function" . describe-function) "w" ("Where is this command" . where-is) "i" ("Info system" . info) "t" ("Invoke Emacs tutorial" . help-with-tutorial) "l" ("Last 100 Keystrokes" . view-lossage) "s" ("Describe syntax table" . describe-syntax) "m" ("Describe current major mode" . describe-mode) ("List all keystroke commands" . describe-bindings) "n" ("View Emacs news" . view-emacs-news) ("View Emacs copying conditions" . describe-copying) "d" ("Describe distribution" . describe-distribution) ("Describe (non)warranty" . describe-no-warranty) provide mouse] 5) emacs-19.22/lisp/mpuz.elc100666 13437 1 22166 5427115457 13733 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 2 00:42:23 1993 ;;; from file /home/fsf/rms/e19/lisp/mpuz.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (random t) (defvar mpuz-silent nil "\ *Set this to T if you don't want dings on inputs.") (defalias 'mpuz-ding #[nil "†ÁÂ!‡" [mpuz-silent ding t] 2 "\ Dings, unless global variable `mpuz-silent' forbids it."]) (byte-code "ÀÁ!„‡" [boundp mpuz-mode-hook nil] 2) (defvar mpuz-mode-map nil "\ Local keymap to use in Mult Puzzle.") (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) (defalias 'mpuz-mode #[nil "ÀÂÄ !ˆÆÇ!‡" [mpuz-mode major-mode "Mult Puzzle" mode-name use-local-map mpuz-mode-map run-hooks mpuz-mode-hook] 2 "\ 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]." nil]) (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.") (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.") (defalias (quote mpuz-digit-solved-p) (quote (macro . #[(digit) "ÀÁ\nE‡" [aref mpuz-found-digits digit] 3]))) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias mpuz-to-digit (macro . #[(letter) "ÀÁ\nE‡" [aref mpuz-letter-to-digit letter] 3]) mpuz-to-letter (macro . #[(digit) "ÀÁ\nE‡" [aref mpuz-digit-to-letter digit] 3])] 3) (defalias 'mpuz-build-random-perm #[nil "ÀÁÂÃÄÅÆÇÈɯ\nÊË  …BÏ !8 Ð \" S   Iˆ  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 "\ Initialize puzzle coding with a random permutation."]) (defvar mpuz-board (make-vector 10 nil) "\ The board associates to any digit the list of squares where it appears.") (defalias 'mpuz-put-digit-on-board #[(number square) "Á¦\n \nHBI‡" [number 10 mpuz-board square] 5 "\ Put (last digit of) NUMBER on SQUARE of the puzzle board."]) (defalias 'mpuz-check-all-solved #[nil "ÀÁ‡" [found (byte-code "À T‰Vƒ H„ HƒÅÆÇ\"ˆ‚)ȇ" [-1 digit 10 mpuz-found-digits mpuz-board throw found nil t] 3)] 2 "\ Check whether all digits have been solved. Return t if yes."]) (defalias 'mpuz-random-puzzle #[nil "À ˆÁ\nÃ\"ˆÃ‰‰‰‰ÉÊ!ÉË!̦_Ì¥__ÊW„ ÊW„ÍÎ\"ˆÍÌ¥Ï\"ˆÍË¥Ð\"ˆÍÑ\"ˆÍÌ¥Ò\"ˆÍÓ\"ˆÍÌ¥Ô\"ˆÍË¥Õ\"ˆÍÊ¥Ö\"ˆÍ ×\"ˆÍ Ì¥Ø\"ˆÍ Ë¥Ù\"ˆÍ Ê¥Ú\"ˆÍ Û\"ˆÍ Ì¥Ü\"ˆÍ Ë¥Ý\"ˆÍ Ê¥Þ\"ˆÍ ߥà\"-‡" [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 "\ Draw random values to be multiplied in a puzzle."]) (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 . . . . ." "\ The general picture of the puzzle screen, as a string.") (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 "\ Create (or recreate) the puzzle buffer. Return it."]) (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 "\ Paint error count on the puzzle screen."]) (defalias 'mpuz-paint-statistics #[nil "ÁUƒ\nÁ‚\nÃ_\\‰\\¥‰ŦÇÉÊ!ˆËÌ!ˆÍ ˆÎ!cˆÉÏ!ˆËÐ!ˆÍ ˆÑÒ Å¥Ó¥Ó¦$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 "\ Paint statistics about previous games 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 "\ Paint board situation on the puzzle screen."]) (defalias 'mpuz-paint-digit #[(digit) " Hƒ Â\\‚ 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 "\ Paint all occurrences of DIGIT on the puzzle board."]) (defalias 'mpuz-delete-line #[nil "`fÀU?…ÁÂ!ˆ‚‡" [10 delete-char 1] 2 "\ Clear from point to next newline."]) (defalias 'mpuz-get-buffer #[nil "ÀÁ!‡" [get-buffer "*Mult Puzzle*"] 2 "\ Get the puzzle buffer if it exists."]) (defalias 'mpuz-switch-to-window #[nil "À ‰„\n à !ˆ „Å ˆÆ )‡" [mpuz-get-buffer buff mpuz-create-buffer switch-to-buffer buffer-read-only toggle-read-only mpuz-mode] 3 "\ Find or create the Mult-Puzzle buffer, and display it."]) (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 "\ Abort any puzzle in progress."]) (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 "\ 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 "\ Ask if user wants to start a new puzzle."]) (defalias 'mpuz #[nil "À ˆ ƒ\n ‡Ã ‡" [mpuz-switch-to-window mpuz-in-progress mpuz-offer-abort mpuz-start-new-game] 1 "\ Multiplication puzzle with GNU Emacs." nil]) (defalias 'mpuz-offer-abort #[nil "ÀÁ!ƒ  ‡Ã ‡" [y-or-n-p "Abort game " mpuz-abort-game mpuz-ask-for-try] 2 "\ Ask if user wants to abort current puzzle." nil]) (defalias 'mpuz-ask-for-try #[nil "ÀÁ!‡" [message "Your try ?"] 2 "\ Ask for user proposal in puzzle."]) (defalias 'mpuz-try-letter #[nil "ƒbÁ‰‰‰– ÈZH Hƒ%ÂÊ \"‚` H„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 "\ Propose a digit for a letter in puzzle." nil]) (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 "\ Propose LETTER-CHAR as code for DIGIT-CHAR."]) (defalias 'mpuz-correct-guess #[(digit) " ÂIˆÃ !ˆÄ …Å ‡" [mpuz-found-digits digit t mpuz-paint-digit mpuz-check-all-solved mpuz-close-game] 3 "\ Handle correct guessing of DIGIT."]) (defalias 'mpuz-close-game #[nil "À\n \\ TÅ ˆÆ Ç!ˆÈÉ!ˆÊË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 "\ Housecleaning when puzzle has been 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 "\ Build a congratulation message when puzzle is solved."]) (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 "\ Display solution for debugging purposes." nil]) emacs-19.22/lisp/netunam.elc100666 13437 1 7532 5416172225 14361 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:42:13 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/netunam.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defconst rfa-node-directory "/net/" "\ Directory in which RFA network special files are stored. By HP convention, this is \"/net/\".") (defvar rfa-default-node nil "\ If not nil, this is the name of the default RFA network special file.") (defvar rfa-password-memoize-p t "\ If non-nil, remember login user's passwords after they have been entered.") (defvar rfa-password-alist nil "\ An association from node-name strings to password strings. Used if `rfa-password-memoize-p' is non-nil.") (defvar rfa-password-per-node-p t "\ If nil, login user uses same password on all machines. Has no effect if `rfa-password-memoize-p' is nil.") (defalias 'rfa-set-password #[(password &optional node user) "„Á  \"‰ƒ1 A\"‰ƒ#¡‚- ‰ABC¤¡)‚< BDC¤‰)‡" [user user-login-name assoc node rfa-password-alist node-entry user-entry password] 5 "\ Add PASSWORD to the RFA password database. Optional second arg NODE is a string specifying a particular nodename; if supplied and not nil, PASSWORD applies to only that node. Optional third arg USER is a string specifying the (remote) user whose password this is; if not supplied this defaults to (user-login-name)."]) (defalias 'rfa-open #[(node &optional user password) "„  š?…  „;Å Å \"A\"A„& †9ÈÉÊ ƒ5ÉË \"‚6Ì# \"))ÍÎ \" Ð Q\"tƒ_ƒ[ÒÓ #ˆ‚_ÔÕ!ˆƒoƒo× #ˆ)‡" [rfa-password-per-node-p user user-login-name node password assoc rfa-password-alist current-prefix-arg rfa-password-read format "password for user %s%s: " " on node \"%s\"" "" sysnetunam expand-file-name rfa-node-directory ":" result message "Opened network connection to %s as %s" error "Unable to open network connection" rfa-password-memoize-p rfa-set-password] 7 "\ Open a network connection to a server using remote file access. First argument NODE is the network node for the remote machine. Second optional argument USER is the user name to use on that machine. If called interactively, the user name is prompted for. Third optional argument PASSWORD is the password string for that user. If not given, this is filled in from the value of `rfa-password-alist', or prompted for. A prefix argument of - will cause the password to be prompted for even if previously memoized." (list (read-file-name "rfa-open: " rfa-node-directory rfa-default-node t) (read-string "user-name: " (user-login-name)))]) (defalias 'rfa-close #[(node) "ÀÁ\n \"Ä\"t„ ‚ „ÆÇ!‚ÈÉ\n\")‡" [sysnetunam expand-file-name node rfa-node-directory "" result error "Unable to close network connection" message "Closed network connection to %s"] 4 "\ Close a network connection to a server using remote file access. NODE is the network node for the remote machine." (list (read-file-name "rfa-close: " rfa-node-directory rfa-default-node t))]) (byte-code "ÀÁÂ\"ˆÃÄ!„ Å „IÆÈ ÉWƒ0Ê Ë!Ì#ˆT‰‚Ê ÍÎ#ˆÊ ÏÐ#ˆÊ ÑÒ#ˆÊ ÓÒ#ˆ)ÃÔ!„RÅÀÌÕ\"ˆÀÐÖ\"‡" [defalias rfa-password-read #[(prompt default) "†Áà …3°ÅGWƒ0ÉIˆT‰‚+\n#ˆ\n)‡" [default "" rfa-password-accumulator read-from-minibuffer prompt 0 length index copy 46 rfa-password-map] 6] boundp rfa-password-map nil 32 char make-keymap 127 define-key char-to-string rfa-password-self-insert "" abort-recursive-edit "" rfa-password-rubout "\n" exit-minibuffer " " rfa-password-accumulator #[nil "Á\n!PÃc‡" [rfa-password-accumulator char-to-string last-command-char 46] 3 nil nil] #[nil "ÀÁ!ˆ\nÃÁO‰‡" [delete-char -1 rfa-password-accumulator 0] 3 nil nil]] 5) emacs-19.22/lisp/nnspool.elc100666 13437 1 17034 5416172247 14424 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:42:31 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/nnspool.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote nntp)) (defvar nnspool-inews-program news-inews-program "\ *Program to post news.") (defvar nnspool-inews-switches (quote ("-h")) "\ *Switches for nnspool-request-post to pass to `inews' for posting news.") (defvar nnspool-spool-directory news-path "\ *Local news spool directory.") (defvar nnspool-active-file "/usr/lib/news/active" "\ *Local news active file.") (defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups" "\ *Local news newsgroups file.") (defvar nnspool-distributions-file "/usr/lib/news/distributions" "\ *Local news distributions file.") (defvar nnspool-history-file "/usr/lib/news/history" "\ *Local news history file.") (defconst nnspool-version "NNSPOOL 1.12" "\ Version numbers of this version of NNSPOOL.") (defvar nnspool-current-directory nil "\ Current news group directory.") (defalias 'nnspool-retrieve-headers #[(sequence) "ŠqˆÁ\nGÃÁÃÁ‰‰‰ÃÁ‰ \n   \nƒ…\n@ Ñ !PÒ!ƒXÓ!„XÔ ˆÕ!ˆebˆÖ×ÁØ#ˆe`}ˆebˆÙÚÁÛ#ƒoÜÝÛ‰#ˆ‚^ebˆÞcˆebˆÖßÁÛ#ƒ`ŠÁˆ`){‚àebˆÖáÁÛ#ƒ¨`ŠÁˆ`){\n‚«â\nebˆÖãÁÛ#ƒÃ`ŠÁˆ`){ ‚ÆÁ ebˆÖäÁÛ#ƒÝ`ŠÁˆ`){‚ßÁebˆÖåÁÛ#ƒùæ`ŠÁˆ`){!‚üÃebˆÖçÁÛ#ƒ`ŠÁˆ`){‚ÁebˆÖèÁÛ#„*ÖéÁÛ#ƒ6`ŠÁˆ`){‚8Á ƒX ƒXê \n  & B \nA T +§ƒ'+Vƒ' ì¦ÃUƒ'íî ï_¥\"ˆ‚'+§ƒ—+Vƒ—íð!ˆ Ÿ. ‡" [nntp-server-buffer nil sequence 0 references date lines xref from message-id subject article headers count number file nnspool-current-directory prin1-to-string file-exists-p file-directory-p erase-buffer insert-file-contents search-forward "\n\n" move re-search-forward "\\( ?\n[ ]+\\)+" t replace-match " " "\n" "\nFrom: " "(Unknown User)" "\nSubject: " "(None)" "\nMessage-ID: " "\nDate: " "\nLines: " string-to-int "\nXref: " "\nReferences: " "\nIn-Reply-To: " vector nntp-large-newsgroup 20 message "NNSPOOL: Receiving headers... %d%%" 100 "NNSPOOL: Receiving headers... done"] 12 "\ Return list of article headers specified by SEQUENCE of article id. The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. If there is no References: field, In-Reply-To: field is used instead. Reader macros for the vector are defined as `nntp-header-FIELD'. Writer macros for the vector are defined as `nntp-set-header-FIELD'. Newsgroup must be selected before calling this."]) (defalias 'nnspool-open-server #[(host &optional service) "†ÁÂ!ÃÅÇ!ƒ+É\n!ƒ+Ë ˜ƒ+Ì \"‚KË ˜ƒ;ÎÏ\"‚K„EЂKÎÑ\" *‡" [host getenv "NNTPSERVER" nil status "" nntp-status-string file-directory-p nnspool-spool-directory file-exists-p nnspool-active-file system-name nnspool-open-server-internal service format "%s has no news spool. Goodbye." "NNTP server is not specified." "NNSPOOL: cannot talk to %s."] 3 "\ Open news server on HOST. If HOST is nil, use value of environment variable `NNTPSERVER'. If optional argument SERVICE is non-nil, open by the service name."]) (defalias 'nnspool-close-server #[nil "À ‡" [nnspool-close-server-internal] 1 "\ Close news server."]) (byte-code "ÀÁKM‡" [nnspool-request-quit nnspool-close-server] 2) (defalias 'nnspool-server-opened #[nil "…Á!‡" [nntp-server-buffer get-buffer] 2 "\ Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL."]) (defun nnspool-status-message nil "\ Return server status response as string." nntp-status-string) (defalias 'nnspool-request-article #[(id) ";ƒ Á!‚\nÃ!P‰;…(Å !…(Æ !?…(ŠÇ !))‡" [id nnspool-find-article-by-message-id nnspool-current-directory prin1-to-string file file-exists-p file-directory-p nnspool-find-file] 4 "\ Select article by message ID (or number)."]) (defalias 'nnspool-request-body #[(id) "À !…Š\nqˆebˆÃÄÅÆ#ƒe`|ˆ)Ƈ" [nnspool-request-article id nntp-server-buffer search-forward "\n\n" nil t] 4 "\ Select article body by message ID (or number)."]) (defalias 'nnspool-request-head #[(id) "À !…Š\nqˆebˆÃÄÅÆ#ƒ`Sd|ˆ)Ƈ" [nnspool-request-article id nntp-server-buffer search-forward "\n\n" nil t] 4 "\ Select article head by message ID (or number)."]) (defalias 'nnspool-request-stat #[(id) "À‡" ["NNSPOOL: STAT is not implemented." nntp-status-string nil] 1 "\ Select article by message ID (or number)."]) (defalias 'nnspool-request-group #[(group) "ÀÁ\nÃÄ#!Æ !… ‰)‡" [nnspool-article-pathname nnspool-replace-chars-in-string group 46 47 pathname file-directory-p nnspool-current-directory] 5 "\ Select news GROUP."]) (defalias 'nnspool-request-list #[nil "ŠÀ !)‡" [nnspool-find-file nnspool-active-file] 2 "\ List active newsgoups."]) (defalias 'nnspool-request-list-newsgroups #[nil "ŠÀ !)‡" [nnspool-find-file nnspool-newsgroups-file] 2 "\ List newsgroups (defined in NNTP2)."]) (defalias 'nnspool-request-list-distributions #[nil "ŠÀ !)‡" [nnspool-find-file nnspool-distributions-file] 2 "\ List distributions (defined in NNTP2)."]) (defalias 'nnspool-request-last #[nil "À‡" ["NNSPOOL: LAST is not implemented." nntp-status-string nil] 1 "\ Set current article pointer to the previous article in the current news group."]) (defalias 'nnspool-request-next #[nil "À‡" ["NNSPOOL: NEXT is not implemented." nntp-status-string nil] 1 "\ Advance current article pointer."]) (defalias 'nnspool-request-post #[nil "ŠÀ ed#ˆ qˆÂÃed ÅÆÇ&ˆÉ ÊU†#ËÌÍ \"ÎedÏÐÑ%ˆÍ Ó ˆ)‡" [copy-to-buffer nntp-server-buffer apply call-process-region nnspool-inews-program delete t nil nnspool-inews-switches buffer-size 0 string-match "spooled" buffer-string subst-char-in-region 10 92 noundo nntp-status-string erase-buffer] 9 "\ Post a new news in current buffer."]) (defalias 'nnspool-open-server-internal #[(host &optional service) "ŠÁ ˜„ ÂÃ\"ˆÄÅ!‰qˆÇp!ˆÈ ˆÉ ˆÊ Ì ÏÐ!ˆ)ʇ" [host system-name error "NNSPOOL: cannot talk to %s." get-buffer-create " *nntpd*" nntp-server-buffer buffer-flush-undo erase-buffer kill-all-local-variables t case-fold-search nil nntp-server-process nntp-server-name run-hooks nntp-server-hook] 4 "\ Open connection to news server on HOST by SERVICE (default is nntp)."]) (defalias 'nnspool-close-server-internal #[nil "À !ƒ ÂÀ !!ˆ ƒ !ˆÄĉ‡" [get-file-buffer nnspool-history-file kill-buffer nntp-server-buffer nil nntp-server-process] 3 "\ Close connection to news server."]) (defalias 'nnspool-find-article-by-message-id #[(id) "ŠÀ !‰ƒ\nqˆ‚ÃÄ!ˆÅ !qˆÃÆ!ˆ)dbˆÇÈÉ\n!ËQÌÍ#…HΔΕ{ϔϕ{ÒÓÔÕ#!P*)‡" [get-file-buffer nnspool-history-file buffer message "Reading history file..." find-file-noselect "Reading history file... done" re-search-backward "^" regexp-quote id "[ ].*[ ]\\([^ /]+\\)/\\([0-9]+\\)[ ]*$" nil t 1 2 number group nnspool-article-pathname nnspool-replace-chars-in-string 46 47] 6 "\ Return full pathname of an article identified by message-ID."]) (defalias 'nnspool-find-file #[(file) "qˆÁ ˆÂÃć" [nntp-server-buffer erase-buffer nil (byte-code "À !ˆÂ‡" [insert-file-contents file t] 2) ((file-error))] 3 "\ Insert FILE in server buffer safely."]) (defalias 'nnspool-article-pathname #[(group) "À !\nÃQ‡" [file-name-as-directory nnspool-spool-directory group "/"] 3 "\ Make pathname for GROUP."]) (defalias 'nnspool-replace-chars-in-string #[(string from to) "ÁÂOGÁ Wƒ% H Uƒ Iˆ T‰‚ +‡" [string 0 nil idx len from to] 4 "\ Replace characters in STRING from FROM to TO."]) (provide (quote nnspool)) emacs-19.22/lisp/nntp.elc100666 13437 1 30600 5472117007 13700 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Nov 16 04:31:50 1993 ;;; from file /home/fsf/rms/e19/lisp/nntp.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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-server-name'.") (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 (quote (usg-unix-v 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.") (defconst nntp-version "NNTP 3.12" "\ Version numbers of this version of NNTP.") (defvar nntp-server-name nil "\ The name of the host running NNTP server.") (defvar nntp-server-buffer nil "\ Buffer associated with 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.") (defalias 'nntp-header-number '(macro . #[(header) "À ÂE‡" [aref header 0] 3 "\ Return article number in HEADER."])) (defalias 'nntp-set-header-number '(macro . #[(header number) "À  F‡" [aset header 0 number] 4 "\ Set article number of HEADER to NUMBER."])) (defalias 'nntp-header-subject '(macro . #[(header) "À ÂE‡" [aref header 1] 3 "\ Return subject string in HEADER."])) (defalias 'nntp-set-header-subject '(macro . #[(header subject) "À  F‡" [aset header 1 subject] 4 "\ Set article subject of HEADER to SUBJECT."])) (defalias 'nntp-header-from '(macro . #[(header) "À ÂE‡" [aref header 2] 3 "\ Return author string in HEADER."])) (defalias 'nntp-set-header-from '(macro . #[(header from) "À  F‡" [aset header 2 from] 4 "\ Set article author of HEADER to FROM."])) (defalias 'nntp-header-xref '(macro . #[(header) "À ÂE‡" [aref header 3] 3 "\ Return xref string in HEADER."])) (defalias 'nntp-set-header-xref '(macro . #[(header xref) "À  F‡" [aset header 3 xref] 4 "\ Set article xref of HEADER to xref."])) (defalias 'nntp-header-lines '(macro . #[(header) "À ÂE‡" [aref header 4] 3 "\ Return lines in HEADER."])) (defalias 'nntp-set-header-lines '(macro . #[(header lines) "À  F‡" [aset header 4 lines] 4 "\ Set article lines of HEADER to LINES."])) (defalias 'nntp-header-date '(macro . #[(header) "À ÂE‡" [aref header 5] 3 "\ Return date in HEADER."])) (defalias 'nntp-set-header-date '(macro . #[(header date) "À  F‡" [aset header 5 date] 4 "\ Set article date of HEADER to DATE."])) (defalias 'nntp-header-id '(macro . #[(header) "À ÂE‡" [aref header 6] 3 "\ Return Id in HEADER."])) (defalias 'nntp-set-header-id '(macro . #[(header id) "À  F‡" [aset header 6 id] 4 "\ Set article Id of HEADER to ID."])) (defalias 'nntp-header-references '(macro . #[(header) "À ÂE‡" [aref header 7] 3 "\ Return references (or in-reply-to) in HEADER."])) (defalias 'nntp-set-header-references '(macro . #[(header ref) "À  F‡" [aset header 7 ref] 4 "\ Set article references of HEADER to REF."])) (defalias 'nntp-retrieve-headers #[(sequence) "ŠqˆÁ ˆ\nGeÉÄÃĉ‰‰Ãĉ \n   \nƒ˜ÒÓ\n@\"ˆ\nAT\nƒN¦ÃUƒ.Õ ˆbˆÖ×ÄØ#ƒeT‚U`Wƒ.§ƒ’Vƒ’Ú¦ÃUƒ’ÛÜÝ_¥\"ˆÞ ˆ‚Qdbˆß×ÄØ#ˆàá!ƒ¸dâZbˆàã!„¸Þ ˆ‚§§ƒÊVƒÊÛä!ˆebˆÖåÄØ#ƒâæç؉#ˆ‚ѧƒôVƒôÛè!ˆebˆm„àé!ƒæêë”ë•{! ì”ì•{\nëyˆÄ ÄÄ ÃÄÄm„²gí>„²àî!ƒ¬ì”ì•{Ôf/0ñ/ò\"ƒP0 ‚«ñ/ó\"ƒ_0 ‚«ñ/ô\"ƒn0‚«ñ/õ\"ƒê0!‚«ñ/ö\"ƒŽ0‚«ñ/÷\"ƒœ0‚«ñ/ø\"ƒ« „«0*ëyˆ‚% „ºù  „Âú  ƒé\nƒéû   \n & B ‚éëyˆS§ƒ÷Vƒ÷Ú¦ÃUƒ÷ÛüÝ_¥\"ˆ‚÷§ƒ%Vƒ%Ûý!ˆ Ÿ.‡" [nntp-server-buffer erase-buffer sequence 0 nil references date lines xref from message-id subject article headers count received last-point number nntp-send-strings-to-server "HEAD" nntp-maximum-request accept-process-output re-search-forward "^[0-9]" t nntp-large-newsgroup 20 message "NNTP: Receiving headers... %d%%" 100 nntp-accept-response re-search-backward looking-at "^[23]" 3 "^\\. $" "NNTP: Receiving headers... done" "\\( ?\n[ ]+\\)+" replace-match " " "NNTP: Parsing headers..." "^[23][0-9][0-9][ ]+\\([0-9]+\\)[ ]+\\(<[^>]+>\\)" string-to-int 1 2 (50 51) "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ ]+\\([^ \n]+.*\\) $" c s char-equal 70 83 68 76 88 82 73 "(None)" "(Unknown User)" vector "NNTP: Parsing headers... %d%%" "NNTP: Parsing headers... done"] 13 "\ Return list of article headers specified by SEQUENCE of article id. The format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. If there is no References: field, In-Reply-To: field is used instead. Reader macros for the vector are defined as `nntp-header-FIELD'. Writer macros for the vector are defined as `nntp-set-header-FIELD'. Newsgroup must be selected before calling this."]) (defalias 'nntp-open-server #[(host &optional service) "†ÁÂ!ÃŃ0Ç\"ƒ0ÉÊ!‰ƒ*Ë Í\"ˆ‚7Î ˆ‚7„7Ï *‡" [host getenv "NNTPSERVER" nil status "" nntp-status-string nntp-open-server-internal service nntp-wait-for-response "^[23].* $" set-process-sentinel nntp-server-process nntp-default-sentinel nntp-close-server-internal "NNTP server is not specified."] 4 "\ Open news server on HOST. If HOST is nil, use value of environment variable `NNTPSERVER'. If optional argument SERVICE is non-nil, open by the service name."]) (defalias 'nntp-close-server #[nil "ÀŽ ƒÂà !=ƒÄ Å\"ˆÆ …ÇÅÈ\")‡" [((nntp-close-server-internal)) nntp-server-process nntp-default-sentinel process-sentinel set-process-sentinel nil nntp-server-opened nntp-send-command "QUIT"] 3 "\ Close news server."]) (byte-code "ÀÁKM‡" [nntp-request-quit nntp-close-server] 2) (defalias 'nntp-server-opened #[nil "… Á!Â>‡" [nntp-server-process process-status (open run)] 2 "\ Return server process status, T or NIL. If the stream is opened, return T, otherwise return NIL."]) (defalias 'nntp-status-message #[nil "ƒÁÂ\"ƒÔÕO‡Ä‡" [nntp-status-string string-match "[0-9][0-9][0-9][ ]+\\([^ ]*\\).*$" 1 ""] 3 "\ Return server status response as string."]) (defalias 'nntp-request-article #[(id) "ÀÁ #Ä ˆ‡" [nntp-send-command "^\\. $" "ARTICLE" id nntp-decode-text] 4 "\ Select article by message ID (or number)."]) (defalias 'nntp-request-body #[(id) "ÀÁ #Ä ˆ‡" [nntp-send-command "^\\. $" "BODY" id nntp-decode-text] 4 "\ Select article body by message ID (or number)."]) (defalias 'nntp-request-head #[(id) "ÀÁ #Ä ˆ‡" [nntp-send-command "^\\. $" "HEAD" id nntp-decode-text] 4 "\ Select article head by message ID (or number)."]) (defalias 'nntp-request-stat #[(id) "ÀÁ #‡" [nntp-send-command "^[23].* $" "STAT" id] 4 "\ Select article by message ID (or number)."]) (defalias 'nntp-request-group #[(group) "ÀÁ #‡" [nntp-send-command "^[23].*$" "GROUP" group] 4 "\ Select news GROUP."]) (defalias 'nntp-request-list #[nil "ÀÁÂ\"à ˆ‡" [nntp-send-command "^\\. $" "LIST" nntp-decode-text] 3 "\ List active newsgroups."]) (defalias 'nntp-request-list-newsgroups #[nil "ÀÁÂ\"à ˆ‡" [nntp-send-command "^\\. $" "LIST NEWSGROUPS" nntp-decode-text] 3 "\ List newsgroups (defined in NNTP2)."]) (defalias 'nntp-request-list-distributions #[nil "ÀÁÂ\"à ˆ‡" [nntp-send-command "^\\. $" "LIST DISTRIBUTIONS" nntp-decode-text] 3 "\ List distributions (defined in NNTP2)."]) (defalias 'nntp-request-last #[nil "ÀÁÂ\"‡" [nntp-send-command "^[23].* $" "LAST"] 3 "\ Set current article pointer to the previous article in the current news group."]) (defalias 'nntp-request-next #[nil "ÀÁÂ\"‡" [nntp-send-command "^[23].* $" "NEXT"] 3 "\ Advance current article pointer."]) (defalias 'nntp-request-post #[nil "ÀÁÂ\"…à ˆÄed\"ˆÅÆ!‡" [nntp-send-command "^[23].* $" "POST" nntp-encode-text nntp-send-region-to-server nntp-wait-for-response "^[23].*$"] 3 "\ Post a new news in current buffer."]) (defalias 'nntp-default-sentinel #[(proc status) "… Á ?… ÂÃ!‡" [nntp-server-process nntp-server-opened error "NNTP: Connection closed."] 2 "\ Default sentinel function for NNTP server process."]) (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 "^\\.$" search-forward "\n.." t] 4 "\ 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-encode-text #[nil "Šdbˆn„ ÀcˆebˆÁÂÃÄ#ƒÅcˆ‚dbˆÆc)‡" ["\n" search-forward "\n." nil t "." ". \n"] 4 "\ 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-send-command #[(response cmd &rest args) "ŠqˆÁ ˆÂà #ˆƒÇ!‚È)‡" [nntp-server-buffer erase-buffer apply nntp-send-strings-to-server cmd args response nntp-wait-for-response t] 4 "\ Wait for server RESPONSE after sending CMD and optional ARGS to server."]) (defalias 'nntp-wait-for-response #[(regexp) "ŠÀ‰Á\n§ƒ \n‚ÃqˆÉ ˆƒFebˆÊË!ƒ0̉‚ÊÍ!ƒ@Ì̉‚É ˆ‚̈e`{…¡Àƒ’dbˆÏyˆÊ!ƒỏ‚X\nƒŒÑ ¥ U„‹ÓÔÕ Ö\"\"ˆ)É ˆ‚V\nƒ  ÁVƒ Ó×!ˆÀ-‡" [t 0 nntp-debug-read 10000 dotsize dotnum wait status nntp-server-buffer nntp-accept-response looking-at "[23]" nil "[45]" nntp-status-string -1 regexp buffer-size newnum message "NNTP: Reading %s" make-string 46 ""] 6 "\ Wait for server response which matches REGEXP."]) (defalias 'nntp-send-strings-to-server #[(&rest strings) "@Aƒ Â@QA‰„\nà ÅP\"*‡" [strings cmd " " process-send-string nntp-server-process " \n"] 5 "\ Send list of STRINGS to news server as command and its arguments."]) (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 "\ Send current buffer region (from BEGIN to END) to news server."]) (defalias 'nntp-open-server-internal #[(host &optional service) "ŠÀÁ!„ ÂÃ!ˆÄÅ!‰qˆÇp!ˆÈ ˆÉ ˆÊ ÁÌp †+Ï$ ÒÓ!ˆ)‡" [fboundp open-network-stream require tcp get-buffer-create " *nntpd*" nntp-server-buffer buffer-flush-undo erase-buffer kill-all-local-variables t case-fold-search "nntpd" host service "nntp" nntp-server-process nntp-server-name run-hooks nntp-server-hook] 6 "\ Open connection to news server on HOST by SERVICE (default is nntp)."]) (defalias 'nntp-close-server-internal #[nil "ƒÁ!ˆ\nƒÃ\n!ˆÄĉ‡" [nntp-server-process delete-process nntp-server-buffer kill-buffer nil] 2 "\ Close connection to news server."]) (defalias 'nntp-accept-response #[nil "À !Â>„ ÃÄ!ˆ ƒÆÇ!ˆÈÉ!ˆÆÊ!‡ËÌ͇" [process-status nntp-server-process (open run) error "NNTP: Connection closed." 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 "\ Read response of server. It is well-known that the communication speed will be much improved by defining this function as macro."]) (provide (quote nntp)) emacs-19.22/lisp/novice.elc100666 13437 1 4417 5416172317 14176 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:43:10 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/novice.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÀÂ\"‡" [disabled-command-hook defalias #[(&rest ignore) "À‹ˆ ÃUƒ ÄÅ!ƒÆ!ˆ‚ ÈÉÀ#ˆ ÊU?…+Ë!)‡" [nil char ((byte-code "ÀÁ ÂHÃUƒÄÅ!ˆ‚!ÄÆ!ˆÄÇÁ !!ˆÄÈ!ˆÄ !ˆÄÊ!ˆ ËN;ƒ9Ä ËN!ˆÄÌÍΆBÏ!ˆŠÀqˆebˆÐÑÌÒ#ƒ[`Sd|ˆ‚^dbˆ)ÄÑ!ˆÄÓ!‘ˆÔÕ!ˆÒ× —‰Ù>„„Ú ˆÔÛ!ˆ‚o)̇" ["*Help*" this-command-keys 0 -8388488 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)." message "Type y, n or Space: " cursor-in-echo-area read-char char (32 121 110) ding "Please type y, n or Space: "] 5)) 121 y-or-n-p "Enable command for future editing sessions also? " enable-command this-command put disabled 110 call-interactively] 4]] 3) (defalias 'enable-command #[(command) "À ÂÃ#ˆŠÄÅÆ!!qˆebˆÇÈÉ !ÊQÃË#ƒ+Ìyˆ`Íyˆ`|ˆ‚6dbˆÎÉ !ϱˆÐ )‡" [put command disabled nil find-file-noselect substitute-in-file-name "~/.emacs" search-forward "(put '" symbol-name " " t 0 1 "\n(put '" " 'disabled nil)\n" save-buffer] 4 "\ 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." "CEnable command: "]) (defalias 'disable-command #[(command) "À ÂÃ#ˆŠÄÅÆ!!qˆebˆÇÈÉ !ÊQËÃ#ƒ(Ìyˆ`Íyˆ`|ˆdbˆÈÉ !αˆÏ )‡" [put command disabled t find-file-noselect substitute-in-file-name "~/.emacs" search-forward "(put '" symbol-name " " nil 0 1 " 'disabled t)\n" save-buffer] 4 "\ Require special confirmation to execute COMMAND from now on. The user's .emacs file is altered so that this will apply to future sessions." "CDisable command: "]) emacs-19.22/lisp/nroff-mode.elc100666 13437 1 10766 5416172331 14767 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:43:21 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/nroff-mode.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar nroff-mode-abbrev-table nil "\ Abbrev table used while in nroff mode.") (defvar nroff-mode-map nil "\ Major mode keymap for nroff mode.") (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) (defalias 'nroff-mode #[nil "À ˆÁ\n!ˆÃÅÇ!ˆ \nËÌ!ˆÍ ËÎ!ˆÏËÐ!ˆÑPËÒ!ˆÑPËÓ!ˆÔËÕ!ˆÖË×!ˆØËÙ!ˆÚÛÜÝ\"‡" [kill-all-local-variables use-local-map nroff-mode-map "Nroff" mode-name nroff-mode major-mode set-syntax-table text-mode-syntax-table nroff-mode-abbrev-table local-abbrev-table make-local-variable nroff-electric-mode nil 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] 3 "\ 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." nil]) (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 "\ Compute indent for an nroff/troff comment. Puts a full-stop before comments on a line by themselves."]) (defalias 'count-text-lines #[(start end &optional print) "ƒ ÁÂà \"\"‡ŠŒ }ˆebˆÆ ÇÆ !Z*‡" [print message "Region has %d text lines" count-text-lines start end buffer-size forward-text-line] 5 "\ 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." "r\np"]) (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 "\ Go forward one nroff text line, skipping lines of nroff requests. An argument is a repeat count; if negative, move backward." "p"]) (defalias 'backward-text-line #[(&optional cnt) "À [!‡" [forward-text-line cnt] 2 "\ Go backward one nroff text line, skipping lines of nroff requests. An argument is a repeat count; negative means move forward." "p"]) (byte-code "À‡" [((".(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 nil] 1) (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 "\ 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." "P"]) (defalias 'electric-nroff-mode #[(&optional arg) "Á=„\nÂÃ!ˆÄ ž„Æ ÇC\"„ ?‚&É!Ê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 "\ 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." "P"]) emacs-19.22/lisp/options.elc100666 13437 1 6023 5416172337 14403 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:43:26 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/options.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'list-options #[nil "ŠÀÁ!qˆÂ ˆ)ÁÃÅÆ!ˆÇ È\"‰…L @ ÊË!ˆÌ !ˆÊÍ!ˆÌ J!ˆÎ ˆÊÏÐ Ñ\"!!ˆÊÒ!ˆ) A‰„Ã)‘‡" [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"] 7 "\ Display a list of Emacs user options, with values and documentation." nil]) (defalias 'edit-options #[nil "À ˆÁÂ!‡" [list-options pop-to-buffer "*List Options*"] 2 "\ 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." nil]) (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) "\ ") (put (quote Edit-options-mode) (quote mode-class) (quote special)) (defalias 'Edit-options-mode #[nil "À ˆÁ\n!ˆÃ !ˆÅÆ!ˆÇÅÈ!ˆÉÊ Ì ÎÐÑ!‡" [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 "\ \\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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias Edit-options-set #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) (eval-minibuffer (concat "New " (symbol-name var) ": ")))] 2 nil nil] Edit-options-toggle #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) (not (symbol-value var)))] 2 nil nil] Edit-options-t #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) t)] 2 nil nil] Edit-options-nil #[nil "ÀÁ!‡" [Edit-options-modify (lambda (var) nil)] 2 nil nil] Edit-options-modify #[(modfun) "ŠÀ‰ÃÄ!ˆÅuˆ`Œ Àˆ`S}ˆ bˆÆp!) bˆÇyˆÇuˆŠ\n\n!Lˆ)ÉÇ!ˆÊ\nJp\"+‡" [nil pos var re-search-backward "^;; \\|\\`" 3 read 1 modfun kill-sexp prin1] 3]] 3) emacs-19.22/lisp/outline.elc100666 13437 1 30141 5451135761 14404 0ustar jimbdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:45:20 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/outline.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (defvar outline-regexp "[* ]+" "\ *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-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-map nil "\ ") (byte-code "„«Á \n¤ÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕÁÕ!B#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞßÁß!B#ˆÃàá#ˆÃâã#ˆÃäå#ˆÃæç#ˆÃèé#ˆÃêëÁë!B#ˆÃìí#ˆÃîï#ˆÃðñ#ˆÃòó#ˆÃôõ#ˆÁ‡" [outline-mode-map make-sparse-keymap text-mode-map 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 [menu-bar hide] "Hide" [menu-bar hide hide-subtree] ("Hide Subtree" . hide-subtree) [menu-bar hide hide-entry] ("Hide Entry" . hide-entry) [menu-bar hide hide-body] ("Hide Body" . hide-body) [menu-bar hide hide-leaves] ("Hide Leaves" . hide-leaves) [menu-bar show] "Show" [menu-bar show show-subtree] ("Show Subtree" . show-subtree) [menu-bar show show-children] ("Show Children" . show-children) [menu-bar show show-branches] ("Show Branches" . show-branches) [menu-bar show show-entry] ("Show Entry" . show-entry) [menu-bar show show-all] ("Show All" . show-all) [menu-bar headings] "Headings" [menu-bar headings outline-backward-same-level] ("Previous Same Level" . outline-backward-same-level) [menu-bar headings outline-forward-same-level] ("Next Same Level" . outline-forward-same-level) [menu-bar headings outline-previous-visible-heading] ("Previous" . outline-previous-visible-heading) [menu-bar headings outline-next-visible-heading] ("Next" . outline-next-visible-heading) [menu-bar headings outline-up-heading] ("Up" . outline-up-heading)] 6) (defvar outline-minor-mode nil "\ Non-nil if using Outline mode as a minor mode of some other mode.") (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÇC\"À‡" [make-variable-buffer-local outline-minor-mode put permanent-local t append minor-mode-alist (outline-minor-mode " Outl")] 4) (defalias 'outline-mode #[nil "À ˆÁà !ˆÅÇÉÊË\"ˆ\n Í!ˆÏÐ!ˆÑÓ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 run-hooks text-mode-hook outline-mode-hook] 4 "\ 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 M-x hide-body make all text invisible (not headings). M-x 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. M-x hide-entry make immediately following body invisible. M-x show-entry make it visible. M-x hide-leaves make body under heading and under its subheadings invisible. The subheadings remain visible. M-x 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." nil]) (defvar outline-minor-mode-prefix "" "\ *Prefix key to use for Outline commands in Outline minor mode.") (byte-code "ÀÁ!„ „$à Ä ÅÆÈ\"#ˆÄ  ÆÊ\"#ˆË ž„3Ë B B ‡" [boundp outline-minor-mode-map nil make-sparse-keymap define-key [menu-bar] lookup-key outline-mode-map [menu-bar] outline-minor-mode-prefix "" outline-minor-mode minor-mode-map-alist] 6) (defalias 'outline-minor-mode #[(&optional arg) "„ ?‚Â!ÃV‰ƒÄÆÇ!ˆ‚ÈÉÊ !‡" [arg outline-minor-mode prefix-numeric-value 0 t selective-display run-hooks outline-minor-mode-hook nil set-buffer-modified-p buffer-modified-p] 3 "\ 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." "P"]) (defvar outline-level (quote 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.") (defalias 'outline-level #[nil "ŠÀ !ˆŠÂ•bˆi*‡" [looking-at outline-regexp 0] 2 "\ 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 column number of the end of what `outline-regexp matches'."]) (defalias 'outline-next-preface #[nil "ÀÁ\nÃQÄÅ#ƒÆ”bˆhÇ>…Èu‡" [re-search-forward "[\n ]\\(" outline-regexp "\\)" nil move 0 (10 13) -1] 4 "\ Skip forward to just before the next heading line."]) (defalias 'outline-next-heading #[nil "ÀÁ\nÃQÄÅ#…Æ”Tb‡" [re-search-forward "[\n ]\\(" outline-regexp "\\)" nil move 0] 4 "\ Move to the next (possibly invisible) heading line." nil]) (defalias 'outline-back-to-heading #[nil "ÀyˆÁ †Âà ÅQÆÇ#‡" [0 outline-on-heading-p re-search-backward "^\\(" outline-regexp "\\)" nil move] 4 "\ Move to previous (possibly invisible) heading line, or to the beginning of this line if it is a heading line."]) (defalias 'outline-on-heading-p #[nil "ŠÀyˆhÁ=…  !)‡" [0 10 looking-at outline-regexp] 2 "\ Return T if point is on a header line."]) (defalias (quote outline-end-of-heading) #[nil "À ÂÃ#…\nÄu‡" [re-search-forward outline-heading-end-regexp nil move -1] 4]) (defalias 'outline-next-visible-heading #[(arg) "ÁWƒ Áyˆ‚ˆÃÄ ÆQ‰$ˆÁyˆÂ‡" [arg 0 nil re-search-forward "^\\(" outline-regexp "\\)"] 5 "\ 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)." "p"]) (defalias 'outline-previous-visible-heading #[(arg) "À [!‡" [outline-next-visible-heading arg] 2 "\ 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)." "p"]) (defalias 'outline-flag-region #[(from to flag) "À ÆUƒÇ‚Æ È%)‡" [nil buffer-read-only subst-char-in-region from to flag 10 13 t] 6 "\ 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 'hide-entry #[nil "À ˆÁ ˆŠÂ`à ˆ`Ä#)‡" [outline-back-to-heading outline-end-of-heading outline-flag-region outline-next-preface 13] 4 "\ Hide the body directly following this heading." nil]) (defalias 'show-entry #[nil "ŠÀ`Á ˆ`Â#)‡" [outline-flag-region outline-next-preface 10] 4 "\ Show the body directly following this heading." nil]) (defalias 'hide-body #[nil "Àed\"‡" [hide-region-body] 3 "\ Hide all of buffer except headings." nil]) (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 "\ Hide all body lines in the region, but not headings."]) (defalias 'show-all #[nil "ÀedÁ#‡" [outline-flag-region 10] 4 "\ Show all of the text in the buffer." nil]) (defalias 'hide-subtree #[nil "ÀÁ!‡" [outline-flag-subtree 13] 2 "\ Hide everything after this heading at deeper levels." nil]) (defalias 'hide-leaves #[nil "À ˆÁ ˆÂ`à ˆ`\"‡" [outline-back-to-heading outline-end-of-heading hide-region-body outline-end-of-subtree] 3 "\ Hide all body after this heading at deeper levels." nil]) (defalias 'show-subtree #[nil "ÀÁ!‡" [outline-flag-subtree 10] 2 "\ Show everything after this heading at deeper levels." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias outline-flag-subtree #[(flag) "ŠÀ ˆÁ ˆÂ`à ˆ` #)‡" [outline-back-to-heading outline-end-of-heading outline-flag-region outline-end-of-subtree flag] 4] outline-end-of-subtree #[nil "À ˆ`Á\n m„! „\n Vƒ!ÆÇ ˆ‚\nÈuˆhÉ>…,Èu+‡" [outline-back-to-heading t outline-level level first opoint nil outline-next-heading -1 (10 13)] 3]] 3) (defalias 'show-branches #[nil "ÀÁ!‡" [show-children 1000] 2 "\ Show all subheadings of this heading, but not their bodies." nil]) (defalias 'show-children #[(&optional level) "ƒ\nÁ!‚ŠÂyˆ Å ˆÆ Z]*ŠŒÂyˆ \\`Ç ˆ`T}ˆebˆm?…aÅ ˆm?…a Xƒ1ŠÈŠÉuˆhÊ>ƒTÉuˆ`)Ë ˆ`Ì#ˆ)‚1*‡" [level prefix-numeric-value 0 outline-level start-level outline-next-heading 1 outline-end-of-subtree outline-flag-region -1 (10 13) outline-end-of-heading 10] 4 "\ 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." "P"]) (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 "\ Move to the heading line of which the present line is a subheading. With argument, move up ARG levels." "p"]) (defalias 'outline-forward-same-level #[(arg) "À ˆ ÂV…%ŠÃ )‰ƒ bˆ S‚!ÂÅÆ!ˆ)‚‡" [outline-back-to-heading arg 0 outline-get-next-sibling point-to-move-to error ""] 3 "\ Move forward to the ARG'th subheading from here of the same level as the present one. It stops at the first and last subheadings of a superior heading." "p"]) (defalias 'outline-get-next-sibling #[nil " ÂÃ!ˆ Vƒm„ÂÃ!ˆ‚ W?…\"`)‡" [outline-level level outline-next-visible-heading 1] 2 "\ Position the point at the next heading of the same level, and return that position or nil if it cannot be found."]) (defalias 'outline-backward-same-level #[(arg) "À ˆ ÂV…%ŠÃ )‰ƒ bˆ S‚!ÂÅÆ!ˆ)‚‡" [outline-back-to-heading arg 0 outline-get-last-sibling point-to-move-to error ""] 3 "\ Move backward to the ARG'th subheading from here of the same level as the present one. It stops at the first and last subheadings of a superior heading." "p"]) (defalias 'outline-get-last-sibling #[nil " ÂÃ!ˆ Vƒo„ÂÃ!ˆ‚ W?…\"`)‡" [outline-level level outline-previous-visible-heading 1] 2 "\ Position the point at the previous heading of the same level, and return that position or nil if it cannot be found."]) (provide (quote outline)) emacs-19.22/lisp/page-ext.elc100666 13437 1 26432 5471634753 14456 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 03:12:26 1993 ;;; from file /home/fsf/rms/e19/lisp/page-ext.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (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.") (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.") (global-unset-key "") (defvar ctl-x-ctl-p-map (make-sparse-keymap) "\ Keymap for subcommands of C-x C-p, which are for page handling.") (byte-code "À ÂÃ#ˆÃ MˆÀ ÅÆ#ˆÀ ÂÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#ˆÀ ÔÕ#‡" [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 " " set-page-delimiter "" pages-directory "d" pages-directory-for-addresses] 4) (defalias 'next-page #[(&optional count) "„Á~ˆÂVƒ$m„$à ÅÆ#„dbˆS‰‚ ÁWƒGo„GÇ ÅÆ#ƒ=”bˆ‚@ebˆT‰‚%È ˆebˆÉÂ!‡" [count 1 0 re-search-forward page-delimiter nil t re-search-backward narrow-to-page recenter] 5 "\ Move to the next page bounded by the `page-delimiter' variable. With arg (prefix if interactive), move that many pages." "p"]) (defalias 'previous-page #[(&optional count) "„ÁÂ[!‡" [count 1 next-page] 2 "\ Move to the previous page bounded by the `page-delimiter' variable. With arg (prefix if interactive), move that many pages." "p"]) (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 "\ 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." "sHeader line: "]) (defvar pages-last-search nil "\ Value of last regexp searched for. Initially, nil.") (defalias 'search-pages #[(regexp) "Ášƒ \n‚ ~ˆÃ!ˆÄ ‡" [regexp "" pages-last-search re-search-forward narrow-to-page] 2 "\ Search for REGEXP, starting from point, and narrow to page it is in." (list (read-string (format "Search for `%s' (end with RET): " (or pages-last-search "regexp"))))]) (autoload (quote sort-subr) "sort" "\ Primary function for sorting." t nil) (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 "À ÂÃ#ƒ Ä”b‡db‡" [re-search-forward page-delimiter nil t 0] 4]] 4 "\ 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)." "P\nr"]) (defalias 'sort-pages-buffer #[(&optional reverse) "„Á~ˆedÄ \n#*‡" [reverse nil end beginning sort-pages-in-region] 4 "\ Sort pages alphabetically in buffer. Prefix arg means reverse order. (Non-nil arg if not interactive.)" "P"]) (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.") (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÁ‡" [pages-directory-map make-sparse-keymap define-key "" pages-directory-goto "" add-new-page] 4) (defvar original-page-delimiter "^ " "\ Default page delimiter.") (defalias 'set-page-delimiter #[(regexp reset-p) "ÀÁ!ˆÀÂ!ˆ † \n „ ‚ t…!ÅÆ\n\"‡" [make-local-variable original-page-delimiter page-delimiter reset-p regexp message "The value of `page-delimiter' is now: %s"] 3 "\ 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." (byte-code "ƒ ÂD‡ÃÄ \"ÆD‡" [current-prefix-arg original-page-delimiter "^ " read-string "Set page-delimiter to regexp: " page-delimiter nil] 3)]) (defalias 'pages-directory #[(pages-list-all-headers-p count-lines-p &optional regexp) "Ášƒ \n‚ tƒÃÄÅ \"ˆpÇÅ ÇRÈ`É\n    ŠqˆÐ ˆÑÒ±ˆÔ)ƒ‚ŠebˆŒŠ×ÔÙ#)ƒdÉ”ÈUƒdÉ•bˆÚ ˆÛ!ˆ)×ÔÙ#ƒ~Û!ˆ‚m)‚»Š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 "\ 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." (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)]) (defalias 'pages-copy-header-and-position #[(count-lines-p) "À‰ ƒŠŒÄ ˆÅed\"*`XƒTŠÈÀwˆÉ ‰`À“ˆ`ŠÀˆ`)\n  qˆ\n B Î \n#ˆ* ƒZŠÐyˆÑÒ \"cˆ)Ó ˆ)Ôy*‡" [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 "\ 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-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 "\ 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-goto #[nil "ƒ\nÁ!„ÂÂÄÅ!ˆÆyˆÇe`\"S‰ 8 m\n  Í!ˆ~ˆ\nƒ9dbˆ‚?Î !bˆ …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 "\ Go to the corresponding line in the pages buffer." nil]) (defalias 'pages-directory-for-addresses #[(&optional filename) "tƒ ÀÁ\n† \"ˆÄ\n† !ƒNÅÆ\n† !!qˆ~ˆÇÈɉ#ˆÊ ˆ   „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 "\ 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." (list (if current-prefix-arg (read-file-name "Filename: " pages-addresses-file-name)))]) (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 "\ 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."]) (provide (quote page-ext)) emacs-19.22/lisp/page.elc100666 13437 1 4567 5471634756 13650 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 03:12:30 1993 ;;; from file /home/fsf/rms/e19/lisp/page.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defalias 'forward-page #[(&optional count) "„ÁÂVƒ)m„)nƒÁuˆÃ ÅÆ#„\"dbˆS‰‚ÂW…Po?…PÇuˆÈ ÅÆ#ƒF•bˆ‚IebˆT‰‚*‡" [count 1 0 re-search-forward page-delimiter nil t -1 re-search-backward] 5 "\ 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'." "p"]) (defalias 'backward-page #[(&optional count) "„ÁÂ[!‡" [count 1 forward-page] 2 "\ 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'." "p"]) (defalias 'mark-page #[(&optional arg) "ƒ\nÁ!‚ ‰ÂVƒÃ!ˆ‚$ÂWƒ$ÃS!ˆÃ ˆÄÅƉ#ˆÃÇ!‡" [arg prefix-numeric-value 0 forward-page push-mark nil t -1] 5 "\ 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." "P"]) (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 "\ 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." "P"]) (put (quote narrow-to-page) (quote disabled) t) (defalias 'count-lines-page #[nil "Š`À‰‰‰‰Ç ˆÈyˆÉ\n!„Àˆ`Ë ˆ`Ì \"Ì \"Ì \"ÍÎ \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 "\ Report number of lines on current page, and how many are before or after point." nil]) (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 "\ Print page and line number of point." nil]) (provide (quote page)) emacs-19.22/lisp/paragraphs.elc100666 13437 1 13416 5432646230 15060 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 13 04:11:04 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/paragraphs.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (defconst paragraph-start "^[ \n ]" "\ *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). The variable `paragraph-separate' specifies how to distinguish lines that start paragraphs from lines that separate them.") (defconst paragraph-separate "^[ ]*$" "\ *Regexp for beginning of a line that separates paragraphs. If you change this, you may have to change paragraph-start also.") (defconst sentence-end (purecopy "[.?!][]\"')}]*\\($\\| $\\| \\| \\)[ \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 "^ " "\ *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.") (defalias 'forward-paragraph #[(&optional arg) "„Á\n…\nÚ?… ?…Å\n!‰ƒ)ÈÉR‚+ÊWƒ·Ë!„EÌÍ`Se]Î#„°ÏuˆÊyˆo„\\Ë!ƒ\\Ïyˆ‚KЈƒ„Êyˆo„Ë!„Ë!ƒÏyˆ‚do?‚ŠÌÐÎ#ƒ­m„žË!ƒžÁyˆ‚`ÒZfÓ=ƒ°Ïyˆ‚°ebˆT‰‚.ÊV…Êyˆm?…ÉË!Áyˆ„Àƒìm„ÿË!„ÿË!ƒÿÁyˆ‚ÔÔÐÎ#ƒüÊ”bˆ‚ÿdbˆS‰‚¸*‡" [arg 1 fill-prefix "" paragraph-ignore-fill-prefix regexp-quote fill-prefix-regexp paragraph-separate "\\|^" "[ ]*$" 0 looking-at re-search-backward "^\n" t -1 nil paragraph-start 2 10 re-search-forward] 5 "\ Move forward to end of paragraph. With arg N, do it N times; negative arg -N means move forward 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." "p"]) (defalias 'backward-paragraph #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-paragraph] 2 "\ 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." "p"]) (defalias 'mark-paragraph #[nil "ÀÁ!ˆÂÃĉ#ˆÅÁ!‡" [forward-paragraph 1 push-mark nil t backward-paragraph] 4 "\ Put point at beginning of this paragraph, mark at end. The paragraph marked is the one that contains point or follows point." nil]) (defalias 'kill-paragraph #[(arg) "À`ŠÁ\n!ˆ`)\"‡" [kill-region forward-paragraph arg] 4 "\ 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." "p"]) (defalias 'backward-kill-paragraph #[(arg) "À`ŠÁ\n!ˆ`)\"‡" [kill-region backward-paragraph arg] 4 "\ 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." "p"]) (defalias 'transpose-paragraphs #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-paragraph arg] 3 "\ Interchange this (or next) paragraph with previous one." "*p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias start-of-paragraph-text #[nil "`ÀÃÄ!ˆ`ÅÀwˆ`\nY…% \nW…% bˆ eV…%Æ *‡" [nil npoint opoint forward-paragraph -1 " \n" start-of-paragraph-text] 2] end-of-paragraph-text #[nil "`ÁÂ!ˆhÃ=ƒÄuˆ`X… Âuˆ`dW… Å )‡" [opoint forward-paragraph 1 10 -1 end-of-paragraph-text] 2]] 3) (defalias 'forward-sentence #[(&optional arg) "„ÁÂWƒ1ŠÃ ˆ`)ÅÇP È#ƒ&•Sbˆ‚) bˆ)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 "\ 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." "p"]) (defalias 'backward-sentence #[(&optional arg) "„ÁÂ[!‡" [arg 1 forward-sentence] 2 "\ Move backward to start of sentence. With arg, do it arg times. See `forward-sentence' for more information." "p"]) (defalias 'kill-sentence #[(&optional arg) "À`ŠÁ\n!ˆ`)\"‡" [kill-region forward-sentence arg] 4 "\ Kill from point to end of sentence. With arg, repeat; negative arg -N means kill back to Nth start of sentence." "*p"]) (defalias 'backward-kill-sentence #[(&optional arg) "À`ŠÁ\n!ˆ`)\"‡" [kill-region backward-sentence arg] 4 "\ Kill back from point to start of sentence. With arg, repeat, or kill forward to Nth end of sentence if negative arg -N." "*p"]) (defalias 'mark-end-of-sentence #[(arg) "ÀŠÁ\n!ˆ`)ÃÄ#‡" [push-mark forward-sentence arg nil t] 4 "\ Put mark at end of sentence. Arg works as in `forward-sentence'." "p"]) (defalias 'transpose-sentences #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-sentence arg] 3 "\ Interchange this (next) and previous sentence." "*p"]) emacs-19.22/lisp/paren.elc100666 13437 1 3410 5432646224 14011 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 13 04:10:59 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/paren.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„‡" [boundp show-paren-overlay nil show-paren-overlay-1 show-paren-mismatch-face] 2) (defvar show-paren-face (quote region) "\ *Name of face to use for showing the matching paren.") (byte-code "ÀÁÂ\"ˆ ƒÄÆÇÁ\"ˆÆÈÉ\"ˆÊË!‡" [defalias show-paren-command-hook #[nil "…PÁÂ!…Pɉ`  gzÊ=ƒ%Ë‚/hzÌ=ƒ/̓ÀŠŒƒIe`Z]d`\\^}ˆÃÏЈ ƒ~ ^ ]‰fzÓU„}SfÔÕÖ fH×\"Ø\"U?*ƒ¿„°Ú ƒ°ÛÜ!‰„°ÝÜ!ˆÜÜÞà á â ã%ˆ+ƒ»‚¿äå!ˆ* ƒ.ÍUƒô&ƒßç&`\\`p$ˆ‚êè Z \"&é&Å #ˆ‚&ƒê&!ƒë&!ˆ,ƒç, Z p$ˆ‚%è Z \",é,Å #‚O,ƒ?ê,!ƒ?ë,!ˆ&…Oê&!…Oë&!-‡" [window-system sit-for 0 nil show-paren-face face oldpos mismatch dir pos 40 1 41 -1 blink-matching-paren-distance (byte-code "À` \"À‡" [scan-sexps dir pos] 3) ((error)) end beg 36 logand lsh syntax-table -8 255 show-paren-mismatch-face x-display-color-p internal-find-face paren-mismatch make-face "purple" frame color internal-set-face-1 background 5 message "Paren mismatch" show-paren-overlay-1 move-overlay make-overlay overlay-put overlay-buffer delete-overlay show-paren-overlay] 7] window-system nil blink-paren-function add-hook post-command-hook window-setup-hook #[nil "…\nÁÃÄÅ\"‡" [window-system nil blink-paren-function add-hook post-command-hook show-paren-command-hook] 3] provide paren] 3) emacs-19.22/lisp/pascal.elc100666 12120 1 41625 5470557577 14063 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 11 19:57:35 1993 ;;; from file /home/fsf/rms/e19/lisp/pascal.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defconst pascal-mode-version "1.3" "\ Version of this pascal mode.") (defvar pascal-mode-abbrev-table nil "\ Abbrev table in use in Pascal-mode buffers.") (define-abbrev-table (quote pascal-mode-abbrev-table) nil) (defvar pascal-mode-map nil "\ Keymap used in Pascal mode.") (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÜ#ˆÂÝÞ#ˆßà!„dá Á‡" [pascal-mode-map make-sparse-keymap define-key ";" electric-pascal-semi "." electric-pascal-dot ":" electric-pascal-colon "=" electric-pascal-equal " " electric-pascal-terminate-line " " electric-pascal-tab "" backward-delete-char-untabify "" pascal-backward-to-beginning-of-function "…" pascal-forward-to-end-of-function "ˆ" pascal-mark-function "" pascal-insert-block "" pascal-comment-area "" pascal-uncomment-area "ª" pascal-star-comment 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")] 4) (defvar pascal-mode-syntax-table nil "\ Syntax table in use in Pascal-mode buffers.") (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) (defconst pascal-indent-level 3 "\ *Indentation of Pascal statements with respect to containing block.") (defconst pascal-continued-expr 1 "\ *Indentation of line that is a continued expression.") (defconst pascal-label-offset -1 "\ *Offset of Pascal label lines, case statements and record lines. This is relative to usual indentation.") (defconst pascal-case-offset 2 "\ *Indentation after case statements.") (defconst pascal-vardecl-indent 15 "\ *Indentation (from the beginning of line to `:' of the declaration.") (defconst pascal-typedecl-indent 10 "\ *Indentation (from the beginning of line to `=' of the declaration.") (defconst pascal-auto-newline nil "\ *Non-nil means automatically newline after semicolons and `end'.") (defconst pascal-tab-always-indent t "\ *Non-nil means TAB in Pascal mode should always reindent the current line. It does so regardless of where in the line point is when the TAB command is used.") (defconst pascal-auto-endcomments t "\ *Non-nil means make a comment { ... } after the end for a case or function. The name of the function or case is put between the braces.") (defalias 'pascal-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍ ÎËÐ!ˆÑËÒ!ˆÑÓÔ!‡" [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-within-comment comment-indent-hook parse-sexp-ignore-comments t case-fold-search run-hooks pascal-mode-hook] 2 "\ Major mode for editing Pascal code. Tab indents for Pascal code. Delete converts tabs to spaces as it moves back. \\{pascal-mode-map} Variables controlling indentation style: 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-newline (default nil) Non-nil means automatically newline after semicolons and the punctation mark after an end. pascal-auto-endcomments (default t) Non-nil means automatically set name of function or `case' in braces after after the `end' if this end ends a function or a case block. pascal-indent-level (default 3) Indentation of Pascal statements within surrounding block. pascal-continued-expr (default 1) Indentation of a line that is a continued expression. pascal-typedecl-indent (default 10) Indentation to the `=' in type declarations. (Or constant declarations.) pascal-vardecl-indent (default 20) Indentation to the `:' in var declarations. pascal-label-offset (default -1) Extra indentation for line that is a label, case statement or part of a record block. pascal-case-offset (default 2) Extra indent to the `:' in case statements. The only auto indention this mode doesn't fully support is if there is a case within a type declaration. However, this is seldom used. When typing text, you should not worry about to get right indentions, they will be set when you hit return. The mode will also automatically delete the whitespaces between `*' and `)' when ending a starcomment. Turning on Pascal mode calls the value of the variable pascal-mode-hook with no args, if that value is non-nil." nil]) (defalias 'electric-pascal-terminate-line #[nil "ŠÀyˆÁÂwˆÃÄ!ƒÅ ˆ)Æ ˆÅ ˆƒ È ˆÂ ŠÊyˆÁÂwˆÃË!ƒ:ÌuˆÍ ˆ‚NÃÎ!ƒNŠÏÐÑ Ò#)„NÒ ) ƒ\\ÓcˆÔ ‚^Å )‡" [0 " " nil looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b" pascal-indent-line newline pascal-auto-endcomments pascal-set-auto-comments setstar -1 "\\*[ ]*)" 1 pascal-delete-whitespaces "(\\*\\|\\*[^)]" search-forward "*)" pascal-get-end-of-line t "*" pascal-indent-command] 4 "\ Terminate line and indent next line." nil]) (defalias 'electric-pascal-semi #[nil "cˆŠÁyˆÂ ˆ) …Ä ‡" [last-command-char 0 pascal-indent-line pascal-auto-newline electric-pascal-terminate-line] 1 "\ Insert ; character and correct this line's indention." nil]) (defalias 'electric-pascal-dot #[nil "cˆŠÁyˆÂ ˆ) …Ä ‡" [last-command-char 0 pascal-indent-line pascal-auto-newline electric-pascal-terminate-line] 1 "\ Insert a period and correct this line's indention." nil]) (defalias 'electric-pascal-colon #[nil "cˆÁ ?…#ŠÂÃ!ˆÄÅ!)ƒŠÆyˆÇ ˆ)È Ê )‡" [last-command-char pascal-within-string backward-char 2 looking-at "[0-9]" 0 pascal-indent-line nil pascal-tab-always-indent pascal-indent-command] 2 "\ Insert : and do all indentions except line indent on this line." nil]) (defalias 'electric-pascal-equal #[nil "cˆÁÂ!A@Ã=…ÄÆ )‡" [last-command-char pascal-calculate-indent t decl nil pascal-tab-always-indent pascal-indent-command] 2 "\ Insert = and do indention if within type declaration." nil]) (defalias 'electric-pascal-tab #[nil "À ?… ƒŠÂyˆÃ ˆ)Ä ‡" [pascal-within-string pascal-tab-always-indent 0 pascal-indent-line pascal-indent-command] 1 "\ Function called when tab is pressed." nil]) (defalias 'pascal-insert-block #[nil "À ˆÁcˆÂ ˆŠÂ ˆÃcˆÄyˆÀ )‡" [pascal-indent-line "begin" electric-pascal-terminate-line "end;" 0] 1 "\ Insert begin ... end; block in the code with right indents." nil]) (defalias 'pascal-star-comment #[nil "À ˆÁcˆÂ ˆŠÂ ˆÃ ˆÄc)‡" [pascal-indent-line "(*" electric-pascal-terminate-line pascal-delete-whitespaces ")"] 1 "\ Insert star comment in the code." nil]) (defalias 'pascal-mark-function #[nil "À`!ˆÁ ˆÀ`!ˆÂ ˆÃ ‡" [push-mark pascal-forward-to-end-of-function pascal-backward-to-beginning-of-function zmacs-activate-region] 2 "\ Mark the current pascal function (or procedure). Put the mark at the end of the function, and point at the beginning." nil]) (defalias 'pascal-comment-area #[(start end) "ŠbˆŠÁÂwˆl)ƒŠÁÂxˆn)„Ãyˆ‚!ÄyˆÅcˆ`Æ ˆbˆÄyˆÈcˆÆ ˆbˆŠÉÊË#ƒLÌÍˉ#ˆ‚:)ŠÉÎË#…`ÌÏˉ#ˆ‚N*‡" [end " " nil 1 0 " ---/\\---EXCLUDED---/\\---}" newline start "{---\\/---EXCLUDED---\\/--- " re-search-backward "\\*)" t replace-match "!(*" "}" "!{"] 4 "\ Put the current region in a comment. The comments that are in this area are be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will however be turned back to normal when the area is uncommented by pressing \\[pascal-uncomment-area]. The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with: ` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area will not be able to recognize them." "r"]) (defalias 'pascal-uncomment-area #[nil "Š``ŠÂÃÄÅ#ˆ`ÆÇÄÅ#ˆ`) `š„#`Xƒ)ÈÉ!‚tbˆÊyˆ` Ĉ `T|ˆ)ŠÌÍ Å#ƒNÎÏʼn#ˆ‚=)ŠÌÐ Å#ƒaÎÑʼn#ˆ‚P) bˆÊyˆ` Ĉ `T|)+‡" [end start search-backward "{---\\/---EXCLUDED---\\/--" nil t search-forward "---/\\---EXCLUDED---/\\---}" message "Not standing within commented area." 0 pos re-search-backward "!{" replace-match "}" "!(\\*" "*)"] 4 "\ Uncomment a commented area. Change all deformed comments in this area back to normal. This function does nothing if the pointer is not in a commented area. See also `pascal-comment-area'." nil]) (defalias 'pascal-backward-to-beginning-of-function #[nil "ŠÀÁÂÃ#ˆÄÅ!)ƒÆ ‡Ç‰È \n ÇyˆŠo„OÄÌ!„OÍÈ!ˆÄÎ!ƒ: T ‚EÄÏ!ƒE S  \n]\n‚)Ç o†aÄÌ!…a ÇU?… ÍÈ!ˆÄÎ!ƒw T ‚SÄÏ!ƒ’ \nšƒŠ T  S ‚SÄÌ!ƒS S ‚S+‡" [re-search-backward "\\\\|\\<" nil t change-word -1] 5 "\ Change the keywords according to argument."]) (defalias 'pascal-delete-whitespaces #[nil "ÀÁxˆ`ÀÁwˆ\n`|)‡" [" " nil pos] 2 "\ Deletes the whitespaces around the current point." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias pascal-get-beg-of-line #[nil "ŠÀyˆ`)‡" [0] 1] pascal-get-end-of-line #[nil "ŠÀˆ`)‡" [nil] 1]] 3) (defalias 'pascal-within-string #[nil "ŠÀÁ Ã#)…ŠÀÁ ÃÄ$)?‡" [search-backward "\"" pascal-get-beg-of-line t 2] 5 "\ Return t if within string; nil otherwise."]) (defalias 'pascal-check-if-within-comment #[nil "``ŠÂÃÄÅ#ƒ`‚Æ)ŠÂÇÄÅ#ƒ#`‚%Æ) W…=Š bˆÈÉ!ƒ;iT‚<i)*‡" [comend comstart re-search-backward "(\\*\\|{" nil t 0 "\\*)\\|}" looking-at "(\\*"] 4 "\ If within a comment, return the correct indent. Return nil otherwise."]) (defalias 'pascal-set-auto-comments #[nil "ŠÀyˆÁÂwˆÃÄ!…ŠÂˆÅÆÇ È#)?…É A@Ê=ƒ1ÂˆË ˆÌc‚ÍŠÃÏ!„_o„_ÐÍ!ˆÃÑ!ƒQS‚5ÃÒ!ƒ5T‚5oƒfÍ)ÓU…œÂŠÕ ˆÖÂwˆÁÂwˆ×`ŠØÂwˆ`)\"ˆ)ÂˆË ˆÙcˆÚ ˆÛÍ!ˆÜc)))‡" [-1 " " nil looking-at "end\\(>\\|;\\)" search-backward "}" pascal-get-beg-of-line t pascal-calculate-indent case pascal-delete-whitespaces " { case }" 1 nest "function\\b\\|\\procedure\\b" backward-sexp "begin\\b\\|case\\b" "end\\(\\b\\|;\\|\\.\\)" 0 last-command pascal-backward-to-beginning-of-function "^ " copy-region-as-kill "a-zA-Z0-9_" " { " yank rotate-yank-pointer " }"] 4 "\ Put { case } or { FUNNAME } on this line if appropriate after `end'."]) (defalias 'pascal-indent-command #[nil "À ˆÁÂ!Ê A@Æ=„ A@Ç=ƒ]ÃyˆÈÉÊ Â#ƒAËÌ!ˆÍ ˆÎ iT]jˆÌuˆÍ ˆiTjˆ‚ ÃyˆÏÐwˆl„ ÑÐwˆÍ ˆÎ iT]jˆ‚  A@Ò=ƒ’Ó ÕÖÐÂ#ˆ×Ø!ƒ€ÙÉ#ˆ‚Ž×Û!ƒŽÙÜ#ˆ)‚  A@Þ=ƒ ß ˆß ˆ)ŠÏÐwˆl)…­Ð*‡" [pascal-indent-line pascal-calculate-indent t 0 pos indent case record search-forward ":" pascal-get-end-of-line backward-char 1 pascal-delete-whitespaces pascal-find-leading-case-colon " " nil "0-9a-zA-Z\"'_;" decl pascal-get-beg-of-line posii re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>" looking-at "var\\b" pascal-declindent-middle-of-line pascal-vardecl-indent "type\\b\\|const\\b" "=" pascal-typedecl-indent function pascal-indent-parameter-list] 4 "\ Indent current line as Pascal code and/or indent within line."]) (defalias 'pascal-indent-line #[nil "ÀÁDÀÁ‰ŠÀyˆÆ )Ç ‰ƒÈ !‚³ŠÉÁxˆn)…³ÀyˆÊ ˆËÌ!„W A@ƒW A@Í=ƒIËÎ!„W A@Ï=ƒ]ËÐ!ƒ] @j‚³ A@Ñ=ƒn @\\j‚³ A@Ó=„~ A@Ô=ƒŠ @\\\\j‚³Ë×!ƒ ØÁwˆÊ ˆ @\\j‚³ A@Ù=ƒ­Ú ‚³ @\\j,‡" [0 nil point beg comindent indent pascal-calculate-indent pascal-check-if-within-comment pascal-indent-within-comment " " pascal-delete-whitespaces looking-at "end\\b\\|until\\b" if "begin\\b\\|\\repeat\\b\\|else\\b" whilewith "begin\\b\\|\\repeat\\b" contexp pascal-continued-expr case record pascal-indent-level pascal-label-offset "[0-9]*:" "0-9:" function pascal-indent-parameter-list] 4 "\ Indent current line as Pascal code."]) (defalias 'pascal-calculate-indent #[(&optional arg) "ÀŠÁyˆÂˆ`)`ÃÄÂDÄ ?à \n   ŠÄU„^o„^ÏÀ!ˆŠ` ˆÐÑ Ã#)ƒM ÂÒÓ!ƒVÂÒÔ!ƒeS‰‚)ÒÕ!ƒ… ƒ|ÄÂ'T‰‚)ÒÖ!ƒ „–Ò×!ƒÄ‰‚)ÒØ!ƒĉŠÛÜÂÃ#„µÝ ˆŠÞßÂÃ#ˆ`)ŠÞàÂÃ#ˆ`))U„ W„`VƒëV„ Yƒ  W„Vƒ ÛÜÂÃ#ˆ‚ÀuˆÄ*‚'ƒ'ŠáÂxˆnƒZáÂwˆl„ZÞÑâ Ã#„ZŠÁyˆÂˆÏÀ!ˆÒã!„Säâ wˆåg!ÑšƒVÄÃ))‚'ƒlæ çD\n‚ºÒè!ƒ{æ éD\n‚ºÒê!ƒŠÛëÂÃ#ˆæ )ìD\nÄyˆí ˆ\n@jˆ‚ºÒë!ƒêŠî `}ˆÏÀ!ˆ~ˆÒê!)ƒÈÄyˆí ˆŠÛëÂÃ#ˆæ )jˆƒáŠïðâ Ã#)„áæ çD\n‚ºæ ìD\n‚ºÒñ!ƒùæ òD\n‚ºÒó!ƒiôD\n‚ºÒõ!ƒiöD\n‚ºÒ÷!ƒ<ƒ4Šïøâ Ã#)„4æ çD\n‚ºiùD\n‚ºÒú!ƒƒŠÞß Ã#ˆ`)ŠÞà Ã#ˆ`);< " beginning-of-buffer search-forward "(" ")" " " pascal-get-end-of-line "\\(do\\|then\\|of\\|begin\\|repeat\\|else\\)\\>" "^; " char-to-string pascal-lstart-col contexp "begin\\b" begin "else\\b" "if\\b" if pascal-delete-whitespaces pascal-get-beg-of-line re-search-forward "then\\b" "repeat\\b" repeat "case\\b" case "record\\b" record "while\\b\\|with\\b\\|for\\b" "do\\b" whilewith "procedure\\b\\|function\\b" epos spos function "var\\b\\|label\\b\\|const\\b\\|type\\b" decl "^[ ]*$"] 10 "\ Search backward in code to find the right indent level. Return a list containing: 1. Indent level 2. The indent keyword (begin, case etc.), or nil if backtracking failed. If arg is non-nil, we do not search for continued expressions."]) (defalias 'pascal-lstart-col #[nil "ŠÀyˆÁÂwˆÃÂwˆi)‡" [0 ":0-9" nil " "] 2 "\ Return the column of the beginning of the first command on the line."]) (defalias 'pascal-indent-parameter-list #[nil "À ÁÁyˆÄÅÆ Ç#„ÁyˆÈÉwˆÈÉwˆÊ ˆ @jˆËÌ!ƒ,ÍuˆÊ ˆ A@jˆŠÈÉwˆl)?…lÄÎÆ Ç#ƒOÏÐ!ˆ‚RÉˆÊ ˆÑ 8jˆgÒš…lÐuˆÊ ˆÑ 8Ñ\\j*‡" [pascal-get-highest-indents-in-parameterlist 0 pos indents search-forward "(" pascal-get-end-of-line t " " nil pascal-delete-whitespaces looking-at "var\\b" 3 ":" backward-char 1 2 58] 4 "\ Indent this line as part of a parameter list in a function."]) (defalias (quote pascal-get-highest-indents-in-parameterlist) #[nil "ŠÀÁÂÃ#ˆÄÅ!ˆiƉ \n„Mm„MÆyˆŠËÌÍ Ã#)ƒ1ÃËÎÍ Ã#„=ÃÏÂxˆ i] Ðyˆ‚ƒ^\n‰Ñ\\ TE‚e\n‰ TE-‡" [re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t search-forward "(" 0 done vardecl arglength start re-search-forward "\\" pascal-get-end-of-line ":" ": " 1 4] 4]) (defalias 'pascal-declindent-middle-of-line #[(declkey endpos defaultindent) "À Å#ƒiS‚ bˆÇˆŠÈ Å#)ƒ.È !ˆÉÇxˆ‚2ÉÇxˆÊ ˆ iT]jˆË !…JÌuˆÊ ˆiTj)‡" [0 decindent search-forward declkey endpos t defaultindent nil search-backward " " pascal-delete-whitespaces looking-at 1] 4 "\ Indent declaration line."]) (defalias 'pascal-indent-within-comment #[(indent) "ŠÀÁxˆn)ƒÂyˆÃ ˆ j‡ŠÂyˆÀÁwˆÅÆ!)…2ŠÂyˆÇÈ!ˆÃ ˆiÉ\\j)‡" [" " nil 0 pascal-delete-whitespaces indent looking-at "\\*\\|(\\*" search-forward "*" 2] 2 "\ Indent comments and/or indent text within comment."]) (defalias 'pascal-find-leading-case-colon #[nil "ŠÀyˆÁÂwˆ`)ŠÄÅ!ˆÆyˆÁÂwˆ `=„)ÇÈÉ Ê#ˆiS‚-i \\*‡" [0 " " nil pos re-search-backward "\\<\\(case\\|record\\)\\>" 1 search-forward ":" pascal-get-end-of-line t pascal-case-offset] 4 "\ Return hpos of first colon after the case-of or record line. If there's no such line, use the place where it ought to be."]) (provide (quote pascal)) emacs-19.22/lisp/perl-mode.elc100666 74777 1 26632 5430402374 14634 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 6 03:15:06 1993 ;;; from file /home/fsf/rms/e19/lisp/perl-mode.el ;;; emacs version 19.17.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"))) (error "This file was compiled for Emacs 19")) (defvar perl-mode-abbrev-table nil "\ Abbrev table in use in perl-mode buffers.") (define-abbrev-table (quote perl-mode-abbrev-table) nil) (defvar perl-mode-map nil "\ Keymap used in Perl mode.") (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) (autoload (quote 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.") (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) (defconst perl-indent-level 4 "\ *Indentation of Perl statements with respect to containing block.") (defconst perl-continued-statement-offset 4 "\ *Extra indent for lines not starting new statements.") (defconst perl-continued-brace-offset -4 "\ *Extra indent for substatements that start with open-braces. This is in addition to perl-continued-statement-offset.") (defconst perl-brace-offset 0 "\ *Extra indentation for braces, compared with other text in same context.") (defconst perl-brace-imaginary-offset 0 "\ *Imagined indentation of an open brace that actually follows a statement.") (defconst perl-label-offset -2 "\ *Offset of Perl label lines relative to usual indentation.") (defconst perl-tab-always-indent t "\ *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.") (defconst perl-tab-to-comment t "\ *Non-nil means that for lines which don't need indenting, TAB will either indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment.") (defconst perl-nochange ";?#\\| \\|\\s(\\|\\(\\w\\|\\s_\\)+:" "\ *Lines starting with this regular expression will not be auto-indented.") (defalias 'perl-mode #[nil "À ˆÁ\n!ˆÃÅÉ\n!ˆËÌ!ˆÍP ËÏ!ˆ ËÐ!ˆÑËÒ!ˆÓËÔ!ˆÑËÕ!ˆÖË×!ˆØËÙ!ˆÚËÛ!ˆÜËÝ!ˆÞËß!ˆàáâ!‡" [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 nil run-hooks perl-mode-hook] 2 "\ Major mode for editing Perl code. Expression and list commands understand all Perl brackets. Tab indents for Perl code. Comments are delimited with # ... \\n. Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{perl-mode-map} Variables controlling indentation style: perl-tab-always-indent Non-nil means TAB in Perl mode should always indent the current line, regardless of where in the line point is when the TAB command is used. perl-tab-to-comment Non-nil means that for lines which don't need indenting, TAB will either delete an empty comment, indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment. perl-nochange Lines starting with this regular expression will not be auto-indented. perl-indent-level Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. perl-continued-statement-offset Extra indentation given to a substatement, such as the then-clause of an if or body of a while. perl-continued-brace-offset Extra indentation given to a brace that starts a substatement. This is in addition to perl-continued-statement-offset. perl-brace-offset Extra indentation for line if it starts with an open brace. perl-brace-imaginary-offset An open brace following other text is treated as if it were this far to the right of the start of its line. perl-label-offset Extra indentation for line that is a label. Various indentation styles: K&R BSD BLK GNU LW perl-indent-level 5 8 0 2 4 perl-continued-statement-offset 5 8 4 2 4 perl-continued-brace-offset 0 0 0 0 -4 perl-brace-offset -5 -8 0 0 0 perl-brace-imaginary-offset 0 0 4 0 0 perl-label-offset -5 -8 -2 -2 -2 Turning on Perl mode calls the value of the variable perl-mode-hook with no args, if that value is non-nil." nil]) (defalias (quote perl-comment-indent) #[nil "nƒ\nl„\nÀ‡ŠÁÂxˆiT ])‡" [0 " " nil comment-column] 2]) (defalias 'electric-perl-terminator #[(arg) "` „PlƒPŠÂyˆÃ Å#?…?ÇUƒ$ÈÉ!…?ÊË \" Í 8†=Î 8†=Ï 8)?)ƒ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 "\ Insert character. If at end-of-line, and not in a comment or a quote, correct the line's indentation." "P"]) (defalias 'perl-indent-command #[(&optional arg) "ƒÁÂ!‡ „iÄ XƒÅ ‡Æ‰‰` \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 " " perl-tab-always-indent current-indentation insert-tab nil oldpnt delta lsexp bof 0 perl-beginning-of-function " \\|;?#" 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 "\ 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." "P"]) (defalias 'perl-indent-line #[(&optional nochange parse-start) "Àd`Z † ŠÂ )À‰‰Éyˆ`fÊUƒ)É‚wË!‰<ƒ7 ‚wÌ †?!ƒGÉ‚wÏÀwˆÌÐ!ƒ[Ñ \\]‚tgÓUƒi Z‚tgÕUƒt \\ iZÏÀwˆ §ƒŽ ÉU„Ž `|ˆ jˆ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 " " "\\(\\w\\|\\s_\\)+:" 1 perl-label-offset 125 perl-indent-level 123 perl-brace-offset] 6 "\ Indent current line as Perl code. Return the amount the indentation changed by, or (parse-state) if line starts in a quoted string."]) (defalias 'calculate-perl-indent #[(&optional parse-start) "ŠÀyˆ`ÁÀÁ‰ƒbˆ‚È ˆ`Wƒ6`É`À#‰A@‚Ê 8ƒ@ ‚Q\n„hËÁwˆgÌUƒRÀ‚QÍ ˆo„_hÎ>ƒcÀ‚Q‚Q\nfÌU„w\nTbˆi‚QÍ ˆhÐ=„hÑ=ƒ£`ÒZfzÓ>ƒ£hÐ=ƒšÔ\n!ˆÀyˆÍ ˆ‚zhÕ>„ÇÔ\n!ˆiŠbˆÖ×!)ƒÁ‚ÂÀ\\\\‚Q\nbˆnƒßŠbˆÖÙ!)ƒß†QŠÛuˆÜÁwˆÖÝ!ƒóÛyˆ‚ãÖÞ!ƒŠÁˆ`)ßà!„ã`W… `Vƒá \"Z‚i)†Qnƒ3ÀUƒ3#\\‚5äÁxˆnƒAÀ‚C%hæ=ƒMçè!ˆá \\\\.‡" [0 nil containing-sexp state colon-line-end case-fold-search indent-point parse-start perl-beginning-of-function parse-partial-sexp 3 " " 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 " \n" ";?#" "\\(\\w\\|\\s_\\)+:" search-forward ":" current-indentation perl-label-offset perl-brace-offset " " perl-brace-imaginary-offset 41 forward-sexp -1] 6 "\ 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 '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 ";" " " -1] 6 "\ Move point backward to after the first non-white-space, skipping comments." nil]) (defalias (quote perl-backward-to-start-of-continued-exp) #[(lim) "hÀUƒ\nÁÂ!ˆÃyˆ` Xƒ TbˆÅÆw‡" [41 forward-sexp -1 0 lim " " nil] 2]) (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 "\ Indent each line of the Perl grouping following point." nil]) (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 "\ 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." "p"]) (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 "\ 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." "p"]) (defalias 'mark-perl-function #[nil "À`!ˆÁ ˆÀ`!ˆÂ ˆÃ ‡" [push-mark perl-end-of-function perl-beginning-of-function backward-paragraph] 2 "\ Put mark at end of Perl function, point at beginning." nil]) emacs-19.22/lisp/picture.elc100666 12120 1 45072 5416172557 14262 0ustar rmsdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:45:50 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/picture.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'move-to-column-force #[(column) "À !„Âà !ˆi‰ Wƒ jˆ‚5 U„5hÅUƒ5ÆÈÉ!ˆ jˆÃ !ˆ)Ê )‡" [natnump column 0 move-to-column col 9 nil indent-tabs-mode delete-char -1 hscroll-point-visible] 3 "\ 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 'picture-beginning-of-line #[(&optional arg) "ƒ\nÁ!SyˆÂyˆÃ ‡" [arg prefix-numeric-value 0 hscroll-point-visible] 2 "\ 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." "P"]) (defalias 'picture-end-of-line #[(&optional arg) "ƒ\nÁ!SyˆÂyˆÃ`ĈxˆÅ ‡" [arg prefix-numeric-value 0 " " nil hscroll-point-visible] 3 "\ 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." "P"]) (defalias 'picture-forward-column #[(arg) "Ài \\!‡" [move-to-column-force arg] 3 "\ Move cursor right, making whitespace if necessary. With argument, move that many columns." "p"]) (defalias 'picture-backward-column #[(arg) "Ài Z!‡" [move-to-column-force arg] 3 "\ Move cursor left, making whitespace if necessary. With argument, move that many columns." "p"]) (defalias 'picture-move-down #[(arg) "iÁ\n!ˆÃ!)‡" [col picture-newline arg move-to-column-force] 2 "\ Move vertically down, making whitespace if necessary. With argument, move that many lines." "p"]) (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.") (defalias 'picture-move-up #[(arg) "À [!‡" [picture-move-down arg] 2 "\ Move vertically up, making whitespace if necessary. With argument, move that many lines." "p"]) (defalias 'picture-movement-right #[nil "ÀÁÂ\"‡" [picture-set-motion 0 1] 3 "\ Move right after self-inserting character in Picture mode." nil]) (defalias 'picture-movement-left #[nil "ÀÁÂ\"‡" [picture-set-motion 0 -1] 3 "\ Move left after self-inserting character in Picture mode." nil]) (defalias 'picture-movement-up #[nil "ÀÁÂ\"‡" [picture-set-motion -1 0] 3 "\ Move up after self-inserting character in Picture mode." nil]) (defalias 'picture-movement-down #[nil "ÀÁÂ\"‡" [picture-set-motion 1 0] 3 "\ Move down after self-inserting character in Picture mode." nil]) (defalias 'picture-movement-nw #[nil "ÀÁ‰\"‡" [picture-set-motion -1] 3 "\ Move up and left after self-inserting character in Picture mode." nil]) (defalias 'picture-movement-ne #[nil "ÀÁÂ\"‡" [picture-set-motion -1 1] 3 "\ Move up and right after self-inserting character in Picture mode." nil]) (defalias 'picture-movement-sw #[nil "ÀÁÂ\"‡" [picture-set-motion 1 -1] 3 "\ Move down and left after self-inserting character in Picture mode." nil]) (defalias 'picture-movement-se #[nil "ÀÁ‰\"‡" [picture-set-motion 1] 3 "\ Move down and right after self-inserting character in Picture mode." nil]) (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 set-buffer-modified-p buffer-modified-p message ""] 5 "\ Set VERTICAL and HORIZONTAL increments for movement in Picture mode. The mode line is updated to reflect the current direction."]) (defalias 'picture-move #[nil "À !ˆÂ !‡" [picture-move-down picture-vertical-step picture-forward-column picture-horizontal-step] 2 "\ Move in direction of `picture-vertical-step' and `picture-horizontal-step'."]) (defalias 'picture-motion #[(arg) "À \n_!ˆÃ _!‡" [picture-move-down arg picture-vertical-step picture-forward-column picture-horizontal-step] 3 "\ 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." "p"]) (defalias 'picture-motion-reverse #[(arg) "À [!‡" [picture-motion arg] 2 "\ 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." "p"]) (defalias 'picture-self-insert #[(arg) "ÁV…SÂiT!ˆÃÄ!ˆ cˆÄuˆÆ ˆ‚‡" [arg 0 move-to-column-force delete-char -1 last-input-char picture-move] 2 "\ 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." "p"]) (defalias 'picture-clear-column #[(arg) "`i‰\n\\Ä !ˆ`|ˆŠ ]j,‡" [opoint original-col arg target-col move-to-column-force] 3 "\ Clear out ARG columns after point without moving." "p"]) (defalias 'picture-backward-clear-column #[(arg) "À [!‡" [picture-clear-column arg] 2 "\ Clear out ARG columns before point, moving back over them." "p"]) (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 "\ 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." "P"]) (defalias 'picture-newline #[(arg) "ÁWƒ yˆ‚)ÁVƒ)ˆmƒà ˆ‚\"ÄuˆS‰‚ Å ‡" [arg 0 nil newline 1 hscroll-point-visible] 3 "\ 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." "p"]) (defalias 'picture-open-line #[(arg) "ŠÀˆÁ\n!ˆ)à ‡" [nil open-line arg hscroll-point-visible] 2 "\ Insert an empty line after the current line. With positive argument insert that many lines." "p"]) (defalias 'picture-duplicate-line #[nil "ŠÀyˆ`ÁÂ!ˆ`{Äyˆ c*‡" [0 picture-newline 1 contents -1] 3 "\ Insert a duplicate of the current line, below it." nil]) (defalias (quote 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]) (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.") (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 "\ 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." "P"]) (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 "\ 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." "P"]) (defalias 'picture-tab #[(&optional arg) "`Á ˆ\n…Ãi`|ˆ j*)‡" [opoint move-to-tab-stop arg nil column indent-tabs-mode] 2 "\ 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'." "P"]) (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]") (defalias 'picture-clear-rectangle #[(start end &optional killp) "À \n #‰‡" [picture-snarf-rectangle start end killp picture-killed-rectangle] 4 "\ 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." "r\nP"]) (defalias 'picture-clear-rectangle-to-register #[(start end register &optional killp) "À  #\"‡" [set-register register picture-snarf-rectangle start end killp] 6 "\ 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." "r\ncRectangle to register: \nP"]) (defalias (quote 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]) (defalias 'picture-yank-rectangle #[(&optional insertp) ":„ ÁÂ!‡Ã \"‡" [picture-killed-rectangle error "No rectangle saved." picture-insert-rectangle insertp] 3 "\ 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." "P"]) (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 "\ 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." "cRectangle from register: \nP"]) (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 "\ 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."]) (byte-code "ÀÂÃÄ\"ˆ „öÅÇ ÈWƒ+É ÊË\"Ì#ˆT‰‚ÃÍÎ\"ˆÃÏÐ\"ˆÃÑÒ\"ˆÃÓÔ\"ˆÃÕÖ\"ˆÃ×Ø\"ˆÃÙÚ\"ˆÃÛÜ\"ˆÃÝÞ\"ˆÃßà\"ˆÃáâ\"ˆÃãä\"ˆÉ åÑ#ˆÉ æç#ˆÉ èé#ˆÉ æê#ˆÉ ëì#ˆÉ íî#ˆÉ ïð#ˆÉ ñò#ˆÉ óô#ˆÉ õö#ˆÉ ÷ø#ˆÉ ùú#ˆÉ ûü#ˆÉ ýþ#ˆÉ ÿ@#ˆÉ AB#ˆÉ CD#ˆÉ EF#ˆÉ GH#ˆÉ IJ#ˆ)À‡" [nil picture-mode-map defalias picture-substitute #[(oldfun newfun) "À \n $‡" [substitute-key-definition oldfun newfun picture-mode-map global-map] 5] 32 i make-keymap 127 define-key make-string 1 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 kill-line picture-clear-line open-line picture-open-line newline picture-newline newline-andindent 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 "" " " 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] 6) (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].") (defalias 'picture-mode #[nil "Á=ƒ\nÂÃ!‡ÄÅ!ˆÆ Ç!ˆÄÉ!ˆ\n ÄË!ˆ ÁÄÌ!ˆÍ ÄÎ!ˆÏÎ!ÄÐ!ˆÏÐ!ÄÑ!ˆÄÒ!ˆÓÕÖ×\"ˆØÙÚ\"ˆÛÜÝ! \"‡" [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 t truncate-lines 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 "\ 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." nil]) (defalias (quote edit-picture) (quote picture-mode)) (defalias 'picture-mode-exit #[(&optional nostrip) "Á=„\nÂÃ!‡ „Å ˆÈ !ˆ\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 set-buffer-modified-p buffer-modified-p] 2 "\ 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." "P"]) (defalias 'picture-clean #[nil "ŠebˆÀÁÂÃ#…Ä”`|ˆ‚)‡" [re-search-forward "[ ][ ]*$" nil t 0] 4 "\ Eliminate whitespace at ends of lines."]) (provide (quote picture)) emacs-19.22/lisp/pp.elc100666 12120 1 5647 5470557756 13222 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 11 19:59:25 1993 ;;; from file /home/fsf/rms/e19/lisp/pp.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (defvar pp-escape-newlines t "\ *Value of print-escape-newlines used by pp-* functions.") (defalias 'pp-to-string #[(object) "ŠÀÁ!qˆÂŽÃ ˆ Æp\"ˆ)ebˆm„ÖÈÉ!ƒ-ÈÉ!ƒÊuˆ‚!ÈË!ƒ|Ê”ÊVƒ|Ê”SfÌUƒ|ŠÍ”bˆÎ ˆÏÐ`f\")ƒ|Ê”SÊ•|ˆÑcˆÎÊ!ˆÈÒ!ƒqÓ”Ó•|ˆ‚uÔÕ!ˆÖÊ!ˆ‚×ØÙƒ¢ÚÊ!ˆÛÜxˆ`ÛÜwˆ`|ˆÏÝ`Sf\"„Þcˆ‚×ßàƒÐÈá!ƒµÊuˆ‚©ÛÜxˆ`ÛÜwˆ`|ˆÏÝ`Sf\"„Þcˆ‚dbˆ‚ebˆâ ˆã *‡" [generate-new-buffer " pp-to-string" ((byte-code "Àp!‡" [kill-buffer] 2)) emacs-lisp-mode 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 "\ 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 #[(object &optional stream) "ÀÁ\n! † \"‡" [princ pp-to-string object stream standard-output] 3 "\ 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-eval-expression #[(expression) "À !\nBà !ÅVƒÆ‚ÇÉÈ!…J)†#Ê ÌÌÍÎ\n@!‘ˆŠÍqˆÏ ,‡" [eval expression values string-to-int emacs-version 18 temp-buffer-show-function temp-buffer-show-hook sym boundp display-buffer old-show-hook #[(buf) "ŠqˆebˆÁˆ`TdW„`eZ Yƒ#ebˆ !‚-ÄÅe`{\"ˆÆ!)‡" [buf 1 screen-width old-show-hook message "%s" delete-windows-on] 4] "*Pp Eval Output*" pp emacs-lisp-mode] 3 "\ 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." "xPp-eval: "]) (defalias 'pp-eval-last-sexp #[(arg) "À `Á‰Æ!ˆŠÈÉ!ˆŠÊyˆËÌ!)ƒC` {ÍÎ\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 "\ Run `pp-eval-expression' on sexp before point (which see). With argument, pretty-print output into current buffer. Ignores leading comment characters." "P"]) (provide (quote pp)) emacs-19.22/lisp/profile.elc100666 13437 1 12613 5432646217 14373 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 13 04:10:54 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/profile.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (defvar profile-functions-list nil "\ *List of functions to profile") (defvar profile-timer-program "emacs-timer" "\ *Name of the timer program") (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. 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 (byte-code "À‰B‡" [0] 2) "\ Used to return result from a filter") (defvar profile-buffer "*profile*" "\ Name of profile buffer") (defalias 'profile-functions #[(&optional flist) "„ ÂÃ\"‡" [flist profile-functions-list mapcar profile-a-function] 3 "\ Profile all the functions listed in profile-functions-list. With argument FLIST, use the list FLIST instead." "*P"]) (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 "\ Filter for the timer process. Sets profile-time to the returned time."]) (defalias 'profile-print #[(entry) "AÁÂÆÇ@\"±ˆÉ\n!ˆË @!‰cˆ G Y„8É\n!ˆ Í GZOcˆ GuˆË A!ÎÏÍÐ GZO ѱ+‡" [entry nil 5 offset str time format "%s" space move-to-column ref-column int-to-string spaces 0 "." "000000" 6 "\n"] 6 "\ Print one ENTRY (from profile-time-list) ."]) (byte-code "À‡" [" " spaces nil] 1) (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 "\ Display profiling results in profile-buffer ." nil]) (defalias (quote profile-reset-timer) #[nil "À Â\"‡" [process-send-string profile-timer-process "z\n"] 3]) (defalias 'profile-check-zero-init-times #[(entry) "AA‰@ÂU… AÂU?…ÃÄ!)‡" [entry time 0 error "Process timer died while making performance profile."] 3 "\ If ENTRY has non zero time, give an error."]) (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 "\ Get time from timer process into profile-time ."]) (defalias 'profile-find-function #[(fun flist) "??… @@=ƒ@A‡Â A\"‡" [flist fun profile-find-function] 3 "\ Linear search for FUN in FLIST ."]) (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 "\ On entry, keep current time for function FUN."]) (byte-code "ÀÀ‡" [1000000 profile-million] 1) (defalias 'profile-update-function #[(fun) "À \n\"À \"ĉ‰ƒ„ÉÊ \"ˆ‰@S ˆ@ËU??…ŒA @@Z AAZË ˆË¡ˆ Ë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 "\ When the call to the function FUN is finished, add its run time."]) (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 "\ Profile the function FUN" "aFunction to profile: "]) (defalias 'profile-fix-fun #[(fun def) "À‰‰‰ÁÀ‰ GÊW?…  @ A@ AA@D ;…< GÊW?…  ;„J ‚YÊ C¤Ê ›@ <ƒo @Ë=ƒo C¤ T  ›‰@Ìš?… Í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 "\ Take function FUN and return it fixed for profiling. DEF is (symbol-function FUN) ."]) (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 "\ Restore profiled function FUN to its original state."]) (defalias 'profile-finish #[nil "ÀÁ\n\"ˆÃÅʼn‡" [mapcar profile-restore-fun profile-time-list 0 profile-max-fun-name nil profile-init-list] 3 "\ Stop profiling functions. Clear all the settings." nil]) (defalias 'profile-quit #[nil "À Â\"‡" [process-send-string profile-timer-process "q\n"] 3 "\ Kill the timer process." nil]) emacs-19.22/lisp/prolog.elc100666 13437 1 13514 5416172621 14231 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:46:25 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/prolog.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„‡" [boundp prolog-mode-syntax-table nil prolog-mode-abbrev-table prolog-mode-map] 2) (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.") (byte-code "ÀÁ!„ „TÄ ÆÇÈ #ˆÆÉÊ #ˆÆËÌ #ˆÆÍÌ #ˆÆÎÌ #ˆÆÏÌ #ˆÆÐÌ #ˆÆÑÒ #ˆÆÓÌ #ˆÆÔÌ #ˆÆÕÖ #ˆ )×ØÙ\"ˆÚÛÜ\"ˆÚÝÞ\"ˆ„qà Ý!ˆÙ‡" [boundp prolog-indent-width 4 prolog-mode-syntax-table make-syntax-table table modify-syntax-entry 95 "w" 92 "\\" 47 "." 42 43 45 61 37 "<" 60 62 39 "\"" define-abbrev-table prolog-mode-abbrev-table nil 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] prolog-mode-commands #[(map) "À ÂÃ#ˆÀ ÄÅ#‡" [define-key map " " prolog-indent-line "" prolog-consult-region] 4] prolog-mode-map make-sparse-keymap] 4) (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 "\ 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." nil]) (defalias 'prolog-indent-line #[(&optional whole-exp) "À d`ZÁÅyˆ`ÆÁwˆ iZÅU„!\n`|ˆ jˆd Z`V…-d Zb+‡" [prolog-indent-level nil beg pos indent 0 " "] 3 "\ Indent current line as Prolog code. With argument, indent any additional lines of the same clause rigidly along with this one (not yet)." "p"]) (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 "\ Compute prolog indentation level."]) (defalias 'end-of-prolog-clause #[nil "ÀyˆŠÁˆ`)à \nÅ#ƒÀ”bˆÆÁx)‡" [0 nil eolpos re-search-forward comment-start-skip move " "] 4 "\ Go to end of clause in this line."]) (defalias 'prolog-comment-indent #[nil "ÀÁ!ƒ‡ÀÃ!ƒÄ ‡ŠÅÆxˆinƒ‚ Ç\\])‡" [looking-at "%%%" 0 "%%" prolog-indent-level " " nil 1 comment-column] 2 "\ Compute prolog comment indentation."]) (byte-code "ÀÁ!„‡" [boundp inferior-prolog-mode-map nil] 2) (defalias 'inferior-prolog-mode #[nil "ÀÁ!ˆÂ ˆÃÅÇÉ ˆ\n„\"Ë !\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 "\ 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." nil]) (defalias 'run-prolog #[nil "ÀÁ!ˆÂÃÄ \"!ˆÆ ‡" [require comint switch-to-buffer make-comint "prolog" prolog-program-name inferior-prolog-mode] 4 "\ Run an inferior Prolog process, input and output via buffer *prolog*." nil]) (defalias 'prolog-consult-region #[(compile beg end) "Šƒ Á \"ˆ‚Á \"ˆÅÂ#ˆÁÂÈ\"ˆ ƒ,Á \"‚/ÊÂ!)‡" [compile send-string "prolog" prolog-compile-string prolog-consult-string send-region beg end "\n" prolog-eof-string process-send-eof] 4 "\ 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." "P\nr"]) (defalias 'prolog-consult-region-and-go #[(compile beg end) "À \n #ˆÄÅ!‡" [prolog-consult-region compile beg end switch-to-buffer "*prolog*"] 4 "\ 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." "P\nr"]) emacs-19.22/lisp/rect.elc100666 13437 1 12717 5416172635 13675 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:46:37 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/rect.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'operate-on-rectangle #[(function start end coerce-tabs) "À‰‰‰Š bˆiÆyˆ`)ŠbˆiÈyˆÉ )\n Wƒ,\n \n U„Š bˆ` Wƒ€À‰‰\n  Í \"ˆi Z ` Í\n\"ˆ\niZ\n ÆWƒo\n \\\nÆ   \n#ˆ+Èyˆ‚6)\n Z,‡" [nil endlinepos endcol startlinepos startcol start 0 end 1 point-marker endextra begextra startpos move-to-column coerce-tabs function] 4 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÀÉÊ\"‡" [defalias delete-rectangle-line #[(startdelpos ignore ignore) "`|‡" [startdelpos] 2] delete-extract-rectangle-line #[(startdelpos begextra endextra) "ŠÀ \n #ˆ) `|‡" [extract-rectangle-line startdelpos begextra endextra] 4] extract-rectangle-line #[(startdelpos begextra endextra) "`{`bˆÃÄ Å#ƒ6iŠÆuˆi)Z\nÈ` ZÉZOÊ!\n‰G` Z\\ËOQ)‚  ÈV„D ÈVƒOÊ !\nÊ !Q\nB‰*‡" [startdelpos end line search-forward " " t -1 width 0 1 spaces-string nil begextra endextra lines] 6] ["" " " " " " " " " " " " " " " " "] spaces-strings spaces-string #[(n) "ÁXƒ\n\nH‡ÃÁVƒÅ PÁZ‰‚ \nHP)‡" [n 8 spaces-strings "" val " "] 4]] 3) (defalias 'delete-rectangle #[(start end) "ÀÁ\n Ä$‡" [operate-on-rectangle delete-rectangle-line start end t] 5 "\ 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." "r"]) (defalias 'delete-extract-rectangle #[(start end) "ÀÂà Æ$ˆ Ÿ)‡" [nil lines operate-on-rectangle delete-extract-rectangle-line start end t] 5 "\ 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 'extract-rectangle #[(start end) "ÀÂà À$ˆ Ÿ)‡" [nil lines operate-on-rectangle extract-rectangle-line start end] 5 "\ Return contents of rectangle with corners at START and END. Value is list of strings, one for each line of the rectangle."]) (defvar killed-rectangle nil "\ Rectangle for yank-rectangle to insert.") (defalias 'kill-rectangle #[(start end) "À \n\"‰‡" [delete-extract-rectangle start end killed-rectangle] 3 "\ 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'." "r"]) (defalias 'yank-rectangle #[nil "À !‡" [insert-rectangle killed-rectangle] 2 "\ Yank the last killed rectangle with upper left corner at point." nil]) (defalias 'insert-rectangle #[(rectangle) "iÁÅ ˆ ….\n„ Æyˆn„ÇcˆÈ Á\"ˆÉ @cˆ A‰„ É+‡" [rectangle t first insertcolumn lines push-mark 1 10 move-to-column nil] 4 "\ 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 'open-rectangle #[(start end) "ÀÁ\n Ä$ˆ\nb‡" [operate-on-rectangle open-rectangle-line start end nil] 5 "\ 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." "r"]) (defalias (quote open-rectangle-line) #[(startpos begextra endextra) "i \\\\ bˆiÅÆwˆ\ni Z\\)`Å xˆ`|ˆ\nj)‡" [begextra endextra column startpos ocol " " nil] 3]) (defalias 'string-rectangle #[(start end string) "ÀÁ\n Ä$ˆ\nb‡" [operate-on-rectangle string-rectangle-line start end nil] 5 "\ 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." "r\nsString rectangle: "]) (defalias (quote string-rectangle-line) #[(startpos begextra endextra) "i \\\\ bˆiÅÆwˆ\ni Z\\)`Å xˆ`|ˆc)‡" [begextra endextra column startpos ocol " " nil string] 3]) (defalias 'clear-rectangle #[(start end) "ÀÁ\n Ä$‡" [operate-on-rectangle clear-rectangle-line start end t] 5 "\ 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." "r"]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias clear-rectangle-line #[(startpos begextra endextra) "ÀÁwˆi\n\\` bˆÀÁxˆ`|ˆ j)‡" [" " nil endextra column startpos] 3] provide rect] 3) emacs-19.22/lisp/refbib.elc100666 13437 1 34612 5416172710 14161 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:47:19 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/refbib.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar r2b-trace-on nil "\ *trace conversion") (defvar r2b-journal-abbrevs nil "\ 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 nil "\ 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 nil "\ 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") (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)") (byte-code "ÀÁ!„  ÄQÀ‡" [boundp capitalize-title-stop-regexp "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)"] 3) (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 "\ Like `capitalize-region', but don't capitalize stop words, except the first." "r"]) (defalias 'capitalize-title #[(s) "ŠÀÁ!qˆÂ ˆ cˆÄed\"ˆÅ )‡" [get-buffer-create "$$$Scratch$$$" erase-buffer s capitalize-title-region buffer-string] 3 "\ Like capitalize, but don't capitalize stop words, except the first."]) (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 "\ Unbind defvars, for debugging." nil]) (byte-code "ÀÁ!„Â Ä Æ°ÇÈÉ\"‡" [boundp r2b-stop-regexp "\\`\\(\\(" r2b-additional-stop-words "\\|" capitalize-title-stop-words "\\)\\('\\w*\\)?\\W+\\)*\\([A-Z0-9]+\\)" defalias r2b-trace #[(&rest args) "… Á \"ˆÄÅ!‡" [r2b-trace-on apply message args sit-for 0] 3]] 5) (defalias 'r2b-match #[(exp) "”•{‡" [exp] 2 "\ Returns string matched in current buffer."]) (defvar r2b-out-buf-name "*Out*" "\ *output from refer-to-bibtex") (defvar r2b-log-name "*Log*" "\ *logs errors from refer-to-bibtex") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂƇ" [boundp r2b-in-buf nil 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) (defalias 'r2b-clear-variables #[nil "‰… @ÂLˆ A‰„Â)‡" [r2b-variables vars nil] 3 "\ Set all global vars used by r2b to nil."]) (defalias (quote r2b-warning) #[(&rest args) "ÀÂÃÄ \"\"ˆÂÇ\"ˆÂÇ\"ˆÂÉ\"ˆÂÃÄ \"\"‡" [t r2b-error-found princ apply format args r2b-log "\n" r2b-out-buf "% "] 4]) (defalias 'r2b-get-field #[(var field &optional unique required capitalize) "À‰ÁÅÆ\"ˆebˆ\nƒeÈÉÊQÀÁ#ƒeËÌ!ÌyÍU‰ƒ@ÎÏ!„@ÎÐ!ˆ ÑËÌ!Q‚# „I ‚ƒ]ÓÔ #ˆ Ñ Q‚ Õ Q‚ ƒ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 "\ 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-set-match #[(var n regexp string) " ;… \"… ” •OL‡" [var string string-match regexp n] 4 "\ Set VAR to the Nth subpattern in REGEXP matched by STRING, or nil if none."]) (byte-code "ÀÁ!„ÂÀ‡" [boundp r2b-month-abbrevs (("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug") ("sep") ("oct") ("nov") ("dec"))] 2) (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 "\ Try to convert `r2bv-month' to a standard 3 letter name."]) (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 "\ Parse buffer into global variables."]) (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Ì•×\\‚ŽØÙ!ˆØ!ˆØÛ!ˆ „̃ÈØÕ!ˆ‚ÌØÜ!ˆÊÝ\"ˆÌ•ÞVƒÜØß!ˆØ!ˆ ?…óƒðØÕ!‚óØà!,‡" [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 "\ 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-require #[(vars) "?†\"<ƒÁ@!ˆÁA!‡J?…\"ÂÃ\"ˆÄL‡" [vars r2b-require r2b-warning "*Missing value for field %s" ""] 3 "\ If any of VARS is null, set to empty string and log error."]) (defalias 'r2b-moveq '(macro . #[(new old) "ÀÁ\n EÁ ÄEE‡" [progn setq new old nil] 5 "\ Set NEW to OLD and set OLD to nil."])) (defalias 'r2b-isa-proceedings #[(name) "…$ÁÂ\"†$à \"†$à \"‰…#ÁÂA@\")‡" [name string-match "proceedings\\|conference" assoc r2b-proceedings-list r2b-booktitle-abbrevs match] 4 "\ Return t if NAME is the name of proceedings."]) (defalias 'r2b-isa-university #[(name) "…ÁÂ\"…ÁÃ\"?‡" [name string-match "university" "press"] 3 "\ Return t if NAME is a university or similar organization, but not a publisher."]) (defalias 'r2b-barf-output #[nil "ÁÂÆÇ!ˆÈÉ!ˆqˆ\n  Q Î!ƒ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 "\ Generate bibtex based on global variables."]) (defalias 'r2b-convert-record #[(output-name) "À‰‰ Æ !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 "\ Transform current bib entry and append to buffer OUTPUT; do \"M-x r2b-help\" for more info." (list (read-string "Output to buffer: " r2b-out-buf-name))]) (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 "\ Transform current buffer and append to buffer OUTPUT; do \"M-x r2b-help\" for more info." (list (read-string "Output to buffer: " r2b-out-buf-name))]) (defvar r2b-load-quietly nil "\ *Don't print help message when loaded") (byte-code "ÀÁ!„ÂÀ‡" [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"] 2) (defalias 'r2b-help #[nil "ÀÁ\n!‘‡" ["*Help*" princ r2b-help-message] 3 "\ Print help message." nil]) (byte-code "„Á ˆÂÃ!ˆÄÅ!‡" [r2b-load-quietly r2b-help message "r2b loaded" provide refer-to-bibtex] 2) emacs-19.22/lisp/refer.elc100666 13437 1 11272 5416172724 14035 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:47:32 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/refer.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (provide (quote refer)) (defvar refer-bib-files (quote 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.") (byte-code "ÀÁ!ˆÀÂ!‡" [make-variable-buffer-local refer-bib-files refer-cache-bib-files] 2) (defalias 'refer-find-entry #[(keywords &optional continue) "„ ƒ \n‚ÃÄ!Å \"‡" [keywords continue refer-previous-keywords read-string "Keywords: " refer-find-entry-internal] 3 "\ 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." (list nil current-prefix-arg)]) (defalias 'refer-find-next-entry #[nil "À Â\"‡" [refer-find-entry-internal refer-previous-keywords t] 3 "\ Find next occurrence of entry in refer-bib-files. See refer-find-entry." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias refer-find-entry-internal #[(keywords continue) "À !\nƒ ‚ Ä ÇÈ*‡" [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] refer-find-entry-in-file #[(keywords-list file &optional continue) "ÀÁ\n\"ˆÃ\n!qˆ ƒÅÆ!ˆ‚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 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] every #[(pred l) "„Á‡\n@!…A?†Ã\nA\"‡" [l nil pred every] 3] 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] 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]] 3) emacs-19.22/lisp/regi.elc100666 12120 1 13072 5474622024 13521 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:06:26 1993 ;;; from file /home/fsf/rms/e19/lisp/regi.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (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 "\ 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-mapcar #[(predlist func &optional negate-p case-fold-search-p) "À‰ „ ƒ C ƒÅ C\"ƒA@D ƒ1Å \"Å\nC\"A)‚\n*‡" [nil tail frame negate-p case-fold-search-p append predlist func element] 3 "\ 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-interpret #[(frame &optional start end) "ŠŒÀ‰‰‰‰‰ƒ:ƒ: ^‰]‰bˆÊË!bˆÊÌ!}ˆ+ÍÎ\"ˆÐ!ˆ\n „ym„y @‰@A@Ô8Ö8ÀÙÚˆ.Ð !ˆ‚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 "\ 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."]) (provide (quote regi)) emacs-19.22/lisp/register.elc100666 13437 1 14132 5470157136 14554 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Nov 10 07:28:14 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/register.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (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.") (defalias 'get-register #[(char) " žA‡" [char register-alist] 2 "\ Return contents of Emacs register named CHAR, or nil if none."]) (defalias 'set-register #[(char value) " ž‰ƒ\n ¡ˆ‚ B‰ B )‡" [char register-alist aelt value] 3 "\ Set contents of Emacs register named CHAR to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUE."]) (defalias 'point-to-register #[(char &optional arg) "À \nƒ à ‚ Ä \"‡" [set-register char arg current-frame-configuration point-marker] 3 "\ 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." "cPoint to register: \nP"]) (defalias 'window-configuration-to-register #[(char &optional arg) "À  \"‡" [set-register char current-window-configuration] 3 "\ 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." "cWindow configuration to register: \nP"]) (defalias 'frame-configuration-to-register #[(char &optional arg) "À  \"‡" [set-register char current-frame-configuration] 3 "\ 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." "cFrame configuration to register: \nP"]) (defalias (quote register-to-point) (quote jump-to-register)) (defalias 'jump-to-register #[(char &optional delete) "À !ÃÄ!ƒÄ\n!ƒÅ\n?\"‚LÇ\n!ƒ%È\n!‚LÉ\n!ƒ6ÊË\n!!ˆ\nb‚L\n:ƒI\n@Ì=ƒIÍ\nA!‚LÎÏ!)‡" [get-register char val fboundp frame-configuration-p set-frame-configuration delete window-configuration-p set-window-configuration markerp switch-to-buffer marker-buffer file find-file error "Register doesn't contain a buffer position or configuration"] 3 "\ 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.)" "cJump to register: \nP"]) (defalias 'view-register #[(char) "À !‰„ÃÄÅ !\"‚®ÆÇÈ!ˆÇÅ !!ˆÇÉ!ˆ\n¨ƒ,Ç\n!‚­Ê\n!ƒHÇË!ˆÇÌÍ\n!!!ˆÇÎ!ˆÇ\n!‚­Ï\n!ƒTÇÐ!‚­Ñ\n!ƒ`ÇÒ!‚­\n:ƒ{\n@Ó=ƒ{ÇÔ!ˆÕ\nA!ˆÇÖ!‚­\n:ƒ—Ç×!ˆ\n…­Ç\n@!ˆØ ˆ\nA‰‚…\n;ƒ¦ÇÙ!ˆÇ\n!‚­ÇÚ!ˆÕ\n!‘)‡" [get-register char val message "Register %s is empty" single-key-description "*Output*" princ "Register " " contains " markerp "a buffer position:\nbuffer " buffer-name marker-buffer ", 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"] 6 "\ Display what is contained in register named REGISTER. REGISTER is a character." "cView register: "]) (defalias 'insert-register #[(char &optional arg) "À ˆÁ\n!‰:ƒÄ !ˆ‚5 ;ƒ cˆ‚5 ¨„)Å !ƒ1Æ p\"ˆ‚5ÇÈ!ˆ) ?…>Ê ‡" [push-mark get-register char val insert-rectangle markerp princ error "Register does not contain text" arg exchange-point-and-mark] 4 "\ Insert contents of register REG. REG 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." "cInsert register: \nP"]) (defalias 'copy-to-register #[(char start end &optional delete-flag) "À \n {\"ˆ …\n |‡" [set-register char start end delete-flag] 4 "\ Copy region into register REG. With prefix arg, delete as well. Called from program, takes four args: REG, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." "cCopy to register: \nr\nP"]) (defalias 'append-to-register #[(char start end &optional delete-flag) "À !;„ ÂÃ!ˆÄ À ! {P\"ˆ… |‡" [get-register char error "Register does not contain text" set-register start end delete-flag] 5 "\ Append region to text in register REG. With prefix arg, delete as well. Called from program, takes four args: REG, START, END and DELETE-FLAG. START and END are buffer positions indicating what to append." "cAppend to register: \nr\nP"]) (defalias 'prepend-to-register #[(char start end &optional delete-flag) "À !;„ ÂÃ!ˆÄ {À !P\"ˆ… |‡" [get-register char error "Register does not contain text" set-register start end delete-flag] 5 "\ Prepend region to text in register REG. With prefix arg, delete as well. Called from program, takes four args: REG, START, END and DELETE-FLAG. START and END are buffer positions indicating what to prepend." "cPrepend to register: \nr\nP"]) (defalias 'copy-rectangle-to-register #[(char start end &optional delete-flag) "À \nƒ à \"‚Æ \"\"‡" [set-register char delete-flag delete-extract-rectangle start end extract-rectangle] 5 "\ Copy rectangular region into register REG. With prefix arg, delete as well. Called from program, takes four args: REG, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle." "cCopy rectangle to register: \nr\nP"]) emacs-19.22/lisp/replace.elc100666 13437 1 31426 5470326426 14350 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Nov 10 22:10:13 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/replace.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (defconst case-replace t "\ *Non-nil means query-replace should preserve case in replacements.") (byte-code "ÀÁ!„ÂÃÄÅ\"‡" [boundp query-replace-history nil defalias query-replace-read-args #[(string) "À‰ÃÄÅ\"À‰‰Ç%ÃÄÈ\n#À‰‰Ç%\n  E*‡" [nil to from read-from-minibuffer format "%s: " string query-replace-history "%s %s with: " current-prefix-arg] 6]] 3) (defalias 'query-replace #[(from-string to-string &optional arg) "À \nÃÄ %ˆ†ÇÈ!‡" [perform-replace from-string to-string t nil arg unread-command-events message "Done"] 6 "\ 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. Preserves case in each replacement if case-replace and case-fold-search are non-nil and FROM-STRING has no uppercase letters. Third arg DELIMITED (prefix arg if interactive) non-nil means replace only matches surrounded by word boundaries. To customize possible responses, change the \"bindings\" in `query-replace-map'." (query-replace-read-args "Query replace")]) (define-key esc-map "%" (quote query-replace)) (defalias 'query-replace-regexp #[(regexp to-string &optional arg) "À \nÉ %ˆ †ÆÇ!‡" [perform-replace regexp to-string t arg unread-command-events message "Done"] 6 "\ 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. 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) non-nil means replace only matches surrounded by word boundaries. In TO-STRING, \\& means insert what matched REGEXP, and \\=\\ means insert what matched th \\(...\\) in REGEXP." (query-replace-read-args "Query replace regexp")]) (defalias 'map-query-replace-regexp #[(regexp to-strings &optional arg) "À\n<ƒ \n‚?\nGÃU„?ÄÅ\n\"ƒ3Æ \nÃÄÅ\n\"OC\"\nÄÅ\n\"TÀO‰‚ Æ \nC\"lj‚ È ʉÀ &ˆ) †TÍÎ!‡" [nil replacements to-strings 0 string-match " " append "" perform-replace regexp t arg unread-command-events message "Done"] 8 "\ 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. A prefix argument N says to use each replacement string N times before rotating to the next." (byte-code "À‰ÃÄÀ‰‰Å%ÃÆÇ\n\"À‰‰Å%\n E*‡" [nil to from read-from-minibuffer "Map query replace (regexp): " query-replace-history format "Query replace %s with (space-separated strings): " current-prefix-arg] 6)]) (defalias 'replace-string #[(from-string to-string &optional delimited) "À \nÉ %ˆ †ÆÇ!‡" [perform-replace from-string to-string nil delimited unread-command-events message "Done"] 6 "\ 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. Third arg DELIMITED (prefix arg if interactive) non-nil means replace only matches surrounded by word boundaries. 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 OLD-STRING nil t) (replace-match REPLACEMENT nil t)) which will run faster and will not set the mark or print anything." (query-replace-read-args "Replace string")]) (defalias 'replace-regexp #[(regexp to-string &optional delimited) "À \nÃÄ %ˆ†ÇÈ!‡" [perform-replace regexp to-string nil t delimited unread-command-events message "Done"] 6 "\ 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) non-nil means replace only matches surrounded by word boundaries. In TO-STRING, \\& means insert what matched REGEXP, and \\=\\ means insert what matched th \\(...\\) in REGEXP. 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 REPLACEMENT nil nil)) which will run faster and will not set the mark or print anything." (query-replace-read-args "Replace regexp")]) (defvar regexp-history nil "\ History list for some commands that read regular expressions.") (defalias (quote delete-non-matching-lines) (quote keep-lines)) (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 "\ 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." (list (read-from-minibuffer "Keep lines (containing match for regexp): " nil nil nil (quote regexp-history)))]) (defalias (quote delete-matching-lines) (quote flush-lines)) (defalias 'flush-lines #[(regexp) "Šm?…!À ÂÃ#…!ŠÄ”bˆÄyˆ`)Åyˆ`|ˆ‚)‡" [re-search-forward regexp nil t 0 1] 4 "\ 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." (list (read-from-minibuffer "Flush lines (containing match for regexp): " nil nil nil (quote regexp-history)))]) (defalias (quote count-matches) (quote how-many)) (defalias 'how-many #[(regexp) "ÀÁŠm„%`Ä ÁÆ#ƒ%\n`UƒÇuˆ‚ T‚ÈÉ \"+‡" [0 nil opoint count re-search-forward regexp t 1 message "%d occurrences"] 4 "\ Print number of matches for REGEXP following point." (list (read-from-minibuffer "How many matches for (regexp): " nil nil nil (quote regexp-history)))]) (byte-code "ÀÁ!„ „à Ä ÅÆ#ˆÀÇ!„ÂÀÈ!„'ÂÀÉ!„0 ‡" [boundp occur-mode-map nil make-sparse-keymap define-key "" occur-mode-goto-occurrence occur-buffer occur-nlines occur-pos-list] 4) (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 "\ Major mode for output from \\[occur]. Move point to one of the occurrences in this buffer, then use \\[occur-mode-goto-occurrence] to go to the same occurrence in the buffer that the occurrences were found in. \\{occur-mode-map}"]) (defalias 'occur-mode-goto-occurrence #[nil "ƒ\nÁ!„ÂÂÄÅ!ˆŠÆyˆÇeŠÆyˆ`)\"SÆWƒ.ÉZ‚?ÆVƒ>‰\\É\\‚?Ê¥)‰ 8‰ „PÄÍ!ˆÎ!ˆÏ !b*‡" [occur-buffer buffer-name nil occur-pos-list error "Buffer in which occurrences were found is deleted" 0 count-lines occur-nlines 2 1 occur-number pos "No occurrence on this line" pop-to-buffer marker-position] 4 "\ Go to the line this occurrence was found in, in the buffer it was found in." nil]) (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 (quote list-matching-lines) (quote occur)) (defalias 'occur #[(regexp &optional nlines) "ƒ\nÁ!‚ \nÃpÄeÅ  \nËŠ qˆÍcˆÎ!ˆÐÑ !ÒÓ±ˆÔ ˆ ×)  =ƒNdbˆŠÙ ˆdU„nÚ×Ã#ƒnÛ”bˆÛyˆÜ ÞŽß`\"\\*`Û•bˆŠÛ”bˆÛWƒ‚’[yˆ`) ŠÛ•bˆÛVƒªTyˆ‚­Äyˆ`)!âã\"$å$Gæ\"'×(ŠÅ ‰(`דˆ qˆ(B\n„æé!„æêcˆ×\në  !#ˆì! Z!ˆ‰(ÛVƒ'í±ˆÄyˆ(S‰(‚þ.`Û•Û”Z\\דˆ`WƒL$„8âã.\"$$í±ˆ×$Äyˆ.T.‚%)(Wƒf'í±ˆÄyˆ(T‰(‚O)Äyˆ-‚R qˆŸt…ïðG\")‘-‡" [nlines prefix-numeric-value list-matching-lines-default-context-lines t 1 make-marker final-context-start prevpos linenum buffer first "*Occur*" standard-output "Lines matching " 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 "%3d" tag make-string 32 empty tem zerop "--------\n" insert-buffer-substring backward-char 58 this-linenum message "%d matching lines."] 6 "\ 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." (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)]) (defconst query-replace-help "Type Space or `y' to replace one match, Delete or `n' to skip to next,\nESC 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." "\ 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', and `help'.") (byte-code "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÅ#ˆÀ ÇÅ#ˆÀ ÈÃ#ˆÀ ÉÅ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÍ#ˆÀ ÏÍ#ˆÀ ÐÍ#ˆÀ ÑÍ#ˆÀ ÒÓ#ˆÀ ÔÕ#ˆÀ Ö×#ˆÀ ØÙ#ˆÀ ÚÛ#ˆÀ ÜÝ#ˆÀ Þß#ˆÀ àß#ˆÀ áâ#ˆÀ ãâ#‡" [define-key query-replace-map " " act "" skip [delete] [backspace] "y" "n" "," act-and-show "" exit [escape] "q" " " [return] "." act-and-exit "" edit "" delete-and-edit " " recenter "!" automatic "^" backup "" help "?" "" quit ""] 4) (defalias 'perform-replace #[(from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map) "„ \n… … ‰—˜? ? ƒÆ‚Ç È‰ÉÊÈɉÈÊ   ;ƒO‚W„WÚƒoÆÜ ƒh ‚kÝ !ÜQÞ ˆß ˆƒ°m„°ÈÊ#ƒ° `=„  ƒ± É”=ƒ± „±m„°ÚuˆÈÊ#‚²Êƒ°à  ƒÃá! <ƒè Uƒè\\8TG¦\"„ã!ˆä#ˆ T ‚ªß ˆÈ‰‰‰%&'((„Šéê #ˆë &ì&!&í&\"%ã!ˆ%î=ƒYïðñ ƒGò‚Hó ôõö7!°!‘ˆ‚%ø=ƒjÈʉ(‚%ù=ƒ”@‰:@bˆ:AÊ=‰'„‹ã:A!ˆA)‚%û=ƒ²'„©ä#ˆÊ(Ê'‚%ü=ƒÓ'„Çä#ˆÈÊ(Ê'‚%ý=ƒî'„ä#ˆÊ'‚%þ=ƒ'„ä#ˆÊ(È\"Ê'‚%ÿ=ƒʉ(‚%@=ƒ/@È!ˆ‚%A=ƒQãà ŠB ˆ)!ˆ ƒá! ‚%C=ƒrɔɕ|ˆãà ŠB ˆ)!ˆÊ'‚ÈDE&!F\"Fʉ(ƒ`'†™GHà \"BB'ƒ© T ,` ‚u…·. ‡" [map query-replace-map case-fold-search case-replace from-string regexp-flag re-search-forward search-forward nil 0 t 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 match-data looking-at query-flag store-match-data replace-match def key replaced done message "Query replacing %s with %s: " read-event vector lookup-key help "*Help*" princ "Query replacing " "regexp " "" " with " ".\n\n" substitute-command-keys query-replace-help exit backup elt act act-and-exit act-and-show automatic skip recenter edit recursive-edit delete-and-edit append listify-key-sequence unread-command-events mapcar #[(elt) "…Á!‡" [elt marker-position] 2]] 14 "\ 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 do exactly what you probably want."]) emacs-19.22/lisp/reporter.elc100666 13437 1 10230 5474622036 14565 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:06:36 1993 ;;; from file /home/fsf/rms/e19/lisp/reporter.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (defvar reporter-mailer (quote (vm-mail 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.") (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.") (defalias 'reporter-dump-variable #[(varsym) "ŠqˆÁ\n!)Ã\n!ÄÈÉÊ>ƒ Ë‚5<ƒ*Ì‚59ƒ4Ì‚5ËÍ!α+‡" [reporter-eval-buffer eval varsym symbol-name t print-escape-newlines sym val " " " " (t nil) "" "'" prin1-to-string "\n"] 6 "\ Pretty-print the value of the variable in symbol VARSYM."]) (defalias 'reporter-dump-state #[(pkgname varlist pre-hooks post-hooks) "p‰qˆÁ à űˆÆÇ!ˆÈcˆÉÊ \"ˆÌcˆÆÍ!)‡" [buffer "Emacs : " emacs-version "\nPackage: " pkgname "\n" run-hooks pre-hooks "\ncurrent state:\n==============\n(setq\n" mapcar #[(varsym-or-cons-cell) "¢†£† Á\n !*‡" [varsym-or-cons-cell reporter-dump-variable printer varsym] 2] varlist " )\n" post-hooks] 6 "\ 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 the symbol. 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."]) (defalias 'reporter-submit-bug-report #[(address pkgname varlist &optional pre-hooks post-hooks salutation) "pÀ <„ ‚5 ‰ƒ*Å @!ƒ# @‰‚ A‰„ „3ÆÇÈ\"ˆ *!ˆp \nËÌ!ˆÍ\n!ˆÍ !ˆebˆŠÎÏÐÑÒÓÔ!EÖ#×QÂØ#ˆÙ”Ù•{)ÚÛ!ˆcˆÚÝ!ˆÞ±ˆÎdØ#ˆàyˆ!ƒ‘â!㱈ä`!ˆãcˆå&'($ˆé ˆ)ê+ìíÂî#‰/ƒ¼ð/!‚½ñ2óô+2#-‡" [call-interactively reporter-mailer nil mailer mlist commandp error "variable `%s' does not contain a command for mailing." "reporter-mailer" mailbuf reporter-eval-buffer require sendmail pop-to-buffer re-search-forward "^\\(" mapconcat identity "[ ]*" "-+" regexp-quote mail-header-separator "\\|" "\\)$" move 0 mail-position-on-field "to" address "subject" "Report on package " pkgname 1 salutation "\n" "\n\n" set-mark reporter-dump-state varlist pre-hooks post-hooks exchange-point-and-mark "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."] 9 "\ 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 (do a `\\[describe-function] 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 saluation. The mailer used is described in the variable `reporter-mailer'."]) (provide (quote reporter)) emacs-19.22/lisp/reposition.elc100666 12241 1 4644 5422716660 15440 0ustar rolanddaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 20 03:24:32 1993 ;;; from file /home/fsf/rms/e19/lisp/reposition.el ;;; emacs version 19.16.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"))) (error "This file was compiled for Emacs 19")) (defalias 'reposition-window #[(&optional arg) "`Á !ÃZÅÆ `\"ÈÉŠm„ÊuˆËÌ!ˆÍÎ!ˆÏÊ!ˆ`)\"]ÉŠËÊ!ˆÑÊ!ˆ`)\"ÅŠËÊ!ˆ`)\"X…XZ XU„v Uƒ˜Vƒ˜ƒ˜ƒ TVƒË ˆÑ ˆÖÈ!‚0ÖÈ]!‚0U„¶ÈU„¶WƒñÈWƒñ UƒÎƒÈË ˆÑ ˆÖÈ!‚0ƒè Wƒè[yˆÈyˆÖÈ!‚0Ö ^!‚0Ì\\\\ VƒƒÖÈ ZT]]!‚0ƒ* Wƒ*[yˆÈyˆ× ‚0Ö ^!.‡" [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 "[^\\s \n ]" backward-char comment-height beginning-of-defun defun-height defun-depth defun-line-onscreen-p arg recenter reposition-window] 4 "\ 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)." "P"]) (byte-code "À ÂÃ#ˆÄÅÆ\"ˆÄÇÈ\"‡" [define-key esc-map " " reposition-window defalias repos-count-screen-lines #[(start end) "ŠŒ }ˆebˆÂdeZ!*‡" [start end vertical-motion] 3] repos-count-screen-lines-signed #[(start end) "À \n\" \nWƒ ‚ [)‡" [repos-count-screen-lines start end lines] 3]] 4) emacs-19.22/lisp/resume.elc100666 13437 1 3534 5416173026 14210 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:48:38 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/resume.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (defalias 'resume-process-args #[nil "pÀ !‰ÇŽ qˆÈ ˆÂÉʈ ËXƒ#‚Jebˆm„DÌÂwˆ` ÎÂwˆ `{ B)ÌÂwˆ‚& ŸÈ ˆÏp\"ˆ ƒ]Ñ @! AÓ !-‡" [get-buffer-create resume-emacs-args-buffer nil 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 default-directory command-line-1] 4 "\ Handler for command line args given when Emacs is resumed."]) (defalias 'resume-suspend-hook #[nil "ŠÀ !qˆÂ ˆÃp \")‡" [get-buffer-create resume-emacs-args-buffer erase-buffer resume-write-buffer-to-file resume-emacs-args-file] 3 "\ Clear out the file used for transmitting args when Emacs resumes."]) (defalias 'resume-write-buffer-to-file #[(buffer file) "À !„ Âà \"ˆŠ qˆÅ ˆŒ~ˆÆ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 "\ Writes the contents of BUFFER into FILE, if permissions allow."]) emacs-19.22/lisp/rfc822.elc100666 13437 1 10376 5416173055 13742 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:49:00 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/rfc822.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÕÖ!‡" [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] 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] 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] rfc822-snarf-word #[nil "gÀUƒÁÂ!†ÃÄ!‡ÁÅ!†ÃÆ!‡" [34 rfc822-looking-at "\"\\([^\"\\\n]\\|\\\\.\\|\\\\\n\\)*\"" rfc822-bad-address "Unterminated quoted string" "[^][--ÿ ()<>@,;:\\\".]+" "Rubbish in address"] 2] rfc822-snarf-words #[nil "À ˆÁÂ!…À ˆ‚‡" [rfc822-snarf-word rfc822-looking-at 46] 2] rfc822-snarf-subdomain #[nil "gÀUƒÁÂ!†ÃÄ!‡ÁÅ!†ÃÆ!‡" [91 rfc822-looking-at "\\[\\([^][\\\n]\\|\\\\.\\|\\\\\n\\)*\\]" rfc822-bad-address "Unterminated domain literal [...]" "[^][--ÿ ()<>@,;:\\\".]+" "Rubbish in host/domain specification"] 2] rfc822-snarf-domain #[nil "À ˆÁÂ!…À ˆ‚‡" [rfc822-snarf-subdomain rfc822-looking-at 46] 2] rfc822-snarf-frob-list #[(name separator terminator snarfer &optional return) "ÀÁ‰mƒÅÆÇ\"!‚7É\n!„]É !ƒ,É !„\"‚: „:ÅÆÌ\"!ƒ] Áƒ\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] 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] 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 rfc822] 3) emacs-19.22/lisp/ring.elc100666 13437 1 4304 5431756515 13652 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Aug 10 13:39:24 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/ring.el ;;; emacs version 19.18.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'ring-p #[(x) ":…@¨…A:…A@¨…ÁAA!‡" [x vectorp] 2 "\ Returns t if X is a ring; nil otherwise."]) (defalias 'make-ring #[(size) "À‰Á\nÃ\"BB‡" [0 make-vector size nil] 5 "\ Make a ring that can contain SIZE elements."]) (defalias 'ring-plus1 #[(index veclen) "Á\\‰ UƒÄ‚\n)‡" [index 1 new-index veclen 0] 3 "\ INDEX+1, with wraparound"]) (defalias 'ring-minus1 #[(index veclen) "ÁUƒ\n\n‚ ÃZ‡" [index 0 veclen 1] 2 "\ INDEX-1, with wraparound"]) (defalias 'ring-length #[(ring) "A@‡" [ring] 1 "\ Number of elements in the ring."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias ring-empty-p #[(ring) "A@ÁU‡" [ring 0] 2] ring-index #[(index head ringlen veclen) " ¦\n Z\\S ¦‡" [index ringlen head veclen] 3]] 3) (defalias 'ring-insert #[(ring item) "AA‰G@A@ \\\n¦ I \nUƒ&Æ \n\" ˆ‚,A T ˆ,‡" [ring vec veclen hd ln item ring-plus1] 6 "\ Insert a new item onto the ring. If the ring is full, dump the oldest item to make room."]) (defalias 'ring-remove #[(ring &optional index) "À !ƒ\nÂÃ!‡ @ A@ AA‰G \\S¦É\n „/ S Ì $  H\n U„c Í \"HIˆÍ \"‰ ‚BÉIˆ A S ˆ\n.‡" [ring-empty-p ring error "Ring empty" hd ln vec veclen tl nil oldelt index ring-index ring-plus1] 7 "\ 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-ref #[(ring index) "À !ƒ\nÂÃ!‡ @ A@ AA‰Ç G$H+‡" [ring-empty-p ring error "indexed empty ring" hd ln vec ring-index index] 7 "\ 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."]) (provide (quote ring)) emacs-19.22/lisp/rlogin.elc100666 13437 1 12117 5462656614 14231 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 25 01:01:00 1993 ;;; from file /home/fsf/rms/e19/lisp/rlogin.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint shell] 2) (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-initially-track-cwd t "\ *If non-`nil', do remote directory tracking via ange-ftp right away. If `nil', you can still enable directory tracking by doing `M-x dirtrack-toggle'.") (defvar rlogin-password-paranoia nil "\ *If non-`nil', query user for a password in the minibuffer when a Password: prompt appears. It's also possible to selectively enter passwords without echoing them in the minibuffer using the command `rlogin-password' explicitly.") (byte-code "ÀÁ!„ „(à BÅ ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÂ‡" [boundp rlogin-mode-map nil keymap shell-mode-map define-key "" rlogin-send-Ctrl-C "" rlogin-send-Ctrl-Z "" rlogin-send-Ctrl-backslash "" rlogin-delchar-or-send-Ctrl-D] 4) (defalias 'rlogin #[(input-args &optional prefix) "Âà \"ÆÆÉ \nËÌ \"ƒ, ͔͕OB Ή”O‚Ï\n!ˆÂÃ@\"Ð\"ƒKÅÓ !!Ô !ˆÕ !†Ö ˆ×p Æ%ˆÙ !Ú!dÆ“ˆÛ ˆÜÝ\"ˆÞ@ßQ !…âÞ@ãQ!-‡" [rlogin-process-connection-type process-connection-type format "*rlogin-%s*" input-args buffer-name nil args proc match-data old-match-data string-match "[ ]*\\([^ ]+\\)$" 1 0 store-match-data append rlogin-explicit-args prefix generate-new-buffer switch-to-buffer comint-check-proc comint-mode comint-exec rlogin-program get-process process-mark rlogin-mode set-process-filter rlogin-filter "/" ":" comint-file-name-prefix rlogin-initially-track-cwd cd-absolute ":~/"] 6 "\ 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*, where HOST is the first word in the string ARGS. If a prefix argument is given and the buffer *rlogin-HOST* already exists, a new buffer with a different connection will be made. 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 ARGS." (list (read-from-minibuffer "rlogin arguments (hostname first): ") current-prefix-arg)]) (defalias 'rlogin-password #[(&optional proc) "„Áp!ÂÃ!!ÄÅÆ\n\"Ç\"‰…,Š\nqˆÉÊ!ˆËÅÌ\"\")*‡" [proc get-buffer-process buffer-name process-buffer comint-read-noecho format "Password for buffer \"%s\": " stars pass insert-before-markers "\n" comint-send-string "%s\n"] 6 "\ Read a password and send it to an rlogin session. For each character typed, a `*' is echoed in the minibuffer. End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts attempt to read and send password. Optional argument PROC is the process to which the password should be sent. If not provided, send to the process in the current buffer. This argument is intended primarily for use by `rlogin-filter'." nil]) (defalias 'rlogin-mode #[nil "À ˆÁ ˆÂÄÆ!ˆ ÊË!ˆÌÍ!‡" [kill-all-local-variables shell-mode rlogin-mode major-mode "rlogin" mode-name use-local-map rlogin-mode-map rlogin-initially-track-cwd shell-dirtrackp make-local-variable comint-file-name-prefix run-hooks rlogin-mode-hook] 2 "\ Set major-mode for rlogin sessions. If `rlogin-mode-hook' is set, run it." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias rlogin-filter #[(proc string) "À‰‰ŠÄ !qˆÆ !`ÈU?…$ É U…$Êp! bˆË !ˆ\nbˆÍÎ Ï#ƒ?ÐÑ!ˆ‚0) ƒRÉ !\nYƒRÒ \nÓ#ˆ+…b Õ˜…bÖ !‡" [nil window region-begin proc-mark process-buffer proc process-mark scroll-step 0 window-start get-buffer-window insert-before-markers string search-forward " " goto-end delete-char -1 set-window-start noforce rlogin-password-paranoia "Password:" rlogin-password] 4] rlogin-send-Ctrl-C #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil] rlogin-send-Ctrl-Z #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil] rlogin-send-Ctrl-backslash #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil]] 3) (defalias 'rlogin-delchar-or-send-Ctrl-D #[(arg) "mƒ ÀÁÂ\"‡Ã !‡" [send-string nil "" delete-char arg] 3 "\ Delete ARG characters forward, or send a C-d to process if at end of buffer." "p"]) emacs-19.22/lisp/rmail.elc100666 12120 1 124300 5475604341 13717 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 02:59:28 1993 ;;; from file /home/fsf/rms/e19/lisp/rmail.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ÂÄ!ƒÅÃÄ\"ˆÂÆ!„&ÂÇ!ƒ&ÅÆÇ\"ˆÀ‡" [require mail-utils fboundp user-original-login-name user-real-login-name defalias buffer-disable-undo buffer-flush-undo] 3) (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:\\|^message-id:\\|^summary-line:" "\ *Gubbish headers one would rather not see.") (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-retry-setup-hook nil "\ Hook that `rmail-retry-failure' uses in place of `mail-setup-hook'.") (defvar mmdf-delim1 "^\n" "\ Regexp marking the start of an mmdf message") (defvar mmdf-delim2 "^\n" "\ Regexp marking the end of an mmdf message") (defvar rmail-message-filter nil "\ If non nil, is a filter function for new headers in RMAIL. Called with region narrowed to unformatted header.") (defvar rmail-reply-prefix "Re: " "\ String to prepend to Subject line when replying to a message.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂÀÆ!„)ÂÀÇ!„2ÂÀÈ!„;ÂÀÉ!„D ÀÊ!„MÂ\nÀË!„V ÀÌ!„_ ÀÍ!„h ÀÎ!„qÂÀÏ!„|ÐÑ!ÀÒ!„žÓÔÕÖRØÙÚÛÜÝÞßàáâã°)äåæ\"‡" [boundp rmail-mode-map nil rmail-inbox-list rmail-keywords rmail-current-message rmail-total-messages rmail-message-vector rmail-deleted-vector rmail-summary-buffer rmail-summary-vector rmail-last-label rmail-last-multi-labels rmail-last-file rmail-last-regexp rmail-last-rmail-file expand-file-name "~/XMAIL" 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]*\\) *" "\\([^ ]*\\) *" "\\([0-9]*\\) *" "\\([0-9:]*\\) *" " [0-9][0-9]\\([0-9]*\\) *" "\\(remote from [^\n]*\\)?" "\n" defalias rmail-select-summary (macro . #[(&rest body) "ÀÁÂÃÄÅÆÇÈ \"ÊEDEÅËÇÌ \"EFÍE‡" [progn if (rmail-summary-displayed) let ((window (selected-window))) save-excursion unwind-protect append (progn (pop-to-buffer rmail-summary-buffer)) body (select-window window) (set-buffer rmail-summary-buffer) (progn) (rmail-maybe-display-summary)] 10])] 14) (defalias 'rmail #[(&optional file-name-arg) "„ÁÂ!Á † !Æ !‰ƒ?È!„?É\nË !ˆ)È!ƒG Í=ƒGÎ ˆÏ ˆ‚GÉ\nË !ˆ) Ð=ƒRÑÒ!ˆƒkÓ ÔVƒk Í=„Õ ˆ‚Õ ˆÖ ˆdbˆ„Ï ˆØ ˆÙ  „ŠÛ ˆØ!+‡" [rmail-last-file expand-file-name "~/xmail" 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-first-unseen-message existing-unseen rmail-get-new-mail] 3 "\ 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 filename as argument; then performs rmail editing on that file, but does not copy any new mail into the file." (byte-code "… ÁÂÉÄ$C‡" [current-prefix-arg read-file-name "Run rmail on RMAIL file: " nil t] 5)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆ „Æ Ç !ˆÈ ÉÊ#ˆÈ ËÌ#ˆÈ ÍÎ#ˆÈ ÏÐ#ˆÈ ÑÒ#ˆÈ ÓÔ#ˆÈ ÕÖ#ˆÈ ×Ø#ˆÈ ÙÚ#ˆÈ ÛÜ#ˆÈ ÝÞ#ˆÈ ßà#ˆÈ áâ#ˆÈ ãÚ#ˆÈ äâ#ˆÈ åæ#ˆÈ çè#ˆÈ éê#ˆÈ ëì#ˆÈ íî#ˆÈ ïð#ˆÈ ñò#ˆÈ óô#ˆÈ õö#ˆÈ ÷ø#ˆÈ ùú#ˆÈ ûü#ˆÈ ýþ#ˆÈ ÿ@#ˆÈ AB#ˆÈ CD#ˆÈ EF#ˆÈ GH#ˆÈ IJ#ˆÈ KÔ#ˆÈ LM#ˆÈ NO#ˆÈ PQ#ˆÈ RS#ˆÈ TU#ˆÈ VW#ˆÈ XY#ˆÈ Z[#ˆÈ \\]#ˆÈ ^_#ˆÈ `a#ˆÈ bc#ˆÈ de#ˆÈ fg #ˆÈ higi!B#ˆÈ jk#ˆÈ lm#ˆÈ no#ˆÈ pq#ˆÈ rsgs!B#ˆÈ tu#ˆÈ vw#ˆÈ xy#ˆÈ z{#ˆÈ |}#ˆÈ ~g!B#ˆÈ €#ˆÈ ‚ƒ#ˆÈ „…#ˆÈ †‡#ˆÈ ˆ‰#ˆÈ Š‹g‹!B#ˆÈ Œ#ˆÈ Ž#ˆÈ ‘#ˆÈ ’“#ˆÈ ”•g•!B#ˆÈ –—#ˆÈ ˜™#ˆÈ š›#ˆÈ œ#ˆÈ žŸ#ˆÈ  ¡#ˆÈ ¢£#ˆÈ ¤¥#ˆ¦§¨©#‡" [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 "" 1 "\n*From " message "Converting to Babyl format..." search-forward "\n" rmail-convert-to-babyl-format "Converting to Babyl format...done"] 4] 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] 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 "" " " "" 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 " " rmail-sort-by-lines [menu-bar] make-sparse-keymap [menu-bar classify] "Classify" [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 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 continue] ("Continue" . rmail-continue) [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-backward) [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 #[nil "À ˆÁ ˆÂ !‡" [rmail-mode-2 rmail-set-message-counters rmail-show-message rmail-total-messages] 2 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias rmail-mode-2 #[nil "À ˆÁ ˆÂ ˆÃÄ!‡" [kill-all-local-variables rmail-mode-1 rmail-variables run-hooks rmail-mode-hook] 2] rmail-mode-1 #[nil "ÀÂÄÆÈÉ!ƒÊ ‚ÊËÌ!AB Í!ˆÏ!ˆ‰‡" [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] rmail-variables #[nil "ÀÁ!ˆÂÀÃ!ˆÀÄ!ˆÀÅ!ˆÀÆ!ˆÀÇ!ˆÀÈ!ˆÀÉ!ˆÀÊ!ˆË\nÀÌ!ˆÍ ÀÎ!ˆÏÀÐ!ˆÀÑ!ˆÀÒ!ˆÓ ‰„tÕ!š„aØÙ!!šƒt†rÛÜ!†qÞ PCÀß!ˆË‰‡" [make-local-variable revert-buffer-function rmail-revert 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 version-control never file-precious-flag t rmail-message-vector rmail-last-file 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-original-login-name rmail-keywords] 5] rmail-revert #[(arg noconfirm) "À \"…Å ˆdbˆÆ ˆÇ )‡" [nil revert-buffer-function revert-buffer arg noconfirm rmail-convert-file rmail-set-message-counters rmail-show-message] 3] 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]] 3) (defalias 'rmail-expunge-and-save #[nil "À ˆÁ ‡" [rmail-expunge save-buffer] 1 "\ Expunge and save RMAIL file." nil]) (defalias 'rmail-quit #[nil "À ˆ ƒ  !ˆpÄÅ !ˆÂ !)‡" [rmail-expunge-and-save rmail-summary-buffer bury-buffer obuf switch-to-buffer other-buffer] 2 "\ Quit out of RMAIL." nil]) (defalias 'rmail-input #[(filename) "À !‡" [rmail filename] 2 "\ Run Rmail on file FILENAME." "FRun rmail on RMAIL file: "]) (defalias 'rmail-get-new-mail #[(&optional file-name) "Àp!„Á !ˆÃÀp!ƒÅ ˆÆ ˆ~ˆÃ=„%ÈÉŽ`ÊÈ …1Ì Èà  dbˆÐÈxˆ`d|ˆŠŒ``}ˆƒ^ÒCÈ\"ˆ‚eÒÃ\" ebˆŠÔ )Õ!„È~ˆ×Ø!ˆ`d}ˆeTbˆÙ ˆÚ ˆ) ƒ ÈÛ܈ A‰ „’*ÊUƒ¼bˆ„¶…ÝÞ!‚ß ƒåà ƒÙá \"ŠãŽä%!ˆæ ˆ+‚âŠ%qˆæ ˆ)ç ˆÝè‰éUƒóê‚ôë#ˆìí!…îï-\"…-ʉ”O-Ê•ÈOP‰-…ðñ!.‡" [verify-visited-file-modtime find-file buffer-file-name t buffer-read-only rmail-forget-messages rmail-maybe-set-message-counters buffer-undo-list nil ((rmail-show-message)) 0 make-backup-files buffer-modified-p 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 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-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" boundp display-time-string string-match " Mail" force-mode-line-update all] 7 "\ 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." (list (if current-prefix-arg (read-file-name "Get new mail from file: ")))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias rmail-insert-inbox-text #[(files renamep) "À‰‰‰‰ƒDÇÈ@!!‰ÉPÊ ! šÌÍÎ !\"‰ƒ4Î !Ï\nƒRÇÑÎ !PÊÇ!!\"Ó !ƒRÇÔ \" ƒ]ÕÖ!ˆ‚‚× !ƒmØÙ !8ÚUƒ}× !ƒ‚ØÙ !8ÚU„‚ÕÛ \"ˆ„Œ ‚ × !„  „œ× !ƒ \n„± „±ÀÜ݈ÀÞ߈‚ À ᎊâã! ä !ˆåÇæ'\"À À &ˆè !ƒ  qˆéedêë$ˆdbˆìÀxˆ`d|ˆebˆíî!ƒûeÚ•|ˆïÏ!ˆÕîed{P!ˆðñ!ˆ+× !ƒ7À2dbˆó !A@2dbˆhêU„2ô2!„2êcˆ B)Õõ!ˆA‰„ -‡" [nil popmail movemail delete-files tofile file files expand-file-name substitute-in-file-name "+" file-name-directory rmail-spool-directory string-match "^po:" file-name-nondirectory t renamep ".newmail-" buffer-file-name file-directory-p user-original-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 nil))) (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 "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] rmail-convert-to-babyl-format #[nil "ÀÁ‰ÂebˆŒm„HÇÈ!ƒ0ÉÊÁË#ƒ&e`|ˆ‚ ˆe`|ˆ‚ ÇÌ!ƒWÉÊÁË#„A ˆT`ŠÍÁwˆ`)|ˆ`d}ˆ‚ ËÇ!)ƒ›ËÏÐ!ˆ`ÑÁË#ˆÏÓ!ˆ)ŠŒ `S}ˆebˆÉÊÁË#ƒŽÏÔ!ˆ‚*`d}ˆT‚ ÇÕ!ƒ6`ÐcˆÖ ˆŠÑ×ÁË#…³`)ËŠÙuˆÉÚË#…Ö`Áˆ`Ý{!*)‰ƒñ§ƒñÀYƒñ\\bˆ+Ñß ááâã°ÁË#ƒ ä”bˆ‚dbˆTŠŒ `}ˆebˆÉÊÁË#ƒ+ÏÔ!ˆ‚*åcˆ`d}ˆ‚ lƒAæä!ˆ‚ çè!ˆ‚ ),‡" [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 " " " \n" mmdf-delim1 replace-match " \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 read size "^[]?\\(" rmail-unix-mail-delimiter "\\|" "^BABYL OPTIONS:\\|" " \n[01],\\)" 1 31 delete-char error "Cannot convert to babyl format"] 9] rmail-nuke-pinhead-header #[nil "ŠŒ`ÀÁˆ`À‰‰ }ˆÇbˆÉÊÀÇ#bˆÉËÀÇ#….`bˆ)ÀÌÍPÀÇ#…xÏÐ ƒLÑ‚lÒÓ”Ó•U„YÔ‚jÕ”Õ•U„iÕ”Õ•{‚jÖ×Q ƒ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] rmail-reformat-message #[(beg end) "bˆÁyˆgÂU„ÃÄ!ˆÅÆ Z ÊÁ!ˆËcˆÁyˆÌ ÎÏ!ƒ3Áyˆ‚')ÎÐ!ƒA`Áyˆ`|ˆ`ŠÑÒÓ#ˆ`){‰Õ±ˆ`Æ Z}ˆ)ebˆƒh× ˆ…p *‡" [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-ignored-headers rmail-clear-headers rmail-message-filter] 6] rmail-clear-headers #[nil "ÀÁÂÃ#…0Œe`}ˆÂÃebˆÆÂÃ#)…/Èyˆ`ÆÉ!ˆÊuˆ`|ˆ‚*‡" [search-forward "\n\n" nil t buffer-read-only case-fold-search re-search-forward rmail-ignored-headers 0 "\n[^ ]" -1] 4]] 3) (defalias 'rmail-toggle-header #[nil "À ˆÁ\n!d}ˆÃebˆÅyˆgÆUƒ\\ÇÅ!ˆÈcˆÅyˆÉ\nËÌ!ƒ0Åyˆ‚$)ÍcˆÎuˆÏÐ!ˆÎyˆ`ÏÒÃÉ#ƒN`|ˆ)ebˆÏÐ!ˆ`d}‚`Ó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] 4 "\ Show original message header if pruned header currently shown, or vice versa." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [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 ", +" "/" rmail-total-messages mode-line-process] 5] 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 " }ˆ‰“ˆ ‰“ˆ UƒÅ ˆÂ‡" [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] rmail-message-labels-p #[(msg labels) "ŠŒ~ˆÀ !bˆÂuˆÃ `ňÆ#*‡" [rmail-msgbeg msg 3 re-search-backward labels nil t] 4] rmail-msgend #[(n) "À \nTH!‡" [marker-position rmail-message-vector n] 3] rmail-msgbeg #[(n) "À \nH!‡" [marker-position rmail-message-vector n] 3]] 3) (defalias 'rmail-widen-to-current-msgbeg #[(function) "ŠdeZÁŽÂ !d}ˆebˆ +‡" [obeg ((byte-code "dZd}‡" [obeg] 2)) rmail-msgbeg rmail-current-message function] 2 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias rmail-forget-messages #[nil "ÀŽÁ\n!…&Ã\n‰G W…% Hlj“ˆ T‰‚+)‡" [((byte-code "ÀÀÀ‡" [nil rmail-message-vector rmail-deleted-vector] 1)) vectorp rmail-message-vector 0 i v n nil] 4] rmail-maybe-set-message-counters #[nil "… … \n… ?…Ä ‡" [rmail-deleted-vector rmail-message-vector rmail-current-message rmail-total-messages rmail-set-message-counters] 1] rmail-count-new-messages #[(&optional nomsg) "ÀÂÀÀ„ÇÈ!ˆdbˆÉÊ!ˆËuˆÌ CÍe!ˆT \\Ð A\"‰ @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] rmail-set-message-counters #[nil "À ˆŠŒ~ˆ`ÂÄÄÄÄÉÊ!ˆdbˆËÌ!ˆÍ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" 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] rmail-set-message-counters-counter #[(&optional stop) "ÀÁ\nÃ#…?ÄuˆÅ BŠÀÇ`ÈyˆÃ#ƒ\"É‚#Ê B ) T‰ ͦÎUƒÏÐ \"ˆ‚‡" [search-backward "\n \n" stop t 1 point-marker messages-head ", deleted," 2 68 32 deleted-head total-messages 20 0 message "Counting messages...%d"] 4]] 3) (defalias 'rmail-beginning-of-message #[nil "À !‡" [rmail-show-message rmail-current-message] 2 "\ Show current message starting from the beginning." nil]) (defalias 'rmail-show-message #[(&optional n) "À ˆ~ˆ Â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 run-hooks rmail-show-message-hook rmail-summary-exists curr-msg 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 "\ Show message number N (prefix argument), counting from start of file. If summary buffer is currently displayed, update current message there also." "p"]) (defalias 'rmail-next-message #[(n) "À ˆÁ\n \\!‡" [rmail-maybe-set-message-counters rmail-show-message rmail-current-message n] 3 "\ Show following message whether deleted or not. With prefix arg N, moves forward N messages, or backward if N is negative." "p"]) (defalias 'rmail-previous-message #[(n) "À [!‡" [rmail-next-message n] 2 "\ Show previous message whether deleted or not. With prefix arg N, moves backward N messages, or forward if N is negative." "p"]) (defalias 'rmail-next-undeleted-message #[(n) "À ˆ ‰ ÅVƒ&\nWƒ&\nTÇ\n!„\n S‰‚ ÅWƒD\nÈVƒD\nSÇ\n!„&\n T‰‚' U„RÉ !ˆÊ‚g ÅWƒ\\ËÌ!ˆ Å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 "\ 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." "p"]) (defalias 'rmail-previous-undeleted-message #[(n) "À [!‡" [rmail-next-undeleted-message n] 2 "\ Show previous non-deleted message. With prefix argument N, moves backward N non-deleted messages, or forward if N is negative." "p"]) (defalias 'rmail-first-message #[nil "À ˆÁÂ!‡" [rmail-maybe-set-message-counters rmail-show-message 1] 2 "\ Show first message in file." nil]) (defalias 'rmail-last-message #[nil "À ˆÁ\n!‡" [rmail-maybe-set-message-counters rmail-show-message rmail-total-messages] 2 "\ Show last message in file." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias rmail-what-message #[nil "`À ‰Â¥ ZÀVƒ.Ç !Yƒ! ‚#  ZÂ¥\\‚ Ç !Yƒ; ‚< ,‡" [1 rmail-total-messages 2 mid high low where rmail-msgbeg] 5] 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]] 3) (defalias 'rmail-message-regexp-p #[(msg regexp) "À !bˆŠÂÃd\"ˆ`)Å Ç#)‡" [rmail-msgbeg msg search-forward "*** EOOH ***" end re-search-forward regexp t] 4 "\ Return t, if for message number MSG, regexp REGEXP matches in the header."]) (defalias 'rmail-search-backward #[(regexp &optional n) "À \n[\"‡" [rmail-search regexp n] 3 "\ 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." (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)]) (byte-code "ÀÁ!„‡" [boundp rmail-search-last-regexp nil] 2) (defalias 'rmail-search #[(regexp &optional n) "„ÁÂÃÄWƒÅ‚Æ#ˆÈ ˆed`ÉÄW\n   ÑŽ~ˆÄU?…› ƒd „Š ÁVƒŠÒ S‰ !bˆÓÔ !Õ#‰ ‚A „Š WƒŠÒ T‰ !bˆÓÔ !Õ#‰ ƒi ƒ”Á‚•×\\‰‚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 "\ 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." (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)]) (defalias 'rmail-search-backwards #[(regexp &optional n) "À \n†Ã[\"‡" [rmail-search regexp n -1] 3 "\ 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." (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)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias rmail-first-unseen-message #[nil "À ˆÁÂŒ~ˆ „# Wƒ#Æ Ç\"ƒ  T‚\n) *‡" [rmail-maybe-set-message-counters 1 nil found current rmail-total-messages rmail-message-labels-p ", ?\\(unseen\\),"] 3] rmail-message-deleted-p #[(n) " HÂU‡" [rmail-deleted-vector n 68] 2] rmail-set-message-deleted-p #[(n state) " \nƒ\n ÄI‡" [rmail-deleted-vector n state 68 32] 3]] 3) (defalias 'rmail-delete-message #[nil "ÀÁÂ\"‡" [rmail-set-attribute "deleted" t] 3 "\ Delete this message and stay on it." nil]) (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 "\ Back up to deleted message, select it, and undelete it." nil]) (defalias 'rmail-delete-forward #[(&optional backward) "ÀÁÂ\"ˆ Å ƒŠqˆÇ !ˆ)È ƒ Ê‚!Ë!Ì ˆ)‡" [rmail-set-attribute "deleted" t rmail-current-message del-msg rmail-summary-exists rmail-summary-buffer rmail-summary-mark-deleted rmail-next-undeleted-message backward -1 1 rmail-maybe-display-summary] 3 "\ 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." "P"]) (defalias 'rmail-delete-backward #[nil "ÀÁ!‡" [rmail-delete-forward t] 2 "\ Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given." nil]) (defalias 'rmail-only-expunge #[nil "ÀÁ!ˆ\nÃ=„ ÄÅ ˆÆ dZÆ eZ ÊVƒ0  HÌUƒ0Ê‚3`eZ ÊHÄB‰ÃÄÒŽŠ~ˆebˆÊÓ ĉ ÄÄ ÄÄ Ä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-deleted-vector 68 opoint rmail-message-vector messages-head messages-tail win ((byte-code "ÀÁ!ˆ\n„à Zà 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-summary-vector summary deleted messages buffer-read-only new-summary new-message-number total number counter marker-position 20 "Expunging deleted messages...%d" apply vector make-string 32 vconcat] 10 "\ Actually erase all deleted messages in the file." nil]) (defalias 'rmail-expunge #[nil "À ˆÁ …* ƒà ŠÅŽÆ!ˆÈ ˆ+‚(ŠqˆÈ ˆ)É ‡" [rmail-only-expunge rmail-summary-exists rmail-summary-displayed selected-window window ((select-window window)) pop-to-buffer rmail-summary-buffer rmail-update-summary rmail-maybe-display-summary] 2 "\ Erase deleted messages from Rmail file and summary buffer." nil]) (defalias (quote rmail-start-mail) #[(&rest args) "ƒ ƒÂà \"ÅÆ Ç\"ˆ‡ÂÈ \"‡" [window-system rmail-mail-new-frame apply mail-other-frame args modify-frame-parameters selected-frame ((dedicated . t)) mail-other-window] 4]) (defalias 'rmail-mail #[nil "ÀÁ‰‰‰‰p&‡" [rmail-start-mail nil] 7 "\ Send mail in another window. While composing the message, use \\[mail-yank-original] to yank the original message into it." nil]) (defalias 'rmail-continue #[nil "ÀÁ!‡" [rmail-start-mail t] 2 "\ Continue composing outgoing message previously being composed." nil]) (defalias 'rmail-reply #[(just-sender) "À‰‰‰‰‰‰‰ŠŒ~ˆÉ\n!bˆËyˆgÌUƒ9Íyˆ`ÎÏÐ\n!Ñ#ˆ`}ˆ‚D`ÎÒ!ˆÓyˆ`}ˆÔÕÖ\"Ô×! †\\ÔØÀÖ#†\\ƒgÀ‚w ƒrÔÚÖ\"‚wÔÛÀÖ# ƒ„ÔÜÖ\"†‡ÔÝ! ƒ“ÔÞÖ\"‚–Ôß! ƒ¢ÔàÖ\"‚«ÔáÀÖ#†«â ƒ·ÔãÖ\"‚ºÔä!* ;ƒÒåæç(!P \"„Ò( PéÀê! ë \n#?…ìê„ð ‚õ íQ!!‰.â˜?….)pïp\nEC&.‡" [nil resent-reply-to message-id to date subject cc reply-to from rmail-msgbeg rmail-current-message 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" string-match "\\`" regexp-quote rmail-reply-prefix rmail-start-mail mail-strip-quoted-names rmail-make-in-reply-to-field rmail-dont-reply-to ", " cc-list (lambda (buf msgnum) (save-excursion (set-buffer buf) (rmail-set-attribute "answered" t msgnum)))] 11 "\ 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." "P"]) (defalias (quote rmail-make-in-reply-to-field) #[(from date message-id) "„\n …ó ‡\nƒ]ÃÄ!ˆÅ!@ ƒDÇÈÇÉ\"ƒ/ʉ”O‚1! \"ƒ; ‚[ ËÌR‚[Í!ƒXÐQ‚Z))‡ÑÓÇÕÖ×Ø°\"†„ÇÙ×ÚÛ°\"*ƒêܔܕ‰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 " (" ")" 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]) (defalias 'rmail-forward #[(resend) "ƒÁÂ!‡pÃÄÅ!†ÄÆ!‰ƒ\"È!ÉP‚#Ê)ÄË!†+ÊÌR „@ÐÑ!ƒ@Ò‚AÓÔ‰ Ô‰‰ÕpEC&…hŠebˆ×ØÙ!P!ˆÛyˆÜ!)*‡" [resend call-interactively rmail-resend "[" mail-fetch-field "From" ">From" from mail-strip-quoted-names ": " "" "Subject" "]" subject forward-buffer rmail-mail-new-frame one-window-p t mail rmail-start-mail nil #[(buf msgnum) "ŠqˆÁÂà #)‡" [buf rmail-set-attribute "forwarded" t msgnum] 4] rmail-current-message search-forward-regexp "^" regexp-quote mail-header-separator 1 insert-buffer] 11 "\ Forward the current message to another user. With prefix argument, \"resend\" the message instead of forwarding it; see the documentation of `rmail-resend'." "P"]) (defalias 'rmail-resend #[(address &optional from comment mail-alias-file) "ÀÁ!ˆÀÂ!ˆ „Ä ÅÆ!ÇÈp \n  ÍŽŠ qˆÎ !ˆebˆÏÐÈÑ#ƒRÈÓyˆ`ÔyˆÕÖ!ƒLÔyˆ‚@`|ˆ)× Ø±ˆÙÚ Ø±ˆ`ƒnÝÄ Ø±ˆÞ;ƒz‚€àáâ#رˆã`\"ˆ)ä%!ƒÃ%GÓU„Ã`È&%cˆl„«Øcˆ`&bˆ`&WƒÂç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 "^Sender:" t beg 0 1 looking-at "[ ]" "Resent-From: " "\n" "Resent-Date: " mail-rfc822-date before mail-self-blind "Resent-Bcc: " "Resent-To: " address mapconcat identity ",\n " expand-mail-aliases sequencep comment after "Resent-Comment: " mail-aliases sendmail-send-it rmail-set-attribute "resent" rmail-current-message] 5 "\ Resend current message to ADDRESSES. ADDRESSES should be a single address, a 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." "sResend to: "]) (byte-code "ÀÁ!„ÂÃÄÅÆÇ°À‡" [boundp mail-unsent-separator "^ *---+ +Unsent message follows +---+ *$\\|" "^ *---+ +Returned message +---+ *$\\|" "^ *---+ +Original message +---+ *$\\|" "^ *--+ +begin message +--+ *$\\|" "^ *---+ +Original message follows +---+ *$\\|" "^|? *---+ +Message text follows: +---+ *|?$"] 6) (defalias 'rmail-retry-failure #[nil "ÀÁ!ˆÂ‰‰‰‰ŠÈ ˆÉ\nË ÂÉ#„$ÍÎ!ˆ)Œ`d}ˆÏÐ!ÏÑ!ÏÒ!ÏÓ!ÔÕ!ˆ`d{*ÂÙ p&…edbˆ cˆebˆÂ.‡" [require mail-utils nil orig-message cc irp2 subj to rmail-beginning-of-message t case-fold-search re-search-forward mail-unsent-separator error "Cannot parse this as a failure message" mail-fetch-field "To" "Subject" "In-reply-to" "Cc" search-forward "\n\n" rmail-retry-setup-hook mail-setup-hook mail-signature rmail-start-mail] 7 "\ 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." nil]) (defalias 'rmail-bury #[nil "pÁ ƒ ÂÄ !‰ƒÆ Ç !\"ˆ‚ È !ˆ)ÉÇp!!ˆÈ!)‡" [rmail-buffer rmail-summary-exists nil window get-buffer-window rmail-summary-buffer set-window-buffer other-buffer bury-buffer switch-to-buffer] 4 "\ Bury current Rmail buffer and its summary buffer." nil]) (defalias 'rmail-summary-exists #[nil "… Á!… ‡" [rmail-summary-buffer buffer-name] 2 "\ Non-nil iff in an RMAIL buffer and an associated summary buffer exists. Non-nil value returned is the summary buffer."]) (defalias 'rmail-summary-displayed #[nil "…Á!‡" [rmail-summary-buffer get-buffer-window] 2 "\ t iff in RMAIL buffer and an associated summary buffer is displayed."]) (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.") (defalias (quote rmail-maybe-display-summary) #[nil "…Á!…\n…Ã!‡" [rmail-summary-buffer buffer-name rmail-redisplay-summary display-buffer] 2]) (autoload (quote 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) (autoload (quote rmail-add-label) "rmailkwd" "\ Add LABEL to labels associated with current RMAIL message. Completion is performed over known labels when reading." t) (autoload (quote rmail-kill-label) "rmailkwd" "\ Remove LABEL from labels associated with current RMAIL message. Completion is performed over known labels when reading." t) (autoload (quote 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 (quote 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 (quote rmail-read-label) "rmailkwd" "\ PROMPT and read with completion an Rmail message label." t) (autoload (quote rmail-edit-current-message) "rmailedit" "\ Edit the contents of the current message" t) (autoload (quote 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 (quote 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 (quote 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 (quote 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 (quote 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 (quote 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 (quote rmail-summary) "rmailsum" "\ Display a summary of all messages, one line per message." t) (autoload (quote 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 (quote 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 (quote 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 (quote 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 (quote 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 (quote rmail-output) "rmailout" "\ Append this message to Unix mail file named FILE-NAME." t) (autoload (quote undigestify-rmail-message) "undigest" "\ Break up a digest message into its constituent messages. Leaves original message, deleted, before the undigestified messages." t) (provide (quote rmail)) emacs-19.22/lisp/rmailedit.elc100666 13437 1 4557 5422716666 14702 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Jul 20 03:24:38 1993 ;;; from file /home/fsf/rms/e19/lisp/rmailedit.el ;;; emacs version 19.16.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ Ä „\"Å ¤Ç ÈÉ#ˆÇ ÊË#ˆÌÍÎÏ#‡" [require rmail boundp rmail-edit-map nil make-sparse-keymap text-mode-map define-key "" rmail-cease-edit "" rmail-abort-edit put rmail-edit-mode mode-class special] 4) (defalias 'rmail-edit-mode #[nil "À !ˆÂÄÆÇ!ƒÈÇ!‚ÈÉ! ÊËÌ\"‡" [use-local-map rmail-edit-map rmail-edit-mode major-mode "RMAIL Edit" mode-name boundp mode-line-modified default-value mode-line-format run-hooks text-mode-hook rmail-edit-mode-hook] 3 "\ 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-current-message #[nil "À ˆÁÂ!ˆed{ÃÅÆ !ˆÇÈ!É=ƒ&ÇÊ!Ë=ƒ&ÌÍ!‡ÌÎÏ!!‡" [rmail-edit-mode make-local-variable rmail-old-text nil buffer-read-only set-buffer-modified-p buffer-modified-p 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 "\ Edit the contents of this message." nil]) (defalias 'rmail-cease-edit #[nil "ŠdbˆhÀU„ Ácˆ\n TH`Ä“ˆ) ÇÈ !ˆÉ ˆGdeZUƒ4ed{˜„RÄÊËÌ\"ˆÍÎ!ƒR SÄIˆŠÏÐ!ˆÑ ˆ))̉‡" [10 "\n" rmail-message-vector rmail-current-message nil rmail-old-text old set-buffer-modified-p buffer-modified-p 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 "\ Finish editing message; switch back to Rmail proper." nil]) (defalias 'rmail-abort-edit #[nil "ed|ˆcˆÁ ‡" [rmail-old-text rmail-cease-edit] 2 "\ Abort edit of current message; restore original contents." nil]) emacs-19.22/lisp/rmailkwd.elc100666 13437 1 11254 5416173324 14541 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:51:48 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/rmailkwd.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ ÂÃÄ\"ÅÆÇÈ\"B ÊË \" ÀÅ!„!Í͇" [boundp rmail-label-obarray make-vector 47 0 rmail-keywords mapcar #[(s) "À \n\"‡" [intern s rmail-label-obarray] 3] ("deleted" "answered" "filed" "forwarded" "unseen" "edited") rmail-attributes intern "deleted" rmail-deleted-label nil] 4) (defalias 'rmail-add-label #[(string) "À Â\"‡" [rmail-set-label string t] 3 "\ Add LABEL to labels associated with current RMAIL message. Completion is performed over known labels when reading." (list (rmail-read-label "Add label"))]) (defalias 'rmail-kill-label #[(string) "À Â\"‡" [rmail-set-label string nil] 3 "\ Remove LABEL from labels associated with current RMAIL message. Completion is performed over known labels when reading." (list (rmail-read-label "Remove label"))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias rmail-read-label #[(prompt) "„Á ˆÂ ƒÅÆ !ÇQ‚ÈP ʉ$‰ ̘ƒ) ‚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] 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}ˆ UƒÅ ˆÀ‡" [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] rmail-attribute-p #[(s) "À !‰ A>… \n)‡" [rmail-make-label s symbol rmail-attributes] 3] rmail-keyword-p #[(s) "À !‰à A>… \n)‡" [rmail-make-label s symbol rmail-keywords] 3] rmail-make-label #[(s &optional forcep) "9ƒ‡ ƒÂ— \"‡Ä— \"‡" [s forcep intern rmail-label-obarray intern-soft] 3] rmail-force-make-label #[(s) "À —\n\"‡" [intern s rmail-label-obarray] 3] rmail-quote-label-name #[(label) "ÀÁ Ä\"!!‡" [regexp-quote symbol-name rmail-make-label label t] 5]] 3) (defalias 'rmail-previous-labeled-message #[(n labels) "À [\n\"‡" [rmail-next-labeled-message n labels] 3 "\ 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." "p\nsMove to previous msg with labels: "]) (defalias 'rmail-next-labeled-message #[(n labels) "Á˜ƒ\n„ÃÄ!ˆÅ ˆ‰ÇÈ!ÉQ\n  Œ~ˆ ÎVƒQ WƒQ T Ð \n\"ƒ'   S‰ ‚) ÎWƒz ÑVƒz S Ð \n\"ƒQ   T‰ ‚S)Ò !ˆ Î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 "\ 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." "p\nsMove to next msg with labels: "]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias rmail-keywords #[nil "†Á ‡" [rmail-keywords rmail-parse-file-keywords] 1] 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] rmail-install-keyword #[(word) "À Â\"à Æ !„bÇ !„bÈ eZÈ dZ \nËŽŠ~ˆÌbˆÂÍÐÑÍÂ#„<͈Ñcˆ`͈`|ˆ AB¡ˆ A‰ƒ\\Ò @!Ó±ˆ‚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]] 3) emacs-19.22/lisp/rmailmsc.elc100666 13437 1 2077 5416173326 14523 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:51:50 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/rmailmsc.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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 "" "Mail: " "\n" rmail-inbox-list rmail-show-message rmail-current-message] 7 "\ 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." "sSet mailbox list to (comma-separated list of filenames): "]) emacs-19.22/lisp/rmailout.elc100666 13437 1 12275 5472134401 14562 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Tue Nov 16 06:26:56 1993 ;;; from file /home/fsf/rms/e19/lisp/rmailout.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (defalias 'rmail-output-to-rmail-file #[(file-name &optional count) "„ÁÂ Ä !\"Æ !ƒÇ !„È \"‡É ˆÊ !Ë !„`Ì !„`ÍÎ ÏQ!ƒ\\Ð !ŠqˆÒ ˆÓÕed ÖÁ%ˆ*×!ˆ)‚`ØÙ!ˆÚV…%ÓÜŽŒ~ˆÝ!ƒ}ÖßàÓ\"ˆŠË !pá!Tâ!T#$%‰&„£ç$# #ˆ‚&p=ƒ®Øè!ˆ&qˆÓéÞ!…»*+*ƒïÉ ˆ~ˆdd}ˆì%$##ˆebˆ~ˆíî!ˆ`d}ˆïÖ!ˆð*!ˆ‚eñ T}ˆdbˆì%$##ˆ*.ßòÖ\"ˆ*S3ƒô ˆ‚`ÚVƒ`õÁ!ˆ‚`‡" [count 1 expand-file-name file-name file-name-directory rmail-last-rmail-file file-readable-p rmail-file-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 append-to-file "Can't output message to same file it's already in" boundp msg buffer-read-only insert-buffer-substring search-backward "\n" rmail-count-new-messages rmail-show-message buffer-size "filed" rmail-delete-after-output rmail-delete-forward rmail-next-undeleted-message] 7 "\ 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. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count." (byte-code "À‰  ƒ)\n„)ŠebˆÄ @@ÀÅ#ƒ\"Æ @A! A)‚\n†/*ÉÊË!ÌQÍ!#‰Î!)D‡" [nil tail answer rmail-output-file-alist re-search-forward t eval rmail-last-rmail-file default-file read-file-name "Output message to Rmail file: (default " file-name-nondirectory ") " file-name-directory prefix-numeric-value current-prefix-arg] 4)]) (defalias (quote rmail-file-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]) (defalias 'rmail-output #[(file-name &optional count noattribute from-gnus) "„Á …Å !\"Æ !ƒ\"Ç !ƒ\"È \"‡pÉÊË! ?…AŠŒÍ!d}ˆebˆÁyˆgÏU*ЉØVƒ? „xŠŒ~ˆÍ!bˆ`ÙÚ!ˆ`}ˆÛÜ!*ŠqˆÝ ˆÞ!ˆßcˆebˆƒ™ß±ˆ‚¶àáÛâ!†®Ûã!†®Ûä!†®å!æç ß±ˆÙèÐÉ#ƒÇéuˆêcˆ‚¶ëed É,…Òí%ˆ),„æ.æðñÉ\"ˆS „Q2ƒøó ‚ØV…ôÁ!Z5‰6ƒƒ÷ ˆØVƒ;6„;øŠqˆùú5‰ÁUƒ4û‚5ü#)!ˆØ*‚Qý!.‡" [count 1 expand-file-name file-name rmail-last-file file-name-directory file-readable-p rmail-file-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 "\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 "\ Append this message to Unix mail file named FILE-NAME. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. When called from lisp code, N may be omitted. 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 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." (list (setq rmail-last-file (read-file-name (concat "Output message to Unix mail file" (if rmail-last-file (concat " (default " (file-name-nondirectory rmail-last-file) "): ") ": ")) (and rmail-last-file (file-name-directory rmail-last-file)) rmail-last-file)) (prefix-numeric-value current-prefix-arg))]) emacs-19.22/lisp/rmailsort.elc100666 13437 1 10071 5474622067 14746 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:07:01 1993 ;;; from file /home/fsf/rms/e19/lisp/rmailsort.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃÄ\"‡" [require sort autoload timezone-make-date-sortable "timezone"] 3) (defalias 'rmail-sort-by-date #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "ÀÁ\nÃ\"!‡" [rmail-make-date-sortable rmail-fetch-field msg "Date"] 4]] 3 "\ Sort messages of current Rmail file by date. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (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 "\ Sort messages of current Rmail file by subject. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (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 "\ Sort messages of current Rmail file by author. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (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 "\ Sort messages of current Rmail file by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-sort-by-correspondent #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "À Â\"‡" [rmail-select-correspondent msg ("From" "Sender" "To" "Apparently-To")] 3]] 3 "\ Sort messages of current Rmail file by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias (quote rmail-select-correspondent) #[(msg fields) "À\nƒ\" À˜ƒ\"ÃÄÅ\n@\"†À!!\nA‰„ )‡" ["" ans fields rmail-dont-reply-to mail-strip-quoted-names rmail-fetch-field msg] 6]) (defalias 'rmail-sort-by-lines #[(reverse) "À Â\"‡" [rmail-sort-messages reverse #[(msg) "ÀÁ\n!Ã\n!\"‡" [count-lines rmail-msgbeg msgnum rmail-msgend] 4]] 3 "\ Sort messages of current Rmail file by number of lines. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-sort-messages #[(reverse keyfun) "ŠÁ=ƒ\n\nqˆÃ‰‰ÇÈ!ˆ~ˆÉ\n \nYƒR \n! \n=\nH\nTHF B\nϦÐUƒJÇÑ\n\"ˆ\nT\n‚)„[ Ÿ @@§ƒgÓ‚iÔÕ Ö\"ƒv ŸÇ×!ˆØÃÉÃ\nÜp!ˆÝÉ!bˆÞß!ˆàÉ!ˆ ƒÚ @ápâ8ã8#ˆâ8ã8|ˆA@ƒÀ\n A\nϦÐUƒÒÇä\n\"ˆ\nT\n‚—åÉ!ˆÃ&ç ˆè ˆé!.‡" [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-flush-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] 5 "\ 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-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 "\ Return the value of the header FIELD of MSG. Arguments are MSG and FIELD."]) (defalias 'rmail-make-date-sortable #[(date) "À ‰#‡" [timezone-make-date-sortable date "GMT"] 4 "\ Make DATE sortable using the function string-lessp."]) (provide (quote rmailsort)) emacs-19.22/lisp/rmailsum.elc100666 13437 1 61515 5474622176 14575 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:08:12 1993 ;;; from file /home/fsf/rms/e19/lisp/rmailsum.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (defalias (quote rmail-update-summary) #[(&rest ignore) "À @ A\"‡" [apply rmail-summary-redo] 3]) (defalias 'rmail-summary #[nil "ÀÁÂÃ#‡" [rmail-new-summary "All" (rmail-summary) nil] 4 "\ Display a summary of all messages, one line per message." nil]) (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 "\ Display a summary of all messages with one or more LABELS. LABELS should be a string containing the desired labels, separated by commas." "sLabels to summarize by: "]) (defalias 'rmail-summary-by-recipients #[(recipients &optional primary-only) "ÀÁ\nPÃ\n EÅÆ\n! %‡" [rmail-new-summary "recipients " recipients rmail-summary-by-recipients primary-only rmail-message-recipients-p mail-comma-list-regexp] 6 "\ 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." "sRecipients to summarize by: \nP"]) (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 "\ 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." "sRegexp to summarize by: "]) (defalias 'rmail-summary-by-topic #[(subject &optional whole-message) "ÀÁ\nPÃ\n EÅÆ\n! %‡" [rmail-new-summary "about " subject rmail-summary-by-topic whole-message rmail-message-subject-p mail-comma-list-regexp] 6 "\ 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." "sTopics to summarize by: \nP"]) (defalias (quote rmail-message-subject-p) #[(msg subject &optional whole-message) "ŒÀ !bˆÂÃ!ˆ` ƒÅ‚Æ!ˆ`}ˆebˆ ƒ*ÇÉÊ#‚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]) (defalias 'rmail-summary-by-senders #[(senders) "ÀÁ\nPÃÄ\n!#‡" [rmail-new-summary "senders " senders rmail-message-senders-p mail-comma-list-regexp] 5 "\ Display a summary of all messages with the given SENDERS. SENDERS is a string of names separated by commas." "sSenders to summarize by: "]) (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅÀ‡" [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] boundp rmail-summary-symbol-number 0] 3) (defalias 'rmail-new-summary #[(description redo-form function &rest args) "ÀÁ!ˆÂ‰‰ŠÇ=ƒÈ qˆ\nƒ)Ë\n!ƒ)\n‚/ÌË ÍP!ÂÏÒÂŒŠ~ˆebˆYƒsƒ_×B\"ƒkÙ!BBT‚FŸ,Â\nŠp qˆÂÜ ˆƒ£Ý@A \"ˆA‰„’ebˆ)ÈÇ ˆÞß!ˆàC !\"- \n) „Îã !ˆä ȉ#ˆÀå!+‡" [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 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 pop-to-buffer rmail-summary-goto-msg "Computing summary lines...done"] 5 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [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] rmail-make-summary-line-1 #[(msg) "À !bˆŠÂyˆ`)ÄÆuˆÇÈ!ˆlƒÉ‚&Ê`Ĉ`{ËQ° ÍyˆÎÏ!…@Еbˆ`Íyˆ`{‰‰ƒXÒÓ\"„X`Ôyˆ`|ˆÄ„¥Õ× !À !bˆÇÙÕ#ƒw`‚{Íyˆ`ÇÛÄÕ#ˆ`Œ}ˆbˆÝ )À !bˆÂyˆÏ±ˆ,ÒÓ\" Sßà \"Ð O  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] rmail-make-basic-summary-line #[nil "ebˆŠÀÁÂÃ#„Ä‚OÀŊˆ`)Ã#ƒ/ÆÇÈɔɕ{!ʔʕ{#‚OÀˊˆ`)Ã#ƒNÆÇÈʔʕ{!ɔɕ{#‚OÌ)ÍŠÀÎÂÃ#„^Ï‚ùÐ`SˆÑÂ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 " " from len mch lo string-match "^" regexp-quote user-login-name "\\($\\|@\\)" "^To:[ ]*" "to: " "[@%]" "%25s" 25 0 9 16 " #" "^Subject:" "[\n][\n]+" "\n"] 9] rmail-summary-next-all #[(&optional number) "ƒ‚ ÁyˆÂ !‡" [number 1 display-buffer rmail-buffer] 2 nil "p"] rmail-summary-previous-all #[(&optional number) "ƒ‚ Á[yˆÂ !‡" [number 1 display-buffer rmail-buffer] 2 nil "p"]] 3) (defalias 'rmail-summary-next-msg #[(&optional number) "Àyˆ ÀVƒ ˆ À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 "\ 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." "p"]) (defalias (quote rmail-summary-previous-msg) #[(&optional number) "À ƒ ‚\nÂ[!‡" [rmail-summary-next-msg number 1] 2 nil "p"]) (defalias 'rmail-summary-next-labeled-message #[(n labels) "ŠqˆÁ\n \")‡" [rmail-buffer rmail-next-labeled-message n labels] 3 "\ Show next message with LABEL. Defaults to last labels used. With prefix argument N moves forward N messages with these labels." "p\nsMove to next msg with labels: "]) (defalias 'rmail-summary-previous-labeled-message #[(n labels) "ŠqˆÁ\n \")‡" [rmail-buffer rmail-previous-labeled-message n labels] 3 "\ Show previous message with LABEL. Defaults to last labels used. With prefix argument N moves backward N messages with these labels." "p\nsMove to previous msg with labels: "]) (defalias 'rmail-summary-delete-forward #[(&optional backward) "À ˆÃ !ˆÅ!ˆÃ!)‡" [nil end rmail-summary-goto-msg pop-to-buffer rmail-buffer rmail-delete-forward backward rmail-summary-buffer] 2 "\ 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." "P"]) (defalias 'rmail-summary-delete-backward #[nil "ÀÁ!‡" [rmail-summary-delete-forward t] 2 "\ Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias rmail-summary-mark-deleted #[(&optional n undel) "ƒ\nÁ‰#ˆm„5ÃÅÃwˆÆÃwˆƒ-ÈÉ!ƒ4ÊË!ˆÅcˆ‚4ÊË!ˆÉcˆ)ÌyˆÃ‡" [n rmail-summary-goto-msg t nil buffer-read-only " " "[0-9]" undel looking-at "D" delete-char 1 0] 4] rmail-summary-mark-undeleted #[(n) "À Â\"‡" [rmail-summary-mark-deleted n t] 3] rmail-summary-deleted-p #[(&optional n) "Šƒ ÁÂÃ#ˆÄÂwˆÅÂwˆÆÇ!)‡" [n rmail-summary-goto-msg nil t " " "[0-9]" looking-at "D"] 4]] 3) (defalias 'rmail-summary-undelete #[(&optional arg) "ÁU„\nÂ!‡ÃÈÅÆÃÇ#…1ÈÉ!ˆÊ ˆË !ˆÍ!ƒ-Ï ˆË!)‡" [arg 1 rmail-summary-undelete-many nil 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 "\ Undelete current message. Optional prefix ARG means undelete ARG previous messages." "p"]) (defalias 'rmail-summary-undelete-many #[(&optional n) "Šqˆ ƒ \n‚ ‰ † Å\nÅVƒ= Wƒ=Ç\n!ƒ6ÈÉÊ\"ˆT\nS‰‚ qˆ Å\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 "\ Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." "P"]) (put (quote rmail-summary-mode) (quote mode-class) (quote special)) (defalias 'rmail-summary-mode #[nil "À ˆÁÃÅ!ˆÇÇ Ê !ˆÌÍ!ˆÌÎ!ˆÌÏ!ˆÐÌÑ!ˆÐÌÒ!ˆÓÌÔ!ˆÕÔÖ\"ˆ×Ø!‡" [kill-all-local-variables rmail-summary-mode major-mode "RMAIL Summary" mode-name use-local-map rmail-summary-mode-map 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 rmail-update-summary post-command-hook add-hook rmail-summary-rmail-update run-hooks rmail-summary-mode-hook] 3 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÃÄ!„ Å „†Æ Ç !ˆÈ ÉÊ#ˆÈ ËÌ#ˆÈ ÍÎ#ˆÈ ÏÐ#ˆÈ ÑÒ#ˆÈ ÓÔ#ˆÈ ÕÖ#ˆÈ ×Ø#ˆÈ ÙÚ#ˆÈ ÛÜ#ˆÈ ÝÞ#ˆÈ ßà#ˆÈ áØ#ˆÈ âà#ˆÈ ãä#ˆÈ åæ#ˆÈ çè#ˆÈ éê#ˆÈ ëì#ˆÈ íî#ˆÈ ïð#ˆÈ ñò#ˆÈ óô#ˆÈ õö#ˆÈ ÷ø#ˆÈ ùú#ˆÈ ûü#ˆÈ ýþ#ˆÈ ÿ@#ˆÈ AB#ˆÈ CD#ˆÈ EF#ˆÈ GH#ˆÈ IJ#ˆÈ KL#ˆÈ MN#ˆÈ OP#ˆÈ QR#ˆÈ ST#ˆÈ UV#ˆÈ WX#ˆÈ YZ#ˆÈ [\\#ˆÈ ]^#ˆÈ _`#ˆÈ ab#ˆÈ cd#ˆÈ ef#ˆÈ gh #ˆÈ ijhj!B#ˆÈ kl#ˆÈ mn#ˆÈ op#ˆÈ qr#ˆÈ stht!B#ˆÈ uv#ˆÈ wx#ˆÈ yz#ˆÈ {|#ˆÈ }~#ˆÈ €h€!B#ˆÈ ‚#ˆÈ ƒ„#ˆÈ …†#ˆÈ ‡ˆ#ˆÈ ‰Š#ˆÈ ‹ŒhŒ!B#ˆÈ Ž#ˆÈ #ˆÈ ‘’#ˆÈ “”#ˆÈ •–h–!B#ˆÈ —˜#ˆÈ ™š#ˆÈ ›œ#ˆÈ ž#ˆÈ Ÿ #ˆÈ ¡¢#ˆÈ £¤#ˆÈ ¥¦#ˆÀܧ\"‡" [defalias rmail-summary-rmail-update #[nil "À !…ZŠÄyˆÅÂwˆ` ÉÂwˆÊ`{! =†YÂ‰Ì   gÐUƒHÑÒ!ˆÅcˆÓ !ÔŽÕ!ˆÖ!,-‡" [get-buffer-window rmail-buffer nil buffer-read-only 0 " " buf msg-num beg "0-9" string-to-int rmail-current-message selected-window owin window go-where 45 delete-char 1 display-buffer ((select-window owin)) select-window rmail-show-message] 3] boundp rmail-summary-mode-map nil 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 "" " " "" 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-sort-by-date "" rmail-summary-sort-by-subject "" rmail-summary-sort-by-author "" rmail-summary-sort-by-recipient "" rmail-summary-sort-by-correspondent " " rmail-summary-sort-by-lines [menu-bar] make-sparse-keymap [menu-bar classify] "Classify" [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 continue] ("Continue" . rmail-summary-continue) [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) #[(&optional n nowarn skip-rmail) ":ƒ Á!mƒÂyˆÃyˆ `Å`d`Æ\\^{! „.‚kÊWƒ:ËÌ!ˆÊ VƒKËÎ!ˆdbˆÏ ˆebˆÐÑÒ!PÓÔ#„k„dËÖ\"ˆbˆÃyˆ×ÓwˆØÓwˆŠgÙUƒˆÓÛÊ!ˆ×cˆ))Ãyˆ?…ŸÝ !ˆÞ!ˆÝ!+‡" [n prefix-numeric-value -1 0 rmail-buffer string-to-int 5 curmsg cur buf 1 message "No preceding message" rmail-total-messages "No following message" rmail-summary-goto-msg re-search-forward "^ *" int-to-string nil t nowarn "Message %d not found" " " "0-9" 45 buffer-read-only delete-char skip-rmail pop-to-buffer rmail-show-message rmail-summary-buffer] 7 nil "P"]] 6) (defalias 'rmail-summary-scroll-msg-up #[(&optional dist) "À !‡" [scroll-other-window dist] 2 "\ Scroll other window forward." "P"]) (defalias 'rmail-summary-scroll-msg-down #[(&optional dist) "À Â=ƒ  „‚Ä ![!‡" [scroll-other-window dist - nil prefix-numeric-value] 3 "\ Scroll other window backward." "P"]) (defalias 'rmail-summary-beginning-of-message #[nil "À !ˆÂ ˆÀ !‡" [pop-to-buffer rmail-buffer beginning-of-buffer rmail-summary-buffer] 2 "\ Show current message from the beginning." nil]) (defalias 'rmail-summary-quit #[nil "À ˆÁ ‡" [rmail-summary-wipe rmail-quit] 1 "\ Quit out of Rmail and Rmail summary." nil]) (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 "\ Kill and wipe away Rmail summary, remaining within Rmail." nil]) (defalias 'rmail-summary-expunge #[nil "ŠqˆÁ ˆ) ‡" [rmail-buffer rmail-only-expunge rmail-update-summary] 1 "\ Actually erase all deleted messages and recompute summary headers." nil]) (defalias 'rmail-summary-expunge-and-save #[nil "ŠqˆÁ ˆ) ˆŠqˆÃ )‡" [rmail-buffer rmail-only-expunge rmail-update-summary save-buffer] 1 "\ Expunge and save RMAIL file." nil]) (defalias 'rmail-summary-get-new-mail #[nil "ÀŠ\nqˆÃ ˆ )Å !)‡" [nil msg rmail-buffer rmail-get-new-mail rmail-current-message rmail-summary-goto-msg] 2 "\ Get new mail and recompute summary headers." nil]) (defalias 'rmail-summary-input #[(filename) "À !ˆÂ !‡" [pop-to-buffer rmail-buffer rmail filename] 2 "\ Run Rmail on file FILENAME." "FRun rmail on RMAIL file: "]) (defalias 'rmail-summary-first-message #[nil "À ‡" [beginning-of-buffer] 1 "\ Show first message in Rmail file from summary buffer." nil]) (defalias 'rmail-summary-last-message #[nil "À ˆÁy‡" [end-of-buffer -1] 1 "\ Show last message in Rmail file from summary buffer." nil]) (byte-code "ÀÁ!„ „à ¤Å ÆÇ#ˆÅ ÈÉ#ˆÂ‡" [boundp rmail-summary-edit-map nil make-sparse-keymap text-mode-map define-key "" rmail-cease-edit "" rmail-abort-edit] 4) (defalias 'rmail-summary-edit-current-message #[nil "À !ˆÂ ˆÃ !‡" [pop-to-buffer rmail-buffer rmail-edit-current-message use-local-map rmail-summary-edit-map] 2 "\ Edit the contents of this message." nil]) (defalias 'rmail-summary-cease-edit #[nil "À ˆÁ\n!‡" [rmail-cease-edit pop-to-buffer rmail-summary-buffer] 2 "\ Finish editing message, then go back to Rmail summary buffer." nil]) (defalias 'rmail-summary-abort-edit #[nil "À ˆÁ\n!‡" [rmail-abort-edit pop-to-buffer rmail-summary-buffer] 2 "\ Abort edit of current message; restore original contents. Go back to summary buffer." nil]) (defalias 'rmail-summary-search-backward #[(regexp &optional n) "pÁŽ\nqˆÃ [\"*‡" [buffer ((set-buffer buffer)) rmail-buffer rmail-search regexp n] 3 "\ 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." (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)]) (defalias 'rmail-summary-search #[(regexp &optional n) "pÁŽ\nqˆÃ \"*‡" [buffer ((set-buffer buffer)) rmail-buffer rmail-search regexp n] 3 "\ 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." (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)]) (defalias 'rmail-summary-toggle-header #[nil "ŠqˆÁ )‡" [rmail-buffer rmail-toggle-header] 1 "\ Show original message header if pruned header currently shown, or vice versa." nil]) (defalias 'rmail-summary-add-label #[(label) "ŠqˆÁ\n!)‡" [rmail-buffer rmail-add-label label] 2 "\ Add LABEL to labels associated with current Rmail message. Completion is performed over known labels when reading." (list (save-excursion (set-buffer rmail-buffer) (rmail-read-label "Add label")))]) (defalias 'rmail-summary-kill-label #[(label) "ŠqˆÁ\nÃ\")‡" [rmail-buffer rmail-set-label label nil] 3 "\ Remove LABEL from labels associated with current Rmail message. Completion is performed over known labels when reading." (list (save-excursion (set-buffer rmail-buffer) (rmail-read-label "Kill label")))]) (defalias 'rmail-summary-mail #[nil "ÀÁ‰‰‰‰\n&ˆÃÄÅ !!ˆÆÅ ÇÈ#‡" [mail-other-window nil rmail-buffer use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 7 "\ Send mail in another window. While composing the message, use \\[mail-yank-original] to yank the original message into it." nil]) (defalias 'rmail-summary-continue #[nil "ÀÁ!‡" [mail-other-window t] 2 "\ Continue composing outgoing message previously being composed." nil]) (defalias 'rmail-summary-reply #[(just-sender) "À‹ˆÃ !ˆÄÅÆ !!ˆÇÆ ÈÉ#)‡" [nil mailbuf ((byte-code "qˆÁ\n!ˆpÁ‡" [rmail-buffer rmail-reply just-sender mailbuf] 2)) pop-to-buffer use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 4 "\ 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." "P"]) (defalias 'rmail-summary-retry-failure #[nil "À‹ˆÃ !ˆÄÅÆ !!ˆÇÆ ÈÉ#)‡" [nil mailbuf ((byte-code "qˆÁ ˆpÁ‡" [rmail-buffer rmail-retry-failure mailbuf] 1)) pop-to-buffer use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 4 "\ 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." nil]) (defalias 'rmail-summary-send-and-exit #[nil "ÀÁ!‡" [mail-send-and-exit t] 2 "\ Send mail reply and return to summary buffer." nil]) (defalias 'rmail-summary-forward #[(resend) "ŠqˆÁ\n!ˆÃÄÅ !!ˆÆÅ ÇÈ#)‡" [rmail-buffer rmail-forward resend use-local-map copy-keymap current-local-map define-key "" rmail-summary-send-and-exit] 4 "\ Forward the current message to another user. With prefix argument, \"resend\" the message instead of forwarding it; see the documentation of `rmail-resend'." "P"]) (defalias 'rmail-summary-output-to-rmail-file #[nil "ŠqˆÁÂ!)‡" [rmail-buffer call-interactively rmail-output-to-rmail-file] 2 "\ 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." nil]) (defalias 'rmail-summary-output #[nil "ŠqˆÁÂ!)‡" [rmail-buffer call-interactively rmail-output] 2 "\ Append this message to Unix mail file named FILE-NAME." nil]) (defalias 'rmail-summary-sort-by-date #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-date reverse] 3 "\ Sort messages of current Rmail summary by date. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-summary-sort-by-subject #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-subject reverse] 3 "\ Sort messages of current Rmail summary by subject. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-summary-sort-by-author #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-author reverse] 3 "\ Sort messages of current Rmail summary by author. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-summary-sort-by-recipient #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-recipient reverse] 3 "\ Sort messages of current Rmail summary by recipient. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-summary-sort-by-correspondent #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-correspondent reverse] 3 "\ Sort messages of current Rmail summary by other correspondent. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-summary-sort-by-lines #[(reverse) "ÀÁ\n\"‡" [rmail-sort-from-summary rmail-sort-by-lines reverse] 3 "\ Sort messages of current Rmail summary by lines of the message. If prefix argument REVERSE is non-nil, sort them in reverse order." "P"]) (defalias 'rmail-sort-from-summary #[(sortfun reverse) "ÀÁ!ˆÂ !ˆ !ˆÆ ‡" [require rmailsort pop-to-buffer rmail-buffer sortfun reverse rmail-summary] 2 "\ Sort Rmail messages from Summary buffer and update it after sorting."]) emacs-19.22/lisp/rnews.elc100666 13437 1 53563 5431756553 14106 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Aug 10 13:39:54 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/rnews.el ;;; emacs version 19.18.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote mail-utils)) (autoload (quote rmail-output) "rmailout" "\ Append this message to Unix mail file named FILE-NAME." t) (autoload (quote 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 (quote 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 (quote news-post-news) "rnewspost" "\ Begin editing a new USENET news article to be posted." t) (autoload (quote 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.") (byte-code "ÀÁ!„\nÂÃ!À‡" [boundp rmail-last-file expand-file-name "~/mbox.news"] 2) (defvar news-startup-file "$HOME/.newsrc" "\ Contains ~/.newsrc") (defvar news-certification-file "$HOME/.news-dates" "\ Contains ~/.news-dates") (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.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ÂÀÆ!„!ÂÀÇ!„*ÂÀÈ!„3‡" [boundp news-mode-map nil news-read-first-time-p t news-user-group-list news-current-news-group news-current-group-begin news-current-group-end] 2) (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-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.") (byte-code "ÀÁ!„‡" [boundp news-group-article-assoc nil] 2) (defvar news-current-message-number 0 "\ Displayed Article Number") (defvar news-total-current-group 0 "\ Total no of messages in group") (byte-code "ÀÁ!„‡" [boundp news-unsubscribe-groups nil] 2) (defvar news-point-pdl nil "\ List of visited news messages.") (byte-code "ÀÁ!„ÂÀ‡" [boundp news-no-jumps-p t] 2) (defvar news-buffer nil "\ Buffer into which news files are read.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"‡" [defalias news-push (macro . #[(item ref) "À  EE‡" [setq ref cons item] 5]) news-cadr (macro . #[(x) "ÀÁ\nDD‡" [car cdr x] 3]) news-cdar (macro . #[(x) "ÀÁ\nDD‡" [cdr car x] 3]) news-caddr (macro . #[(x) "ÀÁ‰\nDDD‡" [car cdr x] 4]) news-cadar (macro . #[(x) "ÀÁÀ\nDDD‡" [car cdr x] 4]) news-caadr (macro . #[(x) "À‰Á\nDDD‡" [car cdr x] 4]) news-cdadr (macro . #[(x) "ÀÁÀ\nDDD‡" [cdr car x] 4]) news-wins (macro . #[(pfx index) "ÀÁ\nÃÄ DFD‡" [file-exists-p concat pfx "/" int-to-string index] 6])] 3) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias news-find-first-and-last #[(prefix base) "À Âà !Q!…Å Æ#Å Ç#B‡" [file-exists-p prefix "/" int-to-string base news-find-first-or-last -1 1] 5] news-/ (macro . #[(a1 a2) "ÀÁ¥ÂUƒ à E‡ÆÇ ÂEÈÃÈ D EDà EF‡" [-1 2 0 / a1 a2 if < -] 6]) 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]] 3) (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 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias news-group-certification #[(group) "À \n\"£‡" [assoc group news-current-certifications] 3] news-set-current-certifiable #[nil "ÁÂà #PÆÇÈ !† !8‰ )‡" [news-path string-subst-char 47 46 news-current-news-group file 5 file-attributes file-symlink-p news-current-certifiable] 5] news-get-certifications #[nil "ŠÀ‹)‡" [((byte-code "ÀÁ¢‰‡" [var (byte-code "À !Ã\n!Å\n!…Æ Ç\"ˆÈŽÉÊ !)*‡" [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] news-write-certifications #[nil "ŠÀ‹)‡" [((byte-code "ÀÁ\n!‘ˆÃÀ!Å !ˆÆÇ!!ˆÉ !)‡" ["*CeRtIfIcAtIoNs*" print news-current-certifications get-buffer buf switch-to-buffer write-file substitute-in-file-name news-certification-file kill-buffer] 3))] 1] news-set-current-group-certification #[nil "À \n\"‰ƒ ¡‚ B\nB‰)‡" [assoc news-current-news-group news-current-certifications cgc news-current-certifiable] 4]] 3) (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 "\ Creates a minor mode list that has group name, total articles, and attribute for current article."]) (defalias 'news-set-message-counters #[nil "?…Á‰‡" [news-list-of-files 0 news-current-message-number] 2 "\ Scan through current news-groups filelist to figure out how many messages are there. Set counters for use with minor mode display."]) (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) (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 boundp minor-mode-alist ("NEWS" news-minor-modes) mode-name "NEWS" 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 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias string-subst-char #[(new old string) "ÀÂà !! ÆÀOÇ \"‰ƒ Iˆ‚ ) ‡" [nil index regexp-quote char-to-string old string 0 string-match new] 3] news-update-message-read (macro . #[(ngroup nno) "ÀÁ ÄED E‡" [setcar news-cdadr assoc ngroup news-group-article-assoc nno] 5])] 3) (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 "\ Parse string representing range of numbers of he form - to a list (a . b)"]) (defalias 'news-get-new-news #[nil "ƒÁ ˆÂÂÄÅ\"ˆÇ! ŠÊ !‰‰‰   ‰qˆÐbˆÑÒÂÓ#ƒˆ` Ðyˆ`ˆ`  ÔZ{ Õ  {!× \"ƒ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 "\ Get new USENET news, if there is any for the current user." nil]) (defalias 'news-list-news-groups #[nil "ÀŠ qˆÂcˆÃcˆ Å…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 "\ Display all the news groups to which you belong." nil]) (defalias 'news-set-mode-line #[nil "À ¨ƒ  !‚ ÃÄ ¨ƒ !‚ RÇÉʉËGZ]OQ ÍÎ!ˆÏÊ!‡" [" " 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 "\ Set mode line string to something useful."]) (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 "\ Takes a string and goes to that news group." (list (completing-read "NewsGroup: " news-group-article-assoc))]) (defalias (quote 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]) (defalias 'news-goto-message #[(arg) "„ ÁÂÃ\"Å !‡" [current-prefix-arg read-no-blanks-input "Go to article: " "" arg news-select-message] 3 "\ Goes to the article ARG in current newsgroup." "p"]) (defalias (quote news-select-message) #[(arg) ";ƒ Á!\nÃÄÅ#ÇRÉ!ƒEÊ  @A >A@†-ÎUƒ7 @¡ˆÐ!ˆÑ )‚IÒÓ\")‡" [arg string-to-int news-path string-subst-char 47 46 news-current-news-group "/" file file-exists-p nil buffer-read-only news-point-pdl news-list-of-files 0 news-current-message-number news-read-in-file news-set-mode-line error "Article %d nonexistent"] 5]) (defalias 'news-force-update #[nil "@ ¡ˆÂà \"‡" [news-point-pdl news-current-message-number message "Updated to %d"] 3 "\ updates the position of last article read in the current news group" nil]) (defalias 'news-next-message #[(arg) " \\‰ W„\n Vƒ/Å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 "\ 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." "p"]) (defalias 'news-previous-message #[(arg) "À [!‡" [news-next-message arg] 2 "\ 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." "p"]) (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 "\ Given arg move forward or backward to a new newsgroup."]) (defalias 'news-next-group #[nil "ÀÁ!ˆ\n?…ÀÁ!ˆ‚‡" [news-move-to-group 0 news-list-of-files] 2 "\ Moves to the next user group." nil]) (defalias 'news-previous-group #[nil "ÀÁ!ˆ\n?…ÀÁ!ˆ‚‡" [news-move-to-group -1 news-list-of-files] 2 "\ Moves to the previous user group." nil]) (defalias 'news-get-motion-lists #[(arg listy) "ÁÄÅ*‡" [listy nil result temp out (byte-code "…%@ šƒÂÃA CB\"ˆ‚@C ¤A‰„Ň" [temp arg throw out result nil] 5)] 2 "\ Given a msgnumber/group this will return a list of two lists; one for moving forward and one for moving backward."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] news-convert-format #[nil "ŠŒ`ÁÂÃÁÁ …> }ˆ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]] 3) (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 "\ Redisplay current news item with all original headers" nil]) (defalias (quote news-delete-headers) #[(pos) "bˆ ;…! ÃÄ#…!Åyˆ`ÂÆ!ˆÇuˆ`|ˆ‚‡" [pos news-ignored-headers re-search-forward nil t 0 "\n[^ ]" -1] 4]) (defalias 'news-exit #[nil "ÀÁ!ƒ.Âà \"ˆÅ ˆÆ ˆÂÇ \"ˆÂÈ!ˆÉÊ!ƒ$Êp!ˆË !ˆÍ‰‡ÂÏ!‡" [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 "\ Quit news reading session and update the .newsrc file." nil]) (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 "\ Updates the .newsrc file in the users home dir."]) (defalias 'news-unsubscribe-group #[(group) "À !‡" [news-unsubscribe-internal group] 2 "\ Removes you from newgroup GROUP." (list (completing-read "Unsubscribe from group: " news-group-article-assoc))]) (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 "\ Removes you from the newsgroup you are now reading." nil]) (defalias (quote news-unsubscribe-internal) #[(group) "À \n\"‰ƒ) BÀ \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]) (defalias 'news-save-item-in-file #[(file) "Àed #‡" [append-to-file file] 4 "\ Save the current article that is being read by appending to a file." "FSave item in file: "]) (defalias 'news-get-pruned-list-of-files #[(gp-list end-file-no) "…Á  !š…ÄƉ?…ÐÉÊË #P Ä …:Î ÏÐ!Q!…:Ñ Ò#ÆăfÆVƒb BS‰‚O ‚ÏÕ !?†sÖ !??…Ï×ØÙ‰‰ ƒ²ÚÛ @\"ƒ¢Õ Ï @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 "\ 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 (quote 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]) (defalias 'news-add-news-group #[(gp) "ÁÂà #PŠÆ \"„®ÈÉ\n!! Ì !ƒ¦Í !ˆÎbˆÏ ÐPÑÒ#ƒDÓÔ \"ˆÕÖ!ˆ×Ø!ˆÙcˆ‚QÓÚ \"ˆÛ ˆ ܱˆÝ ÑÒ#ˆÑ‰‰‰ !ÏâÑÒ#ˆ` Îyˆ`!ш`! ÖZ{ã {!$$@$A$AEDB-å ˆæp!‚ªÓç \")‚²Óè \"*‡" [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 "\ Resubscribe to or add a USENET news group named GROUP (a string)." "sAdd news group: "]) (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 "\ 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." "P\nFName to link to message: "]) (defalias 'caesar-region #[(&optional n) "§„\nÁ‚¦ÃU?…ÒÄÅ!ƒ% ÆHÆ\\U„ŠÃÇÈ \n ÌÍ!ˆÎÏÃ\" ÏWƒM  ‰Iˆ T‰ ‚9\n‰P‰\n– à ÃÂWƒ…  Æ\\\n \\HIˆ  Ð\\  \\HIˆ T‰ ‚[ÌÑ!ˆ+Ò Ó Ãȉ ‰{‰G WƒÃ  HHIˆ T‰ ‚§bˆØ\"ˆc-‡" [n 13 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 "\ Caesar rotation of region by N, default 13, for decrypting netnews." (byte-code "ƒ Á!C‡ÂC‡" [current-prefix-arg prefix-numeric-value nil] 2)]) (defalias 'news-caesar-buffer-body #[(&optional rotnum) "ŠÂÃebˆÄÅÇšƒÈ‚ ÅQÂÊ#ƒ$`‚%e!ˆdbˆË !ˆ ‰*‡" [buffer-read-only buffer-status nil set-mark search-forward "\n" major-mode news-mode "" mail-header-separator t caesar-region rotnum] 5 "\ 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." (byte-code "ƒ Á!C‡ÂC‡" [current-prefix-arg prefix-numeric-value nil] 2)]) (provide (quote rnews)) emacs-19.22/lisp/rnewspost.elc100666 13437 1 20677 5416173614 15006 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:54:51 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/rnewspost.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require sendmail rnews] 2) (defvar news-reply-mode-map nil "\ Mode map used by news-reply.") (byte-code "„UÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÂÛÚ#ˆÁ‡" [news-reply-mode-map make-keymap define-key "?" describe-mode "" news-reply-distribution " " news-reply-keywords "" news-reply-newsgroups "" news-reply-followup-to "" mail-subject "" news-reply-summary "" news-caesar-buffer-body "" news-reply-signature "" news-reply-yank-original "" mail-fill-yanked-message "" news-inews ""] 4) (defalias 'news-reply-mode #[nil "ÀÁ!„\nÂÃ!ˆÄ ˆÅÆ!ˆÇÈ !ˆÊ !ˆ  ÎÐÅÒ!ˆÅÓ!ˆÔÖ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" mode-name paragraph-separate paragraph-start "^" mail-header-separator "$\\|" run-hooks text-mode-hook news-reply-mode-hook] 4 "\ 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)." nil]) (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." "\ ") (defalias 'news-reply-yank-original #[(arg) "À !ˆÂ ˆÃÄ!‡" [mail-yank-original arg exchange-point-and-mark run-hooks news-reply-header-hook] 2 "\ Insert the message being replied to, if any (in rmail). 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." "P"]) (defvar news-reply-header-hook (quote (lambda nil (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.") (defalias 'news-reply-newsgroups #[nil "À ˆebˆÁÂ!‡" [expand-abbrev mail-position-on-field "Newsgroups"] 2 "\ Move point to end of Newsgroups: field. RFC 850 constrains the Newsgroups: field to be a comma separated list of valid newsgroups names at your site: Newsgroups: news.misc,comp.misc,rec.misc" nil]) (defalias 'news-reply-followup-to #[nil "À ˆÁÂÃ\"†ÁÄ!ˆÅc‡" [expand-abbrev mail-position-on-field "Followup-To" t "newsgroups" "\nFollowup-To: "] 3 "\ 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, that are also in the Newsgroups: field: Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc Followup-To: news.misc,comp.misc,rec.misc" nil]) (defalias 'news-reply-distribution #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Distribution"] 2 "\ 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." nil]) (defalias 'news-reply-keywords #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Keywords"] 2 "\ 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." nil]) (defalias 'news-reply-summary #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Summary"] 2 "\ 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." nil]) (defalias 'news-reply-signature #[nil "ÀÁ!‡" [message "~/.signature will be appended automatically."] 2 "\ The inews program appends ~/.signature automatically." nil]) (defalias 'news-setup #[(to subject in-reply-to newsgroups replybuffer) " „*‰Ç  ÂÂ&ˆÊyˆ`Ëyˆ`|ˆdbˆ*‚6Ç  ÂÂ&ˆdbˆÌ ÎÏeÌ#)ƒbÊyˆÐ†OÒÓ±ˆ„_ÔË!ˆ‚bdbˆÕÖ!)‡" [replybuffer mail-reply-buffer nil 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 "\ Setup the news reply or posting buffer with the proper headers and in news-reply-mode."]) (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 "\ Send a news message using inews." nil]) (defalias 'news-mail-reply #[nil "À‰‰‰‰‰pŒeÈe!ˆÉÊ!ˆ`ËZ}ˆÌÍ!ÌÎ!ÌÏ!ÌÐ!ÑÒ!ˆÓÀ\nƒA\n‚B ÔÕ\"‰ƒW×O‚YØ Q)À &.‡" [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 "\ 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." nil]) (defalias 'news-reply #[nil "ÀÁ!ƒ‰‰‰‰‰‰‰‰‰‰p \n   ŒÏÐ U„FÒšƒFÓ ˆeebˆÔÕ!ˆ`ÖZ}ˆ×Ø!‰×Ú! ×Û! ×Ü!‰ †d×Ý!×Þ!×ß!×à!‰!âã!ˆä ˆå …†Àæ!??…ç ˆ ƒ²èé \"ƒ¬èé \"ƒ¬ êÂO ‚šë P ƒÔèì\"‰-ƒËÏ-O‚Íî Q)ï  %ˆ ƒëð ˆ cˆ ƒöñò!ˆ cˆñó!ˆƒcˆƒ ƒôcˆ ƒ cˆ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 "\ 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." nil]) (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 "\ Begin editing a new USENET news article to be posted. Type \\[describe-mode] once editing the article to get a list of commands." nil]) (defalias 'news-mail-other-window #[nil "ÀÁ‰‰‰‰p&‡" [mail-other-window nil] 7 "\ Send mail in another window. While composing the message, use \\[news-reply-yank-original] to yank the original message into it." nil]) emacs-19.22/lisp/rot13.elc100666 13437 1 1520 5416173616 13656 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:54:53 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/rot13.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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) "\ Char table for rot 13 display.") (defalias 'rot13-other-window #[nil "ÀpÁ\"Ã\n \")‡" [display-buffer t w set-window-display-table rot13-display-table] 3 "\ Display current buffer in rot 13 in another window." nil]) (provide (quote rot13)) emacs-19.22/lisp/saveplace.elc100666 12120 1 6573 5433347725 14535 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Aug 15 01:55:32 1993 ;;; from file /home/fsf/rms/e19/lisp/saveplace.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (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 (quote save-place)) (defvar save-place-file "~/.emacs-places" "\ *Name of the file that records `save-place-alist' value.") (defvar save-place-loaded nil "\ Non-nil means that the `save-place-file' has been loaded.") (defalias 'toggle-save-place #[(&optional parg) "„ ÁÂÃÄ \"!‡ ƒ$ƒÇ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 "\ 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)" "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊË\"ˆÉÌÍ\"ˆÉÎÁ\"ˆÏÐ!‡" [defalias save-place-to-alist #[nil "„Á ˆ\n…&Ã\n \"‰ƒÆ \")…&\n`B B‰‡" [save-place-loaded load-save-place-alist-from-file buffer-file-name assoc save-place-alist cell delq save-place] 4] save-place-alist-to-file #[nil "À !ŠÃÄÅ\n\"!ˆÆÇ!qˆed|ˆÈ\n!ƒÉ\n!ˆed|ˆebˆÊ p\"ˆÌ\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 write-file kill-buffer "Saving places to %s... done."] 4] load-save-place-alist-from-file #[nil "?…?Á !Å !ƒ=ŠÆÇÈ \"!ˆÉÊ!qˆed|ˆË !ˆebˆÌed{!@ Îp!ˆÆÇÏ \"!ˆ))Ї" [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] save-places-to-alist #[nil "À  …Š @qˆ\nƒà ˆ A)‚)‡" [buffer-list buf-list buffer-file-name save-place-to-alist] 1] add-hook find-file-hooks #[nil "„Á ˆÂ \"‰… AbˆÆ‰)‡" [save-place-loaded load-save-place-alist-from-file assoc buffer-file-name save-place-alist cell t save-place] 4] kill-emacs-hook #[nil "À ˆÁ ‡" [save-places-to-alist save-place-alist-to-file] 1] kill-buffer-hook provide saveplace] 3) emacs-19.22/lisp/scheme.elc100666 13437 1 17600 5416174017 14174 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:57:03 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/scheme.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar scheme-mode-syntax-table nil "\ ") (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) (defvar scheme-mode-abbrev-table nil "\ ") (byte-code "ÀÁÂ\"ˆÃÄÅ\"ˆÆÇ!„ÈÃÉÊ\"ˆÆË!„!  „/Ì  É !ˆÂ‡" [define-abbrev-table 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 comment-start ";" comment-start-skip ";+[ ]*" comment-column 40 comment-indent-function scheme-comment-indent ("" scheme-mode-line-process) mode-line-process] 2] boundp scheme-mode-line-process "" scheme-mode-commands #[(map) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#‡" [define-key map " " scheme-indent-line "" backward-delete-char-untabify "" scheme-indent-sexp] 4] scheme-mode-map make-sparse-keymap] 3) (defalias 'scheme-mode #[nil "À ˆÁ ˆÂ ˆÃÄ!‡" [kill-all-local-variables scheme-mode-initialize scheme-mode-variables run-hooks scheme-mode-hook] 2 "\ 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." nil]) (defalias (quote scheme-mode-initialize) #[nil "À !ˆÂĉ‡" [use-local-map scheme-mode-map scheme-mode major-mode "Scheme" mode-name] 2]) (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.") (defalias (quote scheme-comment-indent) #[(&optional pos) "ŠƒbˆÁÂ!ƒi‚;ÁÃ!ƒ*Ä ‰<ƒ% @‚& )‚;ÆÇxˆnƒ6È‚8iT ])‡" [pos looking-at ";;;" ";;" calculate-scheme-indent tem " " nil 0 comment-column] 3]) (defvar scheme-indent-offset nil "\ ") (defvar scheme-indent-function (quote scheme-indent-function) "\ ") (defalias 'scheme-indent-line #[(&optional whole-exp) "À Á‰‰d`ZÇyˆ`ÈÁwˆÉÊ!?…s<ƒ)@iZ‰ÇU„< `|ˆjˆd\nZ`VƒId\nZbˆ …s ÇU?…sŠ bˆÌÍ!ˆ` bˆÍyˆ` V)…sÎ #-‡" [calculate-scheme-indent nil pos end beg shift-amt indent 0 " " looking-at "[ ]*;;;" whole-exp forward-sexp 1 indent-code-rigidly] 7 "\ Indent current line as Scheme code. With argument, indent any additional lines of the same expression rigidly along with this one." "P"]) (defalias 'calculate-scheme-indent #[(&optional parse-start) "ŠÀyˆ`Á‰‰ÂÁ‰‰ \n ƒ% bˆ‚(Ì ˆ`\nWƒ:Í`\nÀ# ‚(ƒÚ @‰ƒÚÀVƒÚÁÎ 8 A@‰Tbˆ ƒ€ `Vƒ€Í \nÀ#‰A@‰ƒ )„: Tbˆ „“i‚:Í` ÀÂ$ˆÐÑ!ŠÒyˆ`) VƒÇÍ` ÀÂ$ˆ` U„ÁÓÒ!ˆÍ` ÀÂ$ˆÔ ˆ‚: bˆÀyˆÍ` ÀÂ$ˆÔ ˆ‚: ƒáiÕ ›@ƒ÷\nbˆÖÁwˆi‚2¨ƒ  ƒ  bˆ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 "\ 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 (quote 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]) (defvar scheme-body-indent 2 "\ ") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆËÌÍÎ#ˆËÏÍÐ#ˆËÑÍÎ#ˆËÒÍÓ#ˆËÔÍÐ#ˆËÕÍÉ#ˆËÖÍÐ#ˆË×ÍÐ#ˆËØÍÎ#ˆËÙÍÐ#ˆËÚÍÐ#ˆËÛÍÐ#ˆËÜÍÐ#ˆËÝÍÐ#ˆËÞÍÐ#ˆƒXËàÍÐ#ˆËáÍÐ#ˆËâÍÐ#ˆËãÍÐ#ˆËäÍÐ#ˆËåÍÎ#ˆËæÍÐ#ˆËçÍÐ#ˆËèÍÐ#ˆËéÍÎ#ˆËêÍÐ#ˆËëÍÓ#ˆËìÍÐ#ˆËíÍÐ#ˆËîÍÐ#ˆËïÍÐ#ˆËðÍÐ#ˆËñÍÐ#ˆËòÍÐ#ˆËóÍÐ#ˆËôÍÐ#ˆËõÍÐ#ˆËöÍÐ#ˆË÷ÍÐ#ˆËøÍÐ#ˆËùÍÐ#ˆËúÍÐ#ˆËûÍÐ#ˆËüÍÐ#ˆËýÍÐ#ˆËþÍÐ#ˆËÿÍÐ#ˆË@ÍÐ#ˆËAÍÐ#ˆËBÍÐ#ˆËCÍÐ#ˆÀ‡" [defalias scheme-indent-specform #[(count state indent-point) "A@ ‰‰bˆi \\ÈuˆÉÈ!ˆÊ` ÈÌ$ˆ` Wƒ2ÂÍ΄$ ÏVƒD ‰\\\\D‚] ÏUƒ[ ÏU„W Xƒ[ ‚],‡" [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ÁÂ!ˆÃ` ÂÅ$‡" [count forward-sexp 1 parse-partial-sexp indent-point t] 5) ((error)) 0 normal-indent] 6] scheme-indent-defform #[(state indent-point) "A@bˆÁyˆ`AA@V…A@bˆ\ni\\‡" [state 1 scheme-body-indent] 2] would-be-symbol #[(string) "ÁÂOØ?‡" [string 0 1 "("] 3] next-sexp-as-string #[nil "ÀÁ!ˆ`ÃÁ!ˆ`\n{)‡" [forward-sexp 1 the-end backward-sexp] 2] scheme-let-indent #[(state indent-point) "ÀÁwˆÂÃ!ƒÄÅ#‡ÄÈ#‡" [" " nil looking-at "[a-zA-Z0-9+-*/?!@$%^&_:~]" scheme-indent-specform 2 state indent-point 1] 4] put begin scheme-indent-function 0 case 1 delay do 2 lambda let 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) (defalias 'scheme-indent-sexp #[nil "ÀCÁÀ‰‰‰‰ŠÉÊ!ˆ)ŠÀ ?…\n À  „nm‰„nÍ`Àˆ`À‰ %‰@Î ›@ƒTÏ ˆÀˆÎ ›À ˆÐ ›@ƒgÊyˆÑ ›À ˆ‚'Ò‰ ƒ,ÁX‰„ VƒA S‰ ‚y Wƒ¤ÀB T‰ ‚Êyˆ`ÓÀwˆm„ÔÕ!„@ƒÍ@ÁYƒÍ@‚ùÖ@…Ø@[!‰¨ƒë‰ ˆ‚ø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 "\ Indent each line of the list starting just after point." nil]) (provide (quote scheme)) emacs-19.22/lisp/scribe.elc100666 13437 1 15343 5416174043 14200 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:57:23 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/scribe.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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'.") (byte-code "„DÁ ÃŽÄ !Æ!ˆÇÈÉ\"ˆÇÊÉ\"ˆÇËÌ\"ˆÇÍÎ\"ˆÇÏÐ\"ˆÇÑÒ\"ˆÇÓÔ\"ˆÇÕÖ\"ˆÇ×Ø\"ˆÇÙÌ\"ˆ*ÚÛ!„MÜ„êÝ Þßà#ˆÞáâ#ˆÞãä#ˆÞåæ#ˆÞçè#ˆÞéê#ˆÞëì#ˆÞíì#ˆÞîì#ˆÞïì#ˆÞðñ#ˆÞòó#ˆÞôõ#ˆÞö÷#ˆÞøù#ˆÞúû#ˆÞüý#ˆÞþÿ#ˆÞ@A#ˆÞBC#ˆÜ‡" [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 make-sparse-keymap define-key " " scribe-tab " " tab-to-tab-stop "s" center-line "}" up-list "S" center-paragraph "\"" scribe-insert-quote "(" scribe-parenthesis "[" "{" "<" "c" scribe-chapter "S" scribe-section "s" scribe-subsection "e" scribe-insert-environment "" scribe-bracket-region-be "[" scribe-begin "]" scribe-end "i" scribe-italicize-word "b" scribe-bold-word "u" scribe-underline-word] 4) (defalias 'scribe-mode #[nil "À ˆÁ\n!ˆÃÅÇÈÉ\"ˆ\nËÌ!ˆÍ ËÎ!ˆÍÐ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 ]\\)\\|\\(^@\\w+[" "].*[" scribe-close-parentheses "]$\\)" paragraph-separate scribe-fancy-paragraphs "^$" compile-command "scribe " buffer-file-name set-syntax-table scribe-mode-syntax-table run-hooks text-mode-hook scribe-mode-hook] 5 "\ 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." nil]) (defalias (quote scribe-tab) #[nil "Àc‡" ["@\\"] 1 nil nil]) (defalias 'scribe #[nil "ÀÁ!‡" [call-interactively compile] 2 "\ Run Scribe on the current buffer." nil]) (defalias 'scribe-envelop-word #[(string count) "``ÀÁÀU„BhzÇUƒÈÉ^!ˆ`ÊË ÍQ!ƒ/Îuˆ‚9 bˆÏÁxˆÉuˆÈÐ]!ˆ` bˆ  GWƒpŠÑÒ H! Ó#†eÑÒ H! Ó#)ƒp T‰„E  GYƒŽ bˆÕ×±ˆ bˆØ×±‚® bˆ Hcˆ bˆÙ H±ˆ bˆÚ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 "\ Surround current word with Scribe construct @STRING[...]. COUNT specifies how many words to surround. A negative count means to skip backward."]) (defalias 'scribe-underline-word #[(count) "ÀÁ\n\"‡" [scribe-envelop-word "u" count] 3 "\ Underline COUNT words around point by means of Scribe constructs." "p"]) (defalias 'scribe-bold-word #[(count) "ÀÁ\n\"‡" [scribe-envelop-word "b" count] 3 "\ Boldface COUNT words around point by means of Scribe constructs." "p"]) (defalias 'scribe-italicize-word #[(count) "ÀÁ\n\"‡" [scribe-envelop-word "i" count] 3 "\ Italicize COUNT words around point by means of Scribe constructs." "p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias scribe-begin #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "Begin" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil] scribe-end #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "End" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil] scribe-chapter #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "Chapter" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil] scribe-section #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "Section" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil] scribe-subsection #[nil "ÀcˆÁuˆÂÃÄ\"ˆÅÆÈQ!‡" ["\n" -1 scribe-envelop-word "SubSection" 0 re-search-forward "[" scribe-open-parentheses "]"] 4 nil nil] scribe-bracket-region-be #[(env min max) "ŠbˆÁ\nñˆ bˆÅ\nñ)‡" [max "@end(" env ")\n" min "@begin("] 3 nil "sEnvironment: \nr"] scribe-insert-environment #[(env) "À ``#ˆÂyˆÃcˆÄu‡" [scribe-bracket-region-be env 1 10 -1] 4 nil "sEnvironment: "]] 3) (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 "\ 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 \"." "P"]) (defalias 'scribe-parenthesis #[(count) "ÀÁ\n!!ˆÃ‰‰\n†??…MŠÈuˆ`É\nPÃxˆgËš…0` SU?)…MÌÍÎh!!\n\"‰…MŠ Hc)+‡" [self-insert-command prefix-numeric-value count nil point-save paren-char at-command scribe-electric-parenthesis -1 "^ \n " scribe-open-parentheses 64 string-match regexp-quote char-to-string scribe-close-parentheses] 4 "\ 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." "P"]) emacs-19.22/lisp/scroll-bar.elc100666 13437 1 7141 5430543070 14742 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Aug 6 16:59:35 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/scroll-bar.el ;;; emacs version 19.17.7. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote mouse)) (defalias 'scroll-bar-scale #[(num-denom whole) "ÀÁ\n@! _\nA¥!‡" [truncate float num-denom whole] 3 "\ 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-mode #[(flag) "ƒÁ! ž‰ƒ A‚Å)„#?‚,§?†,ÇYÈÉÊ\"ˆË ‰ …TÍ @ÂBÎBD\"ˆ A‰ „;Ï*‡" [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 "\ 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." "P"]) (defalias 'scroll-bar-set-window-start #[(event) "Á8:ƒ Á‚Â8)‰@Á 8ŠÆ !qˆŠeÇ deZ\"\\bˆÈyˆÉ `\"-‡" [event 2 1 end-position window portion-whole window-buffer scroll-bar-scale 0 set-window-start] 6 "\ Set the window start according to where the scroll bar is dragged. EVENT should be a scroll bar click or drag event." "e"]) (defalias (quote scroll-bar-drag-1) #[(event) "‰A@)‰@à 8ŠÅ\n!qˆeÆ deZ\"\\bˆÇyˆÈ\n`\",‡" [event start-position window 2 portion-whole window-buffer scroll-bar-scale 0 set-window-start] 6]) (defalias 'scroll-bar-drag #[(event) "À !ˆÄ )‡" [nil done 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)))] 2 "\ Scroll the window by dragging the scroll bar slider. If you click outside the slider, the window scrolls to bring the slider there." "e"]) (defalias 'scroll-bar-scroll-down #[(event) "À ÂŽ Ä 8:ƒÄ‚Å 8)‰@Ä8É!ˆÊËÌ S\"!-‡" [selected-window old-selected-window ((select-window old-selected-window)) event 2 1 end-position window portion-whole select-window scroll-down scroll-bar-scale window-height] 5 "\ Scroll the window's top line down to the location of the scroll bar click. EVENT should be a scroll bar click." "e"]) (defalias 'scroll-bar-scroll-up #[(event) "À ÂŽ Ä 8:ƒÄ‚Å 8)‰@Ä8É!ˆÊËÌ S\"!-‡" [selected-window old-selected-window ((select-window old-selected-window)) event 2 1 end-position window portion-whole select-window scroll-up scroll-bar-scale window-height] 5 "\ Scroll the line next to the scroll bar click to the top of the window. EVENT should be a scroll bar click." "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.22/lisp/select.elc100666 12120 1 14001 5416174103 14037 0ustar rmsdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:57:55 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/select.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias (quote x-selection) (quote x-get-selection)) (defalias 'x-get-selection #[(&optional type data-type) "À † † Ä\"‡" [x-get-selection-internal type PRIMARY data-type STRING] 3 "\ 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-clipboard #[nil "ÀÁÂ\"‡" [x-get-selection-internal CLIPBOARD STRING] 3 "\ Return text pasted to the clipboard."]) (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 "\ 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), 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." (byte-code "„ ÁÂ!C‡ÃÄ !ÃÅ !BC‡" [current-prefix-arg read-string "Store text for pasting: " copy-marker point-marker mark-marker] 3)]) (defalias (quote x-valid-simple-selection-p) #[(data) ";†i9†i¨†i:ƒ-@¨ƒ-A¨†iA:ƒ-A@¨†i:…iÁ@!…iÁA!…iÂ@!…iÂA!…iÂ@!ÂA!=…iÃÂ@!!…iÃÂA!!‡" [data markerp marker-buffer buffer-name] 3]) (defalias 'x-get-cut-buffer #[(&optional which-one) "À ƒ  H‚ Ã!‡" [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 "\ 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-set-cut-buffer #[(string &optional push) "ƒÁÂ!ˆÃÄ \"‡" [push x-rotate-cut-buffers-internal 1 x-store-cut-buffer-internal CUT_BUFFER0 string] 3 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"‡" [defalias xselect-convert-to-string #[(selection type value) ";ƒ‡:ƒDÁ@!ƒDÁA!ƒDÂ@!ÂA!=„0ÃÄÅ@AE\"ˆŠÂ@!†;ÄÆ!qˆ@A{)‡Ç‡" [value markerp marker-buffer signal error "markers must be in the same buffer" "selection is in a killed buffer" nil] 5] xselect-convert-to-length #[(selection type value) ";ƒ\nG‚I:…IÁ@!…IÁA!…IÂ@!ÂA!=„3ÃÄÅ@AE\"ˆ@AZ‰ÇYƒE‚H[)‰…WÈÉ\"ÊË\"B)‡" [value markerp marker-buffer signal error "markers must be in the same buffer" n 0 ash -16 logand 65535] 6] xselect-convert-to-targets #[(selection type value) "ÀÁ \"B‰ ƒ9 @ A>ƒ! Æ @ A\"¡ˆ‚ A@Ç=ƒ2 ‰AA¡ˆ‚ A‰„ ÈÉ \"*‡" [TIMESTAMP mapcar car selection-converter-alist all rest delq _EMACS_INTERNAL apply vector] 5] xselect-convert-to-delete #[(selection type value) "À !ˆÂ‡" [x-disown-selection-internal selection NULL] 2] xselect-convert-to-filename #[(selection type value) ":ƒ Á@!ƒ ÁA!ƒ ÂÃ@!†ÄÅ!!‡Æ‡" [value markerp buffer-file-name marker-buffer error "selection is in a killed buffer" nil] 3] xselect-convert-to-charpos #[(selection type value) "À‰‰ :…KÅ @!…KÅ A!…K @ A‰…K S\nS‰ Wƒ5 \n ÆÇÈ É\"Ê Ë\"BÈ\nÉ\"Ê\nË\"B\"B+‡" [nil tmp b a value markerp SPAN vector ash -16 logand 65535] 8] xselect-convert-to-lineno #[(selection type value) "À‰‰‰ :…_Æ @!…_Æ A!…_Ç @!Ç A!È @!‰…_Š\nqˆÉÊ \"ÉÊ \") WƒI   ËÌÍ Î\"Ï Ð\"BÍ Î\"Ï Ð\"B\"B,‡" [nil tmp buf b a value markerp marker-position marker-buffer count-lines 1 SPAN vector ash -16 logand 65535] 7] xselect-convert-to-colno #[(selection type value) "À‰‰‰ :…ZÆ @!…ZÆ A!…Z @ AÇ !‰…ZŠ\nqˆ bˆi bˆi) WƒD   ÈÉÊ Ë\"Ì Í\"BÊ Ë\"Ì Í\"B\"B,‡" [nil tmp buf b a value markerp marker-buffer SPAN vector ash -16 logand 65535] 7] xselect-convert-to-os #[(selection type size) "À !‡" [symbol-name system-type] 2] xselect-convert-to-host #[(selection type size) "À ‡" [system-name] 1] xselect-convert-to-user #[(selection type size) "À ‡" [user-full-name] 1]] 3) (defun xselect-convert-to-class (selection type size) "\ Emacs") (defun xselect-convert-to-name (selection type size) "\ emacs") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÉÊ!‡" [defalias xselect-convert-to-integer #[(selection type value) "¨…ÁÂ\"ÃÄ\"B‡" [value ash -16 logand 65535] 4] xselect-convert-to-atom #[(selection type value) "9…‡" [value] 1] xselect-convert-to-identity #[(selection type value) "À !‡" [vector value] 2] ((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] 3) emacs-19.22/lisp/sendmail.elc100666 12062 1 42662 5474032614 14344 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 21 22:44:12 1993 ;;; from file /home/fsf/rms/e19/lisp/sendmail.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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 are be delimited by a line which is `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. Do not use an rmail file here! Instead, use its inbox file.") (defvar mail-default-reply-to nil "\ *Address to insert as default Reply-to field of outgoing messages.") (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-aliases t "\ Alist of mail address aliases, or t meaning should be initialized from `~/.mailrc'. The alias definitions in `~/.mailrc' have this form: alias ALIAS MEANING") (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.") (byte-code "ÀÁ!„ÂÀÃ!„‡" [boundp mail-abbrevs-loaded nil mail-mode-map] 2) (autoload (quote build-mail-aliases) "mailalias" "\ Read mail aliases from `~/.mailrc' and set `mail-aliases'." nil) (autoload (quote 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) (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 `~/.signature'.") (byte-code "ÀÁ!„‡" [boundp mail-reply-buffer nil] 2) (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-mode-syntax-table nil "\ Syntax table used while in mail mode.") (byte-code "„Á\n!ÃÄÅ#ˆÆÇÈ\"‡" [mail-mode-syntax-table copy-syntax-table text-mode-syntax-table modify-syntax-entry 37 ". " defalias mail-setup #[(to subject in-reply-to cc replybuffer actions) "Á=ƒÂÃÄ!ƒÅ ˆ ebˆÊcˆŠ ƒ;Ì`  ϱˆÐ d\"ˆ*‚>Ñ ˆƒYÌÓcˆ` ϱˆÐ d\"ˆ*ƒeÕϱˆÖ†lØϱˆƒycˆƒ…Ûϱˆƒ‘ÝÞ Ï±ˆƒàϱˆ!ϱˆ ƒ«` \"Á=ƒ¿Ãã!ƒÈäã!ˆ‚È\"ƒÈ\"cˆdbˆn„ÒÑ ˆ) ƒÜ bˆ „ï„ï„ïåÂ!ˆæç!‡" [mail-aliases t nil file-exists-p "~/.mailrc" 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 "In-reply-to: " "Subject: " subject "" mail-default-headers mail-default-reply-to "Reply-to: " mail-self-blind "BCC: " user-login-name mail-archive-file-name "FCC: " mail-header-separator mail-signature "~/.signature" insert-file-contents set-buffer-modified-p run-hooks mail-setup-hook] 3]] 4) (defalias 'mail-mode #[nil "À ˆÁÂ!ˆÃÁÄ!ˆÅ!ˆÇ!ˆ \nË ÍÏÁÑ!ˆÁÒ!ˆÓÕRÓÕRÖ×Ø\"‡" [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 paragraph-separate paragraph-start "^" mail-header-separator "$\\|^[ ]*[-_][-_][-_]+$\\|" run-hooks text-mode-hook mail-mode-hook] 4 "\ 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 Subj: C-c C-f C-b move to BCC: C-c C-f C-c move to CC: C-c C-t move to message text. 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)." nil]) (byte-code "„WÁ \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-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" [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) (defalias 'mail-send-and-exit #[(arg) "À ˆÁ\n!‡" [mail-send mail-bury arg] 2 "\ Send message like `mail-send', then, if no errors, exit from mail buffer. Prefix arg means don't delete this window." "P"]) (defalias 'mail-dont-send #[(arg) "À !‡" [mail-bury arg] 2 "\ Don't send the message you have been editing. Prefix arg means don't delete this window." "P"]) (defalias 'mail-bury #[(arg) "Àp!Âp!ˆÃÄ!ƒ&ÅÄ žAƒ&ÆÇ È \"ƒ&ÉÇ !‚J\n„GË „GŠÌÍÎ Ï\"!qˆ)Ñ=ƒGÒ ‚JÓ !)‡" [other-buffer newbuf bury-buffer fboundp frame-parameters dedicated delq selected-frame visible-frame-list delete-frame arg one-window-p window-buffer next-window selected-window not major-mode rmail-mode delete-window switch-to-buffer] 4 "\ Bury this mail buffer."]) (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? " message "Sending..." run-hooks mail-send-hook 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 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias sendmail-send-it #[nil "ƒ\nÁÂ!‚ ÃÁÄ!ʼnp \nËŽŠ qˆÌ ˆÍ!ˆdbˆhÎU„6ÎcˆebˆÏÐÑ!ÓQ!ˆÔÓ!ˆÕÖ!ˆ× ƒZÙe\"ˆebˆÏÚÛ#ƒt`WƒtÔÓ!ˆ‚]ÛebˆÏÜÛ#ƒ‡ÝÞ!ˆebˆÏßÛ#ƒ˜à!ˆebˆÏáÛ#ƒ¨Ôâ!ˆebˆÏãÛ#ƒ¸Ôä!ˆƒÅŠ\nqˆÌ ˆ))åæçedèé!ƒÖ)‚×êÅ\nÅëì¯íî D/…íð/PC?…óñ$\"ˆ… Š\nqˆebˆÏòÅÛ#ƒÔó!ˆ‚ô ÃU?…Ýõed{\").‡" [mail-interactive generate-new-buffer " sendmail errors" 0 " sendmail temp" nil mailbuf delimline 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 mail-aliases expand-mail-aliases "\n\n\n*" t "^Sender:" error "Sender may not be specified." "^FCC:" mail-do-fcc "^S:" "Subject:" "^Subject:[ ]*\n" "" apply call-process-region append boundp sendmail-program "/usr/lib/sendmail" "-oi" "-t" "-f" user-login-name mail-alias-file "-oA" ("-oem" "-odb") "\n\n* *" "; " buffer-size "Sending...failed to %s"] 11] mail-do-fcc #[(header-end) "ÀpÁ ÂÃ!Ä ŠebˆÊË Ä#ƒ8`ÀˆÍÀxˆ`{ B ΔÏyˆ`|ˆ‚qˆÐ ˆÑÒ ÓÔ!Õ±ˆÖuˆÖvˆ×Ø!ˆÙ!Ó±ˆdbˆÚ!ˆdbˆÛcˆÜbˆÀÝÑÀÄ#ƒÞuˆßcˆ‚p) ƒ?à @!‰!ƒpedŠebˆÜyˆ`)\"#$%Š!qˆæ TdU?…µd'èŽÀéê!…Â*+,+ƒí ˆ~ˆdd}ˆîïÒ Õðñ Õ±ˆÚ%\"##ˆòcˆebˆ~ˆóò!ˆ`d}ˆôÄ!ˆõ+!ˆÀ'‚eæ T}ˆdbˆÚ%$##ˆ. ‚5ö÷ @!ƒ,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 get-file-buffer buffer beg2 end beg curbuf buffer-size max ((byte-code "ƒe}ˆÁ‡" [max nil] 2)) boundp rmail-current-message msg buffer-read-only rmail-maybe-set-message-counters " \n0, unseen,,\n*** EOOH ***\n" "From: " "Date: " mail-rfc822-date "\n" search-backward rmail-count-new-messages rmail-show-message write-region file-exists-p kill-buffer] 8]] 3) (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 "\ Make a Sent-via header line from each To or CC header line." nil]) (defalias 'mail-to #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "To"] 2 "\ Move point to end of To-field." nil]) (defalias 'mail-subject #[nil "À ˆÁÂ!‡" [expand-abbrev mail-position-on-field "Subject"] 2 "\ Move point to end of Subject-field." nil]) (defalias 'mail-cc #[nil "À ˆÁÂÃ\"†ÁÄ!ˆÅc‡" [expand-abbrev mail-position-on-field "cc" t "to" "\nCC: "] 3 "\ Move point to end of CC-field. Create a CC field if none." nil]) (defalias 'mail-bcc #[nil "À ˆÁÂÃ\"†ÁÄ!ˆÅc‡" [expand-abbrev mail-position-on-field "bcc" t "to" "\nBCC: "] 3 "\ Move point to end of BCC-field. Create a BCC field if none." nil]) (defalias 'mail-fcc #[nil "À ˆÁÂÃ\"„ÁÄ!ˆÅÆÇ!±‡" [expand-abbrev mail-position-on-field "fcc" t "to" "\nFCC: " read-file-name "Folder carbon copy: "] 3 "\ Add a new FCC field, with file name completion." nil]) (defalias (quote 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 "\n" 0 field ":" "^[^ ]" move soft ": \n"] 4]) (defalias 'mail-text #[nil "ebˆÀÁ\nÁQ!‡" [search-forward "\n" mail-header-separator] 4 "\ Move point to beginning of text field." nil]) (defalias 'mail-signature #[(atpoint) "Š„dbˆÁÂxˆÂˆ„`d|ˆÃcˆÄÅÆ!!)‡" [atpoint " \n" nil "\n\n" insert-file-contents expand-file-name "~/.signature"] 3 "\ Sign letter with contents of `mail-signature-file'." "P"]) (defalias 'mail-fill-yanked-message #[(&optional justifyp) "ŠebˆÀÁ\nÁQÃÄ#ˆÅ`dÄ$)‡" [search-forward "\n" mail-header-separator nil t fill-individual-paragraphs justifyp] 5 "\ Fill the paragraphs of a message yanked into this one. Numeric argument means justify as well." "P"]) (defalias 'mail-indent-citation #[nil "`ÁÂÃ!\"ˆ „ÅÂÃ!#‚.Šbˆ`ÂÃ!W…- cˆÇyˆ‚))‡" [start mail-yank-clear-headers mark t mail-yank-prefix indent-rigidly mail-indentation-spaces 1] 4 "\ 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-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 "\ 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." "P"]) (defalias (quote mail-yank-clear-headers) #[(start end) "ŠbˆÁ Ä#…2Œ`}ˆbˆÄÆÈÄ#)…1Éyˆ`ÆÊ!ˆËuˆ`|ˆ‚))‡" [start search-forward "\n\n" end t case-fold-search re-search-forward mail-yank-ignored-headers nil 0 "\n[^ ]" -1] 4]) (defalias 'mail #[(&optional noerase to subject in-reply-to cc replybuffer actions) "ÀÁ!ˆÂÃ!Å!ˆÇ ˆÈ \n„9Ë ƒ#ÌÍ!ƒ9Î ˆÏ&ˆÖ ƒIØ!ƒIÙÚ!ˆ )‡" [switch-to-buffer "*mail*" expand-file-name "~/" default-directory 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 "\ 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. By default, the signature file `~/.signature' is 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. If `mail-setup-hook' is bound, its value is called with no arguments after the message is initialized. It can add more default fields. When calling from a program, 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'." "P"]) (defalias 'mail-recover #[nil "À ‹ƒÃÅ ˆÆ Ã\")‚ÇÈ!)‡" [make-auto-save-file-name file-name ((byte-code "Á=„Âà !ˆÅÆÇ ÇÈ &‘ˆÊËÌ \"!‡" [system-type vax-vms "*Directory*" buffer-disable-undo standard-output 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 "\ Reread contents of current buffer from its last auto-save file." nil]) (defalias 'mail-other-window #[(&optional noerase to subject in-reply-to cc replybuffer sendactions) "ÀÂÃ!ˆ)Ä  \n &‡" [t pop-up-windows pop-to-buffer "*mail*" mail noerase to subject in-reply-to cc replybuffer sendactions] 8 "\ Like `mail' command, but display mail buffer in another window." "P"]) (defalias 'mail-other-frame #[(&optional noerase to subject in-reply-to cc replybuffer sendactions) "ÀÂÃ!ˆ)Ä  \n &‡" [t pop-up-frames pop-to-buffer "*mail*" mail noerase to subject in-reply-to cc replybuffer sendactions] 8 "\ Like `mail' command, but display mail buffer in another frame." "P"]) (provide (quote sendmail)) emacs-19.22/lisp/server.elc100666 13437 1 15236 5431363252 14237 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Aug 9 01:54:50 1993 ;;; from file /home/fsf/rms/e19/lisp/server.el ;;; emacs version 19.17.7. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar server-program "emacsserver" "\ *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-process nil "\ the current server process") (byte-code "ÀÁ!„ÂÀ‡" [boundp server-previous-string ""] 2) (defvar server-clients nil "\ List of current server clients. Each element is (CLIENTID FILES...) 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.") (put (quote server-buffer-clients) (quote 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.") (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅÁÆ\"ˆÁž„ÈBÉÊË\"ˆÉÌÍ\"‡" [make-variable-buffer-local server-buffer-clients put permanent-local t set-default nil minor-mode-alist (server-buffer-clients " Server") defalias server-log #[(string) "ÀÁ!…ŠÁqˆdbˆ\ncˆo†à )‡" [get-buffer "*server*" string newline] 2] server-sentinel #[(proc msg) "À !Â=ƒÃÄÅ!!‡À !Æ=…ÃÄÇ!!‡" [process-status proc exit server-log message "Server subprocess exited" signal "Server subprocess killed"] 3]] 4) (defalias 'server-start #[(&optional leave-dead) "ƒÁÂ\"ˆÂÃĈÂÅƈƒ(@A@É!ˆ)‚\n?…Lƒ8ËÌÍ!!ˆÎÏÂ#ÁÑ\"ˆÒÓ\"ˆÔ!‡" [server-process set-process-sentinel nil (delete-process server-process) ((error)) (delete-file "~/.emacs_server") ((error)) server-clients buffer server-buffer-done leave-dead server-log message "Restarting server" start-process "server" server-program server-sentinel set-process-filter server-process-filter process-kill-without-query] 4 "\ 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 `etc/emacsclient' in the Emacs distribution as your standard \"editor\". Prefix arg means just kill any existing server communications subprocess." "P"]) (defalias (quote server-process-filter) #[(proc string) "À !ˆ\n P‰‰GSHÃ=ƒÄÅ \"Æ=„ ‰‡ Æ•ÇOÈ ÆÄÉ \"OCÇÊ   Æ•ÇOÄÎ \"ƒx ƔƕSO Æ•ÇOÄÐ\"ƒgÑÊÇO! ‚t D B Ê )‚=Ò  \"ˆ BÔ A@!ˆÕÖ!ˆ×ØÙ!!+‡" [server-log string server-previous-string 10 string-match "Client: " 0 nil "" " " 1 lineno files client "[^ ]+ " arg "\\`\\+[0-9]+\\'" read server-visit-files server-clients server-switch-buffer run-hooks server-switch-hook message substitute-command-keys "When done with a buffer, type \\[server-edit]."] 6]) (defalias 'server-visit-files #[(files client) "ÀpÃŽ ƒi @@Æ !‰ƒE qƒEÇ !ƒ5È !ƒ-É !ƒNÊËÀ\"ˆ‚NÌÍ ÎQ!ƒNÏ !ˆ‚NÐ !qˆÑÒ!ˆ*Ó @A@!ˆ@Bp\nB A‰„\n)\n¤*‡" [nil obuf client-record ((set-buffer obuf)) files filen get-file-buffer file-exists-p verify-visited-file-modtime buffer-modified-p revert-buffer t 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 "\ Finds FILES and returns the list CLIENT with the buffers nconc'd. FILES is an alist whose elements are (FILENAME LINENUMBER)."]) (defalias 'server-buffer-done #[(buffer) "À !Â=à  ƒU @„\" >A@Ê \"ˆA„MƒGË ÌÍ@\"\"ˆÎÌÍ@\"!ˆÊ \") A‰„Ï !ƒeŠ qˆÃ)Ñ !ˆ+‡" [process-status server-process run nil server-clients old-clients next-buffer running client buffer delq send-string format "Close: %s Done\n" server-log buffer-name server-buffer-clients bury-buffer] 6 "\ Mark BUFFER as \"done\" for its client(s). Buries the buffer, and returns another server buffer as a suggestion for what to select next."]) (defalias 'server-temp-file-p #[(buffer) "À !…  À !\"‡" [buffer-file-name buffer string-match server-temp-file-regexp] 4 "\ 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-done #[nil "p …1Â!ƒÉÆ ˆÇ!ˆ*‚.È ƒ.ÉÊ ÌQ!ƒ.Æ!ˆÍ!)‡" [buffer server-buffer-clients server-temp-file-p nil buffer-backed-up version-control save-buffer kill-buffer buffer-modified-p y-or-n-p "Save file " buffer-file-name "? " server-buffer-done] 4 "\ Offer to save current buffer, mark it as \"done\" for clients. Then bury it, and return a suggested buffer to select next."]) (defalias 'server-edit #[(&optional arg) "„ ƒ !Ã>ƒÄÅ!‡ÆÇ !‡" [arg server-process process-status (signal exit) server-start nil server-switch-buffer server-done] 2 "\ 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]." "P"]) (defalias 'server-switch-buffer #[(next-buffer) "À !ƒ  !ˆ‚à !ƒÂÄ !!ˆ ƒ3Æ !ƒ-Ç !ƒ-È !‡ÉÊ !!‡ ƒ@É @A@!‡ÈÌ !‡" [windowp server-window select-window framep frame-selected-window next-buffer bufferp buffer-name switch-to-buffer server-switch-buffer server-buffer-done server-clients other-buffer] 3 "\ Switch to another buffer, preferably one that has a client. Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [global-set-key "#" server-edit provide server] 3) emacs-19.22/lisp/sgml-mode.elc100666 13437 1 11105 5416174215 14606 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Mon Jul 5 23:59:09 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/sgml-mode.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!‡" [provide sgml-mode require compile] 2) (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") (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÁ‡" [sgml-mode-map make-sparse-keymap define-key ">" sgml-close-angle "/" sgml-slash "" sgml-validate] 4) (defalias 'sgml-mode #[nil "À ˆ à !ˆÅÇÉÊ!ˆË\nÉÌ!ˆÍ ÉÎ!ˆÏ!ˆÉÑ!ˆÒÉÓ!ˆÔÉÕ!ˆÖÉ×!ˆØÙÚÛ\"‡" [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 "\ Major mode for editing SGML. Makes > display the matching <. Makes / display matching /. Use \\[sgml-validate] to validate your document with an SGML parser." nil]) (defalias (quote sgml-comment-indent) #[nil "ÀÁ!ƒ!`SfÂ=ƒ`ÃZfÄ=„!ÅÆxˆiT]‡È‡" [looking-at "--" 33 2 60 " " nil comment-column 0] 2]) (defconst sgml-start-tag-regex "<[A-Za-z]\\([-.A-Za-z0-9= \n ]\\|\"[^\"]*\"\\|'[^']*'\\)*" "\ 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.") (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÁ‡" [sgml-mode-markup-syntax-table make-syntax-table modify-syntax-entry 60 "(>" 62 ")<" 45 "_ 1234" 39 "\""] 4) (defconst sgml-angle-distance 4000 "\ *If non-nil, is the maximum distance to search for 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 "\ Insert > and display matching <." "p"]) (defconst sgml-slash-distance 1000 "\ *If non-nil, is the maximum distance to search for matching /.") (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 "\ 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." "p"]) (defalias 'sgml-validate #[(command) "ÂÃ\"‡" [command sgml-saved-validate-command compile-internal "No more errors"] 3 "\ 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." (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.22/lisp/shell.elc100666 74777 1 35302 5475265210 14056 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:31:35 1993 ;;; from file /home/fsf/rms/e19/lisp/shell.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote comint)) (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-delimiter-argument-list (quote ("|" "&" "<" ">" "(" ")" ";")) "\ List of characters to recognise as separate arguments. Defaults to (\"|\" \"&\" \"(\" \")\" \";\"), which works pretty well. This variable is used to initialise `comint-delimiter-argument-list' in the shell buffer. This is a fine thing to set in your `.emacs' file.") (defvar shell-command-regexp "\\((.*)\\|[^;&|]\\)+" "\ *Regexp to match shell commands. Elements of pipes are considered as separate commands, forks and redirections as part of one command.") (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 (byte-code "Á=ƒ‡Ç" [system-type hpux ("-i" "-T") ("-i")] 2) "\ *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-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-last-dir nil "\ Keep track of last directory for ksh `cd -' command.") (defvar shell-dirstack-query "dirs" "\ Command used by `shell-resync-dir' to query the shell.") (byte-code "ÀÁ!„ „(à !Å ÆÇ#ˆÅ ÈÉ#ˆÅ ÊË#ˆÅ ÌÍ#ˆÂ‡" [boundp shell-mode-map nil full-copy-sparse-keymap comint-mode-map define-key "" shell-forward-command "" shell-backward-command " " comint-dynamic-complete "¿" comint-dynamic-list-filename-completions] 4) (defvar shell-mode-hook nil "\ *Hook for customising Shell mode.") (defalias 'shell-mode #[nil "À ˆÁÃÅ!ˆ \nË ÍÏÑÒ!ˆÑÓ!ˆÔÔÑÖ!ˆ×ØÚÛp!!@ÝÞ!†lßà\"ƒSá‚lßâ\"ƒ_ã‚lßä\"ƒkå‚lá&)çè!ˆé ˆê ‡" [comint-mode shell-mode major-mode "Shell" mode-name use-local-map shell-mode-map shell-prompt-pattern comint-prompt-regexp shell-delimiter-argument-list comint-delimiter-argument-list shell-after-partial-filename comint-after-partial-filename-command shell-get-current-command comint-get-current-command shell-dynamic-complete-command comint-dynamic-complete-command-command make-local-variable paragraph-start shell-dirstack nil shell-last-dir shell-dirtrackp t shell-directory-tracker comint-input-sentinel process-command get-buffer-process shell getenv "HISTFILE" string-match "csh$" "~/.history" "bash$" "~/.bash_history" "ksh$" "~/.sh_history" comint-input-ring-file-name run-hooks shell-mode-hook comint-read-input-ring shell-dirstack-message] 3 "\ Major mode for interacting with an inferior shell. Return after the end of the process' output sends the text from the end of process to the end of the current line. Return before end of process output copies the current line (except for the prompt) to the end of the buffer and sends it. M-x send-invisible reads a line of text without echoing it, and sends it to the shell. This is useful for entering passwords. 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. M-x dirs queries the shell and resyncs Emacs' idea of what the current directory stack is. M-x 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). 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' and `comint-completion-recexact' control the behavior of file name, command name and variable name completion. Variable `shell-completion-execonly' controls the behavior of command name completion. 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', `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." nil]) (defalias 'shell #[nil "ÀÁ!„V\n†ÃÄ!†ÃÅ!†ÆÈ! Ê P ÌÍ ÎQ!ÐÑÒÓ !…< ƒNÔ!ƒNJ‚OÕ%qˆÖ ˆ,×Á!‡" [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 apply make-comint "shell" file-exists-p boundp ("-i") shell-mode switch-to-buffer] 7 "\ 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.)" nil]) (defalias 'shell-directory-tracker #[(str) "…ÁÂÇ" [shell-dirtrackp chdir-failure (byte-code "ÀÁ\n\"ˆÃ•Ä‰‰À \n#…}ÕÊ\nOÉ#Ê\nOˉ#À \"Ã=ƒJÍÎ !!ˆ‚oÀ\"Ã=ƒ^ÐÎ !!ˆ‚oÀ\"Ã=ƒoÒÎ !!ˆÀÓ\n#ˆÃ•‚,‡" [string-match "^[;\\s ]*" 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 "[;\\s ]*"] 4) ((error (message "Couldn't cd")))] 3 "\ 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'."]) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#ˆÀÆÇ\"ˆÀÈÉ\"ˆÀÊË\"ˆÀÌÍ\"‡" [defalias shell-cd #[(directory) "À !ƒ  P!‡Ä !‡" [file-name-absolute-p directory cd-absolute comint-file-name-prefix cd] 3] put byte-optimizer byte-compile-inline-expand shell-process-popd #[(arg) "À !†‰ƒ5 ÂUƒ5 ƒ5 @Æ !ƒ(Ç P!‚+É !ˆ) AÊ ‚g ƒb ÂVƒb GXƒbË B S ›‰ ‰AA¡ˆ AÊ *‚gÎÏÐ!!)‡" [shell-extract-num arg 0 num shell-dirstack directory file-name-absolute-p cd-absolute comint-file-name-prefix cd shell-dirstack-message nil ds cell error message "Couldn't popd."] 4] shell-process-cd #[(arg) "GÁUƒ ÂÃ!‚Ęƒ ‚É!ƒ2Ê P!‚6Ì!ˆ)Í )‡" [arg 0 getenv "HOME" "-" shell-last-dir new-dir default-directory directory file-name-absolute-p cd-absolute comint-file-name-prefix cd shell-dirstack-message] 3] shell-process-pushd #[(arg) "À ! GÃUƒN ƒÅÆ!‚&ƒH @\nË\n!ƒ4Ì \nP!‚8Î\n!ˆ) ABÏ )‚&ÐÑ!‚&\n§ƒñ\nGVƒaÐÒ!‚&\nÃUƒoÓÐÔ!!‚&ƒ¥\nS8× !ˆÅ!ˆ\nË\n!ƒ™Ì \nP!‚Î\n!ˆ)Ï )‚&B‰G\n›Û\nZÛ!›!Ý\"‰@\nË\n!ƒàÌ \nP!‚äÎ\n!ˆ)AÏ -‚& \nË\n!ƒ Ì \nP!‚ Î\n!ˆ) ƒ„#BÏ ))‡" [shell-extract-num arg num 0 shell-pushd-tohome shell-process-pushd "~" shell-dirstack default-directory old directory file-name-absolute-p cd-absolute comint-file-name-prefix 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-pushd-dunique] 5] shell-extract-num #[(str) "ÀÁ\n\"…\nÃ\n!‡" [string-match "^\\+[1-9][0-9]*$" str string-to-int] 3]] 4) (defalias 'shell-dirtrack-toggle #[nil "?Áƒ ÂÄ\"‡" [shell-dirtrackp message "Directory tracking %s" "ON" "OFF"] 3 "\ Turn directory tracking on and off in a shell buffer." nil]) (defalias (quote dirtrack-toggle) (quote shell-dirtrack-toggle)) (defalias 'shell-resync-dirs #[nil "Àp! !‰bˆ cˆÅcˆÆÇ!ˆÈ \"ˆÈ Å\"ˆ `É“ˆ`\nÅcˆËÌ!ˆÍÎ!„?Ï !ˆ\nbˆ‚.) bˆÐÌ!ˆÇ”Ç•S{‰GÉÇÇWƒ|ÕÖ#ˆ̔̕OBÇ•‰‚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 *" reverse (byte-code "À @!ˆ Aà ‡" [cd ds shell-dirstack shell-dirstack-message] 2) ((error (message "Couldn't cd.")))] 5 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias dirs shell-resync-dirs shell-dirstack-message #[nil "À\n BÅÇP!‰G ƒu @‰\nG Yƒ8\nË O˜ƒ8Ç\n ÌOP\nƒf\nGGYƒf\nËGO˜ƒf\nGÌO‰\nƒf \n ˆ Í\n!ÎQ A)‚Ï !,‡" ["" msg default-directory shell-dirstack ds expand-file-name comint-file-name-prefix "~/" home homelen dir 0 nil directory-file-name " " message] 5]] 3) (defalias 'shell-forward-command #[(&optional arg) "ŠÀˆ`) ÄP Å$…ÇÈ!)‡" [nil limit re-search-forward shell-command-regexp "\\([;&|][\\s ]*\\)+" move arg skip-syntax-backward "^\\s "] 5 "\ Move forward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." "p"]) (defalias 'shell-backward-command #[(&optional arg) "ŠÀÁ!ˆ`)ÃÄ\n\"ˆÅÆÇ\"\nÉ\n$…\"Ë”bˆÃÌ!)‡" [comint-bol nil limit skip-syntax-backward "\\s " re-search-backward format "[;&|]+[\\s ]*\\(%s\\)" shell-command-regexp move arg 1 "^\\s "] 5 "\ Move backward across ARG shell command(s). Does not cross lines. See `shell-command-regexp'." "p"]) (defalias 'shell-get-current-command #[nil "ŠÀÁ!ƒ •bˆÃÄ!ˆ`ÅÄ!ˆlƒ`‚Ä•{)‡" [looking-at "\\s *[^;&|]" 0 shell-backward-command 1 shell-forward-command] 3 "\ Function that returns the current command including arguments."]) (defalias 'shell-after-partial-filename #[nil "À  ÄŽÅÆ \"*†Ç”ŠÈÉ!ˆ`)=?)‡" [comint-match-partial-filename filename match-data match-data ((store-match-data match-data)) string-match "/" 0 shell-backward-command 1] 3 "\ Returns t if point is after a file name. File names are assumed to contain `/'s or not be the first item in the command. See also `shell-backward-command'."]) (defalias 'shell-dynamic-complete-command #[nil "À Ä !Æ!AÉÊ !! ÍÎÐ#ÒÀÒÒÀƒ¤ÉØ@†=Ù!!Ú!…MÛ \"‰ƒ›@P„’Ü\"„’ ˜„Ý!„’ƒ‹ß!ƒ’BA‰„SA‰„4„³àá \"ˆâ ‚IGãUƒñ@‰$ ˜ƒÍàå!ˆ‚Ûæ$! GÀOcˆàç!ˆ(…íÝ$!ƒëé‚ìêc)‚Ië ìí\"\"$æ$! GÀOcˆ.ƒ2(ƒ2 $˜ƒ2$ƒ2Ý$!ƒ)é‚*êcˆàï!‚H0„> $˜ƒEñ!‚Hàò!). ‡" [nil completion-ignore-case comint-match-partial-filename filename file-name-nondirectory pathnondir reverse exec-path paths file-name-as-directory expand-file-name default-directory cwd mapconcat #[(x) "À !ÂP‡" [regexp-quote x "$"] 2] completion-ignored-extensions "\\|" ignored-extensions "" path 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 message "No completions of %s" ding 1 completion "Sole completion" directory-file-name "Completed" comint-completion-addsuffix "/" " " try-completion mapcar #[(x) "C‡" [x] 1] comint-completion-recexact "Completed shortest" comint-completion-autolist comint-dynamic-list-completions "Partially completed"] 6 "\ 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 `comint-dynamic-complete-filename'." nil]) (provide (quote shell)) emacs-19.22/lisp/simple.elc100666 12062 1 151163 5475265467 14075 0ustar bobdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:34:30 1993 ;;; from file /home/fsf/rms/e19/lisp/simple.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'open-line #[(arg) "…n‰?…n…o?‰ƒ' ƒ$ Ä=„$` BÅuˆÇVƒCŠÈcˆ) ƒ:cˆS‰‚)\n…IÉu*‡" [fill-prefix do-fill-prefix flag buffer-undo-list t -1 arg 0 10 1] 3 "\ Insert a newline and leave point before it. If there is a fill prefix, insert the fill prefix on the new line if the line would have been empty. With arg N, insert N newlines." "*p"]) (defalias 'split-line #[nil "ÀÁwˆi`ÄcˆÅ Æ\"ˆ\nb*‡" [" " nil pos col 10 indent-to 0] 3 "\ Split current line, moving portion beyond point vertically down." "*"]) (defalias 'quoted-insert #[(arg) "ƒ\nÁ=ƒ ‚à Á=ƒÅ!ˆÇ \")‡" [overwrite-mode overwrite-mode-binary read-quoted-char read-char char delete-char arg insert-char] 3 "\ 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." "*p"]) (defalias 'delete-indentation #[(&optional arg) "Àyˆ ƒ\nÂyˆhÃ=…6``S|ˆ ƒ4` G\\dXƒ4 `` G\\{˜ƒ4`` G\\|ˆÅ ‡" [0 arg 1 10 fill-prefix fixup-whitespace] 4 "\ 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." "*P"]) (defalias 'fixup-whitespace #[nil "ŠÀ ˆÁÂ!†ŠÃuˆÁÄ!)?…Åc)‡" [delete-horizontal-space looking-at "^\\|\\s)" -1 "$\\|\\s(\\|\\s'" 32] 2 "\ Fixup white space between objects around point. Leave one space or none, according to the context." "*"]) (defalias 'delete-horizontal-space #[nil "ÀÁxˆ`ÀÁwˆ`|‡" [" " nil] 3 "\ Delete all spaces and tabs around point." "*"]) (defalias 'just-one-space #[nil "ÀÁxˆgÂUƒÃuˆ‚Âcˆ`ÀÁwˆ`|‡" [" " nil 32 1] 3 "\ Delete all spaces and tabs around point, leaving one space." "*"]) (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 "\ On blank line, delete all surrounding blank lines, leaving just one. On isolated blank line, delete that one. On nonblank line, delete all blank lines that follow it." "*"]) (defalias 'back-to-indentation #[nil "ÀyˆÁÂw‡" [0 " " nil] 2 "\ Move point to the first non-whitespace character on this line." nil]) (defalias 'newline-and-indent #[nil "`ÀÁxˆ`|ˆÂ ˆÃ ‡" [" " nil newline indent-according-to-mode] 3 "\ 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 variable `left-margin'." "*"]) (defalias 'reindent-then-newline-and-indent #[nil "Š`ÀÁxˆ`|ˆÂ ˆ)à ˆÂ ‡" [" " nil indent-according-to-mode newline] 3 "\ 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 variable `left-margin'." "*"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias kill-forward-chars #[(arg) "<ƒ@Á=ƒÂÃ``\\\"‡" [arg - -1 kill-region] 4] kill-backward-chars #[(arg) "<ƒ@Á=ƒÂÃ``Z\"‡" [arg - -1 kill-region] 4]] 3) (defalias 'backward-delete-char-untabify #[(arg &optional killp) "Š ÂVƒ0o„0hÃUƒ&iÅuˆ iZÆÇ \"ˆÈÉ!ˆ)Åuˆ S‰‚*Ê \"ˆ …Gl?…GŠÆÇ\")‡" [arg count 0 9 col -1 insert-char 32 delete-char 1 delete-backward-char killp overwrite-mode] 4 "\ 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 prefix arg is was specified." "*p\nP"]) (defalias 'zap-to-char #[(arg char) "À`Á !ĉ $ˆ`\"‡" [kill-region search-forward char-to-string char nil arg] 7 "\ Kill up to and including ARG'th occurrence of CHAR. Goes backward if ARG is negative; error if CHAR not found." "p\ncZap to char: "]) (defalias 'beginning-of-buffer #[(&optional arg) "À ˆ ƒ& ÃVƒÄ ! ť_‚'Â Ä !_Å\\Å¥‚'ebˆ …/Æy‡" [push-mark arg buffer-size 10000 prefix-numeric-value 10 1] 3 "\ 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 true beginning. Don't use this command in Lisp programs! (goto-char (point-min)) is faster and avoids clobbering the mark." "P"]) (defalias 'end-of-buffer #[(&optional arg) "À ˆ ƒ( T ÃVƒÄ ! ť_‚$Â Ä !_Å¥Z‚)dbˆ ƒ2Æy‡`ŠÈ bˆÉÊ !ˆ`W*…JËÌ!‡" [push-mark arg buffer-size 10000 prefix-numeric-value 10 1 old-point window-start vertical-motion window-height recenter -3] 4 "\ 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 true end. Don't use this command in Lisp programs! (goto-char (point-max)) is faster and avoids clobbering the mark." "P"]) (defalias 'mark-whole-buffer #[nil "À`!ˆÀdÁÂ#ˆeb‡" [push-mark nil t] 4 "\ 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." nil]) (defalias 'count-lines-region #[(start end) "ÀÁ \" Z#‡" [message "Region has %d lines, %d characters" count-lines start end] 5 "\ Print number of lines and characters in the region." "r"]) (defalias 'what-line #[nil "Œ~ˆŠÀyˆÁÂÃÄ`\"T\"*‡" [0 message "Line %d" count-lines 1] 5 "\ Print the current line number (in the buffer) of point." nil]) (defalias 'count-lines #[(start end) "À ÂŽŠŒ }ˆebˆ Æ=ƒTÇÉÊËÆÌ$ƒ)Ì\\‚ÉÊËÆÍ$ƒ;Í\\‚)dbˆ U„Nn„NT‚P)‚ZÎ Î yZ,‡" [match-data match-data ((store-match-data match-data)) start end selective-display t 0 done re-search-forward "[\n ]" nil 40 1 buffer-size] 5 "\ 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 'what-cursor-position #[nil "ged`Ä ‰ÆVƒ Ç¥ S\\ È¥É]¥‚, Ê¥ SÈ_\\ É]¥ Ì ÍUƒ9΂>ÏÐÌ \"i \nUƒv ÉUƒV\n TU„gÓÔ  \n&‚¨ÓÕ  &‚¨ ÉUƒƒ\n TU„˜ÓÖ×!  \n&\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) point=%d of %d(%d%%) <%d - %d> column %d %s" single-key-description "Char: %s (0%o) point=%d of %d(%d%%) column %d %s"] 12 "\ Print info on cursor position (on screen and within buffer)." nil]) (defalias 'fundamental-mode #[nil "À ‡" [kill-all-local-variables] 1 "\ Major mode not specialized for anything in particular. Other major modes are defined by comparison with this one." nil]) (defvar read-expression-map (cons (quote keymap) minibuffer-local-map) "\ Minibuffer keymap used for reading Lisp expressions.") (byte-code "À ÂÃ#ˆÄÅÆÇ#ˆÈÉ!„Ê ʇ" [define-key read-expression-map "‰" lisp-complete-symbol put eval-expression disabled t boundp read-expression-history nil] 4) (defalias 'eval-expression #[(expression) "À !\nBÃ\n@Ä\"‡" [eval expression values prin1 t] 3 "\ Evaluate EXPRESSION and print value in minibuffer. Value is also consed on to front of the variable `values'." (list (read-from-minibuffer "Eval: " nil read-expression-map t (quote read-expression-history)))]) (defalias 'edit-and-eval-command #[(prompt command) "À  ! ÅÆ%Ç !)‡" [read-from-minibuffer prompt prin1-to-string command read-expression-map t (command-history . 1) eval] 6 "\ 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 'repeat-complex-command #[(arg) "S 8ÂɃ9ÈÉÊ! ÂÁB% @;ƒ( A @š„3 BÌ !‚;Í ,‡" [arg command-history t nil newcmd minibuffer-history-sexp-flag minibuffer-history-position elt read-from-minibuffer "Redo: " prin1-to-string read-expression-map eval ding] 8 "\ 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." "p"]) (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 "\ Nonzero when doing history operations on `command-history'. More generally, indicates that the history list being acted on contains expressions rather than strings.") (byte-code "ÀÂÄÅ!„ ÂÆÇÈ\"‡" [minibuffer-history minibuffer-history-variable nil minibuffer-history-position boundp minibuffer-history-search-history 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) (defalias 'previous-matching-history-element #[(regexp n) "JÁ\nÇU„e È ÇWƒÉ‚È\\] G^‰ Uƒ8Ê ÈUƒ5Ë‚6Ì!ˆÍƒIÐ S 8!‚M S 8\"ƒ‰ÇWƒ]È‚^É\\‰‚ Ñ ˆ 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 prin1-to-string erase-buffer elt command-history previous-matching-history-element next-matching-history-element] 6 "\ 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." (byte-code "ÀÂÄÅÂÂÇ%‰ɘƒ‰A@ ‚Ê !+D‡" [t enable-recursive-minibuffers nil minibuffer-history-sexp-flag read-from-minibuffer "Previous element matching (regexp): " minibuffer-local-map minibuffer-history-search-history regexp "" prefix-numeric-value current-prefix-arg] 7)]) (defalias 'next-matching-history-element #[(regexp n) "À \n[\"‡" [previous-matching-history-element regexp n] 3 "\ 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." (byte-code "ÀÂÄÅÂÂÇ%‰ɘƒ‰A@ ‚Ê !+D‡" [t enable-recursive-minibuffers nil minibuffer-history-sexp-flag read-from-minibuffer "Next element matching (regexp): " minibuffer-local-map minibuffer-history-search-history regexp "" prefix-numeric-value current-prefix-arg] 7)]) (defalias 'next-history-element #[(n) "À \nZ] JG^ Uƒ Å ÀUƒÆ‚Ç!‚?È ˆ ‰S J8 \nƒ8Ë !‚: cˆ)eb)‡" [1 minibuffer-history-position n minibuffer-history-variable narg error "End of history; no next item" "Beginning of history; no preceding item" erase-buffer elt minibuffer-history-sexp-flag prin1-to-string] 4 "\ Insert the next element of the minibuffer history into the minibuffer." "p"]) (defalias 'previous-history-element #[(n) "À [!‡" [next-history-element n] 2 "\ Inserts the previous element of the minibuffer history into the minibuffer." "p"]) (defalias 'next-complete-history-element #[(n) "`ÁÂÃe`{!P \"ˆb)‡" [point-at-start next-matching-history-element "^" regexp-quote n] 5 "\ Get previous element of history which is a completion of minibuffer contents." "p"]) (defalias 'previous-complete-history-element #[(n) "À [!‡" [next-complete-history-element n] 2 "\ Get next element of history which is a completion of minibuffer contents." "p"]) (defalias 'goto-line #[(arg) "Œ~ˆÀbˆ Â=ƒÃÄÅÆS$‚Sy)‡" [1 selective-display t re-search-forward "[\n ]" nil end arg] 5 "\ Goto line ARG, counting from line 1 at beginning of buffer." "NGoto line: "]) (define-function (quote advertised-undo) (quote undo)) (defalias 'undo #[(&optional arg) "À Á Ä Å =„ÆÇ!ˆÉ=„ Ê ˆËÌ!ˆÉ ˆ*Ì!ˆ …9À ?…9Ï\n!*‡" [buffer-modified-p recent-auto-save-p recent-save modified selected-window minibuffer-window message "Undo!" last-command undo undo-start undo-more 1 this-command arg delete-auto-save-file-if-necessary] 2 "\ Undo some previous changes. Repeat this command to undo more changes. A numeric argument serves as a repeat count." "*p"]) (defvar pending-undo-list nil "\ Within a run of consecutive undo commands, list remaining to be undone.") (defalias 'undo-start #[nil "Á=ƒ\nÂÃ!ˆ‰‡" [buffer-undo-list t error "No undo information in this buffer" pending-undo-list] 2 "\ 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-more #[(count) "„ÁÂ!ˆÃ \"‰‡" [pending-undo-list error "No further undo information" primitive-undo count] 3 "\ 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."]) (defvar shell-command-history nil "\ History list for some commands that read shell commands.") (defalias 'shell-command #[(command &optional flag) "ƒ Á ˆÂ ˆÃ ÅÆÅÇ&ˆÉÆ!Ê `p“ˆb‡Ë  ÍŽÎÏ\"ƒŒÐÑ!ÅÖ‰”O×!‰ƒ^ØÙ!ƒZÚ!ˆ‚^ÛÜ!ˆŠqˆÝ ˆÞ!ˆßà Ç%á\"ãä\"ˆåæ\",‚“ç``Å$*‡" [flag barf-if-buffer-read-only push-mark call-process shell-file-name nil t "-c" command mark mark-marker match-data data ((store-match-data data)) string-match "[ ]*&[ ]*$" get-buffer-create "*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" erase-buffer display-buffer start-process "Shell" (": %s") mode-line-process set-process-sentinel shell-command-sentinel set-process-filter shell-command-filter shell-command-on-region] 8 "\ Execute string COMMAND in inferior shell; display output, if any. If COMMAND ends in ampersand, execute it asynchronously. Optional second arg non-nil (prefix arg, if interactive) means insert output in current buffer after point (leave mark after it). This cannot be done asynchronously." (list (read-from-minibuffer "Shell command: " nil nil nil (quote shell-command-history)) current-prefix-arg)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias shell-command-sentinel #[(process signal) "À !Â>…$ÃÄÅ !AA@ÇÈO#ˆŠÉ !qˆÊ )Ì !‡" [process-status process (exit signal) message "%s: %s." process-command signal 0 -1 process-buffer nil mode-line-process delete-process] 6] shell-command-filter #[(proc string) "pÁ\n!ÄÆ !È! ÊŽ qˆ`dbˆË !.‡" [obuf process-buffer proc buffer nil opoint get-buffer-window window window-start pos ((byte-code "À \n\"ˆ bˆ q‡" [set-window-start window pos opoint obuf] 3)) insert-before-markers string] 2]] 3) (defalias 'shell-command-on-region #[(start end command &optional flag interactive) "ƒ: … ` W ƒÄ ˆÅɉÊË &ˆÍÎ!ƒ.ÏÎ!ˆ …8 …8Ð )‡ÑÎ!‰p=ƒ`d|ˆe|ˆÅedɉÊË &ˆ‚zŠqˆÓ ˆ)ÅÊÊË &ˆŠqˆÔ ÕUƒŠÕ‚ŽÖed\")‰ÕUƒ¡ØÙ!ˆÏÎ!‚ÄÚUƒ½ØÛŠqˆebˆ`ʈ`{)\"‚ÄÜÝ!Ú\"*‡" [flag interactive mark swap push-mark call-process-region start end shell-file-name t nil "-c" command get-buffer "*Shell Command Output*" kill-buffer exchange-point-and-mark get-buffer-create buffer erase-buffer buffer-size 0 count-lines lines message "(Shell command completed with no output)" 1 "%s" set-window-start display-buffer] 10 "\ 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. Noninteractive args are START, END, COMMAND, FLAG. Noninteractively FLAG means insert output in place of text from START to END, and put point at the end, but don't alter the mark. 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 output is inserted in the current buffer then `*Shell Command Output*' is deleted." (list (region-beginning) (region-end) (read-from-minibuffer "Shell command on region: " nil nil nil (quote shell-command-history)) current-prefix-arg (prefix-numeric-value current-prefix-arg))]) (defalias 'universal-argument #[nil "ÀÁÄÁÅ\"Æ\n!Çšƒ À_ÄÁÅ\"‚ È\n Á#*‡" [4 nil key factor read-key-sequence t key-binding universal-argument prefix-arg-internal] 4 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias prefix-arg-internal #[(key factor value) "À\n§ƒ\nÃWƒÄ\n[\nÅ=ƒÄÆÈšƒ3 [Æ ÊÆË\"‰‚;ƒpGÀUƒpÌ™„pÍ™„p\n§ƒX\n‚YÃÎ_ÃHÏZ\\Æ ÊÆË\"‰‚5 ƒ{ C‚\n§ƒ†\n _‚ ÄU…ÅÑ!Ò=ƒ£Ó\n \"ˆÊÆË\"Ô!‰)‡" [1 sign value 0 -1 - nil key "-" factor read-key-sequence t "0" "9" 10 48 prefix-arg key-binding universal-argument describe-arg listify-key-sequence unread-command-events] 4] describe-arg #[(value sign) "§ƒ Á _\"‡:ƒÁÄ@\"‡ ÅW… ÁÆ!‡" [value message "Arg: %d" sign "Arg: [%d]" 0 "Arg: -"] 4]] 3) (defalias 'digit-argument #[(arg) "ÀÁ Ä\"!Å#‡" [prefix-arg-internal char-to-string logand last-command-char 127 nil arg] 5 "\ Part of the numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." "P"]) (defalias 'negative-argument #[(arg) "ÀÁ #‡" [prefix-arg-internal "-" nil arg] 4 "\ Begin a negative numeric argument for the next command. \\[universal-argument] following digits or minus sign ends the argument." "P"]) (defalias 'forward-to-indentation #[(arg) "yˆÁÂw‡" [arg " " nil] 2 "\ Move forward ARG lines and position at first nonblank character." "p"]) (defalias 'backward-to-indentation #[(arg) "[yˆÁÂw‡" [arg " " nil] 2 "\ Move backward ARG lines and position at first nonblank character." "p"]) (defvar kill-whole-line nil "\ *If non-nil, `kill-line' with no arg at beg of line kills the whole line.") (defalias 'kill-line #[(&optional arg) "À`Š ƒ !yˆ‚0mƒÃÄÅ\"ˆÆÇ!„'ƒ-nƒ-Éyˆ‚0ň`)\"‡" [kill-region arg prefix-numeric-value signal end-of-buffer nil looking-at "[ ]*$" kill-whole-line 1] 5 "\ 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." "P"]) (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.") (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.") (defalias 'kill-new #[(string) " B‰G\nVƒ\nS ›Ã¡ˆ  … Æ\"‡" [string kill-ring kill-ring-max nil kill-ring-yank-pointer interprogram-cut-function t] 4 "\ 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."]) (defalias 'kill-append #[(string before-p) " ƒ \n@P‚@\nP ˆ … @!‡" [kill-ring before-p string interprogram-cut-function] 3 "\ 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 'current-kill #[(n &optional do-not-move) "ÁU… \n… \n ‰ƒÄÆ !ˆ) ‚A„%ÈÉ!ˆÊ GZG\"›  „=   @))‡" [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 "\ 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 'kill-region #[(beg end) "ƒ Á\n \"ˆÄ ‡ Æ=„TÈ=„T\n š„T\n ]\n ^ZÉ\\ Ê   \n |ˆ ‰ @@;„G A‰ ‚8Î @@!ˆÈ‰+‡Á\n \"ˆ\n |‡" [buffer-read-only copy-region-as-kill beg end barf-if-buffer-read-only buffer-undo-list t last-command kill-region 100 nil tail old-list undo-strong-limit kill-new this-command] 4 "\ 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." "r"]) (defalias 'copy-region-as-kill #[(beg end) "Á=ƒ { W\"ˆ‚Å {!ˆÁLJ" [last-command kill-region kill-append beg end kill-new this-command nil] 4 "\ 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." "r"]) (defalias 'kill-ring-save #[(beg end) "À \n\"ˆt…w` Uƒ\n‚ `ÃÇÈ \"ƒNÉ `p“ˆbˆÊË!ˆÉ p“ˆ bˆ …v …vÎ ÏÐ!‚vÑÒ!‰GÔ^` UƒlÖ×[ÎO\"‚uÖØÒ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 nil run-hooks deactivate-mark-hook current-kill 0 killed-text 40 message-len message "Saved text until \"%s\"" "Saved text from \"%s\""] 6 "\ 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." "r"]) (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 "\ Cause following command, if it kills, to append to previous kill." nil]) (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 "\ 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." "*p"]) (defalias 'yank #[(&optional arg) "À`!ˆÁ\n<ƒÂ\nÄ=ƒÅ‚\nS!cˆ\n:ƒ-ÆÇ!È `p“ˆbˆÉ‡" [push-mark current-kill arg 0 - -1 mark t mark-marker nil] 4 "\ 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]." "*P"]) (defalias 'rotate-yank-pointer #[(arg) "À !‡" [current-kill arg] 2 "\ Rotate the yanking point in the kill ring. With argument, rotate that many kills forward (or backward, if negative)." "p"]) (defalias 'insert-buffer #[(buffer) "À !„\n !ɉŠŠ qˆed)Ç  #ˆ`)È !ˆ+Ç" [bufferp buffer get-buffer nil newmark end start insert-buffer-substring push-mark] 4 "\ Insert after point the contents of BUFFER. Puts mark after the inserted text. BUFFER may be a buffer or a buffer name." (list (progn (barf-if-buffer-read-only) (read-buffer "Insert buffer: " (other-buffer) t)))]) (defalias 'append-to-buffer #[(buffer start end) "pŠÁ\n!qˆÃ #*‡" [oldbuf get-buffer-create buffer insert-buffer-substring start end] 4 "\ 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." (list (read-buffer "Append to buffer: " (other-buffer nil t)) (region-beginning) (region-end))]) (defalias 'prepend-to-buffer #[(buffer start end) "pŠÁ\n!qˆŠÃ #+‡" [oldbuf get-buffer-create buffer insert-buffer-substring start end] 4 "\ 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." "BPrepend to buffer: \nr"]) (defalias 'copy-to-buffer #[(buffer start end) "pŠÁ\n!qˆÃ ˆŠÄ #+‡" [oldbuf get-buffer-create buffer erase-buffer insert-buffer-substring start end] 4 "\ 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." "BCopy to buffer: \nr"]) (defvar mark-even-if-inactive nil "\ *Non-nil means you can use the mark even when inactive. This option makes a difference in Transient Mark mode. When the option is non-nil, deactivation of the mark turns off region highlighting, but commands that use the mark behave as if the mark were still active.") (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put mark-inactive error-conditions (mark-inactive error) error-message "The mark is not active now"] 4) (defalias 'mark #[(&optional force) "„ „ \nƒÃÄ !‡ÅÆÇ\"‡" [force mark-active mark-even-if-inactive marker-position mark-marker signal mark-inactive nil] 3 "\ 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 'deactivate-mark #[nil "ÀÂÃ!‡" [nil mark-active run-hooks deactivate-mark-hook] 2 "\ 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'."]) (put (quote deactivate-mark) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'set-mark #[(pos) "ƒÁÃÄ!ˆÅ p“‡ÆÃÇ!ˆÅ p“‡" [pos t mark-active run-hooks activate-mark-hook mark-marker nil deactivate-mark-hook] 3 "\ 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)))."]) (defvar mark-ring nil "\ The list of saved former marks of the current buffer, most recent first.") (make-variable-buffer-local (quote mark-ring)) (defconst mark-ring-max 16 "\ *Maximum size of mark ring. Start discarding off end if gets this big.") (defalias 'set-mark-command #[(arg) "„\nÁ‰Ã#‡ÄÃ!„ÅÆ!‡ÄÃ!bˆÇ ‡" [arg push-mark nil t mark error "No mark set in this buffer" pop-mark] 4 "\ Set mark at where point is, or jump to mark. With no prefix argument, set mark, and push old mark position on mark ring. With argument, jump to mark, and pop a new position for mark off the ring. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information." "P"]) (defalias 'push-mark #[(&optional location nomsg activate) "ÀÁ!ƒ#Âà ! B‰G Vƒ# ›@Ɖ“ˆ S ›Æ¡ˆÃ †+`p“ˆ„C „CÊ ËV„CÌÍ!ˆ„M„SÐÀÁ!!ˆÆ‡" [mark t copy-marker mark-marker mark-ring mark-ring-max nil location nomsg executing-macro minibuffer-depth 0 message "Mark set" activate transient-mark-mode set-mark] 4 "\ Set mark at LOCATION (point, by default) and push old mark on 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 'pop-mark #[nil "…,Á !C¤ @p“ˆÃÅÆ!ˆ@É“ˆÇÈ!„(É ˆA‰‡" [mark-ring copy-marker mark-marker nil mark-active run-hooks deactivate-mark-hook mark t ding] 3 "\ Pop off mark ring into the buffer's actual mark. Does not set point. Does nothing if mark ring is empty."]) (define-function (quote exchange-dot-and-mark) (quote exchange-point-and-mark)) (defalias 'exchange-point-and-mark #[nil "ÀÁ!‰„ ÃÄ!ˆÅ`!ˆ\nbˆ)Ƈ" [mark t omark error "No mark set in this buffer" set-mark nil] 3 "\ 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." nil]) (defalias 'transient-mark-mode #[(arg) "„ ?‚Â!ÃV‰‡" [arg transient-mark-mode prefix-numeric-value 0] 2 "\ Toggle Transient Mark mode. With arg, turn Transient Mark mode on if arg is positive, off otherwise. In Transient Mark mode, changing the buffer \"deactivates\" the mark. While the mark is active, the region is highlighted." "P"]) (defvar next-line-add-newlines t "\ *If non-nil, `next-line' inserts newline to avoid `end of buffer' error.") (defalias 'next-line #[(arg) "` ƒ2\nÃU„Ä\n!ˆ‚HÃyˆ`U„\"hÅ=„(Åcˆ‚HbˆÄ\n!ˆ‚Hmƒ;ÆÇÈ\"ˆÄ\n!ˆ`UƒHȈ)ȇ" [opoint next-line-add-newlines arg 1 line-move 10 signal end-of-buffer nil] 3 "\ 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, a newline character is inserted to create a line and the cursor moves to that line, otherwise the cursor is moved to the end of the buffer (if already at the end of the buffer, an error is signaled). 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.)." "p"]) (defalias 'previous-line #[(arg) "À [!ˆÂ‡" [line-move arg nil] 2 "\ 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.)." "p"]) (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 (quote 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.") (byte-code "ÀÁÂ\"ˆÃÄÅÆ#‡" [defalias line-move #[(arg) "Á=„%Â=„% ƒ\"lƒ\"nƒÄ=ƒ\"Å‚#i¨„2yˆ‚cÉVƒLÊË!ˆÌuˆËyˆS‰‚4ÉWƒcÊÌ!ˆÉyˆT‰‚N͆k!ˆÏ‡" [last-command next-line previous-line track-eol end-of-line 9999 temporary-goal-column selective-display arg 0 vertical-motion 1 -1 move-to-column goal-column nil] 3] put set-goal-column disabled t] 4) (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 "\ 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'." "P"]) (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.") (defalias 'hscroll-point-visible #[nil "iÁ ‰à \\ÄZ\nZW„ \\Vƒ9ÇÈ ÉŠÊˆi)à ZËZà ̥Z^]\"‚P VƒFÍ!‚P\nW…PÎ!+‡" [here window-hscroll left window-width 3 right hscroll-step set-window-hscroll selected-window 0 nil -5 2 scroll-left scroll-right] 8 "\ Scrolls the window horizontally to make point visible."]) (defalias 'transpose-chars #[(arg) "„ lƒ ÁuˆÂÃÄ!\"‡" [arg -1 transpose-subr forward-char prefix-numeric-value] 4 "\ 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." "*P"]) (defalias 'transpose-words #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-word arg] 3 "\ 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." "*p"]) (defalias 'transpose-sexps #[(arg) "ÀÁ\n\"‡" [transpose-subr forward-sexp arg] 3 "\ 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." "*p"]) (defalias 'transpose-lines #[(arg) "ÀÁ\n\"‡" [transpose-subr #[(arg) "ÁUƒÂˆmƒà ‡Áu‡y‡" [arg 1 nil newline] 2] arg] 3 "\ 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." "*p"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] 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]] 3) (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 the value for a particular mode using that mode's hook.") (make-variable-buffer-local (quote comment-column)) (defconst comment-start nil "\ *String to insert to start a new comment, or nil if no comment syntax defined.") (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 (quote (lambda nil 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.") (defalias 'indent-for-comment #[nil "Àyˆ „ ÂÃ!‡ŠÄˆ`)ÄÄÄÉ\n Ë#ƒ@Ì Í•ƒ4Í•bˆ‚@ÎÏÀ”\"ˆÎÐÀ”\"ˆ`iƒO ‚R ‰Uƒ`bˆ‚mÓÄxˆ`|ˆjˆƒ~bˆĉ“‚† cˆŠc),‡" [0 comment-start 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 " " comment-end] 4 "\ Indent this line's comment to comment column, or insert an empty comment." "*"]) (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 "\ 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." "P"]) (defalias 'kill-comment #[(arg) "„ÁÂ!ˆÃ !ʼnÈV…fŠÅˆ`ÈyˆÉ\n™ƒ8ËÌ\n!Í#ˆÎÅwˆ`ÈyˆËÏ#ƒUÈ”bˆÎÅxˆÐ`\"ˆÑ ˆ) ƒ]Ò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 "\ Kill the comment on this line, if any. With argument, kill comments on that many lines starting with this one." "P"]) (defalias 'comment-region #[(beg end &optional arg) "„ÁÂ!ˆ VƒÅ  )ŠŒ \n„.Ë\n‚P\nËVƒP\nS‰\nÌVƒP P P‚5 }ˆ bˆm?…á\nÌWƒÀ\n Ë T‰ Vƒ„ÎÏ !!ƒ„Ð G!ˆ‚gј„¹\n Ë T‰ Vƒ¹ÅˆÒÅxˆÓG!ˆÎÏ!!ƒÐG!ˆ‚Ëyˆ)‚WÎÔ!„Ø cˆј„ØňcˆÕÖÅ×#ˆ‚W,‡" [comment-start error "No comment syntax is defined" beg end nil mid comment-end ce cs arg 1 0 count looking-at regexp-quote delete-char "" " " backward-char "[ ]*$" search-forward "\n" move] 4 "\ Comment the region; third arg numeric 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." "r\np"]) (defalias 'backward-word #[(arg) "[v‡" [arg] 1 "\ 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." "p"]) (defalias 'mark-word #[(arg) "ÀŠ vˆ`)ÂÃ#‡" [push-mark arg nil t] 4 "\ Set mark arg words away from point." "p"]) (defalias 'kill-word #[(arg) "À`Š vˆ`)\"‡" [kill-region arg] 3 "\ Kill characters forward until encountering the end of a word. With argument, do this that many times." "p"]) (defalias 'backward-kill-word #[(arg) "À [!‡" [kill-word arg] 2 "\ Kill characters backward until encountering the end of a word. With argument, do this that many times." "p"]) (defalias 'current-word #[nil "Š```ÃÄ!ˆ`\nbˆÅÄ!ˆ` \n=ƒI\n=ƒIÃÆŠÇyˆ`)\"ˆhÈ=ƒAÅÆ!ˆ`ÅÄ!ˆ`‚I`ÃÄ!ˆ` {,‡" [end start oldpoint skip-syntax-backward "w_" skip-syntax-forward "^w_" 0 10] 3 "\ Return the word point is on as a string, if it's between two word-constituent characters. If not, but it immediately follows one, move back first. Otherwise, if point precedes a word constituent, move forward first. Otherwise, move backwards until a word constituent is found and get that word; if you reach a newline first, move forward instead." nil]) (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 (quote fill-prefix)) (defconst auto-fill-inhibit-regexp nil "\ *Regexp to match lines which should not be auto-filled.") (defalias (quote do-auto-fill) #[nil "À\nƒŠÃyˆÄ\n!)†x ?…xi V…x`ŠÇ T!ˆÈÀxˆnƒ4ÉÊË#ˆÌÀxˆ`* Š bˆn)„riŠÌÀxˆ` U)ƒ\\Ï ˆ‚eŠ bˆÏ ˆ)iYƒnË)‚tË)‚)‡" [nil give-up auto-fill-inhibit-regexp 0 looking-at fill-column opoint move-to-column "^ \n" re-search-forward "[ ]" t " " fill-point prev-column indent-new-comment-line] 4]) (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].") (defalias 'indent-new-comment-line #[nil "À‰ÃÀxˆ`ÃÀwˆ`|ˆÄcˆ „eŠƒd`ÈyˆÉÊ#)ƒdË” lƒXo„XÀËyˆ`ÈyˆÉÊ#)ƒXË” ‚2 bˆi`Ë•{))\nƒ¤\n    ƒ‰ К„‰Èuˆ cˆÑuˆl„Ð ÄcˆÈuˆÒ ˆŠÀˆÓÑ!,‚±ƒ¯c‚±Õ *‡" [nil comstart comcol " " 10 comment-multi-line comment-start-skip opoint -1 re-search-forward t 0 win comment-end comment-start comment-column "" 1 indent-for-comment delete-char fill-prefix indent-according-to-mode] 4 "\ Break line at point and indent, continuing comment if presently within one. The body of the continued comment is indented 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]." "*"]) (defalias 'auto-fill-mode #[(&optional arg) "„ ?‚Â!ÃV…ĉÅÆ !ˆ‡" [arg auto-fill-function prefix-numeric-value 0 do-auto-fill set-buffer-modified-p buffer-modified-p] 3 "\ 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 fill-column automatically breaks the line at a previous space." "P"]) (defalias 'turn-on-auto-fill #[nil "ÀÁ!‡" [auto-fill-mode 1] 2 "\ Unconditionally turn on Auto Fill mode."]) (defalias 'set-fill-column #[(arg) "¨ƒ ‚\niÂà \"‡" [arg fill-column message "fill-column set to %d"] 3 "\ Set `fill-column' to current column, or to argument if given. The variable `fill-column' has a separate value for each buffer." "P"]) (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 "\ 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." "P"]) (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.") (defalias 'overwrite-mode #[(arg) "„ ?‚Â!ÃV…ÄÅ ‡" [arg overwrite-mode prefix-numeric-value 0 overwrite-mode-textual force-mode-line-update] 2 "\ 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." "P"]) (defalias 'binary-overwrite-mode #[(arg) "„ Â=?‚Ã!ÄV…ÂÅ ‡" [arg overwrite-mode overwrite-mode-binary prefix-numeric-value 0 force-mode-line-update] 2 "\ 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'." "P"]) (defvar line-number-mode nil "\ *Non-nil means display line number in mode line.") (defalias 'line-number-mode #[(arg) "„ ?‚Â!ÃVÄ ‡" [arg line-number-mode prefix-numeric-value 0 force-mode-line-update] 2 "\ 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." "P"]) (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.") (defalias 'blink-matching-open #[nil "`eTV…©`ÀZfzÁ>?…©\n…©`ÄÄŠŒƒ-e`Z] }ˆÄÈɈ) ƒQ fzÊU„Q SfËÌÍ fHÎ\"Ï\"U?ƒXÄ ƒ” bˆÐ ƒjÑÒ!‚¨ bˆÓÔŠÕÄxˆn)„ƒÖyˆ` T{‚ Òuˆ×ÄwˆÄˆ`{\"‚¨ƒŸÓØ!‚¨?…¨ÓÙ!,‡" [2 (47 92) blink-matching-paren oldpos nil blinkpos mismatch blink-matching-paren-distance (byte-code "À Â\"À‡" [scan-sexps oldpos -1 blinkpos] 3) ((error)) 36 logand lsh syntax-table -8 255 pos-visible-in-window-p sit-for 1 message "Matches %s" " " 0 "\n " "Mismatched parentheses" "Unmatched parenthesis"] 5 "\ Move cursor momentarily to the beginning of the sexp before point." nil]) (byte-code "ÀÀ‡" [blink-matching-open blink-paren-function] 1) (defalias 'keyboard-quit #[nil "ÀÂÃ!ˆÄÅÀ\"‡" [nil mark-active run-hooks deactivate-mark-hook signal quit] 3 "\ 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." nil]) (define-key global-map "" (quote keyboard-quit)) (defalias 'set-variable #[(var val) " L‡" [var val] 2 "\ 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." (byte-code "ÀÁ!ÃÅ\n‰ÇN‰ƒ ÉÊËÌDÍF!‚&ÎÏÐ\n\"!,D‡" [read-variable "Set variable: " var (funcall myhelp) minibuffer-help-form #[nil "ÀÁ\n!ˆÃÄ!ˆÃÅ\nÆ\"ÇÈO!ˆÉ\n!ƒ'Ê ÃÌ!ˆÁ\nJ!ˆ)È‘‡" ["*Help*" prin1 var princ "\nDocumentation:\n" documentation-property variable-documentation 1 nil boundp 20 print-length "\n\nCurrent value: "] 5] myhelp variable-interactive prop call-interactively lambda (arg) interactive arg eval-minibuffer format "Set %s to value: "] 7)]) (byte-code "ÀÁ!„ „à Å ÆÇ#ˆ )ÈÉÊË#‡" [boundp completion-list-mode-map nil make-sparse-keymap map define-key [mouse-2] mouse-choose-completion put completion-list-mode mode-class special] 4) (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 run-hooks completion-list-mode-hook] 2 "\ Major mode for buffers showing lists of possible completions. Type \\\\[mouse-choose-completion] to select a completion with the mouse." nil]) (byte-code "ÀÁÂ\"ˆÃÄÁ\"ˆÅÆÇ\"‡" [defalias completion-setup-function #[nil "ŠÀ ˆebˆ …ÂÃ!c)‡" [completion-list-mode window-system substitute-command-keys "Click \\[mouse-choose-completion] on a completion to select it.\n\n"] 2] add-hook completion-setup-hook mapcar #[(keypad-normal) "@A@à Å\n!Å !#*‡" [keypad-normal normal keypad 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))] 3) emacs-19.22/lisp/simula.elc100666 13437 1 67653 5451136221 14231 0ustar jimbdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:48:00 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/simula.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (provide (quote 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 (quote (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 (quote (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 (quote 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 (quote 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.") (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) (defvar simula-mode-map nil "\ Keymap used in SIMULA mode.") (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) (defvar simula-mode-abbrev-table nil "\ Abbrev table in SIMULA mode buffers") (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 "\ 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." nil]) (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 " " nil looking-at "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>" simula-context post-indent current-indentation delete-horizontal-space] 3 "\ Indent this line as SIMULA code. If `simula-electric-indent' is non-nil, indent previous line if necessary."]) (defalias 'simula-indent-command #[(&optional whole-exp) "À\n„ „ŠÄÅxˆn)ƒ•ŠÆyˆÇ )È d`ZŠÄÅxˆn)ʼn \n   ÏŽ =ƒOŠÄÅxˆn)ƒYÐ ˆ‚YÆyˆÑ ˆjˆ)` \n…ŠÒyˆ`\n bˆÓÒ!ˆ`‰ \nV… =?…Ô\n  ZÕ$).‚—Ö )‡" [t case-fold-search whole-exp simula-tab-always-indent " " 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 "\ 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." "P"]) (defalias 'simula-context #[nil "ŠÀyˆg)Á=ƒ ‡ŠÃ`ÆexˆÃ o„šÀyˆgÁ=„‰`Wƒ„ÉÃwˆÂuˆhÊ=ƒC`‚)hË=ƒbÌÃwˆgÊ=ƒ\\`Í‚)Âuˆ‚)gÎ=ƒkÂuˆÏÃwˆgÊ=ƒ~`Í‚)Âuˆ‚)ƒšÐÂ!ˆÆÃxˆ`Â*` WƒNÑÒ Ó#ƒNhÔ>ƒÚÕhÖ>ƒÏ „ÏÑ× Ó#ƒ±hÁ=ƒ±Âyˆ‚»ØÙ!ƒ›Ã‚›hÚ>ƒÀÛ wˆ ƒ›` Wƒ›gÊ=ƒüÉ‚çnƒÂyˆ‚ ÂuˆÛ wˆ‚æhË=ƒ#ÜÝ Ó#„›Þ‚›hÎ=ƒH` =„3mƒ8ß‚›ÂuˆÜà Ó#„›ß‚›Â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 ]*\\(;\\|\\\\|\\\\|\\\\|\\\\)" (33 116 84) "^%;" search-forward "\"" 3 4 "'"] 5 "\ 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-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 " " nil "a-zA-Z0-9_" looking-at "virtual\\>" simula-calculate-indent amount delete-horizontal-space] 4 "\ If this is a label that starts the line, reindent the line." nil]) (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 "\ Move backward up COUNT block levels. If COUNT is negative, move forward up block level instead." "p"]) (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 "\ Move forward down COUNT block levels. If COUNT is negative, move backward down block level instead." "p"]) (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 "\ Move backward COUNT statements. If COUNT is negative, move forward instead." "p"]) (defalias 'simula-next-statement #[(count) "ÁWƒ Â[!‡ÃÄ`ÃÈÉ+‡" [count 0 simula-previous-statement nil t origin case-fold-search status (byte-code "À ˆÁÂ!ƒ ÃvˆÄ S‰!ƒ ÆÇdÈ#‰ „  …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 "\ Move forward COUNT statements. If COUNT is negative, move backward instead." "p"]) (defalias 'simula-skip-comment-backward #[nil "ÀÁ‡" [simula-out (byte-code "ÀÂÀxˆhÃ=ƒŠÄÅ!ˆÆ )‚Æ  Ç>ƒHhÈ=ƒ@gÉ>„@ŠÊÀxˆËÌ!)„@ÊÀxˆ‚ÍÎÀ\"ˆ‚ Ï=ƒ^ÐÑ!ƒÆ Ò>„N‚ Å=ƒsψoƒÍÎÀ\"ˆ‚ Ó=ƒÐÔ!ˆÅvˆÍÎÀ\"ˆ‚" [nil context " \n " 59 backward-char 1 simula-context (nil 3 4) 58 (45 61) ": a-zA-Z0-9_" looking-at "virtual\\>" throw simula-out 0 re-search-backward "!\\|\\" (0 1) 2 "\\"] 3)] 2 "\ Search towards bob to find first char that is outside a comment." nil]) (defalias 'simula-skip-comment-forward #[nil "ÀÁ‡" [simula-out (byte-code "ÀÁwˆÂÃ!ƒÄÅÁÆ#ˆ‚nƒ#gÇ=ƒ#Èyˆ‚ÂÉ!ƒ6ÂÊ!„6ËÁwˆ‚ÌÍÎ\"ˆ‚" [" \n " nil looking-at "!\\|\\" search-forward ";" move 37 1 "[a-z0-9_]*[ ]*:[^-=]" "virtual\\>" "a-zA-Z0-9_ :" throw simula-out t] 4)] 2 "\ Search towards eob to find first char that is outside a comment." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias simula-forward-up-level #[nil "À`ÀÁ‰‰ƒ8ÇÈeÉ#ƒ1Ê hË>…#\nÌ>‰?…+Í ‰‚ Á‰„ ƒ@À‚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] 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â ˆ‚ÕÕã!„ÕÕä!ƒÕ%æ ˆ ƒ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 " re-search-backward "^\\|!\\|\\" 3 error "Inside string" 4 "Inside character constant" simula-inside-parens " " 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_]*[ ]*:[^-=]" 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_]*[ ]*:[^-=]" current-indentation (58 59)] 9]] 3) (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 "\ Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement."]) (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 "\ Find INSPECT matching WHEN or OTHERWISE."]) (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 "\ Find keyword matching DO: FOR, WHILE, INSPECT or WHEN"]) (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 "\ Return position after `(' on line if inside parentheses, nil otherwise."]) (defun simula-goto-definition nil "\ Goto point of definition of variable, procedure or class." (interactive)) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias simula-expand-stdproc #[nil "ƒ Á ƒ  ‡Ã=ƒÄÅ!‡Æ=ƒ ÇÅ!‡È=…)ÉÅ!‡" [simula-abbrev-stdproc simula-context unexpand-abbrev upcase upcase-word -1 downcase downcase-word capitalize capitalize-word] 2] simula-expand-keyword #[nil "ƒ Á ƒ  ‡Ã=ƒÄÅ!‡Æ=ƒ ÇÅ!‡È=…)ÉÅ!‡" [simula-abbrev-keyword simula-context unexpand-abbrev upcase upcase-word -1 downcase downcase-word capitalize capitalize-word] 2]] 3) (defalias 'simula-electric-keyword #[nil "Á=‰ƒà Å\"ˆÆÇ!ˆÈÅ!ˆÉ Ê ‰ …8 Í=…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 " " nil simula-calculate-indent indent current-indentation delete-horizontal-space pos show-char delete-char] 6) ((quit (byte-code "dZb‡" [pos] 2)))] 4 "\ Expand SIMULA keyword. If it starts the line, reindent."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] 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]] 3) (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 "\ Define Simula keywords, procedures and classes in local abbrev table." nil]) emacs-19.22/lisp/solar.elc100666 13437 1 33602 5471635067 14060 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Nov 15 03:13:43 1993 ;;; from file /home/fsf/rms/e19/lisp/solar.el ;;; emacs version 19.20.9.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ƒ ÂÃ!ˆ‚ÄÅ!ˆÂÆ!‡" [fboundp atan require lisp-float-type error "Solar calculations impossible since floating point is unavailable." cal-dst] 2) (defvar calendar-time-display-form (quote (12-hours ":" minutes am-pm (if time-zone " (") time-zone (if time-zone ")"))) "\ *The pseudo-pattern that governs the way a time of day is formatted. A pseudo-pattern is a list of expressions that can involve the keywords `12-hours', `24-hours', and `minutes', all numbers in string form, and `am-pm' and `time-zone', both alphabetic strings. For example, the form '(24-hours \":\" minutes (if time-zone \" (\") time-zone (if time-zone \")\")) would give military-style times like `21:07 (UTC)'.") (defvar calendar-latitude nil "\ *Latitude of `calendar-location-name' in degrees, + north, - south. For example, 40.7 for New York City. It may not be a good idea to set this in advance for your site; if there may be users running Emacs at your site who are physically located elsewhere, they would get the wrong value and might not know how to override it.") (defvar calendar-longitude nil "\ *Longitude of `calendar-location-name' in degrees, + east, - west. For example, -74.0 for New York City. It may not be a good idea to set this in advance for your site; if there may be users running Emacs at your site who are physically located elsewhere, they would get the wrong value and might not know how to override it.") (defvar calendar-location-name (quote (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (abs calendar-latitude) (if (> calendar-latitude 0) "N" "S") (abs calendar-longitude) (if (> calendar-longitude 0) "E" "W")))) "\ *Expression evaluating to name of `calendar-longitude', calendar-latitude'. Default value is just the latitude, longitude pair.") (defvar solar-n-hemi-seasons (quote ("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice")) "\ List of season changes for the northern hemisphere.") (defvar solar-s-hemi-seasons (quote ("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")) "\ List of season changes for the southern hemisphere.") (defalias 'solar-setup #[nil "À ˆ „ ÂÃ! „ÂÅ!?…ÂÇ!‰‡" [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 "\ Prompt user for latitude, longitude, and time zone."]) (defalias 'solar-get-number #[(prompt) "À Â\"‰˜?…Ä !)‡" [read-string prompt "" x string-to-int] 4 "\ Return a number from the minibuffer, prompting with PROMPT. Returns nil if nothing was entered."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias solar-sin-degrees #[(x) "À Â_!‡" [sin x .017453292519943295] 3] solar-cosine-degrees #[(x) "À Â_!‡" [cos x .017453292519943295] 3] solar-tangent-degrees #[(x) "À Â_!‡" [tan x .017453292519943295] 3]] 3) (defalias 'solar-xy-to-quadrant #[(x y) "ÁVƒ\nÁVƒÇć\nÁVƒŇƇ" [x 0 y 1 4 2 3] 2 "\ Determines the quadrant of the point X, Y."]) (defalias 'solar-degrees-to-quadrant #[(angle) "ÀÁ\nÃ\"Ä\"T‡" [floor mod angle 360 90] 4 "\ Determines the quadrant of ANGLE."]) (defalias 'solar-arctan #[(x quad) "À !Â_ Åšƒ Æ\\‚+ Çšƒ Æ\\‚+ Èšƒ* É\\‚+ )‡" [atan x 57.295779513082323 deg quad 2 180 3 4 360] 2 "\ Arctangent of X in quadrant QUAD."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias solar-arccos #[(x) "ÀÁ\n‰_Z!Ä \n¥Å\n \"\")‡" [sqrt 1 x y solar-arctan solar-xy-to-quadrant] 5] solar-arcsin #[(y) "ÀÁ\n‰_Z!Ä\n ¥Å \n\"\")‡" [sqrt 1 y x solar-arctan solar-xy-to-quadrant] 5]] 3) (defconst solar-earth-inclination 23.441884000000002 "\ 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 .016718 "\ Eccentricity of orbit of the earth around the sun.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias solar-degrees-to-hours (macro . #[(deg) "À ÂE‡" [/ deg 15] 3]) solar-hours-to-days (macro . #[(hour) "À ÂE‡" [/ hour 24] 3])] 3) (defalias 'solar-longitude-of-sun #[(day) "Á_ÂZÄ Å !Æ_Å ‰\\!Ç_È\\\\\\É\")‡" [day .98559999999999999 3.2890000000000001 mean-anomaly mod solar-sin-degrees 1.916 .02 282.63400000000001 360] 6 "\ Longitude of the sun at DAY in the year."]) (defalias 'solar-right-ascension #[(longitude) "À  !_Ä !\"Å¥‡" [solar-arctan solar-cos-inclination solar-tangent-degrees longitude solar-degrees-to-quadrant 15] 4 "\ Right ascension of the sun, given its LONGITUDE."]) (defalias 'solar-declination #[(longitude) "À  !_!‡" [solar-arcsin solar-sin-inclination solar-sin-degrees longitude] 4 "\ Declination of the sun, given its LONGITUDE."]) (defalias 'solar-sunrise #[(date) "@A@AA@\n SÄ_\\ ÆVƒ> Ç_È\\É¥Z ǦÊUƒ> ˦ÊUƒ; ̦ÊUƒ> T ,‰ÍÏ¥ZÐ¥\\Ò!Ô!Ö!ØÙÚ¥Û\\!Ü!Ü!_ZØ!Ø!_¥ß!àX…¬áâ!ZÏ¥#ä#\\å_æ\\ZÐ\"‰'Ï¥Z(é¥\\*.‡" [date month day year 31 day-of-year 2 4 23 10 0 100 400 6 calendar-longitude 15 24 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 solar-cosine-degrees 50.0 60.0 90 solar-sin-degrees calendar-latitude cos-local-sunrise abs 1 360 solar-arccos local-sunrise mod .065709999999999997 6.6219999999999999 local-mean-sunrise calendar-time-zone 60.0] 5 "\ Calculates the *standard* time of sunrise for Gregorian DATE 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-sunset #[(date) "@A@AA@\n SÄ_\\ ÆVƒ> Ç_È\\É¥Z ǦÊUƒ> ˦ÊUƒ; ̦ÊUƒ> T ,‰ÍÏ¥ZÐ¥\\Ò!Ô!Ö!ØÙÚ¥Û\\!Ü!Ü!_ZØ!Ø!_¥ß!àX…ªá!Ï¥\"ã\"\\ä_å\\ZÐ\"‰&Ï¥Z'è¥\\*.‡" [date month day year 31 day-of-year 2 4 23 10 0 100 400 18 calendar-longitude 15 24 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 solar-cosine-degrees 50.0 60.0 90 solar-sin-degrees calendar-latitude cos-local-sunset abs 1 solar-arccos local-sunset mod .065709999999999997 6.6219999999999999 local-mean-sunset calendar-time-zone 60.0] 5 "\ Calculates the *standard* time of sunset for Gregorian DATE 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-time-string #[(time date &optional style) "AA@ Ä_!AA@S@A@AA@SÈ_\\ ÊVƒZ Ë_Ì\\Í¥Z ˦ÎUƒZ ϦÎUƒU ЦÎUƒZ T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\) Ò¥\\…ïÕ!AA@SÕ!@Õ!A@Õ!AA@SÈ_\\ ÊVƒÕ Ë_Ì\\Í¥Z ˦ÎUƒÕ ϦÎUƒÐ ЦÎUƒÕ T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)×¥\\…nÕ!AA@SÕ!@Õ!A@Õ!AA@SÈ_\\ ÊVƒQ Ë_Ì\\Í¥Z ˦ÎUƒQ ϦÎUƒL ЦÎUƒQ T  , Ñ_ Ë¥ Ï¥[ Ð¥\\\\\\\\)ZÜ¥\\ß=?…Ûà=†Ûƒ¹ƒ¹Wƒ¡Xƒ¡W†ÛWƒ¹W†ÛX†ÛƒË„ËX†Û…Û?…ÛW‰!ƒæ\"‚è#$ !ƒõ‚öÎ\\‰Ä¥%æç Ħ\"(æé%ê\\ë¦T\",%ëYƒí‚î/æç%\"%ðÕ1ò#. ‡" [date year round time 60 prior-years month day 31 day-of-year 2 4 23 10 0 100 400 365 1440.0 rounded-abs-date calendar-daylight-savings-starts eval 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 style standard daylight dst calendar-daylight-time-zone-name calendar-standard-time-zone-name time-zone 24-hours format "%02d" minutes "%d" 11 12 12-hours "pm" "am" am-pm mapconcat calendar-time-display-form ""] 7 "\ Printable form for decimal fraction *standard* TIME on DATE. Optional parameter STYLE forces the time to be standard time when its value is 'standard and daylight savings time (if available) when its value is 'daylight. Format used is given by `calendar-time-display-form'. Converted to daylight savings time 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 'solar-sunrise-sunset #[(date) "À ! !ÅÆ ƒÇÈ \"P‚É ƒ%ÊÈ \"P‚&ËÌ !$*‡" [solar-sunrise date solar-sunset set rise format "%s, %s at %s" "Sunrise " solar-time-string "No sunrise" "sunset " "no sunset" eval calendar-location-name] 7 "\ String giving local times of sunrise and sunset on Gregorian DATE."]) (defalias 'solar-apparent-longitude-of-sun #[(date) "AA@S@A@AA@ \nSÅ_\\\nÇVƒI\nÈ_É\\Ê¥Z ȦËUƒI ̦ËUƒD ͦËUƒIT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)ÏÐÑÒ \nSÅ_\\\nÇVƒ\nÈ_É\\Ê¥Z ȦËUƒ ̦ËUƒ˜ ͦËUƒT, Î_ È¥ Ì¥[ Í¥\\\\\\\\)ZÓ¥‰Õ_‰Ö__×\\\\Ù_‰Ú__‰‰Û___Ü\\\\\\Þ_‰ß__à\\\\á!_â_ã\\á‰\\!_áä_!å_\\\\&&\\'è_é\\*'á*!ë_ì\\\\.‡" [date prior-years month day year 31 day-of-year 2 4 23 10 0 100 400 365 1899 1 .5 1900 36525 time 36000.768920000002 .00030249999999999999 279.69668000000001 l 35999.049749999998 -.00014999999999999996 -3.3000000000000003e-006 358.47582999999997 m -.0047889999999999997 -1.3999999999999999e-005 1.9194599999999999 solar-sin-degrees -.0001 .020094000000000003 3 .00029300000000000006 c L -1934.1420000000001 259.18000000000001 omega -.00479 -.0056899999999999995] 8 "\ Apparent longitude of the sun on Gregorian DATE."]) (defalias 'solar-ephemeris-correction #[(year) "ÁZÂ¥‰Ä_ ‰Å__Æ\\\\)‡" [year 1900 100.0 T 1.2053 .4992 .40999999999999996] 5 "\ Difference in minutes between Ephemeris time and UTC in YEAR. Value is only an approximation."]) (defalias 'solar-equinoxes/solstices #[(k year) "Á_Á\\ EÄÅÉVƒ=ÊË!Ì\"ÍÎ_Z!Ï_@A@\\ E‚@A@Ñ¥Ò !Ó¥[\\\\ E+‡" [k 3 21 year nil 1000 correction app date 1e-005 mod solar-apparent-longitude-of-sun 360 solar-sin-degrees 90 58 calendar-time-zone 1440.0 solar-ephemeris-correction 1440.0] 5 "\ Date of equinox/solstice K for YEAR. K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter solstice. Accurate to within several minutes."]) (defalias 'sunrise-sunset #[(&optional arg) "ÁWƒ\nƒ ƒ „Å ˆÁWƒ ‚\"ÆÇ!ÁWƒ-\n‚0ÆÈ!ÁWƒ; ‚>ÆÉ!ÁWƒJ\n‚mË ÍÎÏ\n!\nÐVƒ\\Ñ‚]ÒÏ ! ÐVƒjÓ‚kÔ%)\nÁWƒz‚• ÐUƒ„Ö‚• ÐWƒ‘Í× \"‚•ÍØ \"ÁW…ŸÁW…©ÛWƒ¶Ü ‚¸Ý ßà\"!â!#Íä!##%æà!'%Gè Xƒåé%!‚êë!ì#Q!‘ˆéí'ƒ.ƒï‚ð‚ñ!!. ‡" [arg 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 "N" "S" "E" "W" 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 "\ Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. If called with an optional prefix argument, prompts for date. If called with an optional double prefix argument, prompts for longitude, latitude, time zone, and date. This function is suitable for execution in a .emacs file." "p"]) (defalias 'calendar-sunrise-sunset #[nil "ƒ ƒ \n„à ˆÄÅÆ †ÇÈ!!!‡" [calendar-latitude calendar-longitude calendar-time-zone solar-setup message solar-sunrise-sunset calendar-cursor-to-date error "Cursor is not on a date!"] 4 "\ Local time of sunrise and sunset for date under cursor. Accurate to +/- 2 minutes." nil]) (defalias 'diary-sunrise-sunset #[nil "ƒ ƒ \n„à ˆÄ !‡" [calendar-latitude calendar-longitude calendar-time-zone solar-setup solar-sunrise-sunset date] 2 "\ Local time of sunrise and sunset as a diary entry. Accurate to +/- 2 minutes."]) (defalias 'diary-sabbath-candles #[nil "ƒ ƒ \n„à ˆ AA@S @ A@ AA@SÉ_\\\nËVƒb\nÌ_Í\\Î¥Z\n̦ÏUƒbЦÏUƒ]ѦÏUƒb\nT\n\n, Ò_ Ì¥ Ð¥[ Ñ¥\\\\\\\\)Ó¦ÔU…œÕ !‰…×Ø¥Z‰…›ÚÛÜ \"\"*‡" [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 18.0 60.0 light format "%s Sabbath candle lighting" solar-time-string] 7 "\ 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 'solar-equinoxes-solstices #[nil " \nÄ_ ‰Å¦ÆUƒÇ‚! ŦÈUƒ Æ‚!ÉÇ\\\\\\‰\nĦT\nÄ¥) ƒ< ‚=Í  …F …O ƒ[ ‚\\É Å¥SÑ\n\"‰A@‰Ô!ZÕ_…ƒÉW@Ô!AA@E‰ÙÚƒ£‚¥8Ý\"#. 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-equinoxes/solstices date day truncate 24 time calendar-latitude s-hemi format "%s %s" solar-s-hemi-seasons solar-n-hemi-seasons solar-time-string] 8 "\ Date and time of equinoxes and solstices, if visible in the calendar window. Requires floating point."]) (provide (quote solar)) emacs-19.22/lisp/sort.elc100666 13437 1 23625 5424635444 13730 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sun Jul 25 22:02:11 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/sort.el ;;; emacs version 19.17.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 "This file was compiled for Emacs 19")) (defvar sort-fold-case nil "\ *Non-nil if the buffer sort functions should ignore case.") (defalias 'sort-subr #[(reverse nextrecfun endrecfun &optional startkeyfun endkeyfun) "deZÀVŠ ƒÂÃ!ˆÄ $ Ê !    ƒ—\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 @ A&V‡" [0 compare-buffer-substrings nil a b] 8] string< sort #[(a b) "@ @W‡" [a b] 2] #[(a b) "ÀÁ @@ @A @@ @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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias sort-build-lists #[(nextrecfun endrecfun startkeyfun endkeyfun) "À‰‰‰m„f`ÀÁÅ\nÀ„1ƒ& ˆ‚1ƒ1 ˆÈ ƒV :ƒN @ šƒN A`šƒN ‰B‚S `BB B\n„ƒ ˆ‚ ,‡" [nil key done start-rec sort-lists (byte-code "ƒ  †`\n† Ä ˆ `)B‡" [startkeyfun start endkeyfun endrecfun t done] 2) endrecfun nextrecfun t] 4] 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]] 3) (defalias 'sort-lines #[(reverse beg end) "ŠŒ }ˆebˆÂ ÄÅ#*‡" [beg end sort-subr reverse forward-line end-of-line] 4 "\ 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)." "P\nr"]) (defalias 'sort-paragraphs #[(reverse beg end) "ŠŒ }ˆebˆÂ ÄÅ#*‡" [beg end sort-subr reverse #[nil "ÀÁw‡" ["\n " nil] 2] forward-paragraph] 4 "\ 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)." "P\nr"]) (defalias 'sort-pages #[(reverse beg end) "ŠŒ }ˆebˆÂ ÄÅ#*‡" [beg end sort-subr reverse #[nil "ÀÁw‡" ["\n" nil] 2] forward-page] 4 "\ 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)." "P\nr"]) (byte-code "ÀÁ!„ „Fà Ä ÇWƒ&È É#ˆ T‰‚ÈÊË#ˆÈÌË#ˆÈÍË#ˆÈÎÏ#ˆ*‡" [boundp sort-fields-syntax-table nil make-syntax-table 0 i table 256 modify-syntax-entry "w" 32 " " 9 10 46 "_"] 5) (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 "\ 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. If you want to sort floating-point numbers, try `sort-float-fields'." "p\nr"]) (defalias 'sort-float-fields #[(field beg end) "À \n ÄÅ%‡" [sort-fields-1 field beg end #[nil "À !ˆÂ`ŠÃÄ!ˆ`){!‡" [sort-skip-fields field string-to-number re-search-forward "[+-]?[0-9]*.?[0-9]*\\([eE][+-]?[0-9]+\\)?"] 4] nil] 6 "\ 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." "p\nr"]) (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 "\ 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." "p\nr"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [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] 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]] 3) (defalias 'sort-regexp-fields #[(reverse record-regexp key-regexp beg end) "Áš„ šƒÃ‚ÄÅ\"ƒÆHÇZŠŒ }ˆebˆÊ Ì !ˆ` ÔbˆÎÐÑÒ$+‡" [key-regexp "" "\\&" 0 string-match "\\`\\\\[1-9]\\'" 1 48 beg end nil sort-regexp-record-end re-search-forward record-regexp sort-subr reverse #[nil "À ÂÃ#…Ä•‰…Ä”b‡" [re-search-forward record-regexp nil move 0 sort-regexp-record-end] 4] #[nil "b‡" [sort-regexp-record-end] 1] #[nil "À\n§ƒ \n‚Ã\n Å#ƒÀ‚ÆÇÈ\"ˆÈÉÊ)‡" [0 n key-regexp re-search-forward sort-regexp-record-end t throw key nil (byte-code "ÀÁ!ƒ \n”\n•B‡\n”\n•{‡" [fboundp buffer-substring-lessp n] 2) ((error (byte-code "ÀÁÂ\"‡" [throw key nil] 3)))] 4]] 5 "\ 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 \"\\=\\\"" "P\nsRegexp specifying records to sort: \nsRegexp specifying key within record: \nr"]) (byte-code "ÀÁ!„ÂÀ‡" [boundp sort-columns-subprocess t] 2) (defalias 'sort-columns #[(reverse &optional beg end) "ŠÀ‰‰‰‰‰^bˆiÉyˆ`]bˆiÀyˆ` ^ ]ÊËÌ#ƒ@ÍÎ!ˆÐ=„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 "\ 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." "P\nr"]) (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 "\ Reverse the order of lines in a region. From a program takes two point or marker arguments, BEG and END." "r"]) (provide (quote sort)) emacs-19.22/lisp/spell.elc100666 13437 1 5366 5416174720 14036 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:04:31 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/spell.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (defalias 'spell-buffer #[nil "ÀedÁ#‡" [spell-region "buffer"] 4 "\ 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." nil]) (defalias 'spell-word #[nil "À‰‰ŠÄÅ!„Ævˆ`Çvˆ`)È \n \n{#+‡" [nil spell-filter end beg looking-at "\\<" -1 1 spell-region] 5 "\ 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." nil]) (defalias 'spell-region #[(start end &optional description) "ÁÂ!Š qˆ~ˆÅ ˆ)ÆdžÉ\"ˆ „N\nSfËUƒN ͘ƒ;Î\nÍÐ %ˆ‚Î\nÐ ÐÒ &ˆ‚pŠ qˆÔ\n#ˆn„eËcˆ ƒl ˆ ͘ƒ~ÎedÍÕ %ˆ‚ŒÎedÕ ÐÒ &ˆ*ÆÖ†•ÉŠ 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 "\ 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\"." "r"]) (defalias 'spell-string #[(string) "ÀÁ!Š\nqˆ~ˆÃ ˆ űˆǘƒ$ÈedÇɉ%ˆ‚2Èed\nɉËÌ&ˆÍ ÎUƒ@ÏÐ \"‚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 "\ Check spelling of string supplied as argument." "sSpell string: "]) emacs-19.22/lisp/spook.elc100666 13437 1 2107 5421114250 14024 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Jul 14 19:37:11 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/spook.el ;;; emacs version 19.16.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"))) (error "This file was compiled for Emacs 19")) (require (quote cookie1)) (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") (defalias 'spook #[nil "À \nÃÄ$‡" [cookie-insert spook-phrases-file spook-phrase-default-count "Checking authorization..." "Checking authorization...Approved"] 5 "\ Adds that special touch of class to your outgoing mail." nil]) (defalias 'snarf-spooks #[nil "À ÂÃ#‡" [cookie-snarf spook-phrases-file "Checking authorization..." "Checking authorization...Approved"] 4 "\ Return a vector containing the lines from `spook-phrases-file'."]) emacs-19.22/lisp/startup.elc100666 13437 1 20771 5473306344 14440 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Nov 19 22:20:01 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/startup.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "À‡" [(normal-top-level) top-level nil] 1) (defvar command-line-processed nil "\ t once command line has been processed") (defconst inhibit-startup-message nil "\ *Non-nil inhibits the initial startup messages. This is for use in your personal init file, once you are familiar with the contents of the startup message.") (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-functions nil "\ 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 before-init-hook nil "\ Functions to call after handling urgent options but before loading init file. 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 "\ Function called to initialize window system display. Emacs calls this after processing the command line arguments and loading the user's init file. Users should not set this variable; use term-setup-hook instead.") (defconst initial-major-mode (quote 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 may be the null string or a string containing a user's name. If the value is a null string, it means that the init file was taken from the user that originally logged in. In all cases, `(concat \"~\" init-file-user \"/\")' evaluates to the directory name of the directory where the `.emacs' file was looked for.") (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'.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"‡" [boundp init-file-debug nil init-file-had-error defalias normal-top-level #[nil "ƒÁÂ!‡Ã Å=„9ÆÇ!‰;ƒ8ÉÊ!ËP!ÉÊ !ËP!š„8ÍÎP\")Ð ! ÑŽÒ )‡" [command-line-processed message "Back to top level." t system-type vax-vms getenv "PWD" pwd file-attributes file-name-as-directory "." default-directory delete "PWD=" process-environment abbreviate-file-name ((byte-code "À !ÂÃ!ˆ ƒÂÄ!ˆÅÆ!ƒÆ ˆÅÇ!ƒ\"Ç ˆƒ+ÂÈ!ˆÀ‡" [abbreviate-file-name default-directory run-hooks emacs-startup-hook term-setup-hook fboundp frame-notice-user-settings font-menu-add-default window-setup-hook] 2)) command-line] 5] command-line #[nil "ÀÁ!‰Ã=„=\nĘ„\nŘƒÆ‚=\nȘ„(\nɘƒ.Â=\nʘ„:\n˘ƒ=Ì) ƒU„UÏÑ !ÒQÃÆ#ˆÃA?…eÖ ‰ƒvØ ˜ƒvÙ„çƒç@‰Û˜„’ܘƒÃA‚ãݘ„«Þ˜ƒ¼A‰@A‚ãߘƒÎà A‚ãᘃàÆ\"A‚ãÆ)‚v¡ˆ*ãä!ƒ÷ä ˆãå!ƒå ˆæç!ˆ ƒÏ Ɖ#ˆÃ(\"é*+\"ƒ&* ˆ‚+ìíîˆ*æï!ˆðñ!ƒFŠñqˆ2ó=ƒE4 ˆ)ƒŒ„Œ „ŒÀõ!Ã6‰7ƒ‹Ï7PƉ#„‹øù7\"‰6ƒ„7ú6O‰7‚^É7„a*ûA!ˆ…šüÆ!‡" [getenv "VERSION_CONTROL" vc nil "t" "numbered" t version-control "nil" "existing" "never" "simple" never window-system noninteractive load term-file-prefix symbol-name "-win" command-line-args args done user-login-name init-file-user user-real-login-name "" argi "-q" "-no-init-file" "-u" "-user" "-no-site-file" site-run-file "-debug-init" init-file-debug fboundp frame-initialize face-initialize run-hooks before-init-hook inhibit-startup-message #[nil "…&Á\nÃ=ƒÄ‚ÅÆQlj‰$ˆ†&É\nÁËlj#)‡" [init-file-user load system-type vax-vms "sys$login:.emacs" "~" "/.emacs" t inhibit-default-init nil inhibit-startup-message "default"] 5] inner debug-on-error error (byte-code " ˆÁÁ‡" [inner nil init-file-had-error] 1) ((error (byte-code "ÀÁ\n@ÃN\nA… ÄÅÆ\nAÇ#$ˆÈ À‡" [message "Error in init file: %s%s%s" error error-message ": " mapconcat prin1-to-string ", " t init-file-had-error] 8))) after-init-hook get-buffer "*scratch*" major-mode fundamental-mode initial-major-mode "TERM" hyphend term string-match "[-_][^-_]+$" 0 command-line-1 kill-emacs] 5] command-line-1 #[(command-line-args-left) "„Á „\n„ÃÄÅ!Æ=ƒÇ‚ÈÉ!!ˆ\n„± ?…°?…°Ì ͘…°Á ?…ƒEÏÎ!ˆÐÑÒ!ƒQÒ ˆƒZÏÓ!ˆÐÔŽÕ Ö±ˆÄ×!Ø=ƒ£ÄÙ!Ú=ƒ£ÄÛ!Ü=ƒ£ÄÝ!Þ=ƒ£Äß!à=ƒ£Äá!â=ƒ£Äã!ä=ƒ£åcˆ‚¨Èæ!cˆçÐ!ˆèé!)‡*ëÐë,-./\nƒñ\n@Ð01\nA\nò13\"‰0ƒæ0A1!ˆ‚í1ô˜„û1õ˜„û1ö˜ƒ÷\n@!0\nA\n0 ˆ‚í1ø˜„1ù˜ƒ@\n@:ûü:!!ƒ0ü:!:ý:Ðþ#ˆ)\nA\n‚í1ÿ˜ƒf\n@;„V@A!ˆB\n@!ˆ\nA\n‚í1C˜ƒxDþ!ˆ‚íEF1\"ƒG1!,‚íHÐI‰Jƒ­J@ ‰I„­JA‰J„šI„ì.T‰.KUƒÎLü1/\"!-‚ÙMü1/\"!ˆN,!„éO,!ˆë,**‚¾.PV…Q-!†RK!ˆS ,‡" [noninteractive input-pending-p init-file-had-error 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 nil fboundp frame-notice-user-settings window-setup-hook ((byte-code "ŠÀÁ!qˆÂ ˆÃÄ!ˆ)ć" [get-buffer "*scratch*" erase-buffer set-buffer-modified-p nil] 2)) emacs-version "\nCopyright (C) 1993 Free Software Foundation, Inc.\n\n" "" help-command "u" advertised-undo "" save-buffers-kill-emacs "" describe-copying "" describe-distribution "" describe-no-warranty "t" help-with-tutorial "Type 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.\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." "Type \\[help-command] 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.\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 default-directory 0 line first-file-buffer file-count dir tem argi assoc command-switch-alist "-f" "-funcall" "-e" intern "-l" "-load" file file-exists-p expand-file-name load t "-insert" error "filename omitted from `-insert' option" insert-file-contents "-kill" kill-emacs string-match "^\\+[0-9]+\\'" string-to-int command-line-functions did-hook hooks 1 find-file find-file-other-window zerop goto-line 2 get-buffer-window other-window buffer-menu] 5]] 3) emacs-19.22/lisp/studly.elc100666 13437 1 2120 5416174760 14230 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:05:04 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/studly.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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 "\ Studlify-case the region" "*r"]) (defalias 'studlify-word #[(count) "`À‰‰ vˆ` ^ ]Æ\n \",‡" [nil re rb end begin count studlify-region] 4 "\ Studlify-case the current word, or COUNT words if given an argument" "*p"]) (defalias 'studlify-buffer #[nil "Àed\"‡" [studlify-region] 3 "\ Studlify-case the current buffer" "*"]) emacs-19.22/lisp/subr.elc100666 13437 1 40467 5474622553 13721 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:12:10 1993 ;;; from file /home/fsf/rms/e19/lisp/subr.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (defalias 'lambda '(macro . #[(&rest cdr) "ÀÁ\nBD‡" [function lambda cdr] 3 "\ 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, etcetera. ARGS should take the same form as an argument list for a `defun'. DOCSTRING should be a string, as described for `defun'. It may be omitted. 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 'one-window-p #[(&optional nomini) "À \nƒ à =ƒÄ ! Ä \n…Å\")=‡" [selected-window base-window nomini minibuffer-window next-window arg] 4 "\ Returns non-nil if there is only one window. Optional arg NOMINI non-nil means don't count the minibuffer even if it is active."]) (defalias 'walk-windows #[(proc &optional minibuf all-frames) "ÀÁ !ƒ ÂÁ ‰Æ # !ˆ =?…$‚*‡" [window-minibuffer-p selected-window t minibuf walk-windows-start walk-windows-current next-window all-frames proc] 5 "\ 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. If MINIBUF is neither t nor nil it means not to count the minibuffer even if it is active. Optional third arg ALL-FRAMES, if t, means include all frames. ALL-FRAMES nil or omitted means 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, stick strictly to the selected frame."]) (defalias 'minibuffer-window-active-p #[(window) "À ‰# =?…Ä Â‰#‰ )=)‡" [previous-window window nil prev next-window should-be-same] 5 "\ Return t if WINDOW (a minibuffer window) is now active."]) (byte-code "ÀÁÂ\"ˆÃÁÄÅ#‡" [defalias undefined #[nil "À ‡" [ding] 1 nil nil] put suppress-keymap t] 4) (defalias 'suppress-keymap #[(map &optional nodigits) "ÀÁ $ˆ †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 "\ 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 'substitute-key-definition #[(olddef newdef keymap &optional oldmap prefix) "„Á\n† ÅÆ!È\" :…) @:ƒ’ @@ @A\n Ì Iˆ G IˆÆ \n¢;ƒO\nA‰\n‚A\n‰ 9ƒhÎ !ƒh K‰ ‚T\n=ƒ{Ð  #ˆ‚ŽÒ\n!ƒŽÓ   %ˆ+‚\"Ô @!ƒ\" @‰GÌÌWƒ!H\n Ì Iˆ G IˆÆ \n¢;ƒØ\nA‰\n‚Ê\n‰ 9ƒñÎ !ƒñ K‰ ‚Ý\n=ƒÐ  #ˆ‚Ò\n!ƒÓ   %ˆ+T‰‚¥+ A‰‚+‡" [prefix "" oldmap keymap scan vector nil vec1 vconcat prefix1 defn char 0 inner-def fboundp olddef define-key newdef keymapp substitute-key-definition arrayp array len i] 7 "\ 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 'define-key-after #[(keymap key definition after) "À !„ ÂÃÀ D\"ˆ GÅVƒÆÇ!ˆ ȉ ÉH\n    ?…† …† A@¢\n=ƒC ‰AA¡ˆ @¢=„\\ A@Á=„\\ A„~ A@Á=ƒhÏ  „{ É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 "\ 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--it must be a string or vector of length 1."]) (defalias 'keyboard-translate #[(from to) "À !„ GV„ GVƒ: G ÆÇ ZÈ\"P ÇWƒ6 ‰Iˆ T‰‚$ * I‡" [arrayp keyboard-translate-table "" from to i make-string 256 0 table] 5 "\ 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."]) (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") (byte-code "ÀÁ\n\"ˆÃ ÅÁ#‡" [defalias ctl-x-4-prefix ctl-x-4-map define-key ctl-x-map "4"] 4) (defvar ctl-x-5-map (make-sparse-keymap) "\ Keymap for frame commands.") (byte-code "ÀÁ\n\"ˆÃ ÅÁ#ˆÆÇÈ\" ÊÆÇË\" \" À‡" [defalias ctl-x-5-prefix ctl-x-5-map define-key ctl-x-map "5" lsh 1 7 listify-key-sequence-1 logior 23] 4) (defalias 'listify-key-sequence #[(key) "À !ƒ  Ã\"‡ÄÅ Ã\"\"‡" [vectorp key append nil mapcar #[(c) "ÁVƒ  \"‡‡" [c 127 logxor listify-key-sequence-1] 3]] 5 "\ Convert a key sequence to a list of events."]) (defalias 'eventp #[(obj) "¨†9ƒÁN†:…@9…@ÁN‡" [obj event-symbol-elements] 2 "\ True if the argument is an event object."]) (put (quote eventp) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'event-modifiers #[(event) "‰<ƒ\n @ 9ƒ ÂNA‚ÃÅÆ ÇÈÉ\"\"!„(Ê BÅÆ ÇÈË\"\"!ƒ=Æ Ì\"ÍY„AÎ BÅÆ ÇÈÏ\"\"!ƒZÆ Ð\"Æ Ð\"—U„^Ñ BÅÆ ÇÈÒ\"\"!„nÓ BÅÆ ÇÈÔ\"\"!„~Õ BÅÆ ÇÈÖ\"\"!„Ž× B ))‡" [event type event-symbol-elements nil list zerop logand lsh 1 23 meta 22 127 32 control 21 255 shift 20 hyper 19 super 18 alt] 7 "\ 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-basic-type #[(event) ":ƒ@9ƒÁN@‡ÂÃÄÅ\"S\"‰ÇWƒ*ÈÉ\"‚,—)‡" [event event-symbol-elements logand lsh 1 18 base 32 logior 64] 6 "\ 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 'mouse-movement-p #[(object) ":… @Á=‡" [object mouse-movement] 2 "\ Return non-nil if OBJECT is a mouse movement event."]) (put (quote mouse-movement-p) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'event-start #[(event) "A@‡" [event] 1 "\ 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 (COL . ROW) TIMESTAMP) The `posn-' functions access elements of such lists."]) (put (quote event-start) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'event-end #[(event) "À 8:ƒ À‚  8‡" [2 event 1] 2 "\ 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 (COL . ROW) TIMESTAMP) The `posn-' functions access elements of such lists."]) (put (quote event-end) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'event-click-count #[(event) "À 8¨ƒ À 8‡Â‡" [2 event 1] 2 "\ Return the multi-click count of EVENT, a click or drag event. The return value is a positive integer."]) (put (quote event-click-count) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'posn-window #[(position) "@‡" [position] 1 "\ Return the window in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP) as returned by the `event-start' and `event-end' functions."]) (put (quote posn-window) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'posn-point #[(position) "A@:ƒ A@@‡A@‡" [position] 1 "\ Return the buffer location in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP) as returned by the `event-start' and `event-end' functions."]) (put (quote posn-point) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'posn-col-row #[(position) "À 8‡" [2 position] 2 "\ Return the row and column in POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP) as returned by the `event-start' and `event-end' functions."]) (put (quote posn-col-row) (quote byte-optimizer) (quote byte-compile-inline-expand)) (defalias 'posn-timestamp #[(position) "À 8‡" [3 position] 2 "\ Return the timestamp of POSITION. POSITION should be a list of the form (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP) as returned by the `event-start' and `event-end' functions."]) (byte-code "ÀÁÂÃ#ˆÄÅÆ\"ˆÄÇÈ\"ˆÄÉÊ\"ˆÄËÌ\"ˆÄÍÎ\"ˆÄÏÐ\"ˆÄÑÒ\"ˆÄÓÔ\"ˆÄÕÖ\"ˆÄ×Ø\"ˆÄÙÚ\"ˆÄÛÜ\"ˆÄÝÞ\"ˆÄßà\"‡" [put posn-timestamp byte-optimizer byte-compile-inline-expand defalias make-syntax-table copy-syntax-table 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) (defun baud-rate nil "\ Obsolete function returning the value of the `baud-rate' variable. Please convert your programs to use the variable `baud-rate' directly." baud-rate) (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 string-to-int string-to-number] 3) (defalias 'run-hooks #[(&rest hooklist) "…6@ !ƒ- Jƒ- J‰<ƒ) @Ä=„)ÅÆ \"ˆ‚, ˆ))A‰„LJ" [hooklist sym boundp value lambda mapcar funcall nil] 4 "\ Takes hook names and runs each one in turn. Major mode functions use this. Each argument should be a symbol, a hook variable. These symbols are processed in the order specified. If a hook symbol has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with no arguments. If it is a list, the elements are called, in order, with no arguments."]) (defconst run-hooks (quote run-hooks) "\ Variable by which C primitives find the function `run-hooks'. Don't change it.") (defalias 'add-hook #[(hook function &optional append) "À !„\n ÂLˆ J‰<ƒ @Ä=ƒ CLˆ) :ƒ4Æ A J\" )š‚8 J>†N ƒI J C¤‚M JBL‡" [boundp hook nil old lambda function assoc tail append] 4 "\ 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."]) (defalias 'remove-hook #[(hook function) "À !?† J?†\n??…/ J‰:ƒ#Ä\n \"‚+ \n=ƒ+Å L)‡" [boundp hook function hook-value delete nil] 4 "\ 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'."]) (defalias 'eval-after-load #[(file form) "À \n\"„ C\nBÀ \n\" C¤ˆ ‡" [assoc file after-load-alist form] 3 "\ 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'. FILE should be the name of a library, with no directory name."]) (defalias 'eval-next-after-load #[(file) "À  \"‡" [eval-after-load file read] 3 "\ 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 'read-quoted-char #[(&optional prompt) "À‰Á ÅWƒr ÀUÁƒÉÊ\"ˆË ƒ*Á *\nƒÍ\nXƒZ\nÎXƒZ Ï_\nÍZ\\ TƒÉÐÑ\n#‰!ˆ‚ ÀVƒj\nCÓ‰‚\nÓ‰‚Ô Õ\"+‡" [0 nil char code count 3 help-form inhibit-quit prompt message "%s-" read-char quit-flag 48 55 8 format "%s %c" unread-command-events 259 logand 255] 6 "\ 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 'force-mode-line-update #[(&optional all) "ƒ\nŠÁ qˆ)Âà !‡" [all other-buffer set-buffer-modified-p buffer-modified-p] 2 "\ Force the mode-line of the current buffer to be redisplayed. With optional non-nil ALL then force then force redisplay of all mode-lines."]) (defalias 'momentary-string-display #[(string pos &optional exit-char message) "„ÁÂà ÂÉŽŠ\nbˆÂË !ˆ`Í Vƒ0ÎÏ Ð¥!ˆÑÒ!ˆ`\nVƒC\nbˆÎÒ!ˆ)Ó†KÔÕ!\"ˆÖ ‰=†`C‰.‡" [exit-char 32 nil buffer-modified-p buffer-file-name insert-end name modified 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] 5 "\ 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."]) (defun ignore (&rest ignore) "\ Do nothing. Accept any number of arguments, but ignore them." nil) (defalias 'error #[(&rest args) "ÀÁÂà \"C\"ˆ‚" [signal error apply format args] 5 "\ Signal an error, making error message by passing all args to `format'."]) (defalias 'user-original-login-name #[nil "ÀÁ!†ÀÂ!†à ‡" [getenv "LOGNAME" "USER" user-login-name] 2 "\ Return user's login name from original login. This tries to remain unaffected by `su', by looking in environment variables."]) (defalias 'start-process-shell-command #[(name buffer &rest args) "Á=ƒÂà $‡Ã ÈÉÊËÌ#P%‡" [system-type vax-vms apply start-process name buffer args shell-file-name "-c" "exec " mapconcat identity " "] 10 "\ 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 handle as usual in the shell."]) (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 "\ Execute the BODY forms, restoring the global value of the match data."])) emacs-19.22/lisp/supercite.elc100666 12120 1 142551 5474623036 14627 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:15:08 1993 ;;; from file /home/fsf/rms/e19/lisp/supercite.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (require (quote regi)) (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 "[ ]*" "\ *Regexp describing citation leader for a cited line. This should NOT have a leading `^' character.") (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 "[ ]*" "\ *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 nil "\ *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 nil "\ *Alist for frame selection during unciting. See the variable `sc-cite-frame-alist' for details.") (defvar sc-recite-frame-alist nil "\ *Alist for frame selection during reciting. See the variable `sc-cite-frame-alist' for details.") (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 "")))) "\ *Default REGI frame for citing a region.") (defvar sc-default-uncite-frame (quote (("^[ ]*$" nil) ((sc-cite-regexp) (sc-uncite-line)))) "\ *Default REGI frame for unciting 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 "")))) "\ *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 (quote (("^\\(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 (quote 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 (quote ("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 (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))) "\ *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.") (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 (byte-code "ÀÁ ÅÆOǘƒÈÉÊ \"ƒË \n*D‡" [v18 GNU flavor version emacs-version 0 2 "19" v19 string-match "Lucid" Lucid] 3) "\ 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.") (byte-code "ÀÁ!ˆÀÂ!ˆÀÃ!‡" [make-variable-buffer-local sc-mail-info sc-attributions sc-minor-mode] 2) (defvar sc-mode-map-prefix "" "\ *Key binding to install Supercite keymap. If this is nil, Supercite keymap is not installed.") (defvar sc-T-keymap nil "\ Keymap for sub-keymap of setting and toggling functions.") (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) (defvar sc-mode-map nil "\ Keymap for Supercite quasi-mode.") (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) (defvar sc-electric-mode-map nil "\ Keymap for `sc-electric-mode' electric references mode.") (byte-code "„IÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÌ#ˆÂÎÏ#ˆÂÐÏ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÔ#ˆÁ‡" [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 ""] 4) (defvar sc-minibuffer-local-completion-map nil "\ Keymap for minibuffer confirmation of attribution strings.") (byte-code "„Á\n!ÃÄÅ#ˆÃÆÇ#ˆÁ‡" [sc-minibuffer-local-completion-map copy-keymap minibuffer-local-completion-map define-key "" sc-toggle-fn " " self-insert-command] 4) (defvar sc-minibuffer-local-map nil "\ Keymap for minibuffer confirmation of attribution strings.") (byte-code "„Á\n!ÃÄÅ#ˆÁ‡" [sc-minibuffer-local-map copy-keymap minibuffer-local-map define-key "" sc-toggle-fn] 4) (defalias 'sc-completing-read #[(prompt table &optional predicate require-match initial-contents history) "À >ƒ &‡Â ¢†!%‡" [v19 sc-emacs-features completing-read prompt table predicate require-match initial-contents history] 7 "\ Compatibility between Emacs 18 and 19 `completing-read'. In version 18, the HISTORY argument is ignored."]) (defalias 'sc-read-string #[(prompt &optional initial-contents history) "À >ƒ  #‡Â \"‡" [v19 sc-emacs-features read-string prompt initial-contents history] 4 "\ Compatibility between Emacs 18 and 19 `read-string'. In version 18, the HISTORY argument is ignored."]) (defalias 'sc-submatch #[(matchnum &optional string) "ƒ  ” •O‡ ” •{‡" [string matchnum] 3 "\ 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."]) (defalias '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'. Emacs19 has a builtin function `member' which does exactly this."]) (byte-code "À >ƒ\nÂÃMˆÀ‡" [v19 sc-emacs-features sc-member member] 2) (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 "\ 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-scan-info-alist #[(alist) "ÀÁ ƒQ @‰@Ç! A@  ƒJ @‰\n@ \nA Í \"ƒA Á Á‚F A +‚ A,‚\n*‡" ["" nil rtnvalue sc-mumble alist elem infokey sc-mail-field infoval mlist ml-elem regexp thing string-match] 4 "\ Find a match in the info alist that matches a regexp in ALIST."]) (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 (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))))) "\ Regi frame for glomming mail header information.") (defalias 'sc-mail-fetch-field #[(&optional attribs-p) "ÀÁ\n\"ƒ,ÃÄ\n\"—ÃÆ\n\" B‰ B \nƒ+ B +̇" [string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline sc-submatch 1 key 2 val keyval sc-mail-info attribs-p sc-attributions nil] 4 "\ 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-append-field #[nil "@‰ƒÂà \"ƒ ‰AÅÆÇ \"Q¡ˆ)ȇ" [sc-mail-info keyval string-match "^\\s *\\(.*\\)$" curline " " sc-submatch 1 nil] 7 "\ Append a continuation line onto the last fetched mail field's info."]) (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 "\ Issue warning that mail headers don't conform to RFC 822."]) (defvar sc-mail-last-header-nuked-p nil "\ True if the last header was nuked.") (defalias 'sc-mail-nuke-line #[nil "ÀÁ!ÀÂ!|ˆÃ‡" [regi-pos bol bonl ((step . -1))] 3 "\ Nuke the current mail header line."]) (defalias 'sc-mail-nuke-header-line #[nil "À ‡" [t sc-mail-last-header-nuked-p sc-mail-nuke-line] 1 "\ Delete current-line and set up for possible continuation."]) (defalias 'sc-mail-nuke-continuation-line #[nil "…Á ‡" [sc-mail-last-header-nuked-p sc-mail-nuke-line] 1 "\ Delete a continuation line if the last header line was deleted."]) (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 "\ 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-build-nuke-frame #[nil "À‰‰ Å=ƒÆ‚6 Ç=ƒÈÉ‚6 Ê=ƒ+ËÌ‚6 Í=„6ÎÏ \"ˆÐ\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 "\ Build the regiframe for nuking mail headers."]) (defalias 'sc-mail-process-headers #[(start end) "À !À\n!ÅÅÆ #ˆ „%ÊË!ˆ  ‰‚-ÆÌ  #*‡" [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 "\ 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." "r"]) (defalias 'sc-mail-field #[(field) "À —\n\"A†\n ‡" [assoc field sc-mail-info sc-mumble] 3 "\ 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-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 "\ 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." "P"]) (defvar sc-attribution-confirmation-history nil "\ History for confirmation of attribution strings.") (defvar sc-citation-confirmation-history nil "\ History for confirmation of attribution prefixes.") (defalias 'sc-attribs-%@-addresses #[(from &optional delim) "ÀÁ\nP Ä#… Ĕĕ\n„Ä‚ÅZO‡" [string-match "[-a-zA-Z0-9_.]+" delim from 0 1] 4 "\ 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) "GÁÂÃ#Õ …# T ‰Uƒ Â!ÇZO+‡" [from string-match "![-a-zA-Z0-9_.]+\\([^-!a-zA-Z0-9_.]\\|$\\)" 0 mend mstart eos 1] 5 "\ Extract the author's email terminus from email address FROM. Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"]) (defalias 'sc-attribs-<>-addresses #[(from) "ÀÁ\n\"… ÃÄ\n\"‡" [string-match "<\\(.*\\)>" from sc-submatch 1] 3 "\ Extract the author's email terminus from email address FROM. Match addresses of the style ``.''"]) (defalias 'sc-get-address #[(from author) "GÂà Å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 "\ Get the full email address path from FROM. AUTHOR is the author's name (which is removed from the address)."]) (defalias 'sc-attribs-emailname #[(from) "À Â\"†$À Ã\"†$Ä !†$Å !†$À !†$ ÆÇO‡" [sc-attribs-%@-addresses from "%" "@" sc-attribs-!-addresses sc-attribs-<>-addresses 0 10] 3 "\ Get the email terminus name from FROM."]) (defalias 'sc-name-substring #[(string start end extend) "… \\\n Z Æ #† O*‡" [start extend end eos sos string string-match sc-titlecue-regexp] 6 "\ 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-attribs-extract-namestring #[(from) "À Âà Ä#Ä•Å$†-À ÂÆ Ä#Ä•Å$†-À ÂÇ Ä#Å•Ä$†-È !‰ …zÄ GS\n‰ \nXƒV  HÌ>ƒV T‰ ‚=\n Vƒq \nHÍ>ƒq\nS‰\n‚X  \nTO*)‡" [sc-name-substring from string-match "(.*)" 0 1 "\".*\"" "\\([-.a-zA-Z0-9_]+\\s +\\)+<" sc-attribs-emailname namestring eos bos (32 9) (32 9)] 7 "\ Extract the name string from FROM. This should be the author's full name minus an optional title."]) (defalias 'sc-attribs-chop-namestring #[(namestring) "ÀÁ\n\"…ÃÄ\n\"Å\nÆ•ÇO!B‡" [string-match "\\([ ]*\\)\\([^ ._]+\\)\\([ ]*\\)" namestring sc-submatch 2 sc-attribs-chop-namestring 3 nil] 5 "\ Convert NAMESTRING to a list of names. example: (sc-namestring-to-list \"John Xavier Doe\") => (\"John\" \"Xavier\" \"Doe\")"]) (defalias 'sc-attribs-strip-initials #[(namelist) "ÀÁ\nÃ#‡" [mapconcat #[(name) "À GW… ÀÂO‡" [0 name 1] 3] namelist ""] 4 "\ Extract the author's initials from the NAMELIST."]) (defalias 'sc-guess-attribution #[(&optional string) "À † ÂÃ!ÂÄ!{Å‰È #†Ê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 "\ 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-attribs-filter-namelist #[(namelist) "GÁ‰ÇÈ\"ˆÇÉ \"ˆ ,‡" [namelist -1 nil filtered-list keepers position elements mapcar #[(name) "TÁÃÄ \"ˆ\n…B‰)‡" [position t keep-p mapcar #[(filter) "@AÃ\n \"…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 "\ Filter out noise in NAMELIST according to `sc-name-filter-alist'."]) (defalias 'sc-attribs-chop-address #[(from) ";ƒ±ÁGWƒ±ÂÄ!ÆÇ !!ÉA!\n@ É\nA! \n@ Î!Ð!ÒÔÔ×Ø Ù# Ù …XÙ °ÚÛ BÜ BÝBÞBF\"Úà BáBâ BãBäBåBæçèé! \"Bêçèë! \"Bìçèí! \"B¯ .\"‰.. ‡å/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 BB\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 "\ Extract attribution information from FROM. This populates the `sc-attributions' with the list of possible attributions."]) (defvar sc-attrib-or-cite nil "\ Used to toggle between attribution input or citation input.") (defalias 'sc-toggle-fn #[nil "?ÁÂÃ\"‡" [sc-attrib-or-cite throw sc-reconfirm t] 3 "\ Toggle between attribution selection and citation selection. Only used during confirmation." nil]) (defalias 'sc-select-attribution #[nil "ÀÁ!ˆ\nÉ  ƒo @‰ ʘƒVË !‰ „- A‚R ;ƒ< ÂR <ƒMÎ !ÂRÏÐÑ\"ˆ)‚kÒ \"A‰ƒhÂk A)‚„¬„¬ÒÕ\"A†ªÒÖ\"A†ªÒ×\"A†ªÒØ\"A†ªÒÙ\"A†ª@A„¸ÛÜ!ÀÝ!ˆƒ Þß\" !\"#$%Û&Ã'Ã(éê„ã(ƒ'ë!†û‚\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 "ƒ Á Ä#‚ÅÆȉ ÊBË&‰ ͘‡" [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 "\ 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-cite-regexp #[(&optional root-regexp) " †\n R‡" [sc-citation-leader-regexp root-regexp sc-citation-root-regexp sc-citation-delimiter-regexp sc-citation-separator-regexp] 4 "\ 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-make-citation #[(attribution) " \n R‡" [sc-citation-leader attribution sc-citation-delimiter sc-citation-separator] 4 "\ Make a non-nested citation from ATTRIBUTION."]) (defalias 'sc-setup-filladapt #[nil "À \"‰ƒ Å  ‚ÆÇ!ˆÈ *‡" [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 "\ Setup `filladapt-prefix-table' to handle Supercited paragraphs."]) (defvar sc-fill-begin 1 "\ Buffer position to begin filling.") (defvar sc-fill-line-prefix "" "\ Fill prefix of previous line") (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 "\ 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-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 "\ Coerce a Supercited line to look like our style."]) (defalias 'sc-cite-coerce-dumb-citer #[nil "À”À•|ˆÁyˆÂ ‡" [1 0 sc-cite-coerce-cited-line] 2 "\ Coerce a non-nested citation that's been cited with a dumb nesting citer."]) (defalias 'sc-guess-nesting #[(&optional string) "À † ÂÃ!ÂÄ!{Å‰È #†Ê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 "\ 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-add-citation-level #[nil "À  GTà !\" 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 "\ Add a citation level for nested citation style w/ coersion."]) (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 "\ Cite a single line of uncited text. Optional CITATION overrides any citation automatically selected."]) (defalias 'sc-uncite-line #[nil "ÀÁ !‰ƒÔÕ|ˆ)ć" [looking-at sc-cite-regexp cited 0 nil] 3 "\ Remove citation from current 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 "\ Remove citation matching REGEXP from current line and recite line."]) (defalias 'sc-cite-region #[(start end &optional confirm-p) "À ˆÁ\n!†\n ƒÅ‚ÈÉ!ˆtƒ#Ê ˆË  #*‡" [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 "\ 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'." "r\nP"]) (defalias 'sc-uncite-region #[(start end) "À ˆÁ\n!†\n ÅÆ!ˆÇ  #)‡" [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 "\ Uncite a region delineated by START and END. First runs `sc-pre-uncite-hook'." "r"]) (defalias 'sc-recite-region #[(start end) "À ˆ)à ˆÄ !†ÈÉ!ˆÊ  #)‡" [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 "\ Recite a region delineated by START and END. First runs `sc-pre-recite-hook'." "r"]) (defalias 'sc-hdr #[(prefix field &optional sep return-nil-p) ";ƒÁ˜„\n †ÁQ‡ ?…Á‡" [field "" prefix sep return-nil-p] 3 "\ 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-whofrom #[nil "ÀÂÃ!)‡" [nil sc-mumble sc-mail-field "from"] 2 "\ Return the value of (sc-mail-field \"from\") or nil."]) (defun sc-no-header nil "\ Does nothing. Use this instead of nil to get a blank header." nil) (defalias 'sc-no-blank-line-or-header #[nil "o?…&l…&ÀyˆÁ\n!„ Ä=…&Å …&ÆyˆÇÉ )‡" [-1 looking-at mail-header-separator major-mode mh-letter-mode mh-in-header-p nil t kill-lines-magic kill-line] 2 "\ Similar to `sc-no-header' except it removes the preceeding blank line."]) (defalias 'sc-header-on-said #[nil "ÀÁ \n… ÅÆÇÈ!É#\nʱ*‡" ["" sc-whofrom whofrom sc-mumble sc-reference-tag-string sc-hdr "On " sc-mail-field "date" ", " " said:\n"] 5 "\ \"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-inarticle-writes #[nil "ÀÁÂ! … ÆÇÁÈ!É# ʱ*‡" ["" sc-mail-field "from" whofrom sc-mumble sc-reference-tag-string sc-hdr "In article " "message-id" ", " " writes:\n"] 5 "\ \"In article , writes:\" Treats \"message-id\" and \"from\" fields similar to `sc-header-on-said'."]) (defalias 'sc-header-regarding-adds #[nil "ÀÁ \n… ÅÆÇÈ!É#\nʱ*‡" ["" sc-whofrom whofrom sc-mumble sc-reference-tag-string sc-hdr "Regarding " sc-mail-field "subject" "; " " adds:\n"] 5 "\ \"Regarding ; adds:\" Treats \"subject\" and \"from\" fields similar to `sc-header-on-said'."]) (defalias 'sc-header-attributed-writes #[nil "ÀÁ \n…2 ÅÆÇÈ!É#ÅÀÇÊ!Ë#ÅÌÇÍ!ÎÏ$†/ÅÌÇÐ!ÎÏ$†/Àѱ*‡" ["" 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 "\ \"\" ==

writes: Treats these fields in a similar manner to `sc-header-on-said'."]) (defalias 'sc-header-author-writes #[nil "ÀÁ \n… ÅÀÆÇ!\"ȱ*‡" ["" sc-whofrom whofrom sc-mumble sc-reference-tag-string sc-hdr sc-mail-field "sc-author" " writes:\n"] 5 "\ writes:"]) (defalias 'sc-header-verbose #[nil "ÀÁ \n …zÆ ÇPÈÉ!Ê#Æ ÈË!ÌÍ$†# Ì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 "\ Very verbose, some say gross."]) (defconst sc-electric-bufname " *sc-erefs* " "\ Supercite electric reference mode's buffer name.") (defvar sc-eref-style 0 "\ Current electric reference style.") (defalias 'sc-valid-index-p #[(index) "À !… \nGW… ‡" [natnump index sc-rewrite-header-list] 2 "\ Returns INDEX if it is a valid index into `sc-rewrite-header-list'. Otherwise returns nil."]) (defalias 'sc-eref-insert-selected #[(&optional nomsg) " 8ÃÄÅ)‡" [sc-eref-style sc-rewrite-header-list ref err (byte-code "À !ˆÂed\" †ÅÆ ‰È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 "\ Insert the selected reference header in the current buffer. Optional NOMSG, if non-nil, inhibits printing messages, unless an error occurs."]) (defalias 'sc-electric-mode #[(&optional arg) " !† !†ÅÇ!ˆŠÉ‹ˆ)ƒ#Ê ˆË!)‡" [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Ë !ˆÍ!ˆÏÐ!ˆÑ ˆ,À‡" [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 "\ 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-eref-show #[(index) "À GÄ !ƒ ‚> ÆWƒ(ƒ\nS‚>È É\"ˆÆ‚> \nY…>ƒ7Æ‚>È Ê\"ˆ\nS Š qˆÍÏ ˆ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 "\ Show reference INDEX in `sc-rewrite-header-list'."]) (defalias 'sc-eref-next #[nil "À T!‡" [sc-eref-show sc-eref-style] 2 "\ Display next reference in other buffer." nil]) (defalias 'sc-eref-prev #[nil "À S!‡" [sc-eref-show sc-eref-style] 2 "\ Display previous reference in other buffer." nil]) (defalias 'sc-eref-setn #[nil "ÂÃ\"‡" [sc-eref-style sc-preferred-header-style message "Preferred reference style set to header %d."] 3 "\ Set reference header selected as preferred." 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 "\ Show reference style indexed by REFNUM. If REFNUM is an invalid index, don't go to that reference and return nil." "NGoto Reference: "]) (defalias 'sc-eref-jump #[nil "À !‡" [sc-eref-show sc-preferred-header-style] 2 "\ Set reference header to preferred header." nil]) (defalias 'sc-eref-abort #[nil "À ‡" [nil sc-eref-style exit-recursive-edit] 1 "\ Exit from electric reference mode without inserting reference." nil]) (defalias 'sc-eref-exit #[nil "À ‡" [exit-recursive-edit] 1 "\ Exit from electric reference mode and insert selected reference." nil]) (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 "\ 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." "P"]) (defalias 'sc-raw-mode-toggle #[nil "? ? ˆÃÄ !‡" [sc-fixup-whitespace-p sc-auto-fill-region-p sc-set-mode-string set-buffer-modified-p buffer-modified-p] 2 "\ Toggle, in one fell swoop, two important SC variables: `sc-fixup-whitespace-p' and `sc-auto-fill-region-p'" 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 "\ 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-set-variable #[(var) "À ÅÆÇ \"!Lˆ*È ‡" [(funcall myhelp) minibuffer-help-form #[nil "ÀÁ\n!ˆÃ\n!ƒÄÆÇ!ˆÁ\nJ!ˆÆÈ!ˆ)ÆÉ!ˆÆÊ\nË\"ÌÍO!ˆÍ‘‡" ["*Help*" prin1 var boundp 20 print-length princ " (Current value: " ")" "\n\nDocumentation:\n" documentation-property variable-documentation 1 nil] 5] myhelp var eval-minibuffer format "Set %s to value: " sc-set-mode-string] 5 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"‡" [defalias sc-toggle-symbol (macro . #[(rootname) "ÀÁ P!ÄÅCÆÇÁÈ ÉQ!DD¯‡" [defun intern "sc-T-" rootname nil interactive sc-toggle-var quote "sc-" "-p"] 10]) sc-setvar-symbol (macro . #[(rootname) "ÀÁ P!ÄÅCÆÇÁÈ P!DD¯‡" [defun intern "sc-S-" rootname nil interactive sc-set-variable quote "sc-"] 9]) sc-T-confirm-always #[nil "ÀÁ!‡" [sc-toggle-var sc-confirm-always-p] 2 nil nil] sc-T-downcase #[nil "ÀÁ!‡" [sc-toggle-var sc-downcase-p] 2 nil nil] sc-T-electric-references #[nil "ÀÁ!‡" [sc-toggle-var sc-electric-references-p] 2 nil nil] sc-T-auto-fill-region #[nil "ÀÁ!‡" [sc-toggle-var sc-auto-fill-region-p] 2 nil nil] sc-T-mail-nuke-blank-lines #[nil "ÀÁ!‡" [sc-toggle-var sc-mail-nuke-blank-lines-p] 2 nil nil] sc-T-nested-citation #[nil "ÀÁ!‡" [sc-toggle-var sc-nested-citation-p] 2 nil nil] sc-T-electric-circular #[nil "ÀÁ!‡" [sc-toggle-var sc-electric-circular-p] 2 nil nil] sc-T-use-only-preferences #[nil "ÀÁ!‡" [sc-toggle-var sc-use-only-preferences-p] 2 nil nil] sc-T-fixup-whitespace #[nil "ÀÁ!‡" [sc-toggle-var sc-fixup-whitespace-p] 2 nil nil] sc-S-preferred-attribution-list #[nil "ÀÁ!‡" [sc-set-variable sc-preferred-attribution-list] 2 nil nil] sc-S-preferred-header-style #[nil "ÀÁ!‡" [sc-set-variable sc-preferred-header-style] 2 nil nil] sc-S-mail-nuke-mail-headers #[nil "ÀÁ!‡" [sc-set-variable sc-mail-nuke-mail-headers] 2 nil nil] sc-S-mail-header-nuke-list #[nil "ÀÁ!‡" [sc-set-variable sc-mail-header-nuke-list] 2 nil nil] sc-S-cite-region-limit #[nil "ÀÁ!‡" [sc-set-variable sc-cite-region-limit] 2 nil nil]] 3) (defalias 'sc-T-describe #[nil "ÀÁ!‡" [describe-function sc-T-describe] 2 "\ 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}" nil]) (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 "\ Update the minor mode string to show state of Supercite."]) (defalias 'sc-cite-original #[nil "ÀÁ!ˆ\nƒ Ã\n \"ˆÅÆ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 "\ 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-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 "\ Like `open-line', but insert the citation prefix at the front of the line. With numeric ARG, inserts that many new lines." "p"]) (defalias 'sc-insert-citation #[(arg) "ŠÀyˆÁ !ƒÁÃ!„ :ƒÅÆ!c‚ ÇÈ!)‡" [0 looking-at sc-cite-regexp "^[ ]*$" arg sc-mail-field "sc-citation" error "Line is already cited."] 2 "\ Insert citation string at beginning of current line if not already cited. With `\\[universal-argument]' insert citation even if line is already cited." "P"]) (defalias 'sc-version #[(arg) "ÀÁ\n\" :„t„Å ±‚Æ !)‡" [format "Using Supercite.el %s" sc-version verstr arg "`sc-version' says: " message] 3 "\ 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." "P"]) (defalias 'sc-describe #[nil "ÀÁ!‡" [describe-function sc-describe] 2 "\ Supercite is a package which provides a flexible mechanism for citing email and news replies. Please see the associated texinfo file for more information." nil]) (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 "\ Submit a bug report on Supercite via mail." nil]) (byte-code "ÀÁ!ˆÂÃ!‡" [provide supercite run-hooks sc-load-hook] 2) emacs-19.22/lisp/swedish.elc100666 12241 1 4175 5416175036 14711 0ustar rolanddaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:05:49 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/swedish.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote iso-syntax)) (defvar swedish-re "[ \n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \n.,?!:;'\")}]" "\ Regular expression for common Swedish words.") (defvar swascii-to-8859-trans (byte-code "ÀÁÂ\"à ÁWƒ ‰Iˆ T‰‚ ÆÇ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) "\ Trans table from SWASCII to 8859.") (defalias 'swascii-to-8859-buffer #[nil "ÀÂed #)‡" [nil buffer-read-only translate-region swascii-to-8859-trans] 4 "\ Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1. Works even on read-only buffers. `$' and `@' are not converted." nil]) (defalias 'swascii-to-8859-buffer-maybe #[nil "À ÄÀ#… Å )‡" [t case-fold-search re-search-forward swedish-re nil swascii-to-8859-buffer] 4 "\ Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii. Leaves point just after the word that looks Swedish." 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) (defvar 8859-to-swascii-trans (byte-code "ÀÁÂ\"à ÁWƒ ‰Iˆ T‰‚ ÆÇ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) "\ 8859 to SWASCII trans table.") (defalias '8859-to-swascii-buffer #[nil "Àed #‡" [translate-region 8859-to-swascii-trans] 4 "\ Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii." "*"]) (byte-code "ÀÀÃÄ!‡" [8859-to-swascii-buffer mail-send-hook news-inews-hook provide swedish] 2) emacs-19.22/lisp/tabify.elc100666 13437 1 2557 5475265474 14210 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Thu Nov 25 21:34:34 1993 ;;; from file /home/fsf/rms/e19/lisp/tabify.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'untabify #[(start end) "ŠŒe}ˆ bˆÂÃÄÅ#…)`iÄÃÄxˆ `|ˆjˆ+‚ *‡" [end start search-forward " " nil t indent-tabs-mode column] 4 "\ 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." "r"]) (defalias 'tabify #[(start end) "ŠŒ }ˆbˆÂÃÄÅ#…$iÅÈ”`|ˆjˆ*‚ *‡" [start end re-search-forward "[ ][ ][ ]*" nil t indent-tabs-mode column 0] 4 "\ 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." "r"]) (provide (quote tabify)) emacs-19.22/lisp/tar-mode.elc100666 74777 1 56064 5432507035 14464 0ustar ericdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Thu Aug 12 14:38:21 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/tar-mode.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (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 "\ *Whether 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.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂÀÆ!„)ÂÇÁÈÉ#ˆÇÃÈÉ#ˆÇÄÈÉ#ˆÇÅÈÉ#‡" [boundp tar-parse-info nil tar-header-offset tar-superior-buffer tar-superior-descriptor tar-subfile-mode put permanent-local t] 4) (defalias 'tar-setf '(macro . #[(form val) "À ÂÃ!… \"‰9ƒÅ E‚^ :„$ÇÈ \"‚^ @É=ƒ8Ê A@Ë 8F‚^ @Ì=ƒIÍ A@E‚^ @Î=ƒZÏ A@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 "\ A mind-numbingly simple implementation of setf."])) (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 "\ syntax: (dolist (var-name list-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 "\ syntax: (dolist (var-name count-expr &optional return-value) &body body)"])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"ˆÀßà\"ˆÀáâ\"ˆÀãä\"ˆå&åç\\‰(é\\‰*é\\‰+é\\‰,í\\‰.í\\‰/é\\‰0ñ\\‰2ç\\‰3é\\‰4õ\\‰6õ\\‰7é\\‰8é\\9À‡" [defalias make-tar-header (macro . #[(name mode uid git size date ck lt ln magic uname gname devmaj devmin) "À \n  \n   ¯‡" [vector name mode uid git size date ck lt ln magic uname gname devmaj devmin] 15]) tar-header-name (macro . #[(x) "À ÂE‡" [aref x 0] 3]) tar-header-mode (macro . #[(x) "À ÂE‡" [aref x 1] 3]) tar-header-uid (macro . #[(x) "À ÂE‡" [aref x 2] 3]) tar-header-gid (macro . #[(x) "À ÂE‡" [aref x 3] 3]) tar-header-size (macro . #[(x) "À ÂE‡" [aref x 4] 3]) tar-header-date (macro . #[(x) "À ÂE‡" [aref x 5] 3]) tar-header-checksum (macro . #[(x) "À ÂE‡" [aref x 6] 3]) tar-header-link-type (macro . #[(x) "À ÂE‡" [aref x 7] 3]) tar-header-link-name (macro . #[(x) "À ÂE‡" [aref x 8] 3]) tar-header-magic (macro . #[(x) "À ÂE‡" [aref x 9] 3]) tar-header-uname (macro . #[(x) "À ÂE‡" [aref x 10] 3]) tar-header-gname (macro . #[(x) "À ÂE‡" [aref x 11] 3]) tar-header-dmaj (macro . #[(x) "À ÂE‡" [aref x 12] 3]) tar-header-dmin (macro . #[(x) "À ÂE‡" [aref x 13] 3]) make-tar-desc (macro . #[(data-start tokens) "À \nE‡" [cons data-start tokens] 3]) tar-desc-data-start (macro . #[(x) "À D‡" [car x] 2]) tar-desc-tokens (macro . #[(x) "À D‡" [cdr x] 2]) 0 tar-name-offset 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] 4) (defalias 'tokenize-tar-header-block #[(string) "GÁWƒ ‡ÃHÃUƒÄHÃU„' SS S\n S  HSO‰ј†EÒ˜ÂÕ×#ƒ_ÕS^×#ƒqÕS^×#ƒƒ\nÕS^\n× #ƒ• ÕS^ OÃU†¨ÚU?…°ÚZ‰„Á×Û\"ƒÁÜÝÞ S#Þ S#Þ !S#Þ!\"S#Þ\"#S#Þ# S#O‰…\nO…  OÞ $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-chk-offset tar-dmin-offset tar-end-offset empty-tar-block] 19 "\ Return a `tar-header' structure. This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias tar-parse-octal-integer #[(string &optional start end) "„Á\n„ G HÁUƒÁ‡Á\nWƒ< HÅWƒ+ ‚4 Æ_ HÅZ\\T‰‚ )‡" [start 0 end string n 48 8] 4] 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]] 3) (defalias 'checksum-tar-header-block #[(string) "‰Â\\ÄÄÄ Wƒ\" H\\T‰‚ ‰ÈWƒ< H\\T‰‚& É\\,‡" [tar-chk-offset chk-field-start 8 chk-field-end 0 sum i string 512 256] 4 "\ Compute and return a tar-acceptable checksum for this block."]) (defalias 'check-tar-header-block-checksum #[(hblock desired-checksum file-name) "Á\n!U?…à ˆÄÅ\"‡" [desired-checksum checksum-tar-header-block hblock beep message "Invalid checksum for file %s!" file-name] 3 "\ Beep and print a warning if the checksum doesn't match."]) (defalias 'recompute-tar-header-block-checksum #[(hblock) "À !ÃÄ\n\"‰G ÇÈIˆ ÉÊIˆÈ    Wƒ? Í Z  ZÎZHIˆ T‰ ‚ - ‡" [checksum-tar-header-block hblock chk format "%6o" chk-string l 154 0 155 32 i _dotimes_end_ 153 1] 6 "\ Modifies the given string to have a valid checksum field."]) (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 "\ Write a \"-rw--r--r-\" representing MODE into STRING beginning at START."]) (defalias 'summarize-tar-header-block #[(tar-hblock &optional mod-p) "ÁHÂHÃHÄHÅHÆHÇHÈHÉHÊHËH  ÆËËËÃ\\S‰\\\\‰\\ßG ƒp GÈ\\‚qÁ\\\\à\"!ÊH\"!Á#ƒˆä‚‰àIˆ!Â\"å=„œ\"Á=ƒ æ‚ \"Â=ƒ«ç‚ \"Ã=ƒ¶è‚ \"Ä=ƒÁé‚ \"Ç=ƒÌê‚ \"È=ƒ×ë‚ \"É=ƒâì‚ \"í=ƒíä‚ \"î=ƒøï‚ \"ð=ƒñ‚ \"ò=… óIˆô!Ã#ˆGÁUƒ$õ!‚&GÁUƒ7õ!‚9õ!SG^Á6767Wƒq!6Z‰G6ZÂZHIˆ6T‰6‚O*!TøIˆSG^Á6767Wƒ§!Ã\\6\\6HIˆ6T‰6‚ˆ*G^Á6767Wƒ×!6Z‰G6ZÂZHIˆ6T‰6‚µ*GÁ6767Wƒÿ!6\\6HIˆ6T‰6‚â* Â=„ Ã=ƒrÄÁ6767WƒC!G6Â\\\\\\ ÂUƒ4ù‚5ú6HIˆ6T‰6‚* GÁ6767Wƒq!G6È\\\\\\ 6HIˆ6T‰6‚N*!.‡" [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 datew slash lastdigit 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 i _dotimes_end_ 47 "==>" "-->"] 13 "\ Returns a line similar to the output of `tar -vtf'."]) (defalias 'tar-summarize-buffer #[nil "ÀÁ!ˆÂÄÄÆ ÇZ]ÄÉ¥]\n  Ì=„– ‰Í\\{Ï! Í\\ÀÐ \n¥\"ˆ Ì=„’ „KÑÒ!ˆ ÓHÔ=ƒX Í\\ ÕH‰×WƒnÑØ ×H#ˆ  B B ÓH„‘×Vƒ‘ Ù‰SÚ\"Û\"Í\\\\))‚ÜÝ!ˆ Ÿ-ŠebˆÂƒÉ@ áâ A!!ˆáã!ˆA)‚ª)Üä!ˆ`$Ä$}ˆåÂ!ˆ*Àæ!‡" [message "parsing tar file..." nil result 1 pos buffer-size 1024 bs 100 bs100 tokens empty-tar-block 512 hblock tokenize-tar-header-block "parsing tar file...%s%%" error "premature EOF parsing tar file." 7 20 4 size 0 "%s has size %s - corrupted." ash -9 9 make-local-variable tar-parse-info buffer-read-only _dolist_iterator_ tar-desc insert-string summarize-tar-header-block "\n" tar-header-offset set-buffer-modified-p "parsing tar file...done."] 6 "\ 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)."]) (defvar tar-mode-map nil "\ *Local keymap for tar-mode listings.") (byte-code "„Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊÉ#ˆÃËÌ#ˆÃÍÌ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÅ#ˆÃÓÅ#ˆÃÔÕ#ˆÃÖ×#ˆÃØ×#ˆÃÙÚ#ˆÃÛÜ#ˆÃÝÞ#ˆÃßà#ˆÃáâ#ˆÃãÕ#ˆÃäå#ˆÃæç#ˆÃèé#ˆÃêë#ˆÃìíîí!B#ˆÃïð#ˆÃñò#ˆÃóô#ˆÃõö#ˆÃ÷øîø!B#ˆÃùú#ˆÃûü#ˆÃýþ#ˆÃÿ@î@!B#ˆÃAB#ˆÃCD#ˆÃEF#ˆÃGH#ˆÃIJ#ˆÃKL#ˆMNOP#ˆMQOP#‡" [tar-mode-map make-keymap suppress-keymap define-key " " tar-next-line "c" tar-copy "d" tar-flag-deleted "" "e" tar-extract "f" "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-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) (defalias 'tar-mode #[nil "À ˆÁÂ!ˆÁÃ!ˆÁÄ!ˆÅÁÆ!ˆÇÁÈ!ˆÅÉ\nË Í!ˆÏÐ!ˆ~ˆÑÂ!ƒA\nƒAÒ\n}ˆ‚DÓ ˆÔÕ!‡" [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 tar-mode major-mode "Tar" mode-name use-local-map tar-mode-map auto-save-mode 0 boundp 1 tar-summarize-buffer run-hooks tar-mode-hook] 2 "\ 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. 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-subfile-mode #[(p) "ÀÁ!ƒ\n „ÂÃ!ˆÄ ž„Æ ÇC\"ÈÄ!ˆ „( ?‚.Ê !ËV‰ƒEÈÌ!ˆÍ ÎÏ!ˆÏÑÒ!‡ÓÌ!‡" [boundp tar-superior-buffer error "This buffer is not an element of a tar file" tar-subfile-mode minor-mode-alist append (tar-subfile-mode " TarFile") make-local-variable 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] 4 "\ Minor mode for editing an element of a tar-file. This mode redefines C-x C-s to save the current buffer back into its associated tar-file buffer. You must save that buffer to actually save your changes to disk." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias tar-mode-revert #[(&optional no-autosave no-confirm) "ÀÀÃÄ \"ˆ~ˆ)Æ ‡" [nil tar-header-offset revert-buffer-function revert-buffer t no-confirm tar-mode] 3] tar-next-line #[(p) "yˆm?…\nÁu‡" [p 36] 1 nil "p"] tar-previous-line #[(p) "À [!‡" [tar-next-line p] 2 nil "p"]] 3) (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 "\ Return the tar-descriptor of the current line, or signals an error."]) (defalias 'tar-extract #[(&optional other-window-p) "Á=à ‰A‰ÆH ÈH ÊH @ Í\\\\‰ \\ ƒiÐÑ Ò=ƒ:Ó‚g Ô=ƒEÕ‚g Ö=ƒPׂg Ø=ƒ[Ù‚g Ú=ƒfÛ‚gÜ\"ˆ ÆUƒtÐÝ!ˆpß!àáßâ !ã°$%†Ž\n&ç$!(é*(„îë$!(ì*íŽ~ˆŠ(qˆî#ˆÆbˆï!ˆð ˆïé!ˆñ$!ˆòó!ˆòô!ˆ3 4õö!ˆ&%÷é!ˆ)qˆ)\nƒø(!ˆ*…ù‰:‚û=ƒü(!‚ƒý(!‚þ(!. ‡" [other-window-p view view-p tar-current-descriptor descriptor tokens 0 name 4 size 7 link-p tar-header-offset -1 start end 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" "This is a zero-length file." tar-buffer file-name-nondirectory " (" " in " buffer-file-name ")" 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 set-visited-file-name 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] 7 "\ *In Tar mode, extract this entry of the tar file into its own buffer." nil]) (defalias 'tar-extract-other-window #[nil "ÀÁ!‡" [tar-extract t] 2 "\ *In Tar mode, find this entry of the tar file in another window." nil]) (defalias 'tar-display-other-window #[nil "ÀÁ!‡" [tar-extract display] 2 "\ *In Tar mode, display this entry of the tar file in another window." nil]) (defalias 'tar-view #[nil "ÀÁ!‡" [tar-extract view] 2 "\ *In Tar mode, view the tar file entry on this line." nil]) (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 "\ Read a file name with this line's entry as the default."]) (defalias 'tar-copy #[(&optional to-file) "À ‰A‰ÃH\nÅH\nÇH @ Ê\\\\‰ \\ ƒ,ÍÎ!ˆÃUƒ7ÍÏ!ˆpÑÓŽÔÕ!~ˆŠqˆÖ  #ˆ×Ñ!ˆØ!ˆÚÛ #ˆq. ‡" [tar-current-descriptor descriptor tokens 0 name 4 size 7 link-p tar-header-offset -1 start end error "This is a link, not a real file." "This is a zero-length file." tar-buffer nil buffer ((byte-code "À }ˆ\nƒ Ã\n!ˆÀ‡" [1 tar-header-offset buffer kill-buffer] 2)) generate-new-buffer "*tar-copy-tmp*" insert-buffer-substring set-buffer-modified-p write-file to-file message "Copied tar entry %s to %s"] 5 "\ *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." (list (tar-read-file-name))]) (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 "\ *In Tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files." "p"]) (defalias 'tar-unflag #[(p) "À Â\"‡" [tar-flag-deleted p t] 3 "\ *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." "p"]) (defalias 'tar-unflag-backwards #[(p) "À [Â\"‡" [tar-flag-deleted p t] 3 "\ *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." "p"]) (defalias 'tar-expunge-internal #[nil "À ‰A @\nÄH\nÆH\nÈH @\n  >A  ƒ*ÄÄyˆ` ΈÎuˆ` Z `|ˆZ*Ñ  \" ~ˆ\nÒ\\\\‰Ô‰Õ\\Ö\"×\"Ø\\\\|ˆZ ƒ—@‰‰@Z ˆA)‚|. Ý}‡" [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 "\ Expunge the tar-entry specified by the current line."]) (defalias 'tar-expunge #[(&optional noconfirm) "„\nÁÂ!…CÊÃbˆm„)ÅÆ!ƒ#Ç ˆ T‚Èyˆ‚É ˆÈ\n}ˆ) ÃUƒ>ËÌ!‚BËÍ \")‡" [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 expunged. Be sure to save this buffer."] 3 "\ *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." nil]) (defalias 'tar-clear-modification-flags #[nil "ŠÀbˆ` W…ÂÃ!ƒÄÅ!ˆÆcˆÅyˆ‚)‡" [0 tar-header-offset looking-at "*" delete-char 1 " "] 2 "\ Remove the stars at the beginning of each line."]) (defalias 'tar-chown-entry #[(new-uid) ";ƒÁ AÂIˆÃ Å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 "\ *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." (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)))))]) (defalias 'tar-chgrp-entry #[(new-gid) ";ƒÁ AÂIˆÃ Å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 "\ *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." (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)))))]) (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 "\ *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." (list (read-string "New name: " (tar-header-name (tar-desc-tokens (tar-current-descriptor)))))]) (defalias 'tar-chmod-entry #[(new-mode) "À AÁ\nIˆÃ ÅÆ\n\"ÇÈOÉP\"‡" [tar-current-descriptor 1 new-mode tar-alter-one-field tar-mode-offset format "%6o" 0 6 " "] 5 "\ *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." (list (tar-parse-octal-integer-safe (read-string "New protection (octal): ")))]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias tar-alter-one-field #[(data-position new-data-string) "À ‰AÃŽŠÄyˆ`Æyˆ `|ˆÇ\n!ȱˆd )~ˆ @ Ê\\\\‰  \\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 summarize-tar-header-block "\n" tar-header-offset -513 start data-position new-data-string checksum-tar-header-block 512 chk tar-chk-offset 8 format "%6o" 32 6 check-tar-header-block-checksum] 6] 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]] 3) (defalias 'tar-subfile-save-buffer #[nil "ÀÁ!ƒ\n „ÂÃ!ˆÀÄ!ƒ „ÂÅ!ˆŠpÆ  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þ!ˆ qˆBù!ˆCDE !\"ˆ,þ‡" [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 checksum-tar-header-block chk tar-chk-offset 8 "%6o" 6 position 1 next-line make-marker nil m p insert-before-markers summarize-tar-header-block t "\n" marker-position tar-pad-to-blocksize set-buffer-modified-p message "saved into tar-buffer \"%s\" - remember to save that buffer!" buffer-name] 6 "\ 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." nil]) (defalias 'tar-pad-to-blocksize #[nil "??…~ˆ GS 8‰@\nA‰ÅH‰ƒ!Ç‚$ ÈH  \\\nËÌ\"‰ ‰\nS ¥_\\φGÇ\n\\bˆÒ T†UÇ\\Vƒl†bÇ\\Ò T|‚}Ó†sÇ\\Ò 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 nil buffer-read-only tar-header-offset buffer-size make-string] 5 "\ If we are being anal about tar file blocksizes, fix up the current buffer. Leaves the region wide."]) (defalias 'maybe-write-tar-file #[nil "Á=…%ÂÃ!…% …%ÄŽŠÅ ˆ~ˆÆ Ç TÉÊ%ˆ*ʇ" [major-mode tar-mode boundp tar-header-offset ((narrow-to-region 1 tar-header-offset)) tar-clear-modification-flags write-region buffer-size buffer-file-name nil t] 6 "\ Used as a write-file-hook to write tar-files out correctly."]) (byte-code "À >„\nÀ BÂÃ!‡" [maybe-write-tar-file write-file-hooks provide tar-mode] 2) emacs-19.22/lisp/tcp.elc100666 13437 1 2720 5433753610 13474 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Mon Aug 16 14:52:56 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/tcp.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (provide (quote tcp)) (defvar tcp-program-name "tcp" "\ *The name of the program emulating open-network-stream function.") (defalias 'open-network-stream #[(name buffer host service) "À \n ;ƒ ‚Æ !%È!ˆ)‡" [start-process name buffer tcp-program-name host service int-to-string proc process-kill-without-query] 7 "\ 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."]) emacs-19.22/lisp/telnet.elc100666 13437 13 12210 5474623060 13752 0ustar jimbuser;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:15:26 1993 ;;; from file /home/fsf/rms/e19/lisp/telnet.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ ÄÂÅ!„ÆÂÇ!„ÈÂÉ!„&Æ ÊÂË!„0Ì ÍËÎÏ#ˆË!ˆÊÂÐ!„CÑÍÐÎÒ#ˆÐ!‡" [require comint boundp telnet-new-line " " telnet-mode-map nil telnet-prompt-pattern "^[^#$%>]*[#$%>] *" 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) (defvar telnet-count 0 "\ Number of output strings from telnet process while looking for password.") (make-variable-buffer-local (quote telnet-count)) (defvar telnet-rsh-program (byte-code "Á>ƒ‡Ç" [system-type (hpux usg-unix-v) "remsh" "rsh"] 2) "\ Program to run for opening a remote shell.") (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 for the again for a username and password.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆ„6È !ÊËÌ#ˆÊÍÅ#ˆÊÎÁ#ˆÊÏÃ#ˆÀ‡" [defalias telnet-interrupt-subjob #[nil "ÀÁ\n\"‡" [send-string nil telnet-interrupt-string] 3 nil nil] telnet-c-z #[nil "ÀÁÂ\"‡" [send-string nil ""] 3 nil nil] send-process-next-char #[nil "ÀÁÂÃÅ Á)!\"‡" [send-string nil char-to-string t inhibit-quit read-char quit-flag] 5 nil nil] telnet-mode-map copy-keymap comint-mode-map define-key " " telnet-send-input "" "" ""] 4) (defalias 'telnet-check-software-type-initialize #[(string) "ÀÂà \"ƒ Ç‚6ÂÉ \"ƒÊ‚6ÂË \"ƒ,Ì‚6ÂÍ \"ƒ6Î)‰‡" [t case-fold-search string-match "unix" string comint-prompt-regexp telnet-prompt-pattern "\n" telnet-new-line "tops-20" "[@>]*" "its" "^[^*>]*[*>] *" "explorer" 10 telnet-replace-c-g] 3 "\ Tries to put correct initializations in. Needs work."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias telnet-initial-filter #[(proc string) "ÀÁ\n\"ƒÃÄ !!ˆÆÇ!‡ÀÈ\n\"ƒ1É \n\"ˆÊ Ì  ÊÏ  P\"*‡Ñ\n!ˆÉ \n\"ˆVƒGÓ É\"‡T‰‡" [string-match "No such host" string kill-buffer process-buffer proc error "No such host." "passw" telnet-filter 0 echo-keystrokes read-password password telnet-count send-string telnet-new-line telnet-check-software-type-initialize telnet-maximum-count set-process-filter] 4] telnet-simple-send #[(proc string) "À \n\"ˆÀ \"‡" [comint-send-string proc string telnet-new-line] 3] telnet-filter #[(proc string) "À !p=… `dUŠÀ !qˆÃ !bˆ`ÅÆÉÊ #‰ƒ>Ì O!ˆT‚Ì ÆO!ˆ* ƒUÎ `Ï $ˆ*\n…\\db)‡" [process-buffer proc at-end process-mark now 0 nil c-m index string-match " " string insert-before-markers telnet-replace-c-g subst-char-in-region 7] 5] telnet-send-input #[nil "À ˆ …\n\n |‡" [comint-send-input telnet-remote-echoes comint-last-input-start comint-last-input-end] 2 nil nil]] 3) (defalias 'telnet #[(host) "ÁPÃÄ\nÄQ!‰ƒÆ !ƒÇÄ\nÄQ!‚HÇÈ\nÉ\"!ˆÊË\n!Ì\"ˆÍË\n!!ˆÎ ˆÏ\nÐÑQ\"ˆÒ ˆÓ‰*‡" [host "-telnet" name get-buffer "*" buffer get-buffer-process switch-to-buffer make-comint "telnet" set-process-filter get-process 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] 6 "\ Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-telnet*. Normally input is edited in Emacs and sent a line at a time." "sOpen telnet connection to host: "]) (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 "\ 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} " nil]) (defalias 'rsh #[(host) "ÀÁ!ˆ\nÃPÅÆ È\n$!ˆÉÊ !Ë\"ˆÌ ˆÍ‰)‡" [require shell host "-rsh" name switch-to-buffer make-comint telnet-rsh-program nil set-process-filter get-process telnet-initial-filter telnet-mode -16 telnet-count] 6 "\ Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-rsh*. Normally input is edited in Emacs and sent a line at a time." "sOpen rsh connection to host: "]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias read-password #[nil "ÀÁÄÅ!ˆÆ ‰Ç>?Áƒ É\n!P‚ *‡" ["" nil tem answ message "Reading password..." read-char (13 10 7) quit-flag char-to-string] 3] provide telnet] 3) emacs-19.22/lisp/term-nasty.elc100666 13437 1 704 5416175206 14771 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:07:34 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/term-nasty.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) emacs-19.22/lisp/terminal.elc100666 13437 1 56767 5416175332 14565 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:08:57 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/terminal.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (require (quote ehelp)) (defvar terminal-escape-char 30 "\ *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 "\ *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.") (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.") (byte-code "ÀÁ!„ÂÀÃ!„Ä „#Å ÇÈÉ#ˆ)ÀÊ!„,Ä\n\n„HÅ ÇËÉ#ˆÇÌ #ˆ\n)ÀÍ!„QÄ  „ÑÅ ÇÎÏ#ˆÐÒHÓXƒ‚ÇÔ#ˆÒÒHTIˆ‚d)ÇÕÖ#ˆÇ×Ø#ˆÇÙÚ#ˆÇÛÜ#ˆÇÝÞ#ˆÇßà#ˆÇáâ#ˆÇãä#ˆÇåæ#ˆÇç(!æ#ˆ )Àé!„ÚÄ))„âê)Àë!„ëÄ++„&Å Çìí#ˆÇç(!î#ˆÇïð#ˆÇÛÜ#ˆÇÝñ#ˆÇòó#ˆ+)Àô!„/Ä4Àõ!„8Ä5Àö!„AÄ6À÷!„JÄ7Àø!„SÄ8Àù!„\\Ä9Àú!„eÄ:Àû!„nÄ;Àü!„wÄ<Àý!„€Ä=Àþ!„‰Ä>Àÿ!„’Ä?@AB\"‡" [boundp terminal-more-break-insertion "*** More break -- Press space to continue ***" terminal-meta-map nil make-sparse-keymap map define-key [t] te-pass-through terminal-map [t] "" terminal-escape-map [t] undefined "0" s 0 57 digit-argument "b" switch-to-buffer "o" other-window "e" te-set-escape-char " " 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-more-old-point te-more-old-local-map te-more-old-filter te-more-old-mode-line-format te-pending-output-info defalias te-escape #[nil "ÀÁ  ÆŽÇ!ˆÉ!ˆÊ ƒ$ÌÍÎ !\"‚%Ï!)ÐÑ!ˆ ÒÓ\"˜ƒCÖ× )‚PØ \"‰…PÙ !+‡" [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 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]] 4) (defalias 'te-escape-help #[nil "ÀÁ!ˆÂ !ÅÆ!)‡" [message "Terminal emulator escape help..." single-key-description terminal-escape-char char with-electric-help #[nil "ÀÁ ‰‰‰%!ˆÀÄÅ!!ˆÀÁÆÇÈ ÊË$È#!ˆÌÍ!ƒ.ÍÎ!Ð\"‚5ÑÎ!Ò\"‰ƒyÔ@A!†EÕ×Ø\"ƒWÙ‰”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 nil 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] 9]] 2 "\ Provide help on commands available after terminal-escape-char is typed." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias te-escape-extended-command #[nil "ÀÂà ÅÀ$)‰…ÇÈ)‡" [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] te-escape-extended-command-unread #[nil "ÀÁ !à ‡" [listify-key-sequence this-command-keys unread-command-events te-escape-extended-command] 2 nil nil]] 3) (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 "\ Change the terminal-emulator escape character." "cSet escape character to: "]) (defalias 'te-stuff-string #[(string) "À \n\"‡" [process-send-string te-process string] 3 "\ 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." "sStuff string: "]) (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 "\ Record output from the terminal emulator in a buffer." (list (if te-log-buffer nil (read-buffer "Record output in buffer: " (format "%s output-log" (buffer-name (current-buffer))) nil)))]) (defalias 'te-tofu #[nil "ÀÁ!‡" [te-set-output-log nil] 2 "\ Discontinue output log." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias te-toggle #[(sym arg) " §„\n ‚! ÂUƒJ?‚! ÃWƒ Ä‚!ÅL‡" [sym arg 1 0 nil t] 3] te-toggle-more-processing #[(arg) "ÀÁ \"ƒ Ä‚ Å!ˆ\n…Ɖ‡" [message te-toggle terminal-more-processing arg "More processing on" "More processing off" -1 te-more-count] 4 nil "p"] te-toggle-scrolling #[(arg) "ÀÁ \"ƒ Ä‚ Å!‡" [message te-toggle terminal-scrolling arg "Scroll at end of page" "Wrap at end of page"] 4 nil "p"]] 3) (defalias 'te-enable-more-processing #[nil "ÀÁ!‡" [te-toggle-more-processing t] 2 "\ Enable ** MORE ** processing" nil]) (defalias 'te-disable-more-processing #[nil "ÀÁ!‡" [te-toggle-more-processing nil] 2 "\ Disable ** MORE ** processing" nil]) (defalias 'te-do-scrolling #[nil "ÀÁ!‡" [te-toggle-scrolling t] 2 "\ Scroll at end of page (yuck)" nil]) (defalias 'te-do-wrapping #[nil "ÀÁ!‡" [te-toggle-scrolling nil] 2 "\ Wrap to top of window at end of page" nil]) (defalias 'te-set-redisplay-interval #[(arg) "Á]‰É‡" [arg 1 terminal-redisplay-interval 0 te-redisplay-count] 3 "\ 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." "NMax number of output chars between redisplay updates: "]) (byte-code "ÀÁÂÃ#ˆÄÁÅ\"‡" [put te-more-break-unread suppress-keymap t defalias #[nil " =ƒ\nÂÃ!‡ÄÅÆ!Ç #ˆÈ Ê ˆË Í )‡" [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]] 4) (defalias 'te-more-break-resume #[nil "ÀÁ!ˆÂ ‡" [message "Continuing from more break" te-more-break-unwind] 2 "\ Proceed past the **MORE** break, allowing the next page of output to appear" nil]) (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 nil 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."] 8]] 2 "\ Provide help on commands available in a terminal-emulator **MORE** break" nil]) (defalias 'te-more-break-advance-one-line #[nil "À ‡" [1 te-more-count te-more-break-unwind] 1 "\ Allow one more line of text to be output before doing another more break." nil]) (defalias 'te-more-break-flush-pending-output #[nil "À ˆÁ ‡" [te-more-break-unwind te-flush-pending-output] 1 "\ Discard any output which has been received by the terminal emulator but not yet processed and then proceed from the more break." nil]) (defalias 'te-flush-pending-output #[nil "A„ ÁÂ!‡Ã ÁÅ \"ˆÆÇÈ \"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 "\ Discard any as-yet-unprocessed output which has been received by the terminal emulator." nil]) (defalias 'te-pass-through #[nil " =ƒ\nÂÃ!‡9ƒÄNƒÄN¨ƒ1ÅÆÇÈ\"\"ÉU„1ÅÊ\"Ë\\¨ƒR ƒE A„EÎÏ!ˆÐÒÇ\"\"ˆÓÔ!‡ÕÖ×!\"‡" [last-input-char terminal-escape-char call-interactively te-escape ascii-character logand lsh 1 23 0 127 128 terminal-more-processing te-pending-output te-set-more-count nil send-string te-process make-string te-process-output t message "Function key `%s' ignored" single-key-description] 5 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„Ç„#È ÉÊË#ˆÌÍÎÏ#‡" [defalias te-set-window-start #[nil "Àp!‰…  ! ?†= `eZ T¥Yƒ#Å e\"‚= d`Z T¥Yƒ<Å d T_ZÆZ\"‚=Ç*‡" [get-buffer-window w window-height h te-width set-window-start -1 nil] 6] te-pending-output-length #[nil "@A ƒ\n @G\\ A‰„\n\n*‡" [te-pending-output tem length] 3] boundp terminal-edit-map nil make-sparse-keymap define-key "" terminal-cease-edit put terminal-edit-mode mode-class special] 4) (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 "\ 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 'te-edit #[nil "À ˆÁ !ˆÃÄ!Å=ƒÆÇ!‡ÆÈÉ!!‡" [terminal-edit-mode set-buffer-modified-p buffer-modified-p 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 "\ Start editing the terminal emulator buffer with ordinary Emacs commands." nil]) (defalias 'terminal-cease-edit #[nil "À~ˆÂ Sebˆ È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 terminal-mode major-mode "terminal" mode-name (": %s") mode-line-process] 6 "\ Finish editing message; switch back to Terminal proper." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias te-more-break #[nil "ÀÁ!ˆÂÃ!ˆ`ÂÄ!ˆÅ Æ!ˆÂÈ!ˆÉ\n!ÂË!ˆ  ÍÏE Ð\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] te-more-break-unwind #[nil "À !ˆÂ \"ˆ bˆÈÉ !ˆÊ m„5 ƒ5Í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 set-buffer-modified-p buffer-modified-p 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] 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]] 3) (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 "\ Move down a line, optionally do more processing, perhaps wrap/scroll, move to start of new line, clear to end of line."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"‡" [defalias te-move-to-position #[nil "À ÁZÀ ÁZ\n V„ V„ e\n T_\\\\bˆ*Ɖ‡" [te-get-char 32 x y te-width te-height -1 te-more-count] 4] te-clear-rest-of-line #[nil "Š`Àˆ`Z`` \\|ˆÂà [\"*‡" [nil n insert-char 32] 3] te-clear-rest-of-screen #[nil "ŠÀ ˆÁˆm?… ÂuˆÁˆ` Z`|ˆÄÅ \"ˆ‚)‡" [te-clear-rest-of-line nil 1 te-width insert-char 32] 3] 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] 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] 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] te-beginning-of-line #[nil "ÀyˆÁ‡" [0 nil] 1] te-backward-char #[nil "n?…ÀÁ!‡" [backward-char 1] 2] te-forward-char #[nil "l?…Àu‡" [1] 1] te-delete #[nil "n?…`S`|ˆÀcˆÁu‡" [32 -1] 2] te-beep #[nil "À ‡" [beep] 1] te-insert-spaces #[nil "`Á ÂZÈ`Z^‰ÅX„!Æ [!ˆbˆÇ \"ˆb*‡" [p te-get-char 32 nil n 0 delete-char insert-char] 4] te-delete-char #[nil "`Á ÂZÈ`Z^‰ÅX„ Æ \"ˆbˆÇ !ˆb*‡" [p te-get-char 32 nil n 0 insert-char delete-char] 4] te-losing-unix (lambda nil) te-output-tab #[nil "`‰Áyˆ`ZÃÄ\nÅ\"Zƈ`Z^\\b+‡" [p 0 x 8 logand 7 nil l] 5]] 3) (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 "\ Move down a line vertically, or scroll at bottom."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"‡" [defalias te-filter #[(process string) "pÁŽÂ !qˆ bˆÅ!ƒ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] te-process-output #[(preemptable) "ÀÂÃˆÄ ‰ Ç!‰=?…+È!p=ƒ É`\"ˆ‚ *‡" [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ˆÐÍ!ˆ‚* =ƒ“ †ŸÑÒ #‰†Ÿ 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] 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] 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] te-update-pending-output-display #[nil "A„\nÁ‚\"à ‰ÅWƒÁ‚!ÆÇ È\\É¥\")ÊË !‡" [te-pending-output "" te-pending-output-info te-pending-output-length length 1500 format "(%dK chars output pending) " 512 1024 set-buffer-modified-p buffer-modified-p] 5] te-sentinel #[(process message) "À !Â=†DÃÄ !!?†DpŠÄ !qˆÆÈ ˆdbˆÉ ˆÊ ˆË ͱˆ) Ä !=…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]] 3) (defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8" "\ Shell command to set terminal modes for terminal emulator.") (defvar explicit-shell-file-name nil "\ *If non-nil, is file name to use for explicitly requested inferior shell.") (defalias 'terminal-emulator #[(buffer program args &optional width height) "À !ˆ\n„ÃÄ !ÅZ„ÇÄ !ÅZÈ ˆ\n \nËÌ \n#ÍDÏÑ ˆ)ÏÓp!‰ƒcÔËÕÖ!\"!ƒX×!ˆ‚;ØÙÖ!\"ˆ‚;)ÚÛ܈Ýß !ˆáâ!ˆãäå&!çåèé*ÏÝ$ë##‡" [switch-to-buffer buffer width window-width selected-window 1 height window-height terminal-mode te-width te-height 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 "ÀÁ\n ƒ Å‚ Æ$ÇÈÉÊËÌ° ÎÏ PBBÑÒpÓÔÀÕ×ØBÛ##%)ÝÞ\"ˆßà\"ˆ)À‡" [format "emacs-virtual:co#%d:li#%d:%s" 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:" termcap "TERM=emacs-virtual" "TERMCAP=" process-environment start-process "terminal-emulator" "/bin/sh" "-c" "%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 " "] 10 "\ 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. Presently with `termcap' only; if somebody sends us code to make this work with `terminfo' we will try to use it." (byte-code "ŠÀÁ!qˆÂÃÄ!ƒ ƒÅ !Æ=„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)]) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#‡" [defalias te-parse-program-and-args #[(s) "ÀÁ\n\"ƒGÃÄ ƒ:ÀÇ\n #ƒ,\n È•OÄ•‰\nG=ƒ2Â2\n ÃOÃB‚ Ÿ‰@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 terminal-mode mode-class special] 4) (defalias 'terminal-mode #[nil "À ˆÁp!ˆÂÄÆÈ È\nËÌ!ˆÍÌ! ËÎ!ˆÍÎ!ËÏ!ˆÍÏ!ËÐ!ˆÍÐ!ËÑ!ˆËÒ!ˆËÓ!ˆËÔ!ˆÕ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 "\ Set up variables for use with the terminal-emulator. One should not call this -- it is an internal function of the terminal-emulator"]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [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] provide terminal] 3) emacs-19.22/lisp/tex-mode.elc100666 13437 1 66765 5474032650 14472 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 21 22:44:39 1993 ;;; from file /home/fsf/rms/e19/lisp/tex-mode.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!‡" [require comint compile] 2) (defvar tex-shell-file-name nil "\ *If non-nil, is file name to use for the subshell in which TeX is run.") (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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (defvar latex-run-command "latex" "\ *Command used to run LaTeX subjob. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (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")) "\ Standard LaTeX block names.") (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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (defvar tex-bibtex-command "bibtex" "\ *Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (defvar tex-dvi-print-command "lpr -d" "\ *Command used by \\[tex-print] to print a .dvi file. If this string contains an asterisk (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string.") (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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string. If two printers are not enough of a choice, you can define the value of tex-alt-dvi-print-command to be 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 (*), it will be replaced by the filename; if not, the name of the file, preceded by blank, will be added to this string. 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] 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.") (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 goes away.") (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 "\ String used by \\[tex-region] to delimit the start of the file's header.") (defvar tex-end-of-header nil "\ String used by \\[tex-region] to delimit the end of the file's header.") (defvar tex-shell-cd-command "cd" "\ Command to give to shell running TeX to change directory. The value of tex-directory will be 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.") (defalias 'tex-define-common-keys #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍÎÍ!B#ˆÀ ÏÐ#ˆÀ ÑÒ#ˆÀ ÓÔ#ˆÀ ÕÖ#ˆÀ ×Ø#ˆÀ ÙÚ#‡" [define-key keymap " " tex-kill-job " " 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 "\ Define the keys that we want defined both in TeX mode and in the tex-shell."]) (defvar tex-mode-map nil "\ Keymap for TeX mode.") (byte-code "„eÁ Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕ#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞß#ˆÃàá#ˆâÍãä#ˆâåãä#ˆâæãç#ˆâèãé#ˆâêãë#ˆâìãí#ˆâîãï#‡" [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 [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) (defvar tex-shell-map nil "\ Keymap for the tex-shell. A comint-mode-map with a few additions.") (byte-code "ÀÁ!„‡" [boundp compare-windows-whitespace nil] 2) (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" "documentstyle{slides}" slitex-mode latex-mode plain-tex-mode tex-default-mode] 4 "\ 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 is used." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias TeX-mode tex-mode LaTeX-mode latex-mode] 3) (defalias 'plain-tex-mode #[nil "À ˆÁà ÇÉ\nË ÍÎÏÐ#‡" [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 "\ 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 calls the value of `text-mode-hook', then the value of `tex-mode-hook', and then the value of `plain-tex-mode-hook'. When the special subshell is initiated, the value of `tex-shell-hook' is called." nil]) (defalias (quote plain-TeX-mode) (quote plain-tex-mode)) (defalias 'latex-mode #[nil "À ˆÁà ÇÉ\nË ÍÎÏÐ#‡" [tex-common-initialization "LaTeX" mode-name latex-mode major-mode latex-run-command tex-command "\\documentstyle" tex-start-of-header "\\begin{document}" tex-end-of-header "\\end{document}\n" tex-trailer run-hooks text-mode-hook tex-mode-hook latex-mode-hook] 4 "\ 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 calls the value of text-mode-hook, then the value of tex-mode-hook, and then the value of latex-mode-hook. When the special subshell is initiated, the value of tex-shell-hook is called." nil]) (defalias 'slitex-mode #[nil "À ˆÁà ÇÉ\nË ÍÎÏÐÑ$‡" [tex-common-initialization "SliTeX" mode-name slitex-mode major-mode slitex-run-command tex-command "\\documentstyle{slides}" tex-start-of-header "\\begin{document}" tex-end-of-header "\\end{document}\n" tex-trailer run-hooks text-mode-hook tex-mode-hook latex-mode-hook slitex-mode-hook] 5 "\ 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 calls the value of `text-mode-hook', then the value of `tex-mode-hook', then the value of `latex-mode-hook', and then the value of `slitex-mode-hook'. When the special subshell is initiated, the value of `tex-shell-hook' is called." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [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 "^[ ]*$\\|^[ \\\\%]" paragraph-separate comment-start "%" comment-start-skip "\\(\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)" comment-indent-function tex-comment-indent compare-windows-whitespace tex-categorize-whitespace tex-command tex-start-of-header tex-end-of-header tex-trailer] 4] tex-comment-indent #[nil "ÀÁ!ƒi‡ÂÃxˆnƒÄ‚iT ]‡" [looking-at "%%%" " " nil 0 comment-column] 2] tex-categorize-whitespace #[(backward-limit) "ÀÁÄ xˆ\nƒRÆÇ!ƒ!È•bˆ À=ƒÉ‚ÆÊ!ƒ> Ë=ƒ5Ì͉‚ ËÈ•bˆ‚ÆÎ!ƒLÌ͉‚ ͉„ ÄÍwˆ Ë=ƒ`É‚a *‡" [null t not-finished category " \n " backward-limit looking-at "[ ]+" 0 space "\n" newline par nil " +"] 3]] 3) (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 "\ 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." "*P"]) (defalias 'validate-tex-buffer #[nil "peÀÄÅÆ!ˆŠqˆÈ ˆ  Ê À )ŠdbˆÍ „—o„—`ÏÐÀÑ#ˆÒ`\"„“ŠÓyˆ`)ÀÀÊyˆ` ƒ^ Ö\n`\"Z‚eÖÓ\"T`Š× qˆebˆÓyˆ B Ø #ˆZuˆÙÚ \"cˆ,)‚\")Šqˆ „¥Ûcˆt…¯ÜÝ G\")‘+‡" [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 "\ 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." nil]) (defalias 'tex-validate-region #[(start end) "À \nZŠÀÅƈ) ƒ bˆÀ‚Ç*‡" [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 "\ 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." "r"]) (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 "\ Insert two newlines, breaking a paragraph for TeX. Check for mismatched braces/$'s in paragraph being terminated. A prefix arg inhibits the checking." "*P"]) (defalias 'tex-insert-braces #[nil "ÀcˆŠÁc)‡" [123 125] 1 "\ Make a pair of braces and be poised to type inside of 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 "\ Creates a matching pair of lines \\begin{NAME} and \\end{NAME} at point. Puts point on a blank line between them." (byte-code "À ˆÁÂÃÄÅ\"\"\"C‡" [barf-if-buffer-read-only completing-read "LaTeX block name: " mapcar list append standard-latex-block-names latex-block-names] 7)]) (defalias 'tex-last-unended-begin #[nil "ÀÁ!…ÂÃ!…Ä ˆ‚‡" [re-search-backward "\\(\\\\begin\\s *{\\)\\|\\(\\\\end\\s *{\\)" looking-at "\\\\end{" tex-last-unended-begin] 2 "\ Leave point at the beginning of the last \\begin{...} that is unended."]) (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 "\ Creates an \\end{...} to match the last unclosed \\begin{...}." "*"]) (defalias 'tex-compilation-parse-errors #[nil "ÀÂÃ!ˆÄÅÆ\"ˆÄÇÆ\"ˆÄÈÆ\"ˆÄÉÆ\"ˆÀ‰‰\n   bˆoƒ.ÎyˆÏÐÀÑ#ƒÎÀ‰‰‰Öyˆ`Î\\bˆ×p!ØcˆÙ ˆÀuˆÚ ‰ šƒk\nU„ÇÛÀxˆÜ ˆÝ ˆÞß!ˆà  š„˜á‰ !…“â! Ö\n ƒÇŠ qˆ\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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias tex-start-shell #[nil "ŠÀÁ\n†ÃÄ!†ÃÅ!†ÆÇ#qˆÈÁ! Ê Ë\"ˆÌ !ˆÍ!Ð!ˆÑ!ˆÒÓ!ˆÔ ÕU…JÖ×!ˆ‚<*‡" [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 copy-keymap comint-mode-map tex-shell-map tex-define-common-keys use-local-map run-hooks tex-shell-hook buffer-size 0 sleep-for 1] 4] 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]] 3) (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 "\ Set BUFFER's default directory to be DIRECTORY."]) (byte-code "ÀÁ!„ÂÃÁ!‡" [boundp tex-send-command-modified-tick 0 make-variable-buffer-local] 2) (defalias 'tex-send-command #[(command &optional file background) "ŠÀ !ÃÄ!ÆÇ\n\" ƒ2ƒ*\nÊO \nTËOQ‚3\nÌ Q‚3\n ƒ<΂=ÏPÑ UƒLÓ !ˆÔ !qˆÕ !bˆcˆÖ ˆÑ ‰-‡" [eval command cmd get-process "tex-shell" proc string-match "\\*" star file 0 nil " " background "&" "" string buffer-modified-tick tex-send-command-modified-tick accept-process-output process-buffer process-mark comint-send-input] 5 "\ 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-delete-last-temp-files #[nil "…#Á!ÃÄ!\n\"‰…\"Æ\n @P!ˆ A‰„Ç*‡" [tex-last-temp-file file-name-directory dir file-name-all-completions file-name-nondirectory list delete-file nil] 4 "\ Delete any junk files from last temp file."]) (add-hook (quote kill-emacs-hook) (quote tex-delete-last-temp-files)) (defalias 'tex-region #[(beg end) "À ƒ Á ˆ‚ ˆ „Ä ÅÆ!ÈÉ\n!!‰ P Í ˆŠŒ~ˆebˆÎyˆ`ee ebˆÓÕ#ƒiÖyˆ`ÓØÕ#ƒfÙyˆ`‚ieÚ^ ÜP؉%ˆÚ] ÜPÕØ%ˆ,qˆà ˆáâ!ˆƒ£á!ˆã \"ˆÚed ÜPÕØ%ˆ+ $å& \"ˆå' \"ˆ (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-delete-last-temp-files 100 default-directory hend hbeg search-end search-forward tex-start-of-header t 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-print-file tex-last-buffer-texed] 7 "\ 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." "r"]) (defalias 'tex-buffer #[nil "Àed\"‡" [tex-region] 3 "\ 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." nil]) (defalias 'tex-file #[nil "À ƒ ÁÀ !‚ÂÃ!ÄÀ !ƒÈ ˆÉ ƒ)Ê ˆ‚,Ë ˆÌ \"ˆÌ\"ˆ*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-last-buffer-texed tex-print-file] 3 "\ 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." nil]) (defalias 'tex-generate-zap-file-name #[nil "ÀÁÂÃÄ!!ÅÆ !#‡" [format "#tz%d%s" process-id get-buffer-process "*tex-shell*" tex-strip-dots system-name] 5 "\ Generate a unique name suitable for use as a file name."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias tex-strip-dots #[(s) "À !Âà \"ƒ Ä”ÅIˆ‚ ‡" [copy-sequence s string-match "\\." 0 45] 3] 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] tex-shell-running #[nil "ÀÁ!… ÂÀÁ!!Ã=‡" [get-process "tex-shell" process-status run] 3]] 3) (defalias 'tex-kill-job #[nil "ÀÁÂ!Ã\"‡" [quit-process get-process "tex-shell" t] 3 "\ Kill the currently running TeX job." 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 "\ 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." "P"]) (defalias 'tex-print #[(&optional alt) "À Â\"Ãpš„ÇÀÈ Â\"‰ \"ƒ É !„)ÊË!‚9Ì ƒ4‚6 Ð#*‡" [tex-append tex-print-file ".dvi" nil test-name print-file-name-dvi tex-last-buffer-texed file-newer-than-file-p buffer-file-name 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 "\ 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'." "P"]) (defalias 'tex-alt-print #[nil "ÀÁ!‡" [tex-print t] 2 "\ Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file]. Runs the shell command defined by tex-alt-dvi-print-command." nil]) (defalias 'tex-view #[nil " )‡" [tex-dvi-view-command tex-dvi-print-command tex-print] 1 "\ 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." nil]) (defalias 'tex-append #[(file-name suffix) ";ƒ:Á!ÂÅ! ÆÇÈ \"O QÊ !„'Ê ËP!ƒ+ ‚8Å! ÆÇÌ \"O Q*‡Í‡" [file-name file-name-nondirectory nil trial-name file file-name-directory 0 string-match "\\." suffix file-exists-p ".aux" "\\.[^.]*$" " "] 6 "\ 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-show-print-queue #[nil "À ƒ Á ˆ‚ ˆÃ !‡" [tex-shell-running tex-kill-job tex-start-shell tex-send-command tex-show-queue-command] 2 "\ Show the print queue that \\[tex-print] put your job on. Runs the shell command defined by `tex-show-queue-command'." nil]) (defalias 'tex-bibtex-file #[nil "À ƒ Á ˆ‚ ˆÃÄÅ !Æ\"ÇÅ ! Ê \"ˆÊ  \"*‡" [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] 3 "\ Run BibTeX on the current buffer's file." nil]) (byte-code "ÀÁ!ˆÂÃ!‡" [run-hooks tex-mode-load-hook provide tex-mode] 2) emacs-19.22/lisp/texinfmt.elc100666 12120 1 126261 5473277202 14461 0ustar rmsdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 19 21:18:41 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/texinfmt.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ÂÃÄ!ˆÃÅ!ˆÀÆ!„Ç„oÈ ÉÊË#ˆÉÌË#ˆÉÍÎ#ˆÉÏÎ#ˆÉÐÑ#ˆÉÒÑ#ˆÉÓÑ#ˆÉÔÑ#ˆÉÕÖ#ˆÉ×Ø#ˆÉÙÑ#ˆÇ‡" [boundp texinfmt-version "2.32 of 19 November 1993" require texinfo texnfo-upd texinfo-format-syntax-table nil make-syntax-table modify-syntax-entry 34 " " 92 64 "\\" 17 91 "." 93 40 41 123 "(}" 125 "){" 39] 4) (defalias 'texinfo-format-buffer #[(&optional notagify) "À !ˆÃ ˆ „-Å Æ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 "\ 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." "P"]) (defvar texinfo-region-buffer-name "*Info Region*" "\ *Name of the temporary buffer used by \\[texinfo-format-region].") (defalias 'texinfo-format-region #[(region-beginning region-end) "ÀÁ!ˆÂ‰‰‰‰‰‰‰‰‰Ã‰‰‰Ä pÃlj \n   ŠŒ~ˆebˆŠßyˆ`) á\" ã#Çyˆ` ƒxá$Âã#Äyˆ`„ebˆáå ã#Äyˆ` Çyˆ`ƒš &^{\n+çè)!!ˆê ˆ\ncˆë &],#ˆhíU„¾îcˆebˆï ˆÀÁ!ˆ ð1!ˆòóÂã#ƒ!` ô P5Äyˆ`ŠÇyˆ`)|ˆÀö5\"ˆŠŒ``÷5!A@\\}ˆebˆòøŠßyˆ`)ã#ƒÄyˆ`ŠÇyˆ`)|ˆ+‚Ðebˆù ˆebˆú ˆdbˆûüÂã#ƒ<`d|ˆhíU„EîcˆÂ=ebˆþÿ!ƒZ`ŠÇyˆ`)|ˆebˆáåŠßyˆ`)ã#ƒ™`Äyˆ`@ AB)C±ˆDEA!!cˆFcˆ)‚¤B)G±ˆHIJ !ƒËKLDJ !!!MQ‚ØNO !MQPQR±ˆebˆS ˆebˆÀT!.‡" [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 "Reading included file: %s" insert-file-contents "^@setfilename" texinfo-raise-lower-sections texinfo-append-refill re-search-backward "^@bye" texinfo-enclosure-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 "\ 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." "r"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias texinfo-format-buffer-1 #[nil "À‰‰‰‰‰‰‰‰‰‰‰‰‰‰ÁÀ‰\np  \n   ÀŠebˆÚÛÀÜ#„PÝÞ!ˆ`ß )à!ˆá ˆâ#!ˆä ˆå !ˆæçè !\"ˆebˆéêÀÜ#ƒÉ` ß P+Áyˆ`Šìyˆ`)|ˆæí+\"ˆŠŒ``î+!A@\\}ˆebˆéïŠðyˆ`)Ü#ƒÅÁyˆ`Šìyˆ`)|ˆ+‚yebˆñ ˆebˆò ˆebˆÚÛ!ˆÁyˆe`|ˆdbˆóôÀÜ#ƒò`d|ˆhõU„ûöcˆ÷ ˆebˆ  ¯.‡" [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 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 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] texinfo-format-convert #[(min max) "bˆÁ Ä#ƒÅÆ!ˆ‚bˆÁÇ Ä#ƒ$ÅÆ!ˆ‚bˆÈÉ Ä#…;Ê”TÊ”Ê\\|ˆ‚'‡" [min search-forward "``" max t replace-match "\"" "''" re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\)" 2] 4]] 3) (defvar texinfo-no-refill-regexp "^@\\(example\\|smallexample\\|lisp\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|menu\\|titlepage\\|iftex\\|tex\\)" "\ Regexp specifying environments in which paragraphs are not filled.") (defvar texinfo-part-of-para-regexp "^@\\(b{\\|bullet{\\|cite{\\|code{\\|emph{\\|equiv{\\|error{\\|expansion{\\|file{\\|i{\\|inforef{\\|kbd{\\|key{\\|lisp{\\|minus{\\|point{\\|print{\\|pxref{\\|r{\\|ref{\\|result{\\|samp{\\|sc{\\|t{\\|TeX{\\|today{\\|var{\\|w{\\|xref{\\)" "\ Regexp specifying @-commands found within paragraphs.") (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 "\ 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-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 "\ 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."]) (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))) "\ *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 (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))) "\ *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.") (byte-code "ÀÁÂ\"ˆÃÄÅÆ#ˆÀÆÇ\"ˆÃÈÅÉ#ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"‡" [defalias texinfo-format-scan #[nil "Àed\"ˆebˆÁÂÃÄ#ƒ—ÅÆ!ƒ8gÇUƒ.`S`T|ˆgÈU„Ècˆ‚ÉÊ!ˆËuˆ‚`S gzÍUƒIËvˆ‚LËuˆ`Ï T{!ÑÒ!\"‰ƒ~A@@Õ A@A@±ˆ bˆ‚“ÖN‰ƒ ˆ‚’Ø ˆ))‚…ªÚ@8bˆÛÜ@@\"‡" [texinfo-format-convert search-forward "@" nil t looking-at "[@{}'` *]" 42 10 delete-char -1 1 texinfo-command-start 119 texinfo-command-end intern texinfo-command-name assoc symbol-name texinfo-enclosure-list enclosure-type texinfo-parse-arg-discard texinfo-format cmd texinfo-unsupported texinfo-stack 2 error "Unterminated @%s"] 5] put begin texinfo-format texinfo-format-begin #[nil "ÀÁ!‡" [texinfo-format-begin-end texinfo-format] 2] end texinfo-format-end #[nil "ÀÁ!‡" [texinfo-format-begin-end texinfo-end] 2] texinfo-format-begin-end #[(prop) "ÀÁ !‰ N‰ƒ ‚Å )‡" [intern texinfo-parse-line-arg texinfo-command-name prop cmd texinfo-unsupported] 3] 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] 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] 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] texinfo-parse-arg-discard #[nil "À Á ˆ‡" [texinfo-parse-line-arg texinfo-discard-command] 2] texinfo-discard-command #[nil " |‡" [texinfo-command-start texinfo-command-end] 2]] 4) (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 "\ Discard braces following command, if any."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆËÌÍÎ#ˆÀÎÏ\"ˆËÐÍÑ#ˆËÒÍÑ#ˆÀÑÓ\"ˆËÔÍÕ#ˆÀÕÖ\"ˆËÔ×Ø#ˆËÙÍÚ#ˆËÛÍÚ#ˆÀÚÜ\"ˆËÝÍÞ#ˆÀÞß\"ˆËàÍá#ˆÀáâ\"ˆËãÍä#ˆËåÍä#ˆËæÍä#ˆËçÍä#ˆËèÍä#ˆËéÍä#ˆËêÍä#ˆËëÍä#ˆËìÍä#ˆÀäí\"ˆËîÍï#ˆËðÍï#ˆËñÍï#ˆËòÍï#ˆËóÍï#ˆËôÍï#ˆËõÍï#ˆËöÍï#ˆË÷Íï#ˆÀïø\"ˆËùÍú#ˆËûÍú#ˆËüÍú#ˆËýÍú#ˆËþÍú#ˆËÿÍú#ˆË@Íú#ˆÀúA\"ˆËBÍC#ˆËDÍC#ˆËEÍC#ˆËFÍC#ˆËGÍC#ˆËHÍC#ˆËIÍC#ˆÀCJ\"ˆÀKL\"ˆËMÍN#ˆÀNO\"ˆËPÍQ#ˆÀQR\"ˆËSÍT#ˆÀTU\"ˆËVÍW#ˆÀWX\"ˆËYÍZ#ˆÀZ[\"ˆË\\Í]#‡" [defalias texinfo-format-parse-line-args #[nil "`SÀ‰‰‰ÆÀwˆl„A`ÇÈ!ˆ`nƒ\" SÉuˆÆÀxˆ`‰ V…4 \n{ B bˆÆÀwˆ‚lƒHÊuˆ` Ÿ-‡" [nil args end beg next start " " re-search-forward "[\n,]" -1 1 texinfo-command-end] 6] texinfo-format-parse-args #[nil "`SÀ‰‰‰ÆÇ!ˆŠÈ`ŠÉÊ!ˆ`S)\"ˆ)hËU„bÌÀwˆ`ÍÎ!ˆ`ÏuˆÌÀxˆ` \nWƒP bˆÆÐ\nÑ#ƒPÒÓ!ˆ‚A\n V…Y \n{ B bˆ‚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] texinfo-format-parse-defun-args #[nil "bˆ`ˆ`Tà “Å `\"ˆÆ ! ‰“ˆ) 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] 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] texinfo-discard-line-with-args #[nil "bˆ`Áyˆ`|‡" [texinfo-command-start 1] 2] put setfilename texinfo-format texinfo-format-setfilename #[nil "À Âà \"ˆÄÅ !!ÇÈÉÊË !ƒ*ÍÎÄË !!!ÏQ‚1ÐÑ !Ï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] node texinfo-format-node nwnode #[nil "À ‰@ A@Ä 8Æ 8È ˆ\n \n—\nË\n \"ƒ.ÍÎ\n\"ˆ‚6\nC B )Ïn„AÑcˆÒÔ\n±ˆ ƒRÕ ±ˆ ƒ[Ö ±ˆƒf×±ˆÑ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 10 "\nFile: " texinfo-format-filename ", Node: " ", Next: " ", Prev: " ", Up: " texinfo-last-node-pos] 5] menu texinfo-format-menu #[nil "À ˆÁc‡" [texinfo-discard-line "* Menu:\n\n"] 1] texinfo-end texinfo-discard-command ref texinfo-format-xref xref #[nil "À  ˆÃcˆ A@†Ä 8‰„%Æ 8„% @DZ‚@ †+ @ȱˆÆ 8ƒ=ÉÆ 8ʱˆ @c*‡" [texinfo-format-parse-args args texinfo-discard-command "*Note " 2 fname 3 "::" ": " "(" ")"] 4] pxref texinfo-format-pxref #[nil "À ˆŠÁuˆÂÃ!)†Äc‡" [texinfo-format-xref -2 looking-at "::" "."] 2] inforef texinfo-format-inforef #[nil "À  ˆ A@ƒà A@ÄÅ 8Æ @±‚'ÃÇÅ 8Æ @ȱ)‡" [texinfo-format-parse-args args texinfo-discard-command "*Note " ": (" 2 ")" "(" "::"] 6] majorheading texinfo-format-chapter chapheading ichapter chapter iappendix appendix iunnumbered top unnumbered #[nil "ÀÁ!‡" [texinfo-format-chapter-1 42] 2] heading texinfo-format-section isection section iappendixsection appendixsection iappendixsec appendixsec iunnumberedsec unnumberedsec #[nil "ÀÁ!‡" [texinfo-format-chapter-1 61] 2] subheading texinfo-format-subsection isubsection subsection iappendixsubsec appendixsubsec iunnumberedsubsec unnumberedsubsec #[nil "ÀÁ!‡" [texinfo-format-chapter-1 45] 2] subsubheading texinfo-format-subsubsection isubsubsection subsubsection iappendixsubsubsec appendixsubsubsec iunnumberedsubsubsec unnumberedsubsubsec #[nil "ÀÁ!‡" [texinfo-format-chapter-1 46] 2] texinfo-format-chapter-1 #[(belowchar) "À Âà \"ˆÄ ÄÅıˆÇy)‡" [texinfo-parse-arg-discard arg message "Formatting: %s ... " 10 "@SectionPAD " belowchar -2] 6] SectionPAD texinfo-format-sectionpad #[nil "À ÂuˆiÄuˆ ÅVƒ cˆ S‰‚ )Æc)‡" [texinfo-parse-arg-discard str -1 column 1 0 10] 3] \. texinfo-format-\. #[nil "À ˆÁc‡" [texinfo-discard-command "."] 1] : texinfo-format-: #[nil "À ‡" [texinfo-discard-command] 1] center texinfo-format-center #[nil "À  ˆ cˆÃcˆŒ`SbˆÄÆ +‡" [texinfo-parse-expanded-arg arg texinfo-discard-command 10 nil indent-tabs-mode center-line] 1] sp texinfo-format-sp #[nil "À  !ÄÅ \"*‡" [texinfo-parse-arg-discard arg read num insert-char 10] 3] br texinfo-format-paragraph-break] 4) (defalias 'texinfo-format-paragraph-break #[nil "À ˆgÁUƒ Ác‡ÂÁÃ\"‡" [texinfo-optional-braces-discard 10 insert-char 2] 3 "\ Force a paragraph break. If used within a line, follow `@br' with braces."]) (defvar texinfo-footnote-style "separate" "\ Footnote style, either separate or end.") (put (quote footnotestyle) (quote texinfo-format) (quote texinfo-footnotestyle)) (defalias 'texinfo-footnotestyle #[nil "À ‰‡" [texinfo-parse-arg-discard texinfo-footnote-style] 2 "\ Specify whether footnotes are at end of node or in separate nodes. Argument is either end or separate."]) (put (quote footnote) (quote texinfo-format) (quote texinfo-format-footnote)) (defalias 'texinfo-format-footnote #[nil "T ˜ƒ à ‡ Ę…Å ‡" [texinfo-footnote-number texinfo-footnote-style "end" texinfo-format-end-node "separate" texinfo-format-separate-node] 2 "\ 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-separate-node #[nil "À ŠÄÅ!ˆÆ•)ŠbˆÈÀwˆ`ÉÊŠÀˆ`)Ë#ƒ+`S‚/Àˆ`{) Í ˆŠÎÀxˆ`)`|ˆÏÐ #cˆÒÀ!ˆŠÓÔÀÕ#ƒYÖyˆŠÄ ×PË#)ƒx`ÏØ #cˆÙ `\"‚“ÚÜ × ݱˆ`ÏØ #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 "\ Format footnote in Separate node style, with notes in own node. The node is constructed automatically."]) (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 "\ Format footnote in the End of node style, with notes at end of node."]) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆÇÈ#ˆÀÈÉ\"ˆÅÆÊË#ˆÀËÌ\"ˆÅÍÇÎ#ˆÀÎÏ\"ˆÅÍÊÐ#ˆÀÐÑ\"ˆÅÒÇÓ#ˆÀÓÔ\"ˆÅÒÊÕ#ˆÀÕÖ\"ˆÅ×ÇØ#ˆÀØÙ\"ˆÅ×ÊÚ#ˆÀÚÛ\"ˆÀÜÝ\"ˆÅÞÇß#ˆÅàÇß#ˆÀßá\"ˆÅÆßâ#ˆÀâã\"ˆÅÍßä#ˆÀäå\"ˆÅÒßæ#ˆÀæç\"ˆÅ×ßè#ˆÀèé\"ˆÅêÇë#ˆÀëì\"ˆÅêßí#ˆÀíî\"ˆÅêÊï#ˆÀïð\"ˆÅñÊï#ˆÅñÇò#ˆÀòó\"ˆÅôÇõ#ˆÅöÇ÷#ˆÀõø\"ˆÀ÷ù\"ˆÀúû\"ˆÅôßü#ˆÅößý#ˆÀüþ\"ˆÀýÿ\"ˆÀ@A\"ˆÅôÊB#ˆÅöÊC#ˆÀBD\"ˆÀCE\"ˆÀFG\"ˆÅHÇI#ˆÅHÊJ#ˆÅKÇL#ˆÀLM\"ˆÅNÇO#ˆÀOP\"ˆÅQÇR#ˆÀRS\"ˆÅTÇI#ˆÅUÇV#ˆÀVW\"ˆÅXÇI#ˆÅYÇZ#ˆÀZ[\"ˆÅ\\Ç]#ˆÀ]^\"ˆÅ_ÇI#ˆÅ`Ça#ˆÀab\"ˆÅcÇd#ˆÅeÇd#ˆÀdf\"ˆÅgÇh#ˆÅiÇh#ˆÅjÇh#ˆÅkÇh#ˆÅlÇh#ˆÅmÇh#ˆÅnÇh#ˆÅoÇh#ˆÅpÇh#ˆÅqÇh#ˆÀhr\"ˆÅsÇt#ˆÅuÇt#ˆÅvÇt#ˆÅwÇt#ˆÅxÇt#ˆÀty\"ˆÅzÇ{#ˆÅ|Ç{#ˆÀ{}\"ˆÅ~Ç#ˆÅ€Ç#ˆÀ\"ˆÅ‚ǃ#‡" [defalias texinfo-push-stack #[(check arg) "T \n E B‰‡" [texinfo-stack-depth check arg texinfo-command-start texinfo-stack] 3] texinfo-pop-stack #[(check) "S „ Âà \"ˆ @@ =„ÂÅ @@#ˆ @A A‡" [texinfo-stack-depth texinfo-stack error "Unmatched @end %s" check "@end %s matches @%s"] 4] put itemize texinfo-format 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] texinfo-end texinfo-end-itemize #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack itemize stacktop texinfo-do-itemize] 2] enumerate 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] texinfo-end-enumerate #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack enumerate stacktop texinfo-do-itemize] 2] alphaenumerate texinfo-alphaenumerate #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack alphaenumerate 96 fill-column 5 texinfo-discard-line] 3] texinfo-end-alphaenumerate #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack alphaenumerate stacktop texinfo-do-itemize] 2] capsenumerate texinfo-capsenumerate #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack capsenumerate 64 fill-column 5 texinfo-discard-line] 3] texinfo-end-capsenumerate #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack capsenumerate stacktop texinfo-do-itemize] 2] texinfo-do-itemize #[(from) "ŠÀyˆ` Y….gÂUƒ ŠÃÄ!ˆÅˆÃÆ!ˆ)‚ÇÈ!„ŠÉcˆ)‚)‡" [-1 from 8 delete-char 1 nil 6 looking-at "[ ]*$" " "] 2] item texinfo-item itemx #[nil "@@ÁN ‡" [texinfo-stack texinfo-item] 2] texinfo-itemize-item #[nil "`TŠÀyˆ`)|ˆÁÂ!ƒà @A@űˆ‚%à @A@ƱˆÇy‡" [0 looking-at "[ ]*[^ \n]+" " " texinfo-stack " \n" " " -1] 3] 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] 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] 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] table 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] texinfo-table-item #[nil "À @A@Ä\nŠƱˆ*Çy‡" [texinfo-parse-arg-discard texinfo-stack itemfont arg 8 123 "}\n \n" -2] 5] texinfo-end-table #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack table stacktop texinfo-do-itemize] 2] description texinfo-description #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack table "@asis" fill-column 5 texinfo-discard-line] 3] ftable texinfo-ftable vtable texinfo-vtable #[nil "ÀÁ!‡" [texinfo-indextable ftable] 2] #[nil "ÀÁ!‡" [texinfo-indextable vtable] 2] texinfo-indextable #[(table-type) "À  \"ˆ ÄZ‰‡" [texinfo-push-stack table-type texinfo-parse-arg-discard fill-column 5] 3] texinfo-ftable-item texinfo-vtable-item #[nil "ÀÁ!‡" [texinfo-indextable-item texinfo-findex] 2] #[nil "ÀÁ!‡" [texinfo-indextable-item texinfo-vindex] 2] texinfo-indextable-item #[(index-type) "À @A@\nÆ Ç È±ˆ  D JBLˆÊy+‡" [texinfo-parse-arg-discard texinfo-stack index-type indexvar itemfont item 8 123 "}\n \n" texinfo-last-node -2] 5] texinfo-end-ftable texinfo-end-vtable #[nil "ÀÁ!‡" [texinfo-end-indextable ftable] 2] #[nil "ÀÁ!‡" [texinfo-end-indextable vtable] 2] texinfo-end-indextable #[(table-type) "Á\\ ˆÃ !Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack table-type stacktop texinfo-do-itemize] 2] ifinfo texinfo-discard-line texinfo-discard-command iftex texinfo-format-iftex #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end iftex[ ]*\n"] 3] tex texinfo-format-tex #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end tex[ ]*\n"] 3] titlepage texinfo-format-titlepage #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end titlepage[ ]*\n"] 3] endtitlepage titlespec texinfo-format-titlespec #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end titlespec[ ]*\n"] 3] endtitlespec today 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] ignore texinfo-format-ignore #[nil "ÁÂ!ˆ`|‡" [texinfo-command-start re-search-forward "@end ignore[ ]*\n"] 3] endignore definfoenclose texinfo-define-info-enclosure #[nil "À ‰@ A@† ÃÅ 8†ÃÇ ˆ\n DDB‰,‡" [texinfo-format-parse-line-args args command-name "" beginning-delimiter 2 end-delimiter texinfo-discard-command texinfo-enclosure-list] 4] var texinfo-format-var sc #[nil "À –cˆ b‡" [texinfo-parse-arg-discard texinfo-command-start] 1] b texinfo-format-noop i r t w asis dmn key math titlefont #[nil "À cˆ b‡" [texinfo-parse-arg-discard texinfo-command-start] 1] cite texinfo-format-code code file kbd samp #[nil "ÀÁ ±ˆ b‡" ["`" texinfo-parse-arg-discard "'" texinfo-command-start] 3] emph texinfo-format-emph strong #[nil "ÀÁ À±ˆ\nb‡" ["*" texinfo-parse-arg-discard texinfo-command-start] 3] dfn texinfo-format-defn defn #[nil "ÀÁ À±ˆ\nb‡" ["\"" texinfo-parse-arg-discard texinfo-command-start] 3] bullet texinfo-format-bullet] 4) (defalias 'texinfo-format-bullet #[nil "À ˆÁc‡" [texinfo-optional-braces-discard "*"] 1 "\ Insert an asterisk. If used within a line, follow `@bullet' with braces."]) (byte-code "ÀÁÂÃ#ˆÀÄÂÃ#ˆÀÅÂÃ#ˆÀÆÂÃ#ˆÀÇÂÃ#ˆÀÈÂÃ#ˆÉÃÊ\"ˆÀÄËÌ#ˆÀÁËÌ#ˆÀÅËÌ#ˆÀÆËÌ#ˆÀÇËÌ#ˆÀÈËÌ#ˆÉÌÍ\"ˆÀÎÂÏ#ˆÉÏÐ\"ˆÀÑÂÒ#ˆÀÑËÓ#ˆÀÔÂÕ#ˆÀÖÂÕ#ˆÉÕ×\"ˆÀÔËØ#ˆÀÖËØ#ˆÉØÙ\"ˆÀÚÂÛ#ˆÉÛÜ\"ˆÀÚËÝ#ˆÉÝÞ\"ˆÉßà\"ˆÀáÂâ#ˆÉâã\"ˆÀäÂå#ˆÉåæ\"ˆÀçÂè#ˆÉèé\"ˆÀêÂë#‡" [put display texinfo-format texinfo-format-example example lisp quotation smallexample smalllisp defalias #[nil "ÀÁÂ\"ˆ ÄZÅ ‡" [texinfo-push-stack example nil fill-column 5 texinfo-discard-line] 3] texinfo-end texinfo-end-example #[nil "Á\\ ˆÃÄ!Æ A@!)‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack example stacktop texinfo-do-itemize] 2] exdent texinfo-format-exdent #[nil "À ˆ`ÁÂwˆ`|ˆÃcˆŠÂˆÄc)‡" [texinfo-discard-command " " nil 8 "\n "] 3] cartouche texinfo-discard-line texinfo-discard-command format texinfo-format-flushleft flushleft #[nil "À ‡" [texinfo-discard-line] 1] texinfo-end-flushleft #[nil "À ‡" [texinfo-discard-command] 1] flushright texinfo-format-flushright #[nil "ÀÁÂ\"ˆÃ ‡" [texinfo-push-stack flushright nil texinfo-discard-line] 3] texinfo-end-flushright #[nil "À ˆÁÂ!Ä A@!)‡" [texinfo-discard-command texinfo-pop-stack flushright stacktop texinfo-do-flushright] 2] texinfo-do-flushright #[(from) "ŠÀyˆ` Y…(ÂyˆÃ ŠÅˆÆÅxˆ`ň`|ˆi)ZÇ\"cˆ‚)‡" [-1 from 0 make-string fill-column nil " " 32] 4] ctrl texinfo-format-ctrl #[nil "À  ÃHÄ\"c)‡" [texinfo-parse-arg-discard str logand 0 31] 3] TeX texinfo-format-TeX #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "TeX"] 1] copyright texinfo-format-copyright #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "(C)"] 1] minus texinfo-format-minus] 4) (defalias 'texinfo-format-minus #[nil "À ˆÁc‡" [texinfo-optional-braces-discard "-"] 1 "\ Insert a minus sign. If used within a line, follow `@minus' with braces."]) (byte-code "ÀÁÂÃ#ˆÄÃÅ\"‡" [put dots texinfo-format texinfo-format-dots defalias #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "..."] 1]] 4) (defvar texinfo-paragraph-indent "asis" "\ Number of spaces for @refill to indent a paragraph; else to leave as is.") (put (quote paragraphindent) (quote texinfo-format) (quote texinfo-paragraphindent)) (defalias 'texinfo-paragraphindent #[nil "À ‰˜ƒ‰‚Ä !‰)‡" [texinfo-parse-arg-discard arg "asis" texinfo-paragraph-indent string-to-int] 3 "\ Specify the number of spaces for @refill to indent a paragraph. Default is to leave the number of spaces as is."]) (put (quote refill) (quote texinfo-format) (quote texinfo-format-refill)) (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 "\ Refill paragraph. Also, indent first line as set by @paragraphindent. Default is to leave paragraph indentation as is."]) (byte-code "ÀÁÂÃ#ˆÄÃÅ\"ˆÀÆÂÇ#ˆÄÇÈ\"ˆÀÉÂÊ#ˆÄÊË\"ˆÀÌÂÍ#ˆÄÍÎ\"ˆÀÏÂÐ#ˆÄÐÑ\"ˆÀÒÂÓ#ˆÄÓÔ\"ˆÀÕÂÖ#ˆÄÖ×\"ˆÄØÙ\"ˆÚÀÜÂÝ#ˆÀÞÂÝ#ˆÄÝß\"ˆÀàÂá#ˆÀâÂá#ˆÄáã\"ˆä%æ'Äèé\"ˆÄêë\"ˆÀìÂí#ˆÄíî\"ˆÄïð\"ˆÀñÂò#ˆÄòó\"ˆÀôÂõ#ˆÄõö\"ˆÀ÷Âø#ˆÄøù\"ˆÀúÂû#ˆÄûü\"ˆÀýÂþ#ˆÄþÿ\"ˆÀ@ÂA#ˆÄAB\"ˆÄCD\"ˆÄEF\"ˆÄGH\"ˆÄIJ\"ˆÀKLM#ˆÀNLM#ˆÀOLM#ˆÀPLM#ˆÀQLM#ˆÀRLM#ˆÄMS\"ˆÀTLU#ˆÀVLU#ˆÀWLU#ˆÀXLU#ˆÀYLU#ˆÀZLU#ˆÀ[LU#ˆÀ\\LU#ˆÀ]LU#ˆÀ^LU#ˆÄU_\"ˆÀ`La#ˆÀbLa#ˆÀcLa#ˆÀdLa#ˆÄae\"ˆÀfLg#ˆÀhLg#ˆÀiLg#ˆÀjLg#ˆÄgk\"ˆÀlLm#ˆÀnLm#ˆÄmo\"ˆÀpLq#ˆÀrLq#ˆÄqs\"ˆÀtLu#ˆÀvLu#ˆÄuw\"ˆÀxLy#ˆÀzLy#ˆÄy{\"ˆÀT|}#ˆÀV|}#ˆÀW|}#ˆÀX|}#ˆÀY|}#ˆÀZ|}#ˆÀ[|}#ˆÀ\\|}#ˆÀ]|}#ˆÀ^|}#ˆÄ}~\"ˆÀK|#ˆÀN|#ˆÀO|#ˆÀP|#ˆÀQ|#ˆÀR|#ˆÀf|#ˆÀh|#ˆÀi|#ˆÀj|#ˆÄ€\"ˆÀ`|#ˆÀb|#ˆÀc|#ˆÀd|#ˆÄ‚\"ˆÀt|ƒ#ˆÀv|ƒ#ˆÄƒ„\"ˆÀl|…#ˆÀn|…#ˆÄ…†\"ˆÀx|‡#ˆÀz|‡#ˆÄ‡ˆ\"ˆÀp|‰#ˆÀr|‰#ˆÄ‰Š\"ˆÀKÂC#ˆÀNÂG#ˆÀK‹E#ˆÀKŒ#ˆÀNŒŽ#ˆÀK#ˆÀN#ˆÀTÂC#ˆÀVÂG#ˆÀT‹E#ˆÀTŒ‘#ˆÀVŒ’#ˆÀT#ˆÀV#ˆÀWÂC#ˆÀXÂG#ˆÀW‹E#ˆÀWŒ“#ˆÀXŒ”#ˆÀW#ˆÀX#ˆÀYÂC#ˆÀZÂG#ˆÀY‹E#ˆÀYŒ•#ˆÀZŒ–#ˆÀY#ˆÀZ#ˆÀOÂC#ˆÀPÂG#ˆÀO‹E#ˆÀOŒ—#ˆÀPŒ˜#ˆÀO™#ˆÀP™#ˆÀ[ÂC#ˆÀ\\ÂG#ˆÀ[‹E#ˆÀ[Œš#ˆÀ\\Œ›#ˆÀ[™#ˆÀ\\™#ˆÀœÂC#ˆÀÂG#ˆÀœ‹E#ˆÀœŒž#ˆÀŒŸ#ˆÀœ™#ˆÀ™#ˆÀ ÂC#ˆÀ¡ÂG#ˆÀ ‹E#ˆÀ Œ¢#ˆÀ¡Œ£#ˆÀ #ˆÀ¡#ˆÀ]ÂC#ˆÀ^ÂG#ˆÀ]‹E#ˆÀ]Œ¤#ˆÀ^Œ¥#ˆÀ]™#ˆÀ^™#ˆÀQÂC#ˆÀRÂG#ˆÀQ‹E#ˆÀQŒ¦#ˆÀRŒ§#ˆÀQ¨#ˆÀR¨#ˆÀlÂC#ˆÀnÂG#ˆÀl‹E#ˆÀlŒ©#ˆÀnŒª#ˆÀl#ˆÀn#ˆÀtÂC#ˆÀvÂG#ˆÀt‹E#ˆÀtŒ«#ˆÀvŒ¬#ˆÀt#ˆÀv#ˆÀpÂC#ˆÀrÂG#ˆÀp‹E#ˆÀpŒ­#ˆÀrŒ®#ˆÀp™#ˆÀr™#ˆÀxÂC#ˆÀzÂG#ˆÀx‹E#ˆÀxŒ¯#ˆÀzŒ°#ˆÀx™#ˆÀz™#ˆÀ`ÂC#ˆÀbÂG#ˆÀ`‹E#ˆÀ`Œ±#ˆÀbŒ²#ˆÀ`#ˆÀb#ˆÀfÂC#ˆÀhÂG#ˆÀf‹E#ˆÀfŒ³#ˆÀhŒ´#ˆÀf#ˆÀh#ˆÀcÂC#ˆÀdÂG#ˆÀc‹E#ˆÀcŒµ#ˆÀdŒ¶#ˆÀc™#ˆÀd™#ˆÀiÂC#ˆÀjÂG#ˆÀi‹E#ˆÀiŒ·#ˆÀjŒ¸#ˆÀi™#ˆÀj™#ˆÀ¹Âº#‡" [put noindent texinfo-format texinfo-noindent defalias #[nil "ŠÀÁ!ˆÂÊÄyˆ`)Å#?…Æ )‡" [forward-paragraph 1 search-backward "@refill" -1 t texinfo-discard-line] 4] vindex texinfo-format-vindex #[nil "ÀÁ!‡" [texinfo-index texinfo-vindex] 2] cindex texinfo-format-cindex #[nil "ÀÁ!‡" [texinfo-index texinfo-cindex] 2] findex texinfo-format-findex #[nil "ÀÁ!‡" [texinfo-index texinfo-findex] 2] pindex texinfo-format-pindex #[nil "ÀÁ!‡" [texinfo-index texinfo-pindex] 2] tindex texinfo-format-tindex #[nil "ÀÁ!‡" [texinfo-index texinfo-tindex] 2] kindex texinfo-format-kindex #[nil "ÀÁ!‡" [texinfo-index texinfo-kindex] 2] texinfo-index #[(indexvar) "À  ˆ ƒÆ `\"T‚ÇE JBL)‡" [texinfo-parse-expanded-arg arg texinfo-discard-command indexvar texinfo-last-node texinfo-last-node-pos count-lines 1] 6] (("cp" . texinfo-cindex) ("fn" . texinfo-findex) ("vr" . texinfo-vindex) ("tp" . texinfo-tindex) ("pg" . texinfo-pindex) ("ky" . texinfo-kindex)) texinfo-indexvar-alist defindex texinfo-format-defindex defcodeindex #[nil "À  ÃP!ÂÅ ÃQ!ÂÇ ÃQ!‰ÉLˆÊ Ë#ˆÌ  \"„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] synindex texinfo-format-synindex syncodeindex #[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] (("cp" . cindex) ("fn" . findex) ("vr" . vindex) ("tp" . tindex) ("pg" . pindex) ("ky" . kindex)) texinfo-short-index-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)) texinfo-short-index-format-cmds-alist texinfo-sort-region #[(start end) "ÀÁ!ˆŒ\n }ˆÄÅÆÇÈ$)‡" [require sort start end sort-subr nil forward-line end-of-line texinfo-sort-startkeyfun] 5] texinfo-sort-startkeyfun #[nil "`ŠÀˆ`){Âà \"ƒ! ĉ”OÅ Ä• GOQ‚ )‡" [nil line string-match "[ ][ ]+\\|[^a-z0-9 ]+" 0 " "] 5] printindex texinfo-format-printindex #[nil "ÀÁ \n\"AJÃÆcˆ`Çà \"ˆÉ=ƒ\"Ê `\"‚(Ë `ÌÍ$*‡" [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] texinfo-print-index #[(file indexelts) "…Y@@;ƒFÁ@@±ˆÃjˆ ƒ!Å ÆQ‚\"Ç@A@ȱˆÉjˆÊ@8ƒ>ËÌÊ@8\"‚?Çͱˆ‚QÎ@A@Ê@8\"ˆA‰„χ" [indexelts "* " ": " 32 file "(" ")" "" "." 54 2 format " %d." "\n" texinfo-print-index nil] 5] equiv texinfo-format-equiv #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "=="] 1] error texinfo-format-error #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "error-->"] 1] expansion texinfo-format-expansion #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "==>"] 1] point texinfo-format-point #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "-!-"] 1] print texinfo-format-print #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "-|"] 1] result texinfo-format-result #[nil "À ˆÁc‡" [texinfo-parse-arg-discard "=>"] 1] texinfo-format-defun #[nil "ÀÁÂ\"ˆ ÄZÅÆ!‡" [texinfo-push-stack defun nil fill-column 5 texinfo-format-defun-1 t] 3] texinfo-end-defun #[nil "Á\\ ˆÃÄ!A@Æ !ˆŠ bˆÇÈ!*‡" [fill-column 5 texinfo-discard-command texinfo-pop-stack defun start texinfo-do-itemize delete-char -1] 2] texinfo-format-defunx #[nil "ÀÁ!‡" [texinfo-format-defun-1 nil] 2] 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] deffn texinfo-deffn-formatting-property texinfo-format-deffn deffnx defvr defvrx deftp deftpx #[(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] defun texinfo-format-specialized-defun defunx defmac defmacx defspec defspecx defvar defvarx defopt defoptx #[(parsed-args) "A@ @ AÅ Æ ±ˆ\n…2Ç\n@ÈHÉUƒ$\n@‚'\n@–±ˆ\nA‰„Ê+‡" [texinfo-defun-type parsed-args args name category " -- " ": " " " 0 38 nil] 5] deftypefn texinfo-format-deftypefn deftypefnx deftypevr deftypevrx #[(parsed-args) "@A@AA@AAAÅ Æ Ç\n±ˆ …,Ç @±ˆ A‰„È,‡" [parsed-args args name data-type category " -- " ": " " " nil] 7] deftypefun texinfo-format-deftypefun deftypefunx deftypevar deftypevarx #[(parsed-args) "A@ @ A@ AAÆ Ç È ±ˆ\n…*È\n@±ˆ\nA‰„É,‡" [texinfo-defun-type parsed-args args name data-type category " -- " ": " " " nil] 7] defop texinfo-format-defop defopx #[(parsed-args) "@A@AA@AAAÅ Æ Ç\n±ˆ …-È @–±ˆ A‰„É,‡" [parsed-args args name class category " -- " " on " ": " " " nil] 7] defcv texinfo-format-defcv defcvx #[(parsed-args) "@A@AA@AAAÅ Æ Ç\n±ˆ …-È @–±ˆ A‰„É,‡" [parsed-args args name class category " -- " " of " ": " " " nil] 7] defmethod texinfo-format-defmethod defmethodx #[(parsed-args) "A@ @ A@ AAÆ Ç È ±ˆ\n…+É\n@–±ˆ\nA‰„Ê,‡" [texinfo-defun-type parsed-args args name class category " -- " " on " ": " " " nil] 7] defivar texinfo-format-defivar defivarx #[(parsed-args) "A@ @ A@ AAÆ Ç È ±ˆ\n…+É\n@–±ˆ\nA‰„Ê,‡" [texinfo-defun-type parsed-args args name class category " -- " " of " ": " " " nil] 7] texinfo-defun-indexing-property texinfo-index-defun #[(parsed-args) "ÁN‰ @ ƒÆ `\"T‚ÇE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7] texinfo-index-deffn #[(parsed-args) "ÁN‰ A@ ƒÆ `\"T‚ÇE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7] texinfo-index-deftypefn #[(parsed-args) "ÁN‰ AA@ ƒÆ `\"T‚ÇE\nJBL)‡" [texinfo-command-name texinfo-defun-index index-list parsed-args texinfo-last-node texinfo-last-node-pos count-lines 1] 7] 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] 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] 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] 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] texinfo-end texinfo-defun-type ((quote deffn-type) nil) ((quote deffn-type) nil) texinfo-defun-index texinfo-findex ((quote defun-type) "Function") ((quote defun-type) "Function") ((quote defun-type) "Macro") ((quote defun-type) "Macro") ((quote defun-type) "Special form") ((quote defun-type) "Special form") ((quote deffn-type) nil) ((quote deffn-type) nil) texinfo-vindex ((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") ((quote defun-type) "User Option") ((quote defun-type) "User Option") ((quote deftp-type) nil) ((quote deftp-type) nil) texinfo-tindex ((quote defop-type) nil) ((quote defop-type) nil) ((quote defmethod-type) "Method") ((quote defmethod-type) "Method") ((quote defop-type) nil) ((quote defop-type) nil) ((quote defmethod-type) "Instance variable") ((quote defmethod-type) "Instance variable") ((quote deftypefn-type) nil) ((quote deftypefn-type) nil) ((quote deftypefun-type) "Function") ((quote deftypefun-type) "Function") ((quote deftypefn-type) nil) ((quote deftypefn-type) nil) ((quote deftypevar-type) "Variable") ((quote deftypevar-type) "Variable") clear texinfo-clear] 4) (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 "\ Clear the value of the flag."]) (put (quote set) (quote texinfo-format) (quote texinfo-set)) (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 "\ 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."]) (put (quote value) (quote texinfo-format) (quote texinfo-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 "\ 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."]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put ifset texinfo-end texinfo-discard-command texinfo-format texinfo-if-set] 4) (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 "\ If set, continue formatting; else do not format region up to @end ifset"]) (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#‡" [put ifclear texinfo-end texinfo-discard-command texinfo-format texinfo-if-clear] 4) (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 "\ If clear, continue formatting; if set, do not format up to @end ifset"]) (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 defalias texinfo-unsupported #[nil "ÀÁ\n {\"‡" [error "%s is not handled by texinfo" texinfo-command-start texinfo-command-end] 4]] 4) (defalias 'batch-texinfo-format #[nil "„ÁÂ!ˆÃĉʼn \nËĉ  ƒhÏ@! Ð !„CÑÒ \"ˆÓA‰‚!Ô !ƒXÕ !A¤‰‚!  B A‰„$ ƒ @  A Ö×؈‚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 "\ 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\"."]) (provide (quote texinfmt)) emacs-19.22/lisp/texinfo.elc100666 13437 1 47236 5474032671 14417 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sun Nov 21 22:44:56 1993 ;;; from file /home/fsf/rms/e19/lisp/texinfo.el ;;; emacs version 19.21.0. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (autoload (quote 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 (quote 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 (quote kill-compilation) "compile" "\ Kill the process made by the \\[compile] command." t nil) (autoload (quote 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 (quote 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 (quote 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 (quote 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 (quote 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 (quote 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 (quote 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 (quote 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) (byte-code "ÀÁ!„ „Eà ÄÅÆ #ˆÄÇÆ #ˆÄÈÉ #ˆÄÊÉ #ˆÄËÌ #ˆÄÍÎ #ˆÄÏÐ #ˆÄÑÒ #ˆÄÓÔ #ˆÀÕ!„N‡" [boundp texinfo-mode-syntax-table nil make-syntax-table modify-syntax-entry 34 " " 92 64 "\\" 17 91 "(]" 93 ")[" 123 "(}" 125 "){" 39 "w" texinfo-mode-map] 4) (defalias 'texinfo-define-common-keys #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#ˆÀ ÈÉ#ˆÀ ÊË#ˆÀ ÌÍ#ˆÀ ÎÏ#ˆÀ ÐÑ#ˆÀ ÒÓ#‡" [define-key keymap " " tex-kill-job "" texinfo-quit-job " " 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 "\ Define the keys both in Texinfo mode and in the texinfo-tex-shell."]) (byte-code "„³Á Â!ˆÃÄÅ#ˆÃÆÇ#ˆÃÈÉ#ˆÃÊË#ˆÃÌÍ#ˆÃÎÏ#ˆÃÐÑ#ˆÃÒÓ#ˆÃÔÕ#ˆÃÖ×#ˆÃØÙ#ˆÃÚÛ#ˆÃÜÝ#ˆÃÞÝ#ˆÃßà#ˆÃáâ#ˆÃãä#ˆÃåæ#ˆÃçè#ˆÃéê#ˆÃëì#ˆÃíî#ˆÃïð#ˆÃñò#ˆÃóô#ˆÃõö#ˆÃ÷ø#ˆÃùú#ˆÁ‡" [texinfo-mode-map make-sparse-keymap texinfo-define-common-keys define-key " " kill-compilation " " 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) (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.") (defalias 'texinfo-mode #[nil "À ˆÁÃÅ!ˆÇ!ˆÉÊ!ˆË Í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 tex-start-of-header "%**start" tex-end-of-header "%**end" run-hooks text-mode-hook texinfo-mode-hook] 3 "\ 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." nil]) (defconst texinfo-environment-regexp "^@\\(f?table\\|enumerate\\|itemize\\|ifinfo\\|iftex\\|example\\|quotation\\|lisp\\|smallexample\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|ignore\\|group\\|tex\\|cartouche\\|end\\)" "\ Regexp for environment-like TexInfo list commands. Subexpression 1 is what goes into the corresponding `@end' statement.") (defalias 'texinfo-insert-@end #[nil "ÀÁŠ ÄVƒ(ÅÁÇ#ƒ(ÈÉ!ƒ! T‰‚% S‰„È!ˆÀ”À•{)Êcˆ\n…?\n˱*‡" [1 nil string depth 0 re-search-backward texinfo-environment-regexp t looking-at "@end" "@end " "\n"] 4 "\ Insert the matching `@end' for the last Texinfo command that needs one." nil]) (defalias (quote texinfo-insert-@-with-arg) #[(string &optional arg) "ƒ4Á!‰ÂWƒ\"ÃÄxˆŠÅ!ˆÆȱˆ)Éc‡ÃÄwˆÆȱˆÅ!ˆÉc‡ÆʱˆË ‡" [arg prefix-numeric-value 0 " \n " nil forward-sexp "@" string "{" "}" "{}" backward-char] 4]) (defalias 'texinfo-insert-braces #[nil "ÀcˆÁ ‡" ["{}" backward-char] 1 "\ Make a pair of braces and be poised to type inside of them. Use \\[up-list] to move forward out of the braces." nil]) (defalias 'texinfo-insert-@code #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "code" arg] 3 "\ 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." "P"]) (defalias 'texinfo-insert-@dfn #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "dfn" arg] 3 "\ 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." "P"]) (defalias 'texinfo-insert-@example #[nil "Àc‡" ["@example\n"] 1 "\ Insert the string `@example' in a Texinfo buffer." nil]) (defalias 'texinfo-insert-@file #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "file" arg] 3 "\ 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." "P"]) (defalias 'texinfo-insert-@item #[nil "ÀcˆÁ ‡" ["@item" newline] 1 "\ Insert the string `@item' in a Texinfo buffer." nil]) (defalias 'texinfo-insert-@kbd #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "kbd" arg] 3 "\ 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." "P"]) (defalias 'texinfo-insert-@node #[nil "ÀcˆÁyˆÂu‡" ["@node \n@comment node-name, next, previous, up" -1 6] 1 "\ Insert the string `@node' in a Texinfo buffer. This also inserts on the following line a comment indicating the order of arguments to @node." nil]) (defalias 'texinfo-insert-@noindent #[nil "Àc‡" ["@noindent\n"] 1 "\ Insert the string `@noindent' in a Texinfo buffer." nil]) (defalias 'texinfo-insert-@samp #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "samp" arg] 3 "\ 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." "P"]) (defalias 'texinfo-insert-@table #[(&optional arg) "Àc‡" ["@table "] 1 "\ Insert the string `@table' in a Texinfo buffer." "P"]) (defalias 'texinfo-insert-@var #[(&optional arg) "ÀÁ\n\"‡" [texinfo-insert-@-with-arg "var" arg] 3 "\ 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." "P"]) (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] 5 "\ 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." "P"]) (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'.") (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 "\ 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." "r"]) (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 "\ Run TeX on visited file, once or twice, to make a correct `.dvi' file." nil]) (defalias 'texinfo-texindex #[nil "ÀÁ!ˆÂ ÅP\"ˆÆÇ!‡" [require tex-mode tex-send-command texinfo-texindex-command tex-zap-file ".??" tex-recenter-output-buffer nil] 4 "\ 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'." nil]) (defalias 'texinfo-tex-print #[nil "ÀÁ!ˆÂ ÅP\"ˆÆÇ!‡" [require tex-mode tex-send-command tex-dvi-print-command tex-zap-file ".dvi" tex-recenter-output-buffer nil] 4 "\ Print `.dvi' file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer]. This runs the shell command defined by `tex-dvi-print-command'." nil]) (defalias 'texinfo-quit-job #[nil "ÀÁ!„\nÂÃ!ˆÄÅ!‡" [get-process "tex-shell" error "No TeX shell running" tex-send-command "x"] 2 "\ Quit currently running TeX job, by sending an `x' to it." nil]) (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 "\ 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)." "nPrinter job number for deletion: "]) (provide (quote texinfo)) emacs-19.22/lisp/texnfo-upd.elc100666 13437 1 116544 5470157250 15050 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Nov 10 07:29:23 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/texnfo-upd.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (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 "\ 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." "P"]) (defalias 'texinfo-make-one-menu #[(level) "ÀŠÂ !bˆÄˆ`)Æ !È \" bˆÊyˆË  Í  #Ï  \"ƒDÐ!ˆÑ!ˆÒ  \"ˆÓ \".‡" [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 "\ 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-all-menus-update #[(&optional update-all-nodes-p) "ÀÁŠÄdÀ\"ˆebˆÅÆÇ \"ˆŠÈ ÁÀ#ƒ8ÀÊ”bˆŠË bˆÊyˆÌuˆ`) ` |ˆ))ƒTÅÏÇ \"ˆÐÑ!ˆÄ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 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 "\ 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." "P"]) (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 "\ 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-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 "\ 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-make-menu-list #[(beginning end level) "bˆÁà \"ƒÆ ÇÈyˆB\nB‚É\n!)‡" [beginning nil new-menu-list texinfo-menu-locate-entry-p level end texinfo-copy-node-name "" 1 reverse] 3 "\ 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-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 "\ 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-copy-node-name #[nil "ŠÀvˆÁÂwˆ`ÃĊˆ`)Å#ƒ`S‚ˆ`{)‡" [1 " " nil search-forward "," t] 5 "\ 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-section-title #[nil "À”bˆÁvˆÂÃwˆ`È`{‡" [7 1 " " nil] 2 "\ 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-old-menu-p #[(beginning first) "bˆÁ Ä#„ÅcˆÆyˆÇ‡È‡" [beginning re-search-forward "^@menu" first goto-end "\n\n" -2 nil t] 4 "\ 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-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 "\ 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-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 "\ 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-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 "\ 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-end #[nil "ŠÀÁÂÃ#ƒ `‚ÄÅ!)‡" [re-search-forward "^@end menu" nil t error "Menu does not have an end."] 4 "\ Return position of end of menu. Does not change location of point. Signal an error if not end of menu."]) (defalias 'texinfo-delete-old-menu #[(beginning first) "ÀÁ\n\"ˆ`ŠÃÄ \"ˆ`)|‡" [re-search-backward "^@menu" beginning re-search-forward "^@end menu" first] 4 "\ 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."]) (defvar texinfo-column-for-description 32 "\ *Column at which descriptions start in a Texinfo menu.") (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 "\ 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-start-menu-description #[nil "À‰‰‰ŠÅyˆÆÇŠÀˆ`)È#ƒ\"ÉÀwˆ`‚&ÊË!ˆÆÌŠÀˆ`)È#ƒHÍÎ!ƒ=ÊÏ!ˆÐÀxˆ `{‚¨ÆÑŠÀˆ`)È#ƒ¤ÉÀwˆ`ÒÓŠÔyˆ`)È#ƒ}ÍÎ!ƒrÊÏ!ˆÕÀxˆ `{‚¨ÒÖŠÔyˆ`)È#ˆ×Àxˆ `{‰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 "\ 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." nil]) (defalias 'texinfo-indent-menu-description #[(column &optional region-p) "ŠŒ~ˆ„ÁÂ!ˆÃ !ˆÅÆ!‚7ÅÇ!ˆÈ bˆ`É Wƒ4Ê ƒ4ËyˆÃ !ˆ‚ÅÌ!*‡" [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 "\ 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." "nIndent menu descriptions to (column number): \nP"]) (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 "\ 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-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 "\ 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." "P"]) (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 "\ 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-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 "\ Format and insert the master menu in the current buffer."]) (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.") (defalias 'texinfo-locate-menu-p #[nil "ÀÁÂÃ#‡" [re-search-forward "\\(^@menu\\)" nil t] 4 "\ 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-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 "\ 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 #[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 "\ 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-specific-section-type #[nil "ÀŠÂÃÄÀ#ƒÅ‚(ÂÄÀ#ƒ%Çyˆ`TÈvˆ`{‚(ÉÊ!*‡" [t case-fold-search re-search-forward "^@node [ ]*top[ ]*\\(,\\|$\\)" nil "top" texinfo-section-types-regexp 0 1 error "texinfo-specific-section-type: Chapter or section not found."] 4 "\ 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-hierarchic-level #[nil "ÀÂà \"A)‡" [t case-fold-search assoc texinfo-specific-section-type texinfo-section-to-generic-alist] 3 "\ Return the general hierarchal level of the next node in a texinfo file. Thus, a subheading or appendixsubsec is of type subsection."]) (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 "\ 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-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 "\ 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-menu-first-node #[(beginning end) "ŠbˆÁyˆÂà Å#ˆÆyˆ`)‡" [beginning 1 re-search-forward "^@node" end t 0] 4 "\ 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."]) (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"))) "\ *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-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 (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 "\\)[ ]+"))) "\ *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 (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 "\\)[ ]*\\)"))) "\ *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 (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"))) "\ *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.") (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 "\ 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." "P"]) (defalias 'texinfo-every-node-update #[nil "ŠÀdÁ\"ˆebˆÂÁ!ˆÃÄ!)‡" [push-mark t texinfo-update-node message "Done...updated every node. You may save the buffer."] 3 "\ Update every node in a Texinfo file." nil]) (defalias 'texinfo-update-the-node #[nil "À ˆÁ ˆÂÃÄ \"ˆŒ~ˆÅÇ É!\nË! ͘ƒ.Î ‚NÏ\n Ð$ˆÏ\n Ñ$ˆÏ\n Ò$ˆÓ -‡" [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 "\ Update one node. Point must be at the beginning of node line. Leave point 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 "\ 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-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 "\ 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-delete-existing-pointers #[nil "ÀÁŠÂˆ`)Ã#ƒ`SbˆÄÂ!ˆÅyˆÂ‡" [search-forward "," nil t kill-line 0] 4 "\ 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-find-pointer #[(beginning end level direction) "À\nÃ=ƒ'ÄyˆÅÆÇÈÉ\n \"A!Q À#ƒ#Í‚ŒÎ‚Œ\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 "\ 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-pointer-name #[(kind) "À\nÃ=ƒÀˆÄÅŠÆy)Ç#ˆÈ ‚\"\nÉ=ƒ\"Ê )‡" [nil name kind normal re-search-backward "^@node" -3 t texinfo-copy-node-name no-pointer " "] 4 "\ Return the node name preceding the section command. The argument is the kind of section, either normal or no-pointer."]) (defalias 'texinfo-insert-pointer #[(beginning end level direction) "ÀˆÁŠÂà $!)±‡" [nil ", " texinfo-pointer-name texinfo-find-pointer beginning end level direction] 7 "\ 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-clean-up-node-line #[nil "ÀˆÁÀxˆ`ŠÀˆ`)|‡" [nil ", "] 2 "\ Remove extra commas, if any, at end of node line."]) (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 "\ 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." "P"]) (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 "\ 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-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 "\ 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-insert-pointer #[(level direction) "ÀˆÁŠÂà \"!)±‡" [nil ", " texinfo-pointer-name texinfo-sequentially-find-pointer level direction] 5 "\ 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-insert-node-lines #[(beginning end &optional title-p) "À‰‰‰ÅÇ\"ˆÈ  bˆÊ Æ#ƒŠ ƒ6ÍyˆÎvˆÏÀwˆ`ŠÀˆ`){ÐÑ †BŠÒyˆ`)Ç#ƒMÎvˆ‚WÍyˆÓcˆÔÎ!ˆ ƒvÏÀwˆÕÖ!„vÍyˆÎvˆ×\n±ˆØÙ\n\"ˆÊ ŠÚyˆ`)Ç#ˆ`Îyˆ‚Û !ˆ ƒšØÜ!‚ØÝ!,‡" [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 "\ 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." "r\nP"]) (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 "\ Return a list of the included files in OUTER-FILE."]) (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 "\ 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-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 "\ 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-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 "\ 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-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 "\ 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-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 "\ 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." (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.22/lisp/text-mode.elc100666 13437 1 6674 5463305412 14624 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Oct 26 16:39:38 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/text-mode.el ;;; emacs version 19.20.7. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (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) (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.") (byte-code "„Á ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÁ‡" [text-mode-map make-sparse-keymap define-key " " ispell-complete-word " " tab-to-tab-stop "s" center-line "S" center-paragraph] 4) (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 "\ 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." nil]) (defvar indented-text-mode-map nil "\ Keymap for Indented Text mode. All the commands defined in Text mode are inherited unless overridden.") (byte-code "„Á Ã\nÄÅ#ˆ\n¤)Á‡" [indented-text-mode-map make-sparse-keymap newmap define-key " " indent-relative text-mode-map] 4) (defalias 'indented-text-mode #[nil "À ˆÁ\n!ˆÃÄÅ\"ˆ Ç!ˆÉÊ!ˆË\nÉÌ!ˆÍP ÉÏ!ˆ Á!ˆÑÓÕÖ!‡" [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] 3 "\ 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." nil]) (defalias 'center-paragraph #[nil "ŠÀ ˆn„ ÁÂ!ˆ`Ä ˆÅ` \"*‡" [forward-paragraph newline 1 end backward-paragraph center-region] 3 "\ Center each nonblank line in the paragraph at or after point. See `center-line' for more info." nil]) (defalias 'center-region #[(from to) " Vƒ \n)ŠŒ }ˆbˆm?….ŠÃÄwˆl)„(Å ˆÆyˆ‚*‡" [from to tem " " nil center-line 1] 2 "\ Center each nonblank line starting in the region. See `center-line' for more info." "r"]) (defalias 'center-line #[nil "ŠÀÂyˆÃ ˆÀˆÃ ˆiÂyˆ Z ZÆ¥\\j*‡" [nil line-length 0 delete-horizontal-space left-margin fill-column 2] 3 "\ 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'." nil]) emacs-19.22/lisp/thingatpt.elc100666 12120 1 7400 5474623100 14547 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:15:43 1993 ;;; from file /home/fsf/rms/e19/lisp/thingatpt.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (provide (quote thingatpt)) (defconst thing@pt-version (substring "$Revision: 1.2 $" 11 -2) "\ The revision number of thing@pt (as string). The complete RCS id is: $Id: thingatpt.el,v 1.2 1993/11/23 19:33:55 rms Exp $") (defalias 'forward-thing #[(THING &optional N) "ÁN† ÂÃÄ\"!Å !ƒ †Ç!‚\"ÈÉ\")‡" [THING forward-op intern-soft format "forward-%s" fboundp N 1 error "Can't determine how to move over %ss"] 4 "\ Move forward to the end of the next THING."]) (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 "\ 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 'thing-at-point #[(THING) "À !‰… \n@\nA{)‡" [bounds-of-thing-at-point THING bounds] 3 "\ Return the THING at point, where THING is an entity defined by bounds-of-thing-at-point."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÉÊËÇ#ˆÉÌËÍ#ˆÉÌÎÏ#‡" [defalias beginning-of-thing #[(THING) "À !‰„ ÃÄ \"ˆ\n@b)‡" [bounds-of-thing-at-point THING bounds error "No %s here"] 4] end-of-thing #[(THING) "À !‰„ ÃÄ \"ˆ\nAb)‡" [bounds-of-thing-at-point THING bounds error "No %s here"] 4] in-string-p #[nil "`ŠÁ ˆÂÃ`\"8*‡" [orig beginning-of-defun 3 parse-partial-sexp] 4] end-of-sexp #[nil "`fz‰Á=„Â=ƒà ƒÄu‚ÅÄ!)‡" [char-syntax 41 34 in-string-p 1 forward-sexp] 3] put sexp end-op list #[nil "ÀÁ!‡" [up-list 1] 2] beginning-op backward-sexp] 4) (defvar file-name-chars "~/A-Za-z0-9---_.${}#%," "\ Characters allowable in filenames.") (byte-code "ÀÁÂÃ#ˆÀÁÄÅ#ˆÆÇÈ\"ˆÀÉÂÊ#ˆÀÉÄË#ˆÆÌÍ\"ˆÆÎÏ\"ˆÆÐÑ\"‡" [put filename end-op #[nil "Áw‡" [file-name-chars nil] 2] beginning-op #[nil "ex‡" [file-name-chars] 2] defalias forward-whitespace #[(ARG) "À !ƒ ÂÃĉ $‡ ÅW….ÆÃĉ#ƒ'Å”fÇ=„'ÈÄxˆ T‰‚‡" [natnump ARG re-search-forward "[ ]+\\|\n" nil 0 re-search-backward 10 " "] 6 nil "p"] buffer end-of-buffer beginning-of-buffer forward-symbol #[(ARG) "À !ƒ ÂÃĉ $‡ ÅW…&ÆÃĉ#ƒÇÈ!ˆ T‰‚‡" [natnump ARG re-search-forward "\\(\\sw\\|\\s_\\)+" nil 0 re-search-backward skip-syntax-backward "w_"] 6 nil "p"] word-at-point #[nil "ÀÁ!‡" [thing-at-point word] 2] sentence-at-point #[nil "ÀÁ!‡" [thing-at-point sentence] 2]] 4) (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 "\ Read a lisp expression from STR, signalling an error if the entire string was not used."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"‡" [defalias form-at-point #[(&optional THING PRED) "ÀÁ ƒ !… )‡" [nil (byte-code "ÀÁ\n†Ã!!‡" [read-from-whole-string thing-at-point THING sexp] 3) ((error)) sexp PRED] 3] sexp-at-point #[nil "ÀÁ!‡" [form-at-point sexp] 2] symbol-at-point #[nil "ÀÁÂ\"‡" [form-at-point sexp symbolp] 3] number-at-point #[nil "ÀÁÂ\"‡" [form-at-point sexp numberp] 3] list-at-point #[nil "ÀÁÂ\"‡" [form-at-point list listp] 3]] 3) emacs-19.22/lisp/time-stamp.elc100666 13437 1 15200 5473277210 15004 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Fri Nov 19 21:18:47 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/time-stamp.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (defvar time-stamp-active t "\ *Non-nil to enable time-stamping of files. See the function time-stamp.") (defvar time-stamp-format (quote (time-stamp-yy/mm/dd time-stamp-hh:mm:ss user-login-name)) "\ *A list of functions to call to generate the time stamp string. Each element of the list is called as a function and the results are concatenated together separated by spaces. Elements may also be strings, which are included verbatim. Spaces are not inserted around literal strings.") (defvar time-stamp-line-limit 8 "\ 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.") (defvar time-stamp-start "Time-stamp: \\\\?[\"<]+" "\ 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 "\\\\?[\">]" "\ Regexp marking the text after the time stamp. \\[time-stamp] deletes the text between the first match of time-stamp-start (which see) and the following match of time-stamp-end on the same line, then writes the time stamp specified by time-stamp-format between them.") (defalias 'time-stamp #[nil "ƒfÁ ;ƒa ;ƒaŠebˆÅ Šyˆ`)Ç#ƒ]`Å ŠÁˆ`)Ç#ƒ\\É”\n\n|ˆbˆË cˆ`\nbˆÌÍ\nÇ#ƒ[Î\n\"ˆ)))‚eÏÐ!ˆ)Á‡" [time-stamp-active nil case-fold-search time-stamp-start time-stamp-end re-search-forward time-stamp-line-limit t start 0 end time-stamp-string search-forward " " untabify message "time-stamp-start or time-stamp-end is not a string"] 4 "\ Update the time stamp string in the buffer. 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 first time-stamp-line-limit lines of the buffer (normally 8) are searched for the time stamp template, and if it is found, a new time stamp is written into it." nil]) (defalias 'time-stamp-string #[nil "À Â\"‡" [time-stamp-fconcat time-stamp-format " "] 3 "\ Generate the new string to be inserted by \\[time-stamp]."]) (defalias 'time-stamp-fconcat #[(list sep) "ÀÁ ƒ/ @9ƒ!\nƒ P @ PÆ‚( @PÁ A‰„ *‡" ["" nil insert-sep-p return-string list sep t] 3 "\ Similar to (mapconcat 'funcall LIST SEP) but LIST can have 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."]) (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))) "\ Assoc list of months and their number.") (byte-code "À‡" [["(zero)" "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"] time-stamp-month-full-names nil] 1) (defvar time-stamp-mail-host nil "\ Name of the host where the user receives mail. See the function time-stamp-mail-host-name.") (defalias 'time-stamp-mail-host-name #[nil "ÀÁ!ƒ ;ƒ † ‡" [boundp time-stamp-mail-host system-name] 2 "\ Return the name of the host where the user receives mail. This is the value of time-stamp-mail-host if bound and a string, otherwise the value of the function system-name."]) (defalias 'time-stamp-current-year #[nil "À ÁÂO‡" [current-time-string -4 nil] 3 "\ Return the current year as a four-character string."]) (defalias 'time-stamp-month-dd-yyyy #[nil "À Âà ŠÆÇO\"AHÉ ÊËO! ÌÍO$)‡" [current-time-string date format "%s %02d, %s" time-stamp-month-full-names assoc 4 7 time-stamp-month-numbers string-to-int 8 10 -4 nil] 7 "\ Return the current date as a string in \"Month dd, yyyy\" form."]) (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 "\ 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-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 "\ Return the current date as a string in \"dd Mon yy\" 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 "\ Return the current date as a string in \"yy/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 "\ Return the current date as a string in \"yyyy/mm/dd\" 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 "\ Return the current date as a string in \"yymmdd\" form."]) (defalias 'time-stamp-dd/mm/yy #[nil "À ÂÃÄ ÅÆO!Ç ÈÉO\n\"A ËÌO$)‡" [current-time-string date format "%02d/%02d/%s" string-to-int 8 10 assoc 4 7 time-stamp-month-numbers -2 nil] 7 "\ Return the current date as a string in \"dd/mm/yy\" form."]) (defalias 'time-stamp-mm/dd/yy #[nil "À ÂÃÄ ÅÆO\"AÈ ÉÊO! ËÌO$)‡" [current-time-string date format "%02d/%02d/%s" assoc 4 7 time-stamp-month-numbers string-to-int 8 10 -2 nil] 7 "\ Return the current date as a string in \"mm/dd/yy\" form."]) (defalias 'time-stamp-hh:mm:ss #[nil "À ÁÂO‡" [current-time-string 11 19] 3 "\ Return the current time as a string in \"hh:mm:ss\" form."]) (defalias 'time-stamp-hh:mm #[nil "À ÁÂO‡" [current-time-string 11 16] 3 "\ Return the current time as a string in \"hh:mm\" form."]) (defalias 'time-stamp-hhmm #[nil "À ‰ÂÃO ÄÅOP)‡" [current-time-string date 11 13 14 16] 5 "\ Return the current time as a string in \"hhmm\" form."]) (provide (quote time-stamp)) emacs-19.22/lisp/time.elc100666 13437 1 5723 5416455724 13660 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Jul 7 01:14:59 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/time.el ;;; emacs version 19.16.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 "This file was compiled for Emacs 19")) (defvar display-time-mail-file nil "\ *File name of mail inbox file, for indicating existence of new mail. Default is system-dependent, and is the same as used by Rmail.") (defvar display-time-day-and-date nil "\ *Non-nil means \\[display-time] should display day and date as well as time.") (byte-code "ÀÁ!„‡" [boundp display-time-process nil] 2) (defvar display-time-interval 60 "\ *Seconds between updates of time in the mode line.") (defvar display-time-24hr-format nil "\ *Non-nill indicates time should be displayed as hh:mm, 0 <= hh <= 23. Nil means 1 <= hh <= 12, and an AM/PM suffix is used.") (byte-code "ÀÁ!„‡" [boundp display-time-string nil] 2) (defvar display-time-hook nil "\ * List of functions to be called when the time is updated on the mode line.") (defalias 'display-time #[nil "… Á!Â=‰?…EƒÄ!ˆ „ÆÇ >„(È É\"ÊËÌÍÏPÐ!$Ò!ˆÓÔ\"ˆÕÖ\")‡" [display-time-process process-status run live delete-process global-mode-string ("") display-time-string append (display-time-string) "" start-process "display-time" nil exec-directory "wakeup" int-to-string display-time-interval process-kill-without-query set-process-sentinel display-time-sentinel set-process-filter display-time-filter] 7 "\ 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'." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias display-time-sentinel #[(proc reason) "À !Â=„\nÊŠqˆ)ÆÇ !ˆÈÉ!‡" [process-status proc run "" display-time-string other-buffer set-buffer-modified-p buffer-modified-p sit-for 0] 2] display-time-filter #[(proc string) "À ÁÂà †!ÅÆ!†!ÅÈ!† ÅÉ!† Ê PÁ‰   ÐÑÒO! „f ÔYƒFÕ‚GÖ  ÔVƒY ÔZ ‚i ×UƒiÔ ‚iØ ÙÚ \"ÒÛO Ü !ƒ‰Ý !ƒ‰Þ‚ŠØ° ƒ×ÑOP-áâ!ˆŠã qˆ)äå !ˆæ×!‡" [current-time-string nil (byte-code "À @ÁUƒ\n‡ÃÄÀ @\"‰ÁÆOÇ ÆÈOQ)‡" [load-average 0 "" format " %03d" str -2 "." nil] 6) ((error "")) display-time-mail-file getenv "MAIL" rmail-spool-directory "LOGNAME" "USER" user-login-name am-pm-flag hour mail-spool-file load time read 11 13 display-time-24hr-format 12 "pm" "am" 0 "" format "%d" 16 file-exists-p display-time-file-nonempty-p " Mail" display-time-string display-time-day-and-date run-hooks display-time-hook other-buffer set-buffer-modified-p buffer-modified-p sit-for] 6] display-time-file-nonempty-p #[(file) "ÀÁÂà !!8W‡" [0 7 file-attributes file-chase-links file] 5]] 3) emacs-19.22/lisp/timer.elc100666 13437 1 6742 5416175603 14037 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:11:47 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/timer.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÂÃ!„\nÄÂÅ!„ÄÂÆ!„Çć" ["timer" timer-program boundp timer-process nil timer-alist timer-out ""] 2) (defvar timer-dont-exit nil "\ If non-nil, don't exit the timer process when no more events are pending.") (defalias 'run-at-time #[(time repeat function &rest args) "¨ƒ\nÁÂ\" ƒÄ !Å>ƒA ƒÆ !ˆÇÉÊÇË  \"#)ÇÏ Ð\"ˆÑ Ò\"ˆÓ !ˆ‚MÄ !Ô=ƒMÕ !ˆÖ ×GQ‰FÝ ÞßR\"ˆB*‡" [time format "%d sec" timer-process process-status (exit signal nil) delete-process nil process-connection-type start-process "timer" expand-file-name timer-program exec-directory 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 repeat function args elt process-send-string "@" "\n"] 7 "\ 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, 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." "sRun at time: \nNRepeat interval: \naFunction: "]) (defalias 'cancel-timer #[(elt) "AÁ ˆAA ‡" [elt nil ignore] 2 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias timer-process-filter #[(proc str) " P‰‰ÆÇ\"ƒ‰ȉ”OÉ \n\"È•ÂO ƒRËÌ 8Í 8\"ˆÎ A@!ƒHÏ A@Ñ @ÇR\"ˆ‚\nÒ \n\"\n‚\nÆÓ \"ƒ\n Ô”Ô•O ̔̕OÉ Í”Í•O\n\"Ò \n\"\nÕÖ!ˆ×Ø Ì 8 $ˆ‚\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 ding no-terminate message "%s for %s; couldn't set at \"%s\"" timer-dont-exit process-send-eof] 6] timer-process-sentinel #[(proc str) "À !‰Ã=ƒÄ !‚( ƒ\"\nÆ=„\"ÇÈ!ˆÉÊ!ˆË ˉ)‡" [process-status proc stat stop continue-process timer-alist exit ding no-terminate message "Timer exited abnormally. All events cancelled." nil timer-process] 3]] 3) (defalias 'cancel-function-timers #[(function) "‰ƒ @8 =ƒÄ @\" A‰„)†) †)Æ!‡" [timer-alist alist 2 function delq timer-dont-exit process-send-eof timer-process] 4 "\ Cancel all events scheduled by `run-at-time' which would run FUNCTION." "aCancel timers of function: "]) (provide (quote timer)) emacs-19.22/lisp/timezone.elc100666 13437 1 20213 5456160055 14555 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Mon Oct 11 00:25:16 1993 ;;; from file /home/fsf/rms/e19/lisp/timezone.el ;;; emacs version 19.19.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"))) (error "This file was compiled for Emacs 19")) (provide (quote timezone)) (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) ("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))) "\ *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 (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))) "\ Alist of first three letters of a month and its numerical representation.") (defalias 'timezone-make-date-arpa-standard #[(date &optional local timezone) "À \n #Å ÆH ÇH ÈHÉ ÊH ËH ÌH# ÍH%)‡" [timezone-fix-time date local timezone new timezone-make-arpa-date 0 1 2 timezone-make-time-string 3 4 5 6] 9 "\ 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-sortable #[(date &optional local timezone) "À \n #Å ÆH ÇH ÈHÉ ÊH ËH ÌH#$)‡" [timezone-fix-time date local timezone new timezone-make-sortable-date 0 1 2 timezone-make-time-string 3 4 5] 9 "\ 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-arpa-date #[(year month day time &optional timezone) "<ƒ.Á!‰ÃWƒ\n[‚\nÅÆ\nÃWƒ\"Ç‚#È É¥ ɦ$*‚/\nÅË ÍÎ\"@!\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 "\ Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. Optional argument TIMEZONE specifies a time zone."]) (defalias 'timezone-make-sortable-date #[(year month day time) "ÀÁ\n %‡" [format "%4d%02d%02d%s" year month day time] 6 "\ Make sortable date string from YEAR, MONTH, DAY, and TIME."]) (defalias 'timezone-make-time-string #[(hour minute second) "ÀÁ\n $‡" [format "%02d:%02d:%02d" hour minute second] 5 "\ Make time string from HOUR, MINUTE, and SECOND."]) (defalias 'timezone-parse-date #[(date) "†Á‰‰‰‰ÈÉ\"ƒ(ÊËÌÍ‚“ÈÎ\"ƒ>ÊËÌÍÏ‚“ÈÐ\"ƒTÍÌËÊ‚“ÈÑ\"ƒjÏÌËÊÍ‚“ÈÒ\"ƒ€ÊËÌÍÏ‚“ÈÓ\"ƒ“ÊËÌ̓Ԕ•O‰GÍWƒ²ÔÕÂOPÖ×””Ê\\O–\"A! ” •O ” •O ƒß ” •OƒðÙ %‚÷ÙÚ‰‰‰Â%.‡" [date "" nil zone time day month year string-match "\\([0-9]+\\)[ ]+\\([^ ,]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+:[0-9:]+\\)[ ]*\\'" 3 2 1 4 "\\([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 int-to-string assoc timezone-months-assoc vector "0"] 7 "\ 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"]) (defalias 'timezone-parse-time #[(time) "†Á‰‰ÆÇ\"ƒÈÉÊ‚IÆË\"ƒ,ÈÉ‚IÆÌ\"ƒ<ÈÉÊ‚IÆÍ\"ƒIÈÉÂÎ ƒW ” •O‚XÏ ƒe ” •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 "\ Parse TIME (HH:MM:SS) and return a vector [hour minute second]. Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."]) (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 "\ 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-time-from-absolute #[(date seconds) "À\n ZÄÅ! _\\ÄÈ! Ê ¥!‰  _ Ê Z! Î  \\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 "\ 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-zone-from-absolute #[(date seconds) "ÀÁ!… \"‰…Á !‰@…))‡" [fboundp current-time-zone timezone-time-from-absolute date seconds utc-time zone] 4 "\ 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-fix-time #[(date local timezone) "À ! ÃH!‰ÅWƒ Æ\\‚  ÇH! ÉH!\nË ÌH!  ÃH! ÇH! ÉH! ÑH†M†iÔÕ\n #Ö_\\Ö_\\\"×!×!Z\\ÙÖ\"\\Ö_ZÛXƒÉÛZ\nT\nÜ \"\nWƒûTÇ\nÝWƒûÇ T‚ûÃVƒûÛ\\\nS\nÇ\nVƒûSÇVƒôÝ SÜ \"\nÞ \n&.‡" [timezone-parse-date date string-to-int 0 year 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 "\ 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-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 "\ The last day in MONTH during YEAR."]) (defalias 'timezone-leap-year-p #[(year) "Á¦ÂUƒæÂU?†ĦÂU‡" [year 4 0 100 400] 2 "\ Returns t if YEAR is a Gregorian leap 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 "\ Return the day number within the year of the date month/day/year."]) (defalias 'timezone-absolute-from-gregorian #[(month day year) "À \n # SÄ_ SÅ¥ SÆ¥[ SÇ¥\\\\\\\\‡" [timezone-day-number month day year 365 4 100 400] 6 "\ 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."]) emacs-19.22/lisp/tpu-edt.elc100666 12120 1 134414 5475604661 14211 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 03:02:56 1993 ;;; from file /home/fsf/rms/e19/lisp/tpu-edt.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defconst tpu-version "3.2" "\ TPU-edt version number.") (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.") (defconst tpu-emacs19-p (byte-code "Á™?‡" [emacs-version "19"] 2) "\ Non-NIL if we are running Lucid or GNU Emacs version 19.") (defconst tpu-gnu-emacs18-p (null tpu-emacs19-p) "\ Non-NIL if we are running GNU Emacs version 18.") (defconst tpu-lucid-emacs19-p (byte-code "…Á \"‡" [tpu-emacs19-p string-match "Lucid" emacs-version] 3) "\ Non-NIL if we are running Lucid Emacs version 19.") (defconst tpu-gnu-emacs19-p (byte-code "… ?‡" [tpu-emacs19-p tpu-lucid-emacs19-p] 1) "\ Non-NIL if we are running GNU Emacs version 19.") (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.") (byte-code "ƒÁÂ!„ à ÄÂÅÆ#ˆÁ‡" [tpu-lucid-emacs19-p boundp minibuffer-local-ns-map make-sparse-keymap put variable-documentation "Hack to give Lucid emacs the same maps as GNU emacs."] 4) (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 t "\ 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.") (defvar tpu-newline-and-indent-p nil "\ If non-nil, Return produces a newline and indents.") (make-variable-buffer-local (quote tpu-newline-and-indent-p)) (defvar tpu-newline-and-indent-string nil "\ Mode line string to identify AutoIndent mode.") (make-variable-buffer-local (quote tpu-newline-and-indent-string)) (defvar tpu-saved-delete-func nil "\ Saved value of the delete key.") (make-variable-buffer-local (quote tpu-saved-delete-func)) (defvar tpu-buffer-local-map nil "\ TPU-edt buffer local key map.") (byte-code "ÀÁ!ˆÂÃ!„ ÂÅ!„ÂÇ!„ÈÀÇ!‡" [make-variable-buffer-local tpu-buffer-local-map boundp tpu-original-mode-line mode-line-format tpu-original-mm-alist minor-mode-alist tpu-mark-flag " "] 2) (defalias 'tpu-set-mode-line #[(for-tpu) "„\n  ‰‡ÅÂÆÇ!ÈÉÆÊ!ËÆÊ!ÌÆÍ!ÎÄÏÐÆÑ!ÆÒ!ÆÓ!¯\"ˆÔ ž„7Õ BÖ ž„A× BØ ž†LÙ B‰‡" [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 "%n" mode-line-process ")%]----" (-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)] 18 "\ Set the mode for TPU-edt, or reset it to default Emacs."]) (defalias 'tpu-update-mode-line #[nil "À ƒ Á‚\n ƒÅ ‡ÆÇ !ˆÈÉ!‡" [tpu-mark "M" " " tpu-mark-flag tpu-emacs19-p force-mode-line-update set-buffer-modified-p buffer-modified-p sit-for 0] 2 "\ Make sure mode-line in the current buffer reflects all changes."]) (byte-code "ƒÁÂÃ\"ˆÁÄÃ\"ˆ‚ ƒÁÆÃ\"ˆÁÇÃ\"ˆÈÉ!„)Ê  ÈË!„3Ê  Á‡" [tpu-gnu-emacs19-p add-hook activate-mark-hook tpu-update-mode-line deactivate-mark-hook tpu-lucid-emacs19-p zmacs-deactivate-region-hook zmacs-activate-region-hook boundp tpu-match-beginning-mark make-marker tpu-match-end-mark] 3) (defalias 'tpu-set-match #[nil "ÀÁ”T!ÀÁ•!‰‡" [copy-marker 0 tpu-match-beginning-mark tpu-match-end-mark] 2 "\ Set markers at match beginning and end."]) (defalias 'tpu-unset-match #[nil "Á‰“ˆ\nÁ‰“‡" [tpu-match-beginning-mark nil tpu-match-end-mark] 3 "\ Unset match beginning and end markers."]) (defalias 'tpu-match-beginning #[nil "À !S‡" [marker-position tpu-match-beginning-mark] 2 "\ Returns the location of the last match beginning."]) (defalias 'tpu-match-end #[nil "À !‡" [marker-position tpu-match-end-mark] 2 "\ Returns the location of the last match end."]) (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 "\ Returns t if point is between tpu-match markers. Otherwise sets the tpu-match markers to nil and returns nil."]) (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 "\ Show the values of the match markers." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias tpu-caar #[(thingy) "@@‡" [thingy] 1] tpu-cadr #[(thingy) "A@‡" [thingy] 1]] 3) (defalias 'tpu-mark #[nil "ƒ Á\n?!‡ ƒ …Á ?!‡Á ‡" [tpu-lucid-emacs19-p mark zmacs-regions tpu-gnu-emacs19-p mark-active transient-mark-mode] 2 "\ TPU-edt version of the mark function. Return the appropriate value of the mark for the current version of emacs."]) (defalias 'tpu-set-mark #[(pos) "À !ˆ\n… …à ‡" [set-mark pos tpu-lucid-emacs19-p zmacs-activate-region] 2 "\ 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-string-prompt #[(prompt history-symbol) "ƒ Á\nɉ %‡Å\n!‡" [tpu-emacs19-p read-from-minibuffer prompt nil history-symbol read-string] 6 "\ Read a string with PROMPT."]) (defvar tpu-last-answer nil "\ Most recent response to tpu-y-or-n-p.") (defalias 'tpu-y-or-n-p #[(prompt &optional not-yes) "ÀÁ ƒ Å‚ Æ#!ˆÇƒ|ÉÊ ‰ ÌU„3 ÍU„3 ÎUƒ9Ç‚x ÐU„N ÑU„N ÒUƒTÉ‚x ÓUƒb ?‚xÇÔ ˆÀÁÕ ƒ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 "\ 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 '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 "\ Replace a key in the TPU-edt local key map. Create the key map if necessary."]) (defalias 'tpu-current-line #[nil "ÀÁ `\"iÂUƒÂÂÄ\\\\‡" [count-lines window-start 0 1 -1] 3 "\ Return the vertical position of point in the selected window. Top line is 0. Counts each text line only once, even if it wraps."]) (defvar tpu-breadcrumb-plist nil "\ The set of user-defined markers (breadcrumbs), as a plist.") (defalias 'tpu-drop-breadcrumb #[(num) "À \np`D#ˆÃÄ\n\"‡" [put tpu-breadcrumb-plist num message "Mark %d set."] 5 "\ Drops a breadcrumb that can be returned to later with goto-breadcrumb." "p"]) (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 "\ Returns to a breadcrumb set with drop-breadcrumb." "p"]) (defalias 'tpu-change-case #[(num) "À ƒ/Á   Vƒ* f— fUƒÅ‚Æ ‰T\"ˆ T‚ ÇÈ!*‡É ƒ]Ê Ë  VƒY f— fUƒMÅ‚NÆ ‰T\"ˆ T‚:Ì *‡ Î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 "\ Change the case of the character under the cursor or region. Accepts a prefix argument of the number of characters to invert." "p"]) (defalias 'tpu-fill #[(num) "À ƒÁ`À \n#ˆÃÄ!‡Å\n!‡" [tpu-mark fill-region num tpu-unselect t fill-paragraph] 4 "\ Fill paragraph or marked region. With argument, fill and justify." "P"]) (defalias 'tpu-version #[nil "ÀÁ\n\"‡" [message "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)" tpu-version] 3 "\ Print the TPU-edt version number." nil]) (defalias 'tpu-reset-screen-size #[(height width) "À !ˆÂ !‡" [set-screen-height height set-screen-width width] 2 "\ Sets the screen size." "nnew screen height: \nnnew screen width: "]) (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 "\ Toggle between 'newline and indent' and 'simple newline'." nil]) (defalias 'tpu-spell-check #[nil "ƒÁ ƒÂÁ `\"ˆ‚)à ˆ‚)Á ƒ&ÄÁ `\"ˆ‚)Å ˆÁ …1ÆÇ!‡" [tpu-have-ispell tpu-mark ispell-region ispell-buffer spell-region spell-buffer tpu-unselect t] 3 "\ Checks the spelling of the region, or of the entire buffer if no region is selected." nil]) (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 "\ Switches in and out of overwrite mode" nil]) (defalias 'tpu-special-insert #[(num) "ƒÁÂ!ˆ ƒ ‚Äc‡" [overwrite-mode delete-char 1 num 0] 2 "\ Insert a character or control code according to its ASCII decimal value." "P"]) (defalias 'tpu-quoted-insert #[(num) "À \nƒ à !ˆÅ \")‡" [read-char char overwrite-mode delete-char num insert-char] 3 "\ Read next input character and insert it. This is useful for inserting control characters." "*p"]) (defalias 'tpu-include #[(file) "ŠÀ !ˆÂÃ!)‡" [insert-file file message ""] 2 "\ TPU-like include file" "fInclude file: "]) (defalias 'tpu-get #[(file) "À !‡" [find-file file] 2 "\ TPU-like get file" "FFile to get: "]) (defalias 'tpu-what-line #[nil "mƒ ÀÁÂÃd\"\"‡ÀÄÂÃ`T\"ÂÃd\"#‡" [message "You are at the End of Buffer. The last line is %d." count-lines 1 "Line %d of %d"] 6 "\ Tells what line the point is on, and the total number of lines in the buffer." nil]) (defalias 'tpu-exit #[nil "À Á=„\n ‡Ã ˆÄ ‡" [recursion-depth 0 exit-recursive-edit save-buffer save-buffers-kill-emacs] 2 "\ Exit the way TPU does, save current buffer and ask about others." nil]) (defalias 'tpu-quit #[nil "À Á ƒ2\nƒ2 @Å !ƒ+Æ !ƒ+ÇÈ!ƒ)ÉÁ!ˆ‚+Ê 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 "\ Quit the way TPU does, ask to make sure changes should be abandoned." 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ˆé*ë,íî!„„ïðñ\".íò!„ïðó\"2íô!„™õ4íö!„¢÷6íø!„«ù8íú!„´û:À‡" [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 " \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 "\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\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 \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\n G Get - load a file into a new edit buffer\n I Include - include a file in this buffer\n K Kill Buffer - abandon edits and delete buffer\n\n M Buffer Menu - display a list of all buffers\n N Next File Buffer - display next buffer containing a file\n O Occur - show following lines containing REGEXP\n\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 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 \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) (defalias 'tpu-help #[nil "À‹‡" [((byte-code "ÀÁ!„ÂÁ!ˆÃÁ!ˆ cˆ 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 2 describe-key key-binding sit-for 3] 3))] 1 "\ Display TPU-edt help." nil]) (defalias 'tpu-insert-escape #[nil "Àc‡" [""] 1 "\ Inserts an escape character, and so becomes the escape-key alias." nil]) (defalias 'tpu-insert-formfeed #[nil "Àc‡" [" "] 1 "\ Inserts a formfeed character." nil]) (defvar tpu-saved-control-r nil "\ Saved value of Control-r.") (defalias 'tpu-end-define-macro-key #[(key) "ÀÁ!ˆÂ \"ˆÂÅ\"‡" [end-kbd-macro nil global-set-key key last-kbd-macro "" tpu-saved-control-r] 3 "\ Ends the current macro definition" "kPress the key you want to use to do what was just learned: "]) (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 "\ Bind a set of keystrokes to a single key, or key combination." nil]) (defalias 'tpu-kill-buffer #[nil "ƒÁÂ!ˆÃp!‡" [tpu-kill-buffers-silently set-buffer-modified-p nil kill-buffer] 2 "\ Kills the current buffer. If tpu-kill-buffers-silently is non-nil, kills modified buffers without asking." nil]) (defalias 'tpu-save-all-buffers-kill-emacs #[nil "ÀÂÀ!‡" [t trim-versions-without-asking save-buffers-kill-emacs] 2 "\ Save all buffers and exit emacs." nil]) (defalias 'tpu-write-current-buffers #[nil "ÀÁ!‡" [save-some-buffers t] 2 "\ Save all modified buffers without exiting." nil]) (defalias 'tpu-next-buffer #[nil "ÀÁ !@!‡" [switch-to-buffer reverse buffer-list] 3 "\ Go to next buffer in ring." nil]) (defalias 'tpu-next-file-buffer #[nil "À ÂÃÄ !@!ˆÀ š„\"Å „\"ÂÃÄ !@!ˆ‚ À š…,ÆÇ!)‡" [buffer-name starting-buffer switch-to-buffer reverse buffer-list buffer-file-name error "No other buffers."] 3 "\ Go to next buffer in ring that is visiting a file." nil]) (defalias 'tpu-next-window #[nil "À ƒ ÁÂ!‡ÃÄ!‡" [one-window-p message "There is only one window on screen." other-window 1] 2 "\ Move to the next window." nil]) (defalias 'tpu-previous-window #[nil "À ƒ ÁÂ!‡ÃÄ !‡" [one-window-p message "There is only one window on screen." select-window previous-window] 2 "\ Move to the previous window." nil]) (defalias 'tpu-toggle-regexp #[nil "?Á ˆt…ÂÃĂÅ\"‡" [tpu-regexp-p tpu-set-search message "Regular expression search and substitute %sabled." "en" "dis"] 3 "\ Switches in and out of regular expression search and replace mode." nil]) (defalias 'tpu-regexp-prompt #[(prompt) "…Á\nP ƒŠƉ‰Ç%‚È !)‡" [tpu-regexp-p "RE " prompt re-prompt tpu-emacs19-p read-from-minibuffer nil tpu-regexp-prompt-hist read-string] 6 "\ Read a string, adding 'RE' to the prompt if tpu-regexp-p is set."]) (defalias 'tpu-search #[nil "À ˆÁÂ!‡" [tpu-set-search tpu-search-internal ""] 2 "\ Search for a string or regular expression. The search is performed in the current direction." nil]) (defalias 'tpu-search-forward #[nil "ÀÂÀ!ˆÃÄ!‡" [t tpu-searching-forward tpu-set-search tpu-search-internal ""] 2 "\ Search for a string or regular expression. The search is begins in the forward direction." nil]) (defalias 'tpu-search-reverse #[nil "ÀÂÃ!ˆÄÅ!‡" [nil tpu-searching-forward tpu-set-search t tpu-search-internal ""] 2 "\ Search for a string or regular expression. The search is begins in the reverse direction." nil]) (defalias 'tpu-search-again #[nil "À !‡" [tpu-search-internal tpu-search-last-string] 2 "\ Search for the same string or regular expression as last time. The search is performed in the current direction." nil]) (defalias 'tpu-set-search #[(&optional arg) "„\n …  ƒ\" ƒÅÆMˆÇÈM‡ÅÉMˆÇÊM‡ ƒ.ÅÈ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 "\ 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-search-internal #[(pat &optional quiet) "Á˜„\n‚ ÂÃ!Å ˆÆ ˆÇ ÈÉ#ƒ#Ê ˆË b‡ÆÉ!ˆÈ‰  Š?Æ ˆÏ ÈÉ# Д * ƒeÑÒÓƒSÔ‚TÕ\"!…y bˆÊ ˆÖ ‚y?…yØÙƒvÛ‚wÁ #*‡" [pat "" tpu-regexp-prompt "Search: " tpu-search-last-string tpu-unset-match tpu-adjust-search 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 "\ Search for a string or regular expression."]) (byte-code "ÀÁKM‡" [tpu-search-internal-core tpu-search-internal] 2) (defalias 'tpu-adjust-search #[(&optional arg) "… ƒo?…Âu‡m?…Ãu‡" [tpu-searching-forward arg -1 1] 1 "\ For forward searches, move forward a character before searching, and backward a character after a failed search. Arg means end of search."]) (defalias 'tpu-toggle-search-direction #[nil "?ÁÂ!ˆt…ÃăłÆ\"‡" [tpu-searching-forward tpu-set-search t message "Searching %sward." "for" "back"] 3 "\ Toggle the TPU-edt search direction. Used for reversing a search in progress." nil]) (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 "\ Sets the mark to define one end of a region." "P"]) (defalias 'tpu-unselect #[(&optional quiet) "ÀÂÀ!ˆÃ ˆ ?…ÅÆ!‡" [nil mark-ring tpu-set-mark tpu-update-mode-line quiet message "Selection canceled."] 2 "\ Removes the mark to unselect the current region." "P"]) (defalias 'tpu-toggle-rectangle #[nil "?‰ƒ Á‚ ÂÄ ˆt… ÅƃǂÈ\"‡" [tpu-rectangular-p " Rect" "" tpu-rectangle-string tpu-update-mode-line message "Rectangular cut and paste %sabled." "en" "dis"] 4 "\ Toggle rectangular mode for remove and insert." nil]) (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 "\ Adjust point and mark to mark upper left and lower right corners of a rectangle."]) (defalias 'tpu-cut-text #[nil "À ƒ' ƒ ˆÃ`À ?#ˆÅÆ!‡À `{À `|ˆÅÆ!‡È ƒDÉ Ê  ‰  {  |ˆÍ *‡ÎÏ!‡" [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 "\ Delete the selected region. The text is saved for the tpu-paste command." nil]) (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 "\ Copy the selected region to the cut buffer without deleting it. The text is saved for the tpu-paste command." nil]) (defalias 'tpu-cut #[(arg) "ƒÁ ‡Â ‡" [arg tpu-store-text tpu-cut-text] 1 "\ Copy selected region to the cut buffer. In the absence of an argument, delete the selected region too." "P"]) (defalias 'tpu-append-region #[(arg) "À ƒÁ   {P„ |ˆÇÈ!*‡É ƒ=Ê Ë  {P„9 |ˆÌ *‡ÍÎ!‡" [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 "\ Append selected region to the tpu-cut buffer. In the absence of an argument, delete the selected region too." "P"]) (defalias 'tpu-delete-current-line #[(num) "` yˆhÂ=„Ãcˆ`{`|)‡" [beg num 10 "\n" tpu-last-deleted-lines] 2 "\ 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." "p"]) (defalias 'tpu-delete-to-eol #[(num) "`Áuˆ\nˆ`{`|)‡" [beg 1 num tpu-last-deleted-lines] 2 "\ 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." "p"]) (defalias 'tpu-delete-to-bol #[(num) "`Á\n!ˆ`{`|)‡" [beg tpu-next-beginning-of-line num tpu-last-deleted-lines] 2 "\ 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." "p"]) (defalias 'tpu-delete-current-word #[(num) "`Á\n!ˆ`{`|)‡" [beg tpu-forward-to-word num tpu-last-deleted-words] 2 "\ Delete one or specified number of words after point. They are saved for the TPU-edt undelete-words command." "p"]) (defalias 'tpu-delete-previous-word #[(num) "`Á\n!ˆ`{`|)‡" [beg tpu-backward-to-word num tpu-last-deleted-words] 2 "\ Delete one or specified number of words before point. They are saved for the TPU-edt undelete-words command." "p"]) (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 "\ Delete one or specified number of characters after point. The last character deleted is saved for the TPU-edt undelete-char command." "p"]) (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 "\ Insert the last region or rectangle of killed text. With argument reinserts the text that many times." "p"]) (defalias 'tpu-undelete-lines #[(num) "` ÂVƒ cˆ S‰‚b)‡" [beg num 0 tpu-last-deleted-lines] 3 "\ Insert lines deleted by last TPU-edt line-deletion command. With argument reinserts lines that many times." "p"]) (defalias 'tpu-undelete-words #[(num) "` ÂVƒ cˆ S‰‚b)‡" [beg num 0 tpu-last-deleted-words] 3 "\ Insert words deleted by last TPU-edt word-deletion command. With argument reinserts words that many times." "p"]) (defalias 'tpu-undelete-char #[(num) "ÁV…\nƒÃuˆÄÅ!ˆcˆÃuˆS‰‚‡" [num 0 overwrite-mode -1 delete-char 1 tpu-last-deleted-char] 3 "\ Insert character deleted by last TPU-edt character-deletion command. With argument reinserts the character that many times." "p"]) (defalias 'tpu-replace #[nil "À ƒÁ  ‰ { |ˆ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 "\ Replace the selected region with the contents of the cut buffer." nil]) (defalias 'tpu-substitute #[(num) "À „\nÁ ƒJ\nÃU?…IÀ „Á …M`Å ˆƒ+Çuˆ‚. bˆ\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 "\ 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." "p"]) (defalias 'tpu-lm-replace #[(from to) "ÀÁ ŘƒÆÇ!ˆÈ ˆÉ À\"ˆ ƒ?Ê „%ˉ‚ÌÍ!ˆÎ ‰ÐU„HÑU„HÒU„HÓUƒq`Õ??#ˆ\nTƒdÚuˆ‚hbˆ)É À\"ˆ‚;ÛU„†ÜU„†ÝUƒŽÉ À\"ˆ‚;ÞU„œßUƒ÷Š`Õ??#ˆ\nTƒ¹Úuˆ‚½bˆ)à À\"ˆÊ ƒñ`Õ??#ˆ\nTƒäÚuˆ‚èbˆ)à À\"ˆ‚Ã)Ë‚;á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 "\ Interactively search for OLD-string and substitute NEW-string." (list (tpu-regexp-prompt "Old String: ") (tpu-regexp-prompt "New String: "))]) (defalias 'tpu-emacs-replace #[(&optional dont-ask) "ƒÁà ƒÅ‚Æ!‡Ã ƒÇ‚È!‡" [dont-ask nil current-prefix-arg call-interactively tpu-regexp-p replace-regexp replace-string query-replace-regexp query-replace] 2 "\ 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." "P"]) (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 "\ Add text to the beginning of each line in a region, or each line in the entire buffer if no region is selected." (list (tpu-string-prompt "String to add: " (quote tpu-add-at-bol-hist)))]) (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 "\ Add text to the end of each line in a region, or each line of the entire buffer if no region is selected." (list (tpu-string-prompt "String to add: " (quote tpu-add-at-eol-hist)))]) (defalias 'tpu-trim-line-ends #[nil "À ‡" [picture-clean] 1 "\ Removes trailing whitespace from every line in the buffer." nil]) (defalias 'tpu-char #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-forward-char num tpu-backward-char] 2 "\ Move to the next character in the current direction. A repeat count means move that many characters." "p"]) (defalias 'tpu-forward-char #[(num) "u‡" [num] 1 "\ Move right ARG characters (left if ARG is negative)." "p"]) (defalias 'tpu-backward-char #[(num) "À !‡" [backward-char num] 2 "\ Move left ARG characters (right if ARG is negative)." "p"]) (defconst tpu-word-separator-list nil "\ List of additional word separators.") (defconst tpu-skip-chars "^ " "\ Characters to skip when moving by word. Additional word separators are added to this string.") (defalias 'tpu-word #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-forward-to-word num tpu-backward-to-word] 2 "\ Move to the beginning of the next word in the current direction. A repeat count means move that many words." "p"]) (defalias 'tpu-forward-to-word #[(num) "ÁV…Bm?…B`È`\nbˆlƒÅuˆ‚:`f>ƒ1ÅuˆÇ wˆ‚: wˆÇ wˆ*S‰‚‡" [num 0 beg nil end 1 tpu-word-separator-list " " tpu-skip-chars] 3 "\ Move forward until encountering the beginning of a word. With argument, do this that many times." "p"]) (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 "\ Move backward until encountering the beginning of a word. With argument, do this that many times." "p"]) (defalias 'tpu-add-word-separators #[(separators) "À\nG W…]\n H\n ‰TO‰>„VÇ \" ÈUƒ2 ÊP ‚V ËUƒA ÌP ‚V ÍUƒP ÎP ‚V P T*‚*‡" [0 n separators length ss char tpu-word-separator-list append 45 tpu-skip-chars "\\-" 92 "\\\\" 94 "\\^"] 5 "\ Add new word separators for TPU-edt word commands." "sSeparators: "]) (defalias 'tpu-reset-word-separators #[nil "À‰‡" [nil tpu-word-separator-list "^ " tpu-skip-chars] 2 "\ Reset word separators to default value." nil]) (defalias 'tpu-set-word-separators #[(separators) "À ˆÁ\n!‡" [tpu-reset-word-separators tpu-add-word-separators separators] 2 "\ Set new word separators for TPU-edt word commands." "sSeparators: "]) (defalias 'tpu-next-line #[(num) "À !ˆÂ‰‡" [next-line-internal num next-line this-command] 2 "\ Move to next line. Prefix argument serves as a repeat count." "p"]) (defalias 'tpu-previous-line #[(num) "À [!ˆÂ‰‡" [next-line-internal num previous-line this-command] 2 "\ Move to previous line. Prefix argument serves as a repeat count." "p"]) (defalias 'tpu-next-beginning-of-line #[(num) "ÀÁ!ˆÁ\nZy‡" [backward-char 1 num] 2 "\ 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." "p"]) (defalias 'tpu-end-of-line #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-next-end-of-line num tpu-previous-end-of-line] 2 "\ Move to the next end of line in the current direction. A repeat count means move that many lines." "p"]) (defalias 'tpu-next-end-of-line #[(num) "Àuˆ ‡" [1 num] 1 "\ 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." "p"]) (defalias 'tpu-previous-end-of-line #[(num) "À Z‡" [1 num] 2 "\ Move EOL upward. Accepts a prefix argument for the number of lines to move." "p"]) (defalias 'tpu-current-end-of-line #[nil "`Áˆ`U…ÂÃ!)‡" [beg nil message "You are already at the end of a line."] 2 "\ Move point to end of current line." nil]) (defalias 'tpu-line #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-forward-line num tpu-backward-line] 2 "\ Move to the beginning of the next line in the current direction. A repeat count means move that many lines." "p"]) (defalias 'tpu-forward-line #[(num) "y‡" [num] 1 "\ Move to beginning of next line. Prefix argument serves as a repeat count." "p"]) (defalias 'tpu-backward-line #[(num) "[y‡" [num] 1 "\ Move to beginning of previous line. Prefix argument serves as repeat count." "p"]) (defalias 'tpu-paragraph #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-next-paragraph num tpu-previous-paragraph] 2 "\ Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." "p"]) (defalias 'tpu-next-paragraph #[(num) "Àyˆm„- ÀVƒ-ÂÃÄÅ#ƒ'ÂÆÄÅ#ƒ$À”bˆ‚'dbˆ S‚ÀyˆÄ‡" [0 num re-search-forward "^[ ]*$" nil t "[^ \n]"] 4 "\ Move to beginning of the next paragraph. Accepts a prefix argument for the number of paragraphs." "p"]) (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 "\ Move to beginning of previous paragraph. Accepts a prefix argument for the number of paragraphs." "p"]) (defalias 'tpu-page #[(num) "ƒ Á\n!ˆ‚Ã\n!ˆm…ÄÅ!‡" [tpu-advance forward-page num backward-page recenter -1] 2 "\ Move to the next page in the current direction. A repeat count means move that many pages." "p"]) (defalias 'tpu-scroll-window #[(num) "ƒÁ\n!‡Ã\n!‡" [tpu-advance tpu-scroll-window-up num tpu-scroll-window-down] 2 "\ Scroll the display to the next section in the current direction. A repeat count means scroll that many sections." "p"]) (defalias 'tpu-scroll-window-down #[(num) "À  S _Æ¥_È[!ˆ V… ÉÊ!+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal recenter 0] 3 "\ Scroll the display down to the next section. A repeat count means scroll that many sections." "p"]) (defalias 'tpu-scroll-window-up #[(num) "À  S _Æ¥_È!ˆ \\ Y…!ÉÊ!+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal recenter -1] 3 "\ Scroll the display up to the next section. A repeat count means scroll that many sections." "p"]) (defalias 'tpu-pan-right #[(num) "À \n_!‡" [scroll-left tpu-pan-columns num] 3 "\ Pan right tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll." "p"]) (defalias 'tpu-pan-left #[(num) "À \n_!‡" [scroll-right tpu-pan-columns num] 3 "\ Pan left tpu-pan-columns (16 by default). Accepts a prefix argument for the number of tpu-pan-columns to scroll." "p"]) (defalias 'tpu-move-to-beginning #[nil "eb‡" [] 1 "\ Move cursor to the beginning of buffer, but don't set the mark." nil]) (defalias 'tpu-move-to-end #[nil "dbˆÀÁ!‡" [recenter -1] 2 "\ Move cursor to the end of buffer, but don't set the mark." nil]) (defalias 'tpu-goto-percent #[(perc) "ÁV„ ÂWƒÃÄ\"‡d_Á¥b‡" [perc 100 0 error "Percentage %d out of range 0 < percent < 100"] 3 "\ Move point to ARG percentage of the buffer." "NGoto-percentage: "]) (defalias 'tpu-beginning-of-window #[nil "ÀÁ!‡" [move-to-window-line 0] 2 "\ Move cursor to top of window." nil]) (defalias 'tpu-end-of-window #[nil "ÀÁ!‡" [move-to-window-line -1] 2 "\ Move cursor to bottom of window." nil]) (defalias 'tpu-line-to-bottom-of-window #[nil "ÀÁ!‡" [recenter -1] 2 "\ Move the current line to the bottom of the window." nil]) (defalias 'tpu-line-to-top-of-window #[nil "ÀÁ!‡" [recenter 0] 2 "\ Move the current line to the top of the window." nil]) (defalias 'tpu-advance-direction #[nil "ÀÂÄÆ ˆÇ ‡" [" Advance" tpu-direction-string t tpu-advance nil tpu-reverse tpu-set-search tpu-update-mode-line] 1 "\ Set TPU Advance mode so keypad commands move forward." nil]) (defalias 'tpu-backup-direction #[nil "ÀÂÄÆ ˆÇ ‡" [" Reverse" tpu-direction-string nil tpu-advance t tpu-reverse tpu-set-search tpu-update-mode-line] 1 "\ Set TPU Backup mode so keypad commands move backward." 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#ˆÀ  \n#ˆÀ  #ˆ!ƒ~À \n#ˆÀ #ˆÀ Zñ#ˆÀ [§#ˆÀ ^#ˆÀ cí#ˆÀ gï#ˆÀ hi#ˆÀ j#ˆÀ q#ˆÀ u#ˆÀ w#ˆÀ x#ˆÀ |é#‡" [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 " " 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 "" quoted-insert tpu-current-end-of-line tpu-insert-formfeed recenter tpu-delete-to-bol tpu-quoted-insert redraw-display] 4) (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" " " " " "" "" "" "" ""] 7 "\ Set control keys to TPU or emacs style functions."]) (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 "\ Toggles control key bindings between TPU-edt and Emacs." nil]) (defalias 'tpu-next-history-element #[(n) "À !ˆdb‡" [next-history-element n] 2 "\ Insert the next element of the minibuffer history into the minibuffer." "p"]) (defalias 'tpu-previous-history-element #[(n) "À !ˆdb‡" [previous-history-element n] 2 "\ Insert the previous element of the minibuffer history into the minibuffer." "p"]) (defalias 'tpu-arrow-history #[nil "ÀÁ!‰@‰ƒ7Å Ç#ˆÅ Ç#ˆÅ Ç#ˆÅ\n Ç#ˆÅ Ç#ˆ A‰‚ÀÌ!‰@‰…lÅ Í#ˆÅ Í#ˆÅ Í#ˆÅ\n Í#ˆÅ Í#ˆ A‰‚<*‡" [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 "\ Modify minibuffer maps to use arrows for history recall." nil]) (defalias 'tpu-load-xkeys #[(file) "ƒ Á!‚)\nƒÁ\n!‚) ƒ!ÁÄ!‚) ƒ)ÁÆ!Ç!ƒ3È!‡ÉÊ!ˆË ˆÌcˆÍΉÏÁÐ!C\"„‡ƒ‡@ÕÖ@\"ƒiׂjØQÙ!ƒÚ!„ÛA‚Oƒ ÜÝ\"cˆÞß!…¦È!‚¦àcˆáâ!,‡" [file expand-file-name tpu-xkeys-file tpu-gnu-emacs19-p "~/.tpu-gnu-keys" tpu-lucid-emacs19-p "~/.tpu-lucid-keys" 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-exists-p 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 "\ 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-gnu-keys for GNU emacs." "fX key definition file: "]) (defalias 'tpu-edt-on #[nil "?…SÁÂ!ˆÃÄ!ˆ ƒ ƒÇÈ!ˆÉ ˆ‚<ÊËÌÍÄ$ˆÊÎÌÏÄ$ˆÊÐÌÑÄ$ˆÊÒÌÓÄ$ˆÔÄ!ˆÕ ˆÖ×Ø\"ˆÖÙÄ\"ˆÚĉ‡" [tpu-edt-mode require picture tpu-reset-control-keys t tpu-emacs19-p window-system tpu-load-xkeys nil tpu-arrow-history autoload ispell-word "ispell" "Check spelling of word at or before point" 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 " " truncate-lines 1 scroll-step] 5 "\ Turn on TPU/edt emulation." nil]) (defalias 'tpu-edt-off #[nil "…!ÁÂ!ˆÃÂ!ˆÄÅÆ\"ˆÄÇÂ\"ˆÈ Ê !ˆÂ‰‡" [tpu-edt-mode tpu-reset-control-keys nil tpu-set-mode-line set-default page-delimiter "^ " truncate-lines 0 scroll-step use-global-map global-map] 3 "\ Turn off TPU/edt emulation. Note that the keypad is left on." nil]) (byte-code "À ˆÁÂ!‡" [tpu-edt-mode provide tpu-edt] 2) emacs-19.22/lisp/tpu-extras.elc100666 12120 1 21256 5475604721 14717 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 03:03:29 1993 ;;; from file /home/fsf/rms/e19/lisp/tpu-extras.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defconst tpu-extras-revision "$Revision: 1.6 $" "\ Revision number of the TPU-edt extras.") (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.") (defvar tpu-cursor-free nil "\ If non-nil, let the cursor roam free.") (byte-code "ƒÁ\n>„Á\nB‚ÃÄÁ\"ˆÁ‡" [tpu-gnu-emacs18-p tpu-set-cursor-free edit-picture-hook add-hook picture-mode-hook] 3) (defalias 'tpu-write-file-hook #[nil "À … …  ‡" [buffer-modified-p tpu-cursor-free picture-clean] 1 "\ Eliminate whitespace at ends of lines, if the cursor is free."]) (byte-code "À >„\nÀ BÀ‡" [tpu-write-file-hook write-file-hooks] 2) (defalias 'tpu-top-check #[(beg lines) "À _Â¥ WƒÅ !‚ Z W…Å !)‡" [window-height tpu-top-scroll-margin 100 margin beg recenter lines] 2 "\ Enforce scroll margin at the top 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 "\ Enforce scroll margin at the bottom of screen."]) (defalias 'tpu-forward-char #[(num) "ƒÁ\n!‡\nu‡" [tpu-cursor-free picture-forward-column num] 2 "\ Move right ARG characters (left if ARG is negative)." "p"]) (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 "\ Move left ARG characters (right if ARG is negative)." "p"]) (defalias 'tpu-next-line #[(num) "À \nƒm„à !ˆ‚Å !ˆÆ \"ˆÇ‰)‡" [tpu-current-line beg tpu-cursor-free picture-move-down num next-line-internal tpu-bottom-check next-line this-command] 3 "\ Move to next line. Prefix argument serves as a repeat count." "p"]) (defalias 'tpu-previous-line #[(num) "À \nƒà !ˆ‚Å [!ˆÆ \"ˆÇ‰)‡" [tpu-current-line beg tpu-cursor-free picture-move-up num next-line-internal tpu-top-check previous-line this-command] 3 "\ Move to previous line. Prefix argument serves as a repeat count." "p"]) (defalias 'tpu-next-beginning-of-line #[(num) "À ÂÃ!ˆÃ ZyˆÅ \")‡" [tpu-current-line beg backward-char 1 num tpu-top-check] 3 "\ 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." "p"]) (defalias 'tpu-next-end-of-line #[(num) "À \nƒ%`à Wƒ yˆÅ ˆ` Xƒ!ÆyˆÅ ˆ)‚+Æuˆ ˆÇ \")‡" [tpu-current-line beg tpu-cursor-free 1 num picture-end-of-line nil tpu-bottom-check] 3 "\ 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." "p"]) (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 "\ Move EOL upward. Accepts a prefix argument for the number of lines to move." "p"]) (defalias 'tpu-current-end-of-line #[nil "` ƒ  ˆ‚È`U…ÄÅ!)‡" [beg tpu-cursor-free picture-end-of-line nil message "You are already at the end of a line."] 2 "\ Move point to end of current line." nil]) (defalias 'tpu-forward-line #[(num) "À  !ˆÄ \"ˆÅyˆ)Ƈ" [tpu-current-line beg next-line-internal num tpu-bottom-check 0 nil] 3 "\ Move to beginning of next line. Prefix argument serves as a repeat count." "p"]) (defalias 'tpu-backward-line #[(num) "À  [!ˆÄ \"ˆÅyˆ)Ƈ" [tpu-current-line beg next-line-internal num tpu-top-check 0 nil] 3 "\ Move to beginning of previous line. Prefix argument serves as repeat count." "p"]) (defalias 'tpu-paragraph #[(num) "À Ä ÇUƒÈ‚ \nÇUƒ\"Ë‚$\n  _Í¥  _Í¥Ï\\ 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 "\ Move to the next paragraph in the current direction. A repeat count means move that many paragraphs." "p"]) (defalias 'tpu-page #[(num) "À Ä ÇUƒÈ‚ \nÇUƒ\"Ë‚$\n  _Í¥  _Í¥Ï\\ 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 "\ Move to the next page in the current direction. A repeat count means move that many pages." "p"]) (defalias 'tpu-scroll-window-down #[(num) "À  S _Æ¥_È[!ˆÉ \"+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal tpu-top-check] 3 "\ Scroll the display down to the next section. A repeat count means scroll that many sections." "p"]) (defalias 'tpu-scroll-window-up #[(num) "À  S _Æ¥_È!ˆÉ \"+‡" [tpu-current-line beg window-height height num tpu-percent-scroll 100 lines next-line-internal tpu-bottom-check] 3 "\ Scroll the display up to the next section. A repeat count means scroll that many sections." "p"]) (defalias 'tpu-search-internal #[(pat &optional quiet) "À Ä ÇUƒÈ‚ \nÇUƒ\"Ë‚$\n  _Í¥  _Í¥Ï\\ 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 "\ Search for a string or regular expression."]) (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) (defalias 'newline #[(&optional num) "À \n„ ÃÄ\n!ˆÅ \n\")‡" [tpu-current-line beg num 1 tpu-old-newline tpu-bottom-check] 3 "\ 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." "p"]) (defalias 'newline-and-indent #[nil "À  ˆÃ Ä\")‡" [tpu-current-line beg tpu-old-newline-and-indent tpu-bottom-check 1] 3 "\ 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." nil]) (defalias 'do-auto-fill #[nil "À  ˆÃ Ä\")‡" [tpu-current-line beg tpu-old-do-auto-fill tpu-bottom-check 1] 3 "\ TPU-edt version that respects the bottom scroll margin."]) (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 "\ Set scroll margins." "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): "]) (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 "\ Allow the cursor to move freely about the screen." nil]) (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 "\ Constrain the cursor to the flow of the text." nil]) emacs-19.22/lisp/tpu-mapper.elc100666 12120 1 20731 5474623454 14675 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:19:38 1993 ;;; from file /home/fsf/rms/e19/lisp/tpu-mapper.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (defconst tpu-mapper-revision "$Revision: 1.5 $" "\ Revision number of TPU-edt x-windows emacs key mapper.") (byte-code "ƒ\n ™ƒÃcˆÄÅ!ˆÆÇ!ˆÄ‡" [window-system emacs-version "19" "\n\n Whoa! This isn't going to work...\n\n You must run tpu-mapper.el under X-windows and Emacs version 19.\n\n Press any key to exit. " sit-for 600 kill-emacs t] 2) (defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) "\ Non-NIL if we are running Lucid Emacs version 19.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂÀÆ!„)ÂÀÇ!„2ƒ@ÉÂÊË#ˆ‚GÌÍ ÊË#ˆÎÏ!„QÐÏ!ˆÎÑ!„[ÐÑ!ˆÎÒ!„eÐÒ!ˆÑqˆÓcˆÔÏ!ˆÕcˆÖ ˆƒ×Ø!ÙÚÛÜÝH!\"ÞQ‚ ßØ!ˆà ÙÚÛ\"ÞQáâã\"ˆáäå\"ˆæƒ´â‚µäMˆÑqˆçcˆÒqˆècˆÏqˆæéêëì$ˆæíêîï$ˆæðêñò$ˆæóêôõ$ˆÑqˆöcˆÒqˆ÷cˆÏqˆæøùúû$ˆæüýþÿ$ˆæ@ABC$ˆæDEFG$ˆÑqˆHcˆÒqˆIcˆÏqˆæJKLM$ˆæNOPQ$ˆæRSTU$ˆæVWXY$ˆæZ[\\ï$ˆæ]^_ì$ˆæ`abc$ˆædefg$ˆæhijk$ˆælmno$ˆæpqrs$ˆætuvw$ˆæxyz{$ˆæ|}~$ˆ  Ñqˆ€cˆÒqˆcˆÏqˆæ‚ƒC„$ˆæ…†c„$ˆæ‡ˆb‰$ˆæŠ‹z{$ˆæŒŽ$ˆæ‘’“$ˆÑqˆ”cˆÒqˆ•cˆÏqˆæ–—˜„$ˆæ™š›„$ˆæœž„$ˆæŸ ¡„$ˆæ¢£¤„$ˆæ¥¦þ§$ˆæ¨©g„$ˆæªê«¬$ˆÒqˆ š„%­cˆÚ® \"cˆÚ¯ \"cˆÚ° \"cˆÚ± \"cˆ²cˆƒXÚ³\"cˆÚ´\"cˆµcˆ¶cˆ·cˆ¸cˆ‚`Ú³ \"cˆ¹Ñº`#ˆÑqˆƒx»‚{¼½¾¿ÚÀ½\"½#!ˆ)Á ˆßÂ!ˆÃÄ!ˆÅÆ!‡" [boundp tpu-key nil tpu-enter tpu-return tpu-key-seq tpu-enter-seq tpu-return-seq tpu-lucid-emacs19-p set-screen-size 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 defalias tpu-lucid-map-key #[(ident descrip func gold-func) "ÀÁ #!ÆÁÇÈ ÉH!\"ÊQ‰  š„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] tpu-gnu-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] tpu-map-key "\n;; Arrows\n;;\n" "\n;; GOLD Arrows\n;;\n" "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" "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "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" "\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" "\n;; Minibuffer map additions to make KP_enter = RET\n;;\n" "(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;; Define the tpu-help-enter/return symbols\n;;\n" "(setq tpu-help-enter \"%s\")\n" "(setq tpu-help-return \"%s\")\n" "(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-gnu-keys" file set-visited-file-name read-file-name "Save key mapping to file (default %s): " save-buffer "That's it! Press any key to exit" sit-for 600 kill-emacs t] 6) emacs-19.22/lisp/tq.elc100666 13437 1 5312 5416175640 13334 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:12:16 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/tq.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'tq-create #[(process) "À ÂÃÄ !P!BBÆ ÇÈÉÊ DËEE\"ˆ )‡" [nil process generate-new-buffer " tq-temp-" process-name tq set-process-filter lambda (proc string) tq-filter quote string] 7 "\ 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."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"‡" [defalias tq-queue #[(tq) "@‡" [tq] 1] tq-process #[(tq) "A@‡" [tq] 1] tq-buffer #[(tq) "AA‡" [tq] 1] tq-queue-add #[(tq re closure fn) "Á!\n BBÅB¤ ˆÆ‡" [tq tq-queue re closure fn nil ok] 5] tq-queue-head-regexp #[(tq) "À !@@‡" [tq-queue tq] 2] tq-queue-head-fn #[(tq) "À !@AA‡" [tq-queue tq] 2] tq-queue-head-closure #[(tq) "À !@A@‡" [tq-queue tq] 2] tq-queue-empty #[(tq) "À !?‡" [tq-queue tq] 2] tq-queue-pop #[(tq) "‰@A ˆ@?‡" [tq] 2]] 3) (defalias 'tq-enqueue #[(tq question regexp closure fn) "À \n $ˆÅÆ !\"‡" [tq-queue-add tq regexp closure fn process-send-string tq-process question] 5 "\ 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-close #[(tq) "ÀÁ\n!!ˆÃÄ\n!!‡" [delete-process tq-process tq kill-buffer tq-buffer] 3 "\ Shut down transaction queue TQ, terminating the process."]) (defalias 'tq-filter #[(tq string) "À !qˆdbˆ\ncˆÃ !‡" [tq-buffer tq string tq-process-buffer] 2 "\ Append STRING to the TQ's buffer; then process the new data."]) (defalias 'tq-process-buffer #[(tq) "À !qˆÂ ÃU?…]Ä !ƒ5ÅÆ!Èed#ˆe`|ˆÉÊ\"ˆËÌÍÎ !!ÏQ!)‡ebˆÐÑ !ÊÒ#…]e`{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 *spurious*." re-search-forward tq-queue-head-regexp t answer tq-queue-head-fn tq-queue-head-closure tq-queue-pop tq-process-buffer] 5 "\ Check TQ's buffer for the regexp at the head of the queue."]) (provide (quote tq)) emacs-19.22/lisp/trace.elc100666 12120 1 10601 5474623462 13673 0ustar rmsdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:19:46 1993 ;;; from file /home/fsf/rms/e19/lisp/trace.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÂÃ!„ÄÃÅ\"ˆÆÀ‡" [require advice fboundp \` autoload "backquote" "2.0" trace-version] 3) (defvar trace-buffer "*trace-output*" "\ *Trace output will by default go to that buffer.") (byte-code "ÀÁ!„ÂÀÃ!„ÄÀÅ!„ÆÇÈÉÊ\"\"ËÌÍ\"ˆËÎÏ\"ˆËÐÑ\"ˆËÒÓ\"ˆËÔÕ\"‡" [boundp trace-level 0 trace-advice-name trace-function\ trace-separator format "%s\n" make-string 70 61 defalias trace-entry-message #[(function level argument-bindings) "ÀÁÂÃÄ SÆ\"Ç# ÈVƒÇ‚É \nÂË Ç#&‡" [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] trace-exit-message #[(function level value) "ÀÁÂÃÄ SÆ\"Ç# ÈVƒÇ‚É \nË !&‡" [format "%s%s%d <- %s: %s\n" mapconcat char-to-string make-string level 124 " " 1 "" function prin1-to-string value] 8] trace-make-advice #[(function buffer background) "À Âà ƒ9ÅÆÂÇÈÉÊ DDDÌÍÎÏÐÑÒDÔÕFD¯ÖÌ×ØÐÙÒDÔÚFDF¯F‚bÅÆÂÇÛÉÊ DDDÜÝÞÐÑÒDÔÕFDÖßàÐÙÒDÔÚFD¯\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 ad-return-value (trace-level (1+ trace-level)) (pop-to-buffer trace-buffer) (goto-char (point-max)) (if (= trace-level 1) (insert trace-separator)) (pop-to-buffer trace-buffer) (goto-char (point-max))] 21] trace-function-internal #[(function buffer background) "À  † #ÆÇ$ˆÈ É\"‡" [ad-add-advice function trace-make-advice buffer trace-buffer background around last ad-activate nil] 6] trace-is-traced #[(function) "Á\nÃNžAž‡" [trace-advice-name around function ad-advice-info] 4]] 5) (defalias 'trace-function #[(function &optional buffer) "À \nÃ#‡" [trace-function-internal function buffer nil] 4 "\ 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." (list (intern (completing-read "Trace function: " obarray (quote fboundp) t)) (read-buffer "Output to buffer: " trace-buffer))]) (defalias 'trace-function-background #[(function &optional buffer) "À \nÃ#‡" [trace-function-internal function buffer t] 4 "\ 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." (list (intern (completing-read "Trace function in background: " obarray (quote fboundp) t)) (read-buffer "Output to buffer: " trace-buffer))]) (defalias 'untrace-function #[(function) "À !… à #ˆÅ !‡" [trace-is-traced function ad-remove-advice around trace-advice-name ad-update] 4 "\ 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." (list (ad-read-advised-function "Untrace function: " (quote trace-is-traced)))]) (defalias 'untrace-all #[nil "Á‰ƒ @Ä\n@!Å\n!ˆ A‰„*Á‡" [ad-advised-functions nil function ad-dO-vAr intern untrace-function] 3 "\ Untraces all currently traced functions." nil]) (provide (quote trace)) emacs-19.22/lisp/two-column.elc100666 13437 1 22470 5416175677 15052 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:12:46 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/two-column.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar tc-mode-map nil "\ Keymap for commands for two-column mode.") (byte-code "„OÁ ÂÃÄ#ˆÂÅÆ#ˆÂÇÈ#ˆÂÉÊ#ˆÂËÌ#ˆÂÍÎ#ˆÂÏÐ#ˆÂÑÒ#ˆÂÓÔ#ˆÂÕÖ#ˆÂ×Ø#ˆÂÙÚ#ˆÛÜ\"‡" [tc-mode-map make-sparse-keymap define-key "1" tc-merge "2" tc-two-columns "b" tc-associate-buffer "e" tc-dissociate " " tc-recenter "o" tc-associated-buffer "s" tc-split "{" shrink-window-horizontally "}" enlarge-window-horizontally " " tc-scroll-up "" tc-scroll-down " " tc-scroll-line global-set-key "6"] 4) (defvar tc-other nil "\ Marker to the associated buffer, if non-nil.") (byte-code "ÀÁ!ˆÂÁÃÄ#ˆÅBÀ‡" [make-variable-buffer-local tc-other put permanent-local t (tc-other " 2C") minor-mode-alist] 4) (defvar tc-mode-line-format (quote ("-%*- %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 tc-separator "" "\ *A string inserted between the two columns when merging. This gets set locally by \\[tc-split].") (put (quote tc-separator) (quote permanent-local) t) (defvar tc-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.") (byte-code "ÀÁ!ˆÂÁÃÄ#‡" [make-variable-buffer-local tc-window-width put permanent-local t] 4) (defvar tc-beyond-fill-column 4 "\ *Base for calculating `fill-column' for a buffer in two-column minor mode. The value of `fill-column' becomes `tc-window-width' for this buffer minus this value.") (defvar tc-mode-hook nil "\ Function called, if non-nil, whenever turning on two-column minor mode. It can get called by \\[tc-two-columns] (tc-two-columns), \\[tc-split] (tc-split) and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.") (defalias (quote tc-other) #[nil "…Á!\n†ÄÀ!ˆÄÃ!ˆÅ‡" [tc-other marker-buffer tc-mode-line-format mode-line-format kill-local-variable nil] 2]) (defalias 'tc-two-columns #[(&optional buffer) "À Á Wƒ ÂÃÄ\"ˆÅÁ Z^]!ˆÈ ƒ1ÉÊ!ˆËÈ !ˆÉÌ!ˆÍÎ!‡ZÓ!ˆÕ ÉÊ!ˆË†UØÙÚ P!!ˆ„_Û ˆZÕ Ó!ˆÉÌ!ˆ‰)‡" [window-width frame-width enlarge-window 99999 t split-window-horizontally window-min-width tc-window-width tc-other other-window 1 switch-to-buffer -1 tc-scroll-line 0 tc-beyond-fill-column fill-column tc-mode-line-format mode-line-format run-hooks tc-mode-hook point-marker other buffer generate-new-buffer "2C/" buffer-name text-mode] 5 "\ Split current window vertically for two-column editing. When called the first time, associates a buffer with the current buffer. Both buffers are put in two-column minor mode and tc-mode-hook gets called on both. These buffers remember about one another, even when renamed. When called again, restores the screen layout with the current buffer first and the associated buffer to it's right. 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. You have the following commands at your disposal: \\[tc-two-columns] Rearrange screen \\[tc-associate-buffer] Reassociate buffer after changing major mode \\[tc-scroll-up] Scroll both buffers up by a screenfull \\[tc-scroll-down] Scroll both buffers down by a screenful \\[tc-scroll-line] Scroll both buffers up by one or more lines \\[tc-recenter] Recenter and realign other buffer \\[shrink-window-horizontally], \\[enlarge-window-horizontally] Shrink, enlarge current column \\[tc-associated-buffer] Switch to associated buffer \\[tc-merge] Merge both buffers These keybindings can be customized in your ~/.emacs by `tc-prefix' and `tc-mode-map'. The appearance of the screen can be customized by the variables `tc-window-width', `tc-beyond-fill-column', `tc-mode-line-format' and `truncate-partial-width-windows'." "P"]) (defalias (quote tc-mode) (quote tc-two-columns)) (defalias 'tc-associate-buffer #[nil "pÀ † ÁÂà \"ŠÆ qˆÀ ƒ' À =„'ÇÈÉÀ !\"ˆÊË ž…0\n) ƒ<Ì Z\nÍ !*‡" [tc-other read-buffer "Associate buffer: " other-buffer b2 b1 nil error "Buffer already associated with buffer `%s'." buffer-name tc-window-width buffer-local-variables frame-width tc-two-columns] 4 "\ 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 \\[tc-two-columns] and `lisp/two-column.el' for further details." nil]) (defalias 'tc-split #[(arg) "À ƒ\"ÁÂÃÀ !ÄQ!ƒŠÀ qˆÅ ˆ)‚\"ÆÇÈ\"ˆ`iÉe`\"Sȉ\n   ŠÏ!ˆ`{ ÑwˆÒÓ!ˆ`{i)Õ ˆÀ \nŠm?…½i Uƒx `ŠÏ!ˆ`){˜„€ T ‚¶`Ï!ˆÑÈxˆ`|ˆ`Ö× \"ˆØ\nȈmƒª`‚¬`T#ˆ`|ˆÙ ÚÛ!ˆ‚\\.‡" [tc-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 tc-separator tc-window-width tc-two-columns insert-char 10 append-to-buffer 0 next-line 1] 5 "\ Unmerge a two-column text into two buffers in two-column minor mode. The text is unmerged at the cursor's column which becomes the local value of `tc-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 `tc-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 as you like them. You write the first line of each column with the separator you like and then unmerge that line. E.g.: First column's text sSs Second columns text \\___/\\ / \\ 5 character Separator You type M-5 \\[tc-split] with the point here See \\[tc-two-columns] and `lisp/two-column.el' for further details." "p"]) (defalias 'tc-dissociate #[nil "pŠÁ ƒBÁ qƒBÁ ƒÁ =ƒB „.mƒ.oƒ.ÃÄ!ˆ‚BÅÁ!ˆÅÆ!ˆÅÇ!ˆÅÈ!ˆÅÉ!ˆ)ÅÁ!ˆÅÆ!ˆÅÇ!ˆÅÈ!ˆÅÉ!)‡" [buffer tc-other buffer-modified-p kill-buffer nil kill-local-variable tc-window-width tc-separator mode-line-format fill-column] 2 "\ Turn off two-column minor mode in current and associated buffer. If the associated buffer is unmodified and empty, it is killed." nil]) (defalias 'tc-merge #[nil "À „ ÁÂ!ˆÃ @ÄVƒÅÆ !À =ƒÇÈ!ˆŠpÀ É\n  ebˆ qˆebˆm„k`Ɉ`{\nm„GÉuˆ qˆ\n͘„`Ɉjˆ\n±ˆÐÑ!ˆ qˆ‚4,Ò Ó W…xÔÕÖ\"‡" [tc-other error "You must first set two-column minor mode." window-edges 0 window-buffer previous-window other-window -1 nil string b2 b1 "" tc-window-width tc-separator next-line 1 window-width frame-width enlarge-window 99999 t] 3 "\ Merges the associated buffer with the current buffer. They get merged at the column, which is the value of `tc-window-width', i.e. usually at the vertical window separator. This separator gets replaced with white space. Beyond that the value of 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 `tc-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" nil]) (defalias 'tc-associated-buffer #[nil "À „ ÁÂ!ˆÃÀ !ƒÄÃÀ !!‡ÅÀ !‡" [tc-other error "You must set two-column minor mode." get-buffer-window select-window switch-to-buffer] 3 "\ Switch to associated buffer." nil]) (defalias 'tc-scroll-line #[(arg) "À „ ÁÂ!ˆÃ !„Å !ˆÆeÇ \"ÈÀ !…TÉ \nËÈÀ !!ˆ ÆeÇ \"ZŠdbˆÌÍ ÆÇ d\"ZÎZ\"ˆ)à !„OÅ !ˆË\n!)‡" [tc-other error "You must set two-column minor mode." zerop arg scroll-up count-lines window-start get-buffer-window selected-window window select-window insert-char 10 -1] 6 "\ Scroll current window upward by ARG lines. The associated window gets scrolled to the same line." "p"]) (defalias 'tc-scroll-up #[(arg) "À  ZÄZ_!‡" [tc-scroll-line arg window-height next-screen-context-lines 1] 4 "\ Scroll current window upward by ARG screens. The associated window gets scrolled to the same line." "p"]) (defalias 'tc-scroll-down #[(arg) "À \nà ZÄZ_!‡" [tc-scroll-line arg next-screen-context-lines window-height -1] 4 "\ Scroll current window downward by ARG screens. The associated window gets scrolled to the same line." "p"]) (defalias 'tc-recenter #[(arg) "…Á!ÂÃÄ `\"„Šƥ‚'ÇWƒ&Å \\‚'Z!‡" [arg prefix-numeric-value tc-scroll-line count-lines window-start window-height 2 0] 4 "\ Center point in window. With ARG, put point on line ARG. This counts from bottom if ARG is negative. The associated window gets scrolled to the same line." "P"]) (defalias 'enlarge-window-horizontally #[(arg) "À Â\"ˆÃ … \\‰…à q… Z‰‡" [enlarge-window arg t tc-other tc-window-width] 3 "\ Make current window ARG columns wider." "p"]) (defalias 'shrink-window-horizontally #[(arg) "À [!‡" [enlarge-window-horizontally arg] 2 "\ Make current window ARG columns narrower." "p"]) (provide (quote two-column)) emacs-19.22/lisp/uncompress.elc100666 13437 1 3060 5416175702 15103 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:12:50 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/uncompress.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÃÄ \"„Æ BÀ‡" [defalias uncompress-backup-file #[nil "ƒ ƒ\n„Ã!„ÄÅƉ‰%ˆÆ‡" [buffer-file-name make-backup-files buffer-backed-up file-exists-p call-process "uncompress" nil] 6] assoc "\\.Z$" auto-mode-alist ("\\.Z$" . uncompress-while-visiting)] 3) (defalias 'uncompress-while-visiting #[nil "ƒÁÂ\"ƒÃĉ”O!ˆÅÆ!ˆÇÉedÊË$ˆ)ÅÌ!ˆÍÇ!ˆÎÏ!ˆÐ>„;ÐBÑ ‡" [buffer-file-name string-match "\\.Z$" set-visited-file-name 0 message "Uncompressing..." nil buffer-read-only shell-command-on-region "uncompress" t "Uncompressing...done" set-buffer-modified-p make-local-variable write-file-hooks uncompress-backup-file normal-mode] 5 "\ Temporary \"major mode\" used for .Z files, to uncompress the contents. It then selects a major mode from the uncompressed file name and contents."]) (byte-code "À >„\nÀ BÀ‡" [find-compressed-version find-file-not-found-hooks] 2) (defalias 'find-compressed-version #[nil "À ÂP!… ÂPà Ä\"ˆebˆÅć" [file-exists-p buffer-file-name ".Z" insert-file-contents t nil error] 3 "\ Hook to read and uncompress the compressed version of a file."]) (provide (quote uncompress)) emacs-19.22/lisp/underline.elc100666 13437 1 2134 5416175704 14675 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:12:52 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/underline.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'underline-region #[(start end) "ŠÀ ‰\n ]Ä“ˆ\n ^bˆ` W…%ÅÆ!„ÇcˆÈuˆ‚*‡" [make-marker end1 start end nil looking-at "[_- ]" "_" 1] 4 "\ 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." "r"]) (defalias 'ununderline-region #[(start end) "ŠÀ ‰\n ]Ä“ˆ\n ^bˆÅÆ Ç#…ÈÉ!ˆ‚*‡" [make-marker end1 start end nil re-search-forward "_\\|_" t delete-char -2] 5 "\ Remove all underlining (overstruck underscores) in the region. Called from program, takes two arguments START and END which specify the range to operate on." "r"]) emacs-19.22/lisp/undigest.elc100666 13437 1 3222 5416175715 14533 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:13:01 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/undigest.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'undigestify-rmail-message #[nil "~ˆÀÁ\n!Ã\n!{Ã\n!bˆ``}ˆ cˆedS}ˆ*ÆÀÈŽŒebˆeÉÊ!ˆ`|ˆËcˆ`d}ˆÌ ÆÏŒÉÐ!ˆe`}ˆdbˆÑÒ!†`ÑÓ!†`ÑÔ!†`ÑÕ!)†gÇÖ!!ŠdbˆØÀxˆÙÀÜVƒž„žÝyˆSÞßàá!âãR!ƒxÆ‚x„§ÇÖ!ˆ+äåæçè\"éQ!ˆêË!ˆŒ`ÉÐ!ˆ`}ˆÑÓ!„Ïebˆë챈)äÐæíè\"éQÀÆ#ƒêî!ˆŒÞï!ƒóëбˆ‚ý`ÉÐÀð#ˆ`}ˆÑÓ!„ ebˆë챈)‚Ð,Àñò!ˆ\n3ô ˆõ3!ˆö ,‡" [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" " \n0, unseen,,\n*** EOOH ***\n" "" fill-prefix case-fold-search mail-strip-quoted-names "\n\n" mail-fetch-field "Reply-To" "To" "Apparently-To" "From" "Message is not a digest" digest-name " \n" 10 found count 0 -1 looking-at "End of.*Digest.*\n" regexp-quote "*********" "*" "\\(\n------*\\)*" re-search-forward "^" make-string 55 45 "-*\n*" replace-match "To: " "\n" 27 "\n\n \n0, unseen,,\n*** EOOH ***\n" "End " move message "Message successfully undigestified" n rmail-forget-messages rmail-show-message rmail-delete-forward] 5 "\ Break up a digest message into its constituent messages. Leaves original message, deleted, before the undigestified messages." nil]) emacs-19.22/lisp/unrmail.elc100666 13437 1 2507 5424635450 14361 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Sun Jul 25 22:02:16 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/unrmail.el ;;; emacs version 19.17.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 "This file was compiled for Emacs 19")) (defalias 'batch-unrmail #[nil "„ÁÂ!ˆÃ ƒ\"Å @ @ÆP\"„Ç A‰„ÈÉ!ˆÊ ƒ/Ë‚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 "\ Convert Rmail files to mailbox files. 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 'unrmail #[(file to-file) "ÀÁÄ !ˆÆÇ\"ˆ  Wƒ&Ê T‰!ˆËÌÍ#ˆ‚ÆÎ\"*‡" [0 nil rmail-delete-after-output message-count rmail file message "Writing messages to %s..." to-file rmail-total-messages rmail-show-message rmail-output 1 t "Writing messages to %s...done"] 4 "\ Convert Rmail file FILE to mailbox-format file TO-FILE." "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): "]) emacs-19.22/lisp/unused.elc100666 13437 1 2263 5416175722 14216 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:13:05 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/unused.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'mark-beginning-of-buffer #[nil "Àe!‡" [push-mark] 2 "\ Set mark at the beginning of the buffer." nil]) (defalias 'mark-end-of-buffer #[nil "Àd!‡" [push-mark] 2 "\ Set mark at the end of the buffer." nil]) (defalias 'upcase-char #[(arg) "ŠÀ` uˆ`\")‡" [upcase-region arg] 3 "\ Uppercasify ARG chars starting from point. Point doesn't move" "p"]) (defalias 'forward-to-word #[(arg) "À ÂVƒ  ÄÅÆ $† ÂVƒd‚eb‡" [re-search-forward arg 0 "\\W\\b" "\\b\\W" nil t] 5 "\ Move forward until encountering the beginning of a word. With argument, do this that many times." "p"]) (defalias 'backward-to-word #[(arg) "À [!‡" [forward-to-word arg] 2 "\ Move backward until encountering the end of a word. With argument, do this that many times." "p"]) emacs-19.22/lisp/upd-copyr.elc100666 13437 13 6144 5434456434 14377 0ustar jimbuser;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Aug 18 12:47:24 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/upd-copyr.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (defconst current-year (byte-code "À ÁÂO‡" [current-time-string -4 nil] 3) "\ String representing the current year.") (defvar current-gpl-version "2" "\ String representing the current version of the GPL.") (defvar replace-copying-with nil "\ *If non-nil, replace copying notices with this file.") (defvar inhibit-update-copyright nil "\ If nil, ask the user whether or not to update the copyright notice. If the user has said no, we set this to t locally.") (defalias 'update-copyright #[(&optional replace ask-upd ask-year) "ŠŒ~ˆebˆÀÁ\nÃÄOÅÆ\nÄÇO°ÇÈ#ƒ' †ôÊË\n\"‚ôebˆ ?…ô ƒ@ÍÎÇÈ#ebˆ…ôÀÏÇÈ#…ô ƒRЋ…ô†^…^Ó‹‰ƒmÔ”Ô•|ˆ‚pÕcˆ\ncˆÊÖƒ~ׂØ\n#ˆƒ×ÈÇebˆÍÜÇÈ#ƒÎÀÝÇÈ#ƒ¦Ôyˆ‚²Þßàá!!ˆâ ‘ˆ`ÍãÇÈ#„ÉÞßàä!!ˆâ ‘ˆ`|ˆå!ˆ*‚ìÀæÇÈ#ƒìÔ”bˆ`Ô•|ˆ'cˆ †ôèé!*‡" [re-search-forward "\\(" current-year 0 2 "\\)?" "\\([0-9][0-9]\\(,\\s \\)+\\)*'?" nil t ask-upd message "Copyright notice already includes %s." inhibit-update-copyright search-forward "is free software" "[Cc]opyright[^0-9]*\\(\\([-, ]*\\([0-9]+\\)\\)\\)+" ((byte-code "Àp!ˆŠebˆÁÂ!ˆÃÄ!†ÅÆ!ÇLˆÈ)‡" [pop-to-buffer sit-for 0 y-or-n-p "Update copyright? " make-local-variable inhibit-update-copyright t nil] 2)) replace ask-year ((byte-code "Àp!ˆŠebˆÁÂ!ˆÃÄ!)‡" [pop-to-buffer sit-for 0 y-or-n-p "Replace copyright year? "] 2)) 1 ", " "Copyright updated to %s%s." "" "include " replace-copying-with beg case-fold-search "copyright" "^\\(\\s \\s<\\|\\s>\\)*$" "*Help*" princ substitute-command-keys "I don't know where the copying notice begins.\nPut point there and hit \\[exit-recursive-edit]." recursive-edit "02139, USA." "I don't know where the copying notice ends.\nPut point there and hit \\[exit-recursive-edit]." insert-file "; either version \\(.+\\), or (at your option)" current-gpl-version error "This buffer contains no copyright notice!"] 9 "\ 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." "*P"]) (defalias 'ask-to-update-copyright #[nil "ÀÁ‰#ˆÁ‡" [update-copyright nil t] 4 "\ 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."]) (provide (quote upd-copyr)) emacs-19.22/lisp/userlock.elc100666 13437 1 6765 5432646053 14553 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Fri Aug 13 04:09:14 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/userlock.el ;;; emacs version 19.18.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"))) (error "This file was compiled for Emacs 19")) (put (quote file-locked) (quote error-conditions) (quote (file-locked file-error error))) (defalias 'ask-user-about-lock #[(fn opponent) "À ˆÁ‹‡" [discard-input ((byte-code "À „bÂà #ˆÆ‰É —À\n*‰  Uƒ(Í ˆ‚^Î Ï\"‰„@Ð ˆÂÑ!ˆÒÓ!ˆ‚^ AÔ=ƒOÍ ˆÀ‚^ AÕ=ƒ^Ö×Ø E\"ˆ)‚ 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 "\ 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."]) (byte-code "ÀÁÂ\"ˆÃÄÅÆ#‡" [defalias ask-user-about-lock-help #[nil "ÀÁÂ!‘‡" ["*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."] 3] put file-supersession error-conditions (file-supersession file-error error)] 4) (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 "\ 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 (quote ask-user-about-supersession-help) #[nil "ÀÁÂ!‘‡" ["*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."] 3]) emacs-19.22/lisp/vc-hooks.elc100666 12241 1 12325 5475720051 15006 0ustar rolanddaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 13:44:22 1993 ;;; from file /home/fsf/rms/e19/lisp/vc-hooks.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar vc-master-templates (quote (("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS) ("%sSCCS/s.%s" . SCCS) ("%ss.%s" . SCCS))) "\ *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), for files covered by version control don't get backups.") (defvar vc-rcs-status t "\ *If non-nil, revision and locks on RCS working file displayed in modeline. Otherwise, not displayed.") (byte-code "ÀÁ\n\"„ Ã\nBÄÁ!ˆÅÁÆÇ#ˆÈÉÊ\"‡" [assoc vc-mode minor-mode-alist (vc-mode vc-mode) make-variable-buffer-local put permanent-local t defalias vc-error-occurred (macro . #[(&rest body) "ÀÁÂà Å\"BÆF‡" [condition-case nil progn append body (nil) (error t)] 6])] 4) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias vc-file-setprop #[(file property value) "ÀÁ\n \" #‡" [put intern file vc-file-prop-obarray property value] 4] vc-file-getprop #[(file property) "À \n\" N‡" [intern file vc-file-prop-obarray property] 3] vc-registered #[(file) "À‰ÃÄ!ƒ>Å ÇŽ ‰:ƒ=\n„= @:ƒ6 @@;ƒ6È @@ \"ƒ6 @A A‰‚*\nƒJ\nÊ \"‚^Ë !†RÌÍ !ÐÑ**‡" [nil handlers handler boundp file-name-handler-alist match-data match-data ((store-match-data match-data)) string-match file vc-registered file-name-directory "" file-name-nondirectory basename dirname found (byte-code "ÀÁ\n\"ˆÃ‡" [mapcar #[(s) "À @\n #Å !…(\nÆ !˜ƒ!Ç!Ç !š?…(ÉÊ AB\")‡" [format s dirname basename trial file-exists-p file-name-directory file-attributes file throw found] 4] vc-master-templates nil] 3)] 4]] 3) (defalias 'vc-name #[(file) "À Â\"†à !‰…Å Æ A#ˆÅ  @#)‡" [vc-file-getprop file vc-name vc-registered name-and-type vc-file-setprop vc-backend] 5 "\ Return the master name of a file, nil if it is not registered."]) (defalias 'vc-backend-deduce #[(file) "…!ÁÂ\"†!Ã!‰… ÅÆ @#ˆÅ A#)‡" [file vc-file-getprop vc-backend vc-registered name-and-type vc-file-setprop vc-name] 5 "\ Return the version-control type of a file, nil if it is not registered."]) (defalias 'vc-toggle-read-only #[nil "ÀÁ !ƒ ÂÃ!‡Ä ‡" [vc-backend-deduce buffer-file-name vc-next-action nil toggle-read-only] 2 "\ 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." nil]) (define-key global-map "" (quote vc-toggle-read-only)) (defalias 'vc-mode-line #[(file &optional label) "À !‰…à †Å\n!…\nÇ=…Æ !Q\nƒC „CÊË !ƒCÌÍ!ƒCÎ Ï !˜„CÐ ÑÒ !ˆ\n)‡" [vc-backend-deduce file vc-type " " label symbol-name vc-rcs-status RCS vc-mode buffer-read-only zerop user-uid require vc user-login-name vc-locking-user t set-buffer-modified-p buffer-modified-p] 5 "\ 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." (list buffer-file-name nil)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆÃ\"‡" [defalias vc-rcs-status #[(file) "À !‰…§ŠÅÆ!qˆÂÈ ! Ê ˆ „EË ‰ TbˆÍ  ‰Î\\$A@ÏU)„EÏyˆÐÑÂÒ#‰ƒ …¦ÓÔÕ !ÖQŒØ”Ø•}ˆebˆÐÂÒ#ƒvÙmƒnÚ‚oÛÒ‰#ˆ‚\\Ü )‰Ú˜„†‚šebˆÞß!ƒ™àؔؕ{P‚šá\"Ê ˆãÂ!ˆ\"+)*‡" [vc-name file nil found master get-buffer-create " *vc-rcs-status*" buffer-read-only file-name-directory default-directory erase-buffer buffer-size s insert-file-contents 8192 0 re-search-forward "^locks\\([^;]*\\);" t "[  \n ]+\\(" regexp-quote user-login-name ":\\)?" lock-pattern 1 replace-match "" ":" buffer-string locks looking-at "head[  \n ]+\\([.0-9]+\\)" "-" " @@" status set-buffer-modified-p] 7] vc-find-file-hook #[nil "ƒ\nÁÂÃ#ˆÄ!… ?…ÆÇ!ˆÃ‰‡" [buffer-file-name vc-file-setprop vc-backend nil vc-mode-line vc-make-backup-files make-local-variable make-backup-files] 4] add-hook find-file-hooks] 3) (defalias 'vc-file-not-found-hook #[nil "À !…ÂÃ!ˆÄÅÆ?‡" [vc-backend-deduce buffer-file-name require vc nil (byte-code "À !ˆÂ‡" [vc-checkout buffer-file-name nil] 2) ((error t))] 3 "\ When file is not found, try to check it out from RCS or SCCS. Returns t if checkout was successful, nil otherwise."]) (byte-code "ÀÁÂ\"ˆÃ Å\"Ç!„qÈ É Å#ˆÉÊË#ˆÉÌÍ#ˆÉÎÏ#ˆÉÐÑ#ˆÉÒÓ#ˆÉÔÕ#ˆÉÖ×#ˆÉØÙ#ˆÉÚÛ#ˆÉÜÝ#ˆÉÞß#ˆÉàá#ˆâã!‡" [add-hook find-file-not-found-hooks vc-file-not-found-hook 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 provide vc-hooks] 4) emacs-19.22/lisp/vc.elc100666 74777 1 112644 5475720205 13404 0ustar ericdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Sat Nov 27 13:45:52 1993 ;;; from file /home/fsf/rms/e19/lisp/vc.el ;;; emacs version 19.21.90. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!ˆÀÂ!ˆÃÄ \"„Æ BÀ‡" [require vc-hooks ring assoc vc-parent-buffer minor-mode-alist (vc-parent-buffer vc-parent-buffer-name)] 3) (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-suppress-confirm nil "\ *If non-nil, treat user as expert; suppress yes-no prompts on some things.") (defvar vc-keep-workfiles t "\ *If non-nil, don't delete working files after registering changes.") (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-mistrust-permissions (quote file-symlink-p) "\ *Don't assume that permissions and ownership track version-control status.") (defvar vc-checkin-switches nil "\ *Extra switches passed to the checkin program by \\[vc-checkin].") (defvar vc-path (byte-code "ÀÁ!…‡" [file-exists-p "/usr/sccs" ("/usr/sccs")] 2) "\ *List of extra directories to search for version control commands.") (defconst vc-maximum-comment-ring-size 32 "\ Maximum number of saved comments in the comment ring.") (defvar diff-switches "-c" "\ *A string or list of strings specifying switches to be be passed to diff.") (defvar vc-checkin-hook nil "\ *List of functions called after a checkin is done. See `run-hooks'.") (defvar vc-header-alist (quote ((SCCS "%W%") (RCS "$Id$"))) "\ *Header keywords to be inserted when `vc-insert-headers' is executed.") (defvar vc-static-header-alist (quote (("\\.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 (quote ((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.") (defvar vc-checkout-carefully (byte-code "À ÁU‡" [user-uid 0] 2) "\ *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.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÆÀÇ!„)ÂÀÈ!„2ÂÉ\nÀË!„> ÌË!ˆÀÍ!„K ÀÎ!„TÂÀÏ!„]ÂÐÑÒ\"‡" [boundp vc-log-entry-mode nil 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-names" vc-name-assoc-file vc-dired-mode make-variable-buffer-local vc-comment-ring vc-comment-ring-index vc-last-comment-match defalias vc-file-clearprops #[(file) "ÀÁ\n \"Ä\"‡" [setplist intern file vc-file-prop-obarray nil] 4]] 3) (defalias 'vc-clear-context #[nil "À Â\"ˆÂ‰‡" [fillarray vc-file-prop-obarray nil vc-comment-ring] 3 "\ Clear all cached file properties and the comment ring." nil]) (byte-code "ÀÁÂ\"ˆÃÄ!„ ÅŇ" [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] boundp vc-binary-assoc nil] 3) (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 "\ Look for a command anywhere on the subprocess-command search path."]) (defalias 'vc-do-command #[(okstatus command file &rest flags) "À !\nƒÃÄ #ˆppÆ …Ç !Æ \n  ÍÎ!qˆÏÐ! LˆÏÑ!ÒÓ !PLˆÔ ˆÕ !×Ø\"ˆ ƒVÚ\n C\"\nÕ †\\Û!ƒkÚ\"‚mÞß ÆàÆ\n&*dbˆáyˆ¨ƒ’\"Wƒ´ãÎ!ˆebˆä ˆåæ ¨ƒ­çè\"‚¯#ˆ‚½\nƒ½Ãé \"ˆ qˆ-‡" [expand-file-name file vc-command-messages message "Running %s on %s..." command nil vc-name status vc-file squeezed camefrom obuf get-buffer-create "*vc*" make-local-variable vc-parent-buffer vc-parent-buffer-name " from " buffer-name erase-buffer file-name-directory default-directory mapcar #[(s) "… Á\nC\"‰‡" [s append squeezed] 3] flags append "./" vc-path exec-path apply call-process t -1 okstatus pop-to-buffer shrink-window-if-larger-than-buffer error "Running %s...FAILED (%s)" format "status %d" "Running %s...OK"] 7 "\ Execute a version-control command, notifying user and checking for errors. The command is successful if its exit status does not exceed OKSTATUS. Output from COMMAND goes to buffer *vc*. The last argument of the command is the master name of FILE; this is appended to an optional list of FLAGS."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"‡" [defalias vc-position-context #[(posn) "Á dÂ\\^{E‡" [posn buffer-size 100] 6] 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] vc-revert-buffer1 #[(&optional arg no-confirm) "~ˆÀ`!Á !p=…À !ÃÄÅ!…#pŠÇÈÉ \"*\n   Î\"ˆ\nƒq\n@ƒhŠ\n@qˆpÑ ¢@!ÔÕ\"ˆ ƒg @@U„g A‰„W+\nA‰\n„7× !‰ƒbˆ) …”× !‰…“Ú!),‡" [vc-position-context marker-buffer mark-marker nil boundp compilation-error-list curbuf mapcar #[(buffer) "qˆ †\nÉ:ƒ/ „/Æ @A!ƒ(Ç @A!=ƒ(È A‰‚ …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 revert-buffer arg no-confirm marker-position error-pos compilation-last-buffer compile-reinitialize-errors (4) compilation-parsing-end vc-find-position-by-context new-point new-mark set-mark] 7 nil "P"] vc-buffer-sync #[nil "À … „ÂÃÄÅ \"!„ÆÇ!ˆÈ ‡" [buffer-modified-p vc-suppress-confirm y-or-n-p format "Buffer %s modified; save it? " buffer-name error "Aborted" save-buffer] 4] vc-workfile-unchanged-p #[(file) "À Â\"ÃÄ !8‰ƒ š‚1Ç È\"ÉUƒ*Ê Â #ˆË‚1Ê ÂÌ#ˆÈ*‡" [vc-file-getprop file vc-checkout-time 5 file-attributes lastmod checkout-time vc-backend-diff nil 0 vc-file-setprop t (0 . 0)] 5] vc-next-action-on-file #[(file verbose &optional comment) "À‰Á\n! „%Æ\"ˆ ƒʉ ‚ºÌ\n!‚ºÍ\n!‰„mƒgÏ\n!„gÐ\nÀ\"ÑU„gÒ‹ƒPÓ\n!ˆÔ\n!‚ºÕÖ!„\\×Ø!‚ºÙÚ‰\"ˆÌ\n!‚ºÌ\n!‚º Û ˜„ƒ~×Ü\n\"ˆÝ\n…ˆÞß! #‚ºà\n!ˆá ˆÏ\n!ƒ«â „«ã\n!ˆä\nÚÀ#‚ºƒ´Þå!æ\n #+‡" [nil vc-name file vc-file version owner vc-register verbose comment vc-initial-comment vc-checkout-writable-buffer-hook vc-log-after-operation-hook vc-checkout-writable-buffer vc-locking-user vc-checkout-carefully vc-workfile-unchanged-p vc-backend-diff 0 ((byte-code "ÀÁ!ˆebˆÂÃÄ \"!ˆÆ ˆÇÈÉP!‡" [pop-to-buffer "*vc*" 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 yes-or-no-p "Revert to checked-in version, instead? " error "Checkout aborted." vc-revert-buffer1 t user-login-name "Sorry, you can't steal the lock on %s this way" vc-steal-lock read-string "Version to steal: " find-file vc-buffer-sync buffer-modified-p vc-backend-revert vc-resynch-window "New version level: " vc-checkin] 4] vc-next-action-dired #[(file rev comment) "qˆÁ‰‰‰Æ ÁŠebˆÉÁÊ#…!Ë ‰??ƒWbˆÌÍ!ˆÎ‹\nBbˆÏyˆÁ‰“ˆÉÁÊ#…QË ‰„,) ƒ`\n‚cЋC.Ñ ˆ‡" [vc-parent-buffer nil results found case-fold-search buffer-read-only dired-marker-regexp next-position regexp re-search-forward t point-marker sit-for 0 ((byte-code "À Âà \"ˆÄ Å#ˆÂÇ \")‡" [dired-get-filename file message "Processing %s..." vc-next-action-on-file nil comment "Processing %s...done"] 4)) 1 ((byte-code "À Âà \"ˆÄ Å#ˆÂÇ \")‡" [dired-get-filename file message "Processing %s..." vc-next-action-on-file nil comment "Processing %s...done"] 4)) dired-move-to-filename] 5]] 3) (defalias 'vc-next-action #[(verbose) "ÀÁ‡" [nogo (byte-code "ƒ$Á ‰GÃUƒÄÅ !ˆ‚#Ælj‰ÈÉ%ˆÊËÇ\"ˆ) ƒ1Í !ˆ‚$ƒ=Ï\"‡ÑÇ!‡" [vc-dired-mode dired-get-marked-files files 1 find-file-other-window dired-get-filename vc-start-entry nil "Enter a change comment for the marked files." vc-next-action-dired throw nogo vc-parent-buffer pop-to-buffer buffer-file-name vc-next-action-on-file verbose vc-registration-error] 7)] 2 "\ Do the next logical checkin or checkout operation on the current file. 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. 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. For checkin, a prefix argument lets you specify the version number to use." "P"]) (defalias 'vc-checkout-writable-buffer #[(&optional file) "À † Ã\"‡" [vc-checkout file buffer-file-name t] 3 "\ Retrieve a writable copy of the latest version of the current buffer's file."]) (defalias 'vc-register #[(&optional override comment) "À !ƒ\nÂÃ!ˆÄ „ Å ÆUƒ Ç !„ ÈÉ!ˆÊ ˆË  …0ÍÎÏ \"!\"‡" [vc-name buffer-file-name error "This file is already registered" buffer-modified-p buffer-size 0 file-exists-p set-buffer-modified-p t vc-buffer-sync vc-admin override read-string format "Initial version level for %s: "] 6 "\ Register the current file into your version-control system." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias vc-resynch-window #[(file &optional keep noquery) " ˜…\nƒÃÄ \"ˆÆ!‡Ç ˆÈp!‡" [buffer-file-name file keep vc-revert-buffer1 t noquery vc-mode-line delete-window kill-buffer] 3] vc-start-entry #[(file rev comment msg action) "ƒ\nÁ!‚ p ƒÄÅ!qˆ‚ÆÄÅ!!ˆÇÈ!\nLˆÇÉ!ÊË!PLˆÌ†5Í!ˆÎ ˆ ƒaÔ ˆ Õ=ƒXÖÕ!‚f cˆÖ×!‚fØÙ\")‡" [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 " (no file)" vc-log-mode 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]] 3) (defalias 'vc-admin #[(file rev &optional comment) "À \n † ?ÅÆ%‡" [vc-start-entry file rev comment vc-initial-comment "Enter initial comment." vc-backend-admin] 6 "\ 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-checkout #[(file &optional writable) "ÀÁ\n\"ƒÃÄ!ƒÅÆ!ˆÇ\n\"ˆ\n ˜…#Ê\nˉ#‡" [string-match "^/[^/:]+:" file vc-find-binary "ftp" error "Sorry, you can't check out files over FTP" vc-backend-checkout writable buffer-file-name vc-resynch-window t] 4 "\ Retrieve a copy of the latest version of the given file."]) (defalias 'vc-steal-lock #[(file rev &optional owner) "„Á\n!ÃÄÅ\n$!„ÇÈ!ˆÉÊË!!ˆÌÍ!Ï!ˆÑ ˆÒ ˆÓÄÔ\n#Õ‰‰Ö\nEC&ˆdbˆÄ×\n#Ø Ù±ˆÚÛ!‡" [owner vc-locking-user file y-or-n-p format "Take the lock on %s:%s from %s? " rev 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 "%s:%s" nil vc-finish-steal "I stole the lock on %s:%s, " current-time-string ".\n" message "Please explain why you stole the lock. Type C-c C-c when done."] 9 "\ Steal the lock on the current workfile." nil]) (defalias (quote vc-finish-steal) #[(file version) "À \n\"ˆÃ ĉ#‡" [vc-backend-steal file version vc-resynch-window t] 4]) (defalias 'vc-checkin #[(file &optional rev comment) "À ÆÇ%‡" [vc-checkin-hook vc-log-after-operation-hook vc-start-entry file rev comment "Enter a change comment." vc-backend-checkin] 6 "\ 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'). COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment."]) (defalias 'vc-comment-to-change-log #[(&optional whoami file-name) "À Â\"ÃÄÈ \nˉ$ˆŠcˆÌ )ÍÎ!ƒ'ÏÐ!ˆÑ ˆÒ Š` Wƒ?Ôyˆjˆ‚/`*ÖPÖPÂyˆØ` \"ˆ*ÙÚ \"ˆÏÛÚ![!ˆm†oÍÜ!†oÝc+‡" [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 "\ 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'." (byte-code "…Á D‡" [current-prefix-arg prompt-for-change-log-name] 2)]) (defalias 'vc-finish-logentry #[(&optional nocomment) "„!dbˆn„Á ˆÂ !ˆ „Å!Ç È \"ˆ ƒ4Š \nÈ #ˆ)‚8ËÌ!ˆÍ!ˆÏÐ!Ò!ˆÓ!ˆ)ƒZÕ×#ˆØ!‡" [nocomment newline vc-backend-logentry-check vc-log-file vc-comment-ring make-ring vc-maximum-comment-ring-size ring-insert buffer-string vc-log-operation vc-log-version error "No log operation is pending" pop-to-buffer vc-parent-buffer get-buffer "*VC-log*" logbuf delete-windows-on kill-buffer buffer-file-name vc-resynch-window vc-keep-workfiles t run-hooks vc-log-after-operation-hook] 4 "\ Complete the operation implied by the current log entry." nil]) (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 "\ Cycle backwards through comment history." "*p"]) (defalias 'vc-next-comment #[(arg) "À [!‡" [vc-previous-comment arg] 2 "\ Cycle forwards through comment history." "*p"]) (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 "\ Searches backwards through comment history for substring match." "sComment substring: "]) (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 "\ Searches forwards through comment history for substring match." "sComment substring: "]) (defalias 'vc-diff #[(historic) "ƒ\nÁ !qˆ ƒÄ !ˆ‚\n ƒÆÇ!‡ƒ)É!„-ÊË!ˆÌ ‰ƒ?É!„DÏ!ˆÐ ˆÑ!‰ ƒZÒÓ\"ˆ‚ÔÌ\"ˆÄÕ!ˆÄÕ!ˆÖ ×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 vc-workfile-unchanged-p message "No changes to %s since latest version." vc-backend-diff "*vc*" buffer-size 0 t shrink-window-if-larger-than-buffer] 4 "\ 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." "P"]) (defalias 'vc-version-diff #[(file rel1 rel2) "Á˜ƒÂ Á˜ƒÂÄ !ƒ_pÇÈ!qˆÉÊ!LˆÉË!ÌÍ!PLˆÎ ˆÏ†9ÐÑ †?ÒÓ±ˆÇÔ!qˆÕ !ˆÖ×!ˆØÈ!ˆÙcˆebˆÚÂ!)‡Û  #ÜUƒpÝÞ  $‡ØÔ!‡" [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*" cd vc-file-tree-walk #[(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 "\ 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." "FFile or directory to diff: \nsOlder version: \nsNewer version: "]) (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 "\ 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." "sVersion to visit (default is latest version): "]) (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-deduce 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 @\"c‡" [string-match f buffer-file-name format hdstrings] 3]] 4 "\ 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'." nil]) (byte-code "ÀÁ!„  Ã Ä #ˆÀÆ!ƒ$Çž„$Ç BBÀ‡" [boundp vc-dired-prefix-map make-sparse-keymap define-key "v" vc-prefix-map minor-mode-map-alist vc-dired-mode] 4) (defalias 'vc-dired-mode #[nil "À‰‡" [t vc-dired-mode " under VC" vc-mode] 2 "\ The augmented Dired minor mode used in VC directory buffers. 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 (quote vc-dired-reformat-line) #[(x) "Àvˆ ƒ  ÃQÄÅÆÇ#…% ÈPÇÉO\nËÌ\nÍQÎ\")‡" [1 x "(" ")" re-search-forward "\\([0-9]+ \\).................\\( .*\\)" nil 0 " " 9 rep replace-match "\\1" "\\2" t] 4]) (defalias 'vc-directory #[(verbose) "À GÀ‰‰‰ÈÉ!ˆŠÊ ŸB \"ˆpÌ ÍU?)ƒJÎ !ˆÏ ˆebˆÀÑyˆÒÓ Ÿ\"ˆÔeb‚XÕÖƒUØ‚VÙ #.‡" [nil default-directory dired-buf-mod-count dired-buf userlist filelist dl nonempty vc-file-tree-walk #[(f) "À !…' ! „ …& ÆOB‰…& B‰)‡" [vc-registered f vc-locking-user user verbose dl nil filelist userlist] 3] dired dired-listing-switches buffer-size 0 pop-to-buffer vc-dired-mode buffer-read-only 1 mapcar #[(x) "ÀuˆÁ\n!ˆÃy‡" [2 vc-dired-reformat-line x 1] 2] t message "No files are currently %s under %s" verbose "registered" "locked"] 6 "\ Show version-control status of all files under the current directory." "P"]) (defalias 'vc-directory-18 #[(verbose) "À ŠÄÅ!qˆÆ ˆÇ\n!ˆÈÉ!ˆÊ ËU?) ƒ+ÌÅÍ\"ˆebˆÎ ˆÏЃ6Ò‚7Ó #*‡" [nil default-directory dir nonempty get-buffer-create "*vc-status*" erase-buffer cd vc-file-tree-walk #[(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 "\ Show version-control status of all files under the current directory." "P"]) (byte-code "ÀÁ!„\nÂÃMˆÀÄ!„ÅÆÇÈ\"ˆÆÉÊ\"ˆÆËÌ\"ˆÆÍÎ\"‡" [boundp minor-mode-map-alist vc-directory vc-directory-18 compilation-old-error-list nil defalias vc-add-triple #[(name file rev) "ŠÀÁ\n!à Q!ˆdbˆ Æ\nÇɱˆÊ ˆËp!)‡" [find-file vc-backend-subdirectory-name file "/" vc-name-assoc-file name " : " " " rev "\n" basic-save-buffer kill-buffer] 6] vc-record-rename #[(file newname) "ŠÀÁ\n!à Q!ˆebˆÅÆÇ\n!ÈQÆ P\"ˆÊ ˆËp!)‡" [find-file vc-backend-subdirectory-name file "/" vc-name-assoc-file replace-regexp ":" regexp-quote "$" newname basic-save-buffer kill-buffer] 4] vc-lookup-triple #[(file name) "„Á‡ÂH‰ÄY… ÅX)ƒ‡ÆÇ!É\nQËÌRC\"@‡" [name "" 0 firstchar 48 57 vc-master-info vc-backend-subdirectory-name file "/" vc-name-assoc-file " : " " \\(.+\\)"] 7] vc-locked-example #[nil "ÀÁ‡" [vc-locked-example (byte-code "ÀÁ!ˆÂ‡" [vc-file-tree-walk #[(f) "À !… !…ÃÄ \"‡" [vc-registered f vc-locking-user throw vc-locked-example] 3] nil] 2)] 2]] 3) (defalias 'vc-create-snapshot #[(name) "À ‰ƒÂà \"‚ÄÅ!)‡" [vc-locked-example locked error "File %s is locked" vc-file-tree-walk #[(f) "À !…\n \"‡" [vc-name f vc-backend-assign-name name] 3]] 4 "\ 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." "sNew snapshot name: "]) (defalias 'vc-retrieve-snapshot #[(name) "À ‰ƒÂà \"‚ÄÅ!)‡" [vc-locked-example locked error "File %s is locked" vc-file-tree-walk #[(f) "À !…\nÂÃć" [vc-name f nil (byte-code "À  #ˆÂ‡" [vc-backend-checkout f nil name] 4) ((error t))] 3]] 4 "\ 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." "sSnapshot name to retrieve: "]) (defalias 'vc-print-log #[nil "ƒ\nÁ !qˆ ƒÄ !ˆ‚\n ƒQÆ !ƒQÇ !ˆÄÈÉ!!ˆÊË!ƒ=ÌÍ•Í”Z!ˆÎyˆ‚)ebˆÊÏ!ƒNÌÍ•Í”Z!ˆÐ ‡Ñ !‡" [vc-dired-mode find-file-noselect dired-get-filename vc-parent-buffer pop-to-buffer buffer-file-name vc-name vc-backend-print-log get-buffer-create "*vc*" looking-at "=*\n" delete-char 0 -1 "[ \n ]+" shrink-window-if-larger-than-buffer vc-registration-error] 3 "\ List the change log of the current buffer in a window." nil]) (defalias 'vc-revert-buffer #[nil "ƒ Á !ˆ ƒÄ !ˆ‚ pÆÇ! \nƒ9 „/ÌÍ!„9Î ˆÏÐ!ˆ‚= qˆƒEÎ ˆÑ\n!ˆÒ\nÓ‰#+‡" [vc-dired-mode find-file-other-window dired-get-filename vc-parent-buffer pop-to-buffer buffer-file-name vc-diff nil changed obuf file vc-suppress-confirm yes-or-no-p "Discard changes? " delete-window error "Revert cancelled" vc-backend-revert vc-resynch-window t] 4 "\ 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." nil]) (defalias 'vc-cancel-version #[(norevert) "ƒ Á !ˆ ƒÄ !ˆ‚ ÅÆ !°ÈÆ !°‰ ˜ƒ/Ê‚0Ë ÍÎ \"!??…]ÏÆ \"ˆ„QÍÑ!„XÒÆ !‚]ÓÆ Ô\"+‡" [vc-dired-mode find-file-other-window dired-get-filename vc-parent-buffer pop-to-buffer vc-latest-version buffer-file-name target vc-your-latest-version yours "Remove your version %s from master? " "Version %s was not your change. Remove it anyway? " prompt yes-or-no-p format vc-backend-uncheck norevert "Revert buffer to most recent remaining version? " vc-mode-line vc-checkout nil] 5 "\ Get rid of most recently checked in version of this file. A prefix argument means do not revert the buffer afterwards." "P"]) (defalias 'vc-rename-file #[(old new) "À !‰ƒÃ\n!ƒÄÅ!ˆÀ!ƒÄÇ!ˆÈ!ƒ(ÄÉ!ˆÊ !‰ ƒlÌ !ƒ;ÄÍ!ˆÎ !„JÎÏ !!ƒNÄÐ!ˆÑ Ò !Ó!†\\ÔÕ!ÙÚ+\"ˆ ƒwÈ !ƒ}Ñ \"ˆ)\nƒŠ\nqˆÛ!ˆÜÝ!ˆ))Ò !‰ß=ƒ¤à \"‚¬á=…¬Ý)‡" [get-file-buffer old oldbuf buffer-modified-p error "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 vc-backend-deduce file-name-directory "" file-name-nondirectory newbase newdir backend found (byte-code "ÀÁ\n\"ˆÃÄ!‡" [mapcar #[(s) " A=…# @ #Æ !‰ƒÈ!…\"ÉÊ \"*‡" [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 "\ Rename file OLD to NEW, and rename its master file likewise." "fVC rename file: \nFRename to: "]) (defalias 'vc-update-change-log #[(&rest args) "Âà !ˆÄ ˆÅ ˆÆ ˆebˆÇ ˆÈÉ!ˆÈÊ ƒ3ÌÍÎÏÐÏÑÒ \"&Ó=ƒ7Ô‚8Õ\")‡" [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 mapcar #[(f) "ÀÁ\n!ƒ \n‚ \nP!‡" [file-relative-name file-name-absolute-p f odefault] 3] 0 "done" "failed"] 11 "\ 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." (byte-code ":ƒ C‡ƒ8Âà  ƒ4Á @!‰ƒ-Ç !ƒ- B A‰„+‡ÉP\nË\n!…NÌÍÎ\nÂÏ#\")‡" [current-prefix-arg buffer-file-name nil buffer-list file buffers files vc-backend-deduce default-directory "RCS" RCS file-directory-p mapcar #[(f) "ÀÁ\n\"ƒ \nÃÄ•O‡\n‡" [string-match "\\(.*\\),v$" f 0 1] 3] directory-files "...\\|^[^.]\\|^.[^.]"] 7)]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias vc-match-substring #[(bn) "”•{‡" [bn] 2] vc-parse-buffer #[(patterns &optional file properties) "ÀÁ\n\"‡" [mapcar #[(p) "ebˆÀÁ\n\"ƒ1ÃÄÇ\nÄÈ#ƒ0ÉÊ!  ™ƒ, ÉÌ!)‚*Ç\nÄÈ#…PÉÌ! ƒMÏ@ #ˆ )A‡" [string-match "\\\\(.*\\\\(" p "" nil latest-val latest-date re-search-forward t vc-match-substring 2 date 1 value file vc-file-setprop properties] 4] patterns] 3] vc-master-info #[(file fields &optional rfile properties) "ƒ3Á!ƒ3ŠÂÄ!‰qˆ)Å ˆÆÂ\"ˆÇÂ!ˆÈÂ!ˆÉ\n  #Íp!ˆ)‡ …=ÎÏ \"‡" [file file-exists-p nil buf create-file-buffer erase-buffer insert-file-contents set-buffer-modified-p auto-save-mode vc-parse-buffer fields rfile properties kill-buffer mapcar #[(p) "À \nÃ#‡" [vc-file-setprop rfile p nil] 4]] 5] vc-log-info #[(command file patterns &optional properties) "ƒ-Á!ƒ-ŠÂÄÅ!‰qˆ)ÆÇ#ˆÉÂ!ˆÊ  #Íp!ˆ)‡…6ÎÏ \"‡" [file file-exists-p nil buf get-buffer-create "*vc*" vc-do-command 0 command set-buffer-modified-p vc-parse-buffer patterns properties kill-buffer mapcar #[(p) "À \nÃ#‡" [vc-file-setprop file p nil] 4]] 5]] 3) (defalias 'vc-locking-user #[(file) "À !\nƒ Ä=„ ƒ Å !!ƒÆ !‡Ç !ÉÊË8\"ƒ1Ì‚MÍ8Î UƒJÉÏË8\"ƒJÐ ‚MÆ !)‡" [expand-file-name file vc-keep-workfiles vc-mistrust-permissions t vc-backend-subdirectory-name vc-true-locking-user file-attributes attributes string-match ".r-.r-.r-." 8 nil 2 user-uid ".rw.r-.r-." user-login-name] 4 "\ Return the name of the person currently holding a lock on FILE. Return nil if there is no such person."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [defalias vc-true-locking-user #[(file) "À !ˆÂ Ã\"‡" [vc-fetch-properties file vc-file-getprop vc-locking-user] 3] vc-latest-version #[(file) "À !ˆÂ Ã\"‡" [vc-fetch-properties file vc-file-getprop vc-latest-version] 3] vc-your-latest-version #[(file) "À !ˆÂ Ã\"‡" [vc-fetch-properties file vc-file-getprop vc-your-latest-version] 3]] 3) (defalias 'vc-backend-dispatch '(macro . #[(f s r) "ÀÁ DDCÄÅÁÆEDÅÁÈE DEE‡" [let type vc-backend-deduce f cond eq (quote SCCS) s (quote RCS) r] 7 "\ Execute FORM1 or FORM2 depending on whether we're using SCCS or RCS."])) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"‡" [defalias vc-lock-file #[(file) "À !‰…ÃÄ\n\"…\nŔŕOÆ\nǔǕOQ)‡" [vc-name file master string-match "\\(.*/\\)s\\.\\(.*\\)" 1 "p." 2] 6] vc-fetch-properties #[(file) "À !‰Ã=ƒ(ÄÅ !ÆÇD È$ˆÄÉ !ÊËÌÍ !ÎQD Ï$‚>\nÐ=…>ÑÒ ÓÔÕÖÌÍ !×QFØ$)‡" [vc-backend-deduce file type SCCS vc-master-info vc-lock-file "^[^ ]+ [^ ]+ \\([^ ]+\\)" "^\\([^ ]+\\)" (vc-locking-user vc-locked-version) vc-name "^d D \\([^ ]+\\)" "^d D \\([^ ]+\\) .* " regexp-quote user-login-name " " (vc-latest-version vc-your-latest-version) RCS vc-log-info "rlog" "^locks: strict\n \\([^:]+\\)" "^locks: strict\n [^:]+: \\(.+\\)" "^revision[ ]+\\([0-9.]+\\).*\ndate: \\([ /0-9:]+\\);" "^revision[ ]+\\([0-9.]+\\)\n.*author: " ";" (vc-locking-user vc-locked-version vc-latest-version vc-your-latest-version)] 10] vc-backend-subdirectory-name #[(&optional file) "À ƒ  !† †ÄÅ!ƒÆ‚lj!‡" [symbol-name file vc-backend-deduce vc-default-back-end vc-find-binary "rcs" RCS SCCS] 3] vc-backend-admin #[(file &optional rev comment) "À !ˆ\n„ÃÄ!ƒÅ‚ÆÇÈ \"ˆÉÊ !ƒ$\n‚9ÉË!ƒ.Å‚9ÉÌ!ƒ8Æ‚9\n‰ Æ=ƒ‚ÎÏÐ …NÒPÓÔ P…[ÖP×ØÆ\"@Ú !†iÛÜ !#&ˆÝ !ˆƒ§ÎÏß #ˆ‚§ Å=ƒ§ÎÏà ƒ–á‚—Ò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" backend vc-do-command 0 "admin" rev "-r" "-fb" "-i" comment "-y" format rassq vc-master-templates file-name-directory "" file-name-nondirectory delete-file vc-keep-workfiles "get" "ci" "-u" "-t-" "Registering %s...done"] 14] vc-backend-checkout #[(file &optional writable rev workfile) "† ÃÄ\n\"ˆÅ !‰Ç=ƒ9ÈÉÊ  … Ì…'ÍP…3ÏÐ \"P&ˆ‚Ñ=ƒƒˆÒÓÔ !! ƒSÕ‚TÉ\"ÖÙŽÈÉÚ ÛÜÝÞß!à\"Þßá !à\"#â\n …zãäP& ˆå+‚ÈÉæ  …’ã…›ÏP%ˆ)„¬ç èéê !8#ˆÃë\n\")‡" [workfile file filename message "Checking out %s..." vc-backend-deduce type SCCS vc-do-command 0 "get" writable "-e" "-G" rev "-r" vc-lookup-triple RCS logior file-modes vc-name 128 t failed vc-modes ((byte-code "ƒÁ\n!ƒÃ\n!ˆÁ‡" [failed file-exists-p filename delete-file] 2)) "/bin/sh" "-c" format "umask %o; exec >\"$1\" || exit; shift; umask %o; exec co \"$@\"" logand lognot 511 default-file-modes "" "-l" "-p" nil "co" vc-file-setprop vc-checkout-time 5 file-attributes "Checking out %s...done"] 12] vc-backend-logentry-check #[(file) "À !‰Ã=ƒÄ ÅY…!ÅbˆÆÇ!‚!\nÈ=…!É)‡" [vc-backend-deduce file type SCCS buffer-size 512 error "Log must be less than 512 characters; point is now at pos 512" RCS nil] 3] vc-backend-checkin #[(file &optional rev comment) "ÀÁ\n\"ˆŠÃ\n!† pqˆÄ\n!‰Æ=ƒ>ÇÈÉÊ\n …'Ì PÍP&ˆƒ_ÈÉÑ\n#ˆ‚_ Ò=ƒ_ÇÈÉÓ\nƒRÔ‚SÌ PÕP&ˆ*Ö\n×Ø#ˆÀÙ\n\"‡" [message "Checking in %s..." file get-file-buffer vc-backend-deduce type SCCS apply vc-do-command 0 "delta" rev "-r" "-y" comment vc-checkin-switches vc-keep-workfiles "get" RCS "ci" "-u" "-m" vc-file-setprop vc-locking-user nil "Checking in %s...done"] 9] vc-backend-revert #[(file) "ÀÁ\n\"ˆÃ\n!‰Å=ƒ ÆÇÈ\nÉ$ˆÆÇÊ\nÉ$ˆ‚. Ë=ƒ.ÆÇÌ\nÍÎ%ˆ)Ï\nÐÉ#ˆÀÑ\n\"‡" [message "Reverting %s..." file vc-backend-deduce type SCCS vc-do-command 0 "unget" nil "get" RCS "co" "-f" "-u" vc-file-setprop vc-locking-user "Reverting %s...done"] 7] vc-backend-steal #[(file &optional rev) "ÀÁ\n\"ˆÃ\n!‰Å=ƒ2ÆÇÈ\nÉ\n…Ë\nP%ˆÆÇÌ\nÍ\n…-Ë\nP%ˆ‚H Î=ƒHÆÇÏ\nÐÑ\nPÒ\nP&ˆ)Ó\nÔÕ #ˆÀÖ\n\"‡" [message "Stealing lock on %s..." file vc-backend-deduce type SCCS vc-do-command 0 "unget" "-n" rev "-r" "get" "-g" RCS "rcs" "-M" "-u" "-l" vc-file-setprop vc-locking-user user-login-name "Stealing lock on %s...done"] 9] vc-backend-uncheck #[(file target) "ÀÁ\n\"ˆÃ\n!‰Å=ƒÆÇÈ\nÉ\nP$ˆ‚, Ë=ƒ,ÆÇÌ\nÍ\nP$ˆ)ÀÎ\n\"‡" [message "Removing last change from %s..." file vc-backend-deduce type SCCS vc-do-command 0 "rmdel" "-r" target RCS "rcs" "-o" "Removing last change from %s...done"] 7] vc-backend-print-log #[(file) "ÀÁ !‰Å=ƒÆ‚ Ç=…È) #‡" [vc-do-command 0 vc-backend-deduce file type SCCS "prs" RCS "rlog"] 5] vc-backend-assign-name #[(file name) "À !‰Ã=ƒÄ Æ !#‚#\nÇ=…#ÈÉÊ Ë ÌQ$)‡" [vc-backend-deduce file type SCCS vc-add-triple name vc-latest-version RCS vc-do-command 0 "rcs" "-n" ":"] 8] vc-backend-diff #[(file oldvers &optional newvers) "À !Â=ƒà \"‚à \"ÆÇÈÀ !‰ Â=ƒ'Ê‚/ Ë=…/Ì)†6Í ! Î …?Ï P …FÏ P<ƒQ‚TC&‡" [vc-backend-deduce file SCCS vc-lookup-triple oldvers newvers apply vc-do-command 1 type "vcdiff" RCS "rcsdiff" vc-registration-error "-q" "-r" diff-switches] 10]] 3) (defalias 'vc-check-headers #[nil "ŠebˆÀ !‰Ã=ƒÄÅÆÇ#‚!\nÈ=…!ÄÉÆÇ#*‡" [vc-backend-deduce buffer-file-name type SCCS re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t RCS "\\$[A-Za-zÀ-ÖØ-öø-ÿ]+\\(: [ -#%-~ -ÿ]*\\)?\\$"] 5 "\ Check if the current file has any headers in it." nil]) (defalias 'vc-log-mode #[nil "À !ˆÂ !ˆ ÆÈ ÊË!ˆÊÌ!ˆÊÍ!ˆÎÏ!ˆÏÑÒÓ\"‡" [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 "\ 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. vc-static-header-alist By default, version headers inserted in C files get stuffed in a static string area so that ident(RCS) 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). " 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) (defalias 'vc-file-tree-walk #[(func &rest args) "À \n #ˆÄÅ \"‡" [vc-file-tree-walk-internal default-directory func args message "Traversing directory %s...done"] 4 "\ Walk recursively through default directory. Invoke FUNC f ARGS on each non-directory file f underneath it."]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias vc-file-tree-walk-internal #[(file func args) "À !„  #‡ÅÆ \"ˆÇ !ÉÊË!\")‡" [file-directory-p file apply func args message "Traversing directory %s..." file-name-as-directory dir mapcar #[(f) "Á˜†˜† PÅ !†Æ #)‡" [f "." ".." dir dirf file-symlink-p vc-file-tree-walk-internal func args] 4] directory-files] 4] provide vc] 3) emacs-19.22/lisp/vi.elc100666 13437 1 113451 5416176316 13373 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:17:17 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/vi.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'vi-switch-mode #[(arg mode-char) "À  !\"‰„ÅÆÇÈ!!‘‚# \nË Ì\"ˆÍÎ !)‡" [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}" arg prefix-arg command-execute nil set-buffer-modified-p buffer-modified-p] 5 "\ Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}" "P\nc"]) (byte-code "ÀÁ \"„à ÅÁ#ˆÀ‡" [where-is-internal vi-switch-mode current-local-map define-key ctl-x-map "~"] 4) (defvar vi-tilde-map nil "\ Keymap used for \\[vi-switch-mode] prefix key. Link to various major modes.") (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) (defalias 'vi-debugging #[(arg) "ƒ Á‚ \n?\nƒÃÄ!‡ÃÅ!‡" [arg t debug-on-error message "Debug-on-error ..." "NO more debug-on-error"] 2 "\ Toggle debug-on-error flag. If prefix arg is given, set t." "P"]) (defalias 'vi-back-to-old-mode #[nil "… à !ˆÈÉ !‡" [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 set-buffer-modified-p buffer-modified-p] 2 "\ Go back to the previous mode without setting up for insertion." nil]) (defalias 'vi-readonly-mode #[nil "?‰‡" [buffer-read-only] 2 "\ Toggle current buffer's readonly flag." nil]) (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.") (byte-code "ÀÁÂÃ#ˆ „‚Å Æ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÆ ÕÖ#ˆÆ ×Ø#ˆÆ ÙÚ#ˆÆ ÛÜ#ˆÆ ÝÞ#ˆÆ ßà#ˆÆ áÚ#ˆÆ âã#ˆÆ äå#ˆÆ æç#ˆÆ èé#ˆÆ êë#ˆÆ ìí#ˆÆ îï#ˆÆ ðñ#ˆÆ òó#ˆÆ ôõ#ˆÆ ö÷#ˆÆ øù#ˆÆ úû#ˆÆ üý#ˆÆ þÿ#ˆÆ @A#ˆÆ BÁ#ˆÆ CD#ˆÆ EF#ˆÆ GH#ˆÆ IJ#ˆÆ KL#ˆÆ MN#ˆÆ Oý#ˆÆ PQ#ˆÆ RS#ˆÆ TU#ˆÆ VW#ˆÆ Xà#ˆÆ YZ#ˆÆ [\\#ˆÆ ]^#ˆÆ _`#ˆÆ ab#ˆÆ cd#ˆÆ ed#ˆÆ fd#ˆÆ gd#ˆÆ hd#ˆÆ id#ˆÆ jd#ˆÆ kd#ˆÆ ld#ˆÆ mn#ˆÆ op#ˆÆ qF#ˆÆ rF#ˆÆ sF#ˆÆ tu#ˆÆ vw#ˆÆ xy#ˆÆ z{#ˆÆ |}#ˆÆ ~Ü#ˆÆ €#ˆÆ ‚#ˆÆ ƒ„#ˆÆ …†#ˆÆ ‡ˆ#ˆÆ ‰Š#ˆÆ ‹Á#ˆÆ Œ#ˆÆ Ž#ˆÆ ‘#ˆÆ ’“#ˆÆ ”•#ˆÆ –—#ˆÆ ˜™#ˆÆ š›#ˆÆ œ#ˆÆ žý#ˆÆ ŸÁ#ˆÆ  ¡#ˆÆ ¢£#ˆÆ ¤¥#ˆÆ ¦§ #ˆÆ ¨©#ˆÆ ªý#ˆÆ «F#ˆÆ ¬ý#ˆÆ ­®#ˆÆ ¯Á#ˆÆ °±#ˆÆ ²³#ˆÆ ´µ#ˆÆ ¶F#ˆÆ ·F#ˆÆ ¸¹#ˆÆ º»#ˆÆ ¼½#ˆÆ ¾¿#ˆÆ ÀÁ#ˆÆ ÂÚ#ˆÆ Ãå#ˆÆ ÄD#ˆÆ ÅÆ#ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÌ#ˆÆ ÍÎ#ˆÆ ÏÐ#ˆÆ ÑÒ#ˆÆ ÓÔ#ˆÆ ÕÖ#ˆÆ ×Ø#ˆÆ ÙÚ#ˆÆ ÛÜ#ˆÆ Ý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 " " 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) (defvar vi-mark-alist nil "\ Alist of (NAME . MARK), marks are local to each buffer.") (defvar vi-scroll-amount (byte-code "À Á¥‡" [window-height 2] 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 "\ Last insertion point. Should use 'mark' instead.") (defvar vi-ins-length nil "\ Length of last insertion.") (defvar vi-ins-repetition nil "\ The repetition required for last insertion.") (defvar vi-ins-overwrt-p nil "\ T if last insertion was a replace actually.") (defvar vi-ins-prefix-code nil "\ Code to be eval'ed before (redo-)insertion begins.") (defvar vi-last-find-char nil "\ Save last direction, char and upto-flag used for char finding.") (defvar vi-last-change-command nil "\ 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 "\ Save last shell command given for \"!\" operator.") (defvar vi-insert-state nil "\ T if it is in insert state.") (defvar vi-search-last-command nil "\ 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.") (byte-code "ÀÁ!„‡" [boundp vi-mode-old-case-fold nil] 2) (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 "\ Setup a buffer for vi-mode by creating necessary buffer-local variables."]) (defalias 'vi-mode #[nil "„Á ˆ\nÃ=ƒÄÅÆ \"‡Ç  \n\n  Í Î!ˆÃÐ ÑÒ !ˆ…:Ô ‡" [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" set-buffer-modified-p buffer-modified-p vi-insert-state vi-end-of-insert-state] 3 "\ 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." nil]) (defalias 'vi-ding #[nil "À ‡" [ding] 1 "\ Ding !" nil]) (defalias 'vi-save-all-and-exit #[nil "ÀÁ!ˆÂ ‡" [save-some-buffers t kill-emacs] 2 "\ Save all modified buffers without asking, then exits emacs." nil]) (byte-code "ÀÁ!„ÂÀÃ!„‡" [boundp vi-replaced-string nil vi-replacing-string] 2) (defalias 'vi-ex-cmd #[nil "ÀÁÂÃ!!‘‡" ["*Help*" princ documentation vi-ex-cmd] 4 "\ 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 " nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias vi-undefined #[nil "ÀÁ !\"ˆÄ ‡" [message "Command key \"%s\" is undefined in Evi." single-key-description last-command-char ding] 4 nil nil] vi-unimplemented #[nil "ÀÁ !\"ˆÄ ‡" [message "Command key \"%s\" is not implemented in Evi." single-key-description last-command-char ding] 4 nil nil]] 3) (defalias 'vi-goto-insert-state #[(repetition &optional prefix-code do-it-now-p) "ƒ Á\n@\nA\"ˆ` \n \nË !ˆ ÏÐ !ˆÑ‰‡" [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 set-buffer-modified-p buffer-modified-p t vi-insert-state] 3 "\ 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-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 "\ Terminate insertion and set up last change command."]) (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 "\ 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-more-redo-insertion #[(str &optional overwrite-p prefix-code) "ƒ Á@A\"ˆ\nƒ`` G\\|ˆ c‡" [prefix-code apply overwrite-p str] 3 "\ 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-goto-command-state #[(&optional from-insert-state-p) "À !ˆÂ … …ÅÆ!‡" [use-local-map vi-com-map nil vi-insert-state from-insert-state-p overwrite-mode 0] 2 "\ Go to vi-mode command state. If optional arg exists, means return from insert state."]) (defalias 'vi-kill-line #[(arg) "À !ˆÂÀ \"‡" [kill-line arg vi-set-last-change-command] 3 "\ kill specified number of lines (=d$), text saved in the kill ring." "*P"]) (defalias (quote vi-kill-region) #[nil "À ˆÁÀ!‡" [kill-region vi-set-last-change-command] 2 nil nil]) (defalias 'vi-append-at-end-of-line #[(arg) "À ÂÃ#‡" [vi-goto-insert-state arg (end-of-line) t] 4 "\ go to end of line and then go into vi insert state." "*p"]) (defalias 'vi-change-rest-of-line #[(arg) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 kill-line arg t] 4 "\ Change the rest of (ARG) lines (= c$ in vi)." "*P"]) (defalias 'vi-insert-before-first-nonwhite #[(arg) "À ÂÃ#‡" [vi-goto-insert-state arg (back-to-indentation) t] 4 "\ (= ^i in vi)" "*p"]) (defalias 'vi-open-above #[(arg) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 #[(x) "ÀyˆÁ\n!‡" [0 open-line x] 2] arg t] 4 "\ open new line(s) above current line and enter insert state." "*p"]) (defalias 'vi-open-below #[(arg) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 #[(x) "À† Á\n!† \ny‡" [nil open-line x] 2] arg t] 4 "\ open new line(s) and go into insert mode on the last line." "*p"]) (defalias 'vi-insert-after #[(arg) "À ÂCÃ#‡" [vi-goto-insert-state arg #[nil "l?…Àu‡" [nil] 1] t] 4 "\ start vi insert state after cursor." "*p"]) (defalias 'vi-insert-before #[(arg) "À !‡" [vi-goto-insert-state arg] 2 "\ enter insert state before the cursor." "*p"]) (defalias 'vi-goto-line #[(arg) "À !„  ‡ÃÄ !!‡" [vi-raw-numeric-prefix arg end-of-buffer goto-line vi-prefix-numeric-value] 3 "\ Go to ARGth line." "P"]) (defalias 'vi-beginning-of-buffer #[nil "eb‡" [] 1 "\ Move point to the beginning of current buffer." nil]) (defalias 'vi-isearch-forward #[(arg) "ƒÁ‚ Â`Å !ˆ `U?…#ƒÆ‚ lj*‡" [arg isearch-forward-regexp isearch-forward opoint scmd call-interactively re-search-forward search-forward vi-search-last-command] 2 "\ Incremental search forward. Use regexp version if ARG is non-nil." "P"]) (defalias 'vi-isearch-backward #[(arg) "ƒÁ‚ Â`Å !ˆ `U?…#ƒÆ‚ lj*‡" [arg isearch-backward-regexp isearch-backward opoint scmd call-interactively re-search-backward search-backward vi-search-last-command] 2 "\ Incremental search backward. Use regexp version if ARG is non-nil." "P"]) (defalias 'vi-search-forward #[(arg string) "ƒÁ‚  GÅVƒ  ljÈ$‡" [arg re-search-forward search-forward vi-search-last-command string 0 search-last-string nil 1] 5 "\ Nonincremental search forward. Use regexp version if ARG is non-nil." (byte-code "ƒ ÁÂÃÄ\"D‡ÄÂÅÄ\"D‡" [current-prefix-arg t read-string "regexp/" nil "/"] 4)]) (defalias 'vi-search-backward #[(arg string) "ƒÁ‚  GÅVƒ  ljÈ$‡" [arg re-search-backward search-backward vi-search-last-command string 0 search-last-string nil 1] 5 "\ Nonincremental search backward. Use regexp version if ARG is non-nil." (byte-code "ƒ ÁÂÃÄ\"D‡ÄÂÅÄ\"D‡" [current-prefix-arg t read-string "regexp?" nil "?"] 4)]) (defalias 'vi-repeat-last-search #[(arg &optional search-command search-string) "„ \n„ „ÄÅÆ \"‡\nlj$‡" [search-command vi-search-last-command search-string search-last-string message "No last search command to repeat." ding nil arg] 5 "\ Repeat last search command. If optional search-command/string are given, use those instead of the ones saved." "p"]) (defalias 'vi-reverse-last-search #[(arg &optional search-command search-string) "„ \n„ „ÄÅÆ \"‡Ç=ƒ È‚;È=ƒ*Ç‚;É=ƒ4Ê‚;Ê=…;É\nˉ $‡" [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 "\ Redo last search command in reverse direction. If the optional search args are given, use those instead of the ones saved." "p"]) (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 "\ join ARG lines from current line (default 2), cleaning up white space." "P"]) (defalias 'vi-backward-kill-line #[nil "??… ÁyˆÂÃ!‡" [vi-insert-state 0 kill-line nil] 2 "\ kill the current line. Only works in insert state." nil]) (defalias 'vi-abort-ins #[nil "??…` Vƒ `\"ˆÃÄ!‡" [vi-insert-state vi-ins-point kill-region vi-goto-command-state t] 3 "\ abort insert state, kill inserted text and go back to command state." nil]) (defalias 'vi-backward-windowfull #[(count) "ÁV…ÂÃ!ˆS‰‚‡" [count 0 scroll-down nil] 3 "\ Backward COUNT windowfulls. Default is one." "p"]) (defalias 'vi-scroll-down-window #[(count) "¨ƒ !‡" [count vi-scroll-amount scroll-up] 2 "\ Scrolls down window COUNT lines. If COUNT is nil (actually, non-integer), scrolls default amount. The given COUNT is remembered for future scrollings." "P"]) (defalias 'vi-expose-line-below #[(count) "À !‡" [scroll-up count] 2 "\ Expose COUNT more lines below the current window. Default COUNT is 1." "p"]) (defalias 'vi-forward-windowfull #[(count) "ÁV…ÂÃ!ˆS‰‚‡" [count 0 scroll-up nil] 3 "\ Forward COUNT windowfulls. Default is one." "p"]) (defalias 'vi-next-line #[(count) "À` !†\n`UƒÄ ‡À‰‡" [next-line this-command line-move count ding last-command] 3 "\ Go down count lines, try to keep at the same column." "p"]) (defalias 'vi-next-line-first-nonwhite #[(count) "`yˆÁ ˆ`U… ‡" [count back-to-indentation ding] 2 "\ Go down COUNT lines. Stop at first non-white." "p"]) (defalias 'vi-previous-line-first-nonwhite #[(count) "À !ˆÂ ‡" [previous-line count back-to-indentation] 2 "\ Go up COUNT lines. Stop at first non-white." "p"]) (defalias 'vi-scroll-up-window #[(count) "¨ƒ !‡" [count vi-scroll-amount scroll-down] 2 "\ Scrolls up window COUNT lines. If COUNT is nil (actually, non-integer), scrolls default amount. The given COUNT is remembered for future scrollings." "P"]) (defalias 'vi-expose-line-above #[(count) "À !‡" [scroll-down count] 2 "\ Expose COUNT more lines above the current window. Default COUNT is 1." "p"]) (defalias 'vi-char-argument #[(arg) "À \n„à B‰‚\"\n¨ƒ\n B‰‚\"\n@ B‰)‡" [read-char char arg nil prefix-arg] 2 "\ 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)." "P"]) (defalias 'vi-goto-mark #[(mark-char &optional line-flag) "À \n\"ƒà ˆ …CÅ ‡À Æ\"ƒ#ÇÈ!ˆ …CÅ ‡É !‰\n„4ËÌÍ \"‚BÇÎ!ˆ\nbˆ …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 "\ 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-line-mark #[(char) "À Â\"‡" [vi-goto-mark char t] 3 "\ Go to the line (at first non-white) marked by next char." "c"]) (defalias 'vi-goto-char-mark #[(char) "À !‡" [vi-goto-mark char] 2 "\ Go to the char position marked by next mark-char." "c"]) (defalias 'vi-digit-argument #[(arg) "„Á!‡¨ƒÁÂ!ˆ _‰‡ÁÂ!ˆ @„%Ä‚'@_AB‰‡" [arg digit-argument nil prefix-arg 1] 2 "\ Set numeric prefix argument." "P"]) (defalias 'vi-raw-numeric-prefix #[(arg) ":ƒ@‡‡" [arg] 1 "\ Return the raw value of numeric part prefix argument."]) (defalias 'vi-prefix-numeric-value #[(arg) "„Á‡¨ƒ ‡:…@ƒ@‡Á‡" [arg 1] 1 "\ 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-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 "\ Reverse last f F t T operation COUNT times. If the optional FIND-ARG is given, it is used instead of the saved one." "p"]) (defalias 'vi-find-char #[(arg count) "@A@AA` \\Åƃ b‚Ç ,‡" [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 "\ 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-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 "\ Repeat last f F t T operation COUNT times. If optional FIND-ARG is given, it is used instead of the saved one." "p"]) (defalias 'vi-backward-find-char #[(count char) "À ÂBBÄ !‡" [-1 char nil vi-last-find-char vi-repeat-last-find-char count] 3 "\ Find the COUNT'th CHAR backward on current line." "p\nc"]) (defalias 'vi-forward-find-char #[(count char) "À ÂBBÄ !‡" [1 char nil vi-last-find-char vi-repeat-last-find-char count] 3 "\ Find the COUNT'th CHAR forward on current line." "p\nc"]) (defalias 'vi-backward-upto-char #[(count char) "À ÂBBÄ !‡" [-1 char t vi-last-find-char vi-repeat-last-find-char count] 3 "\ Find upto the COUNT'th CHAR backward on current line." "p\nc"]) (defalias 'vi-forward-upto-char #[(count char) "À ÂBBÄ !‡" [1 char t vi-last-find-char vi-repeat-last-find-char count] 3 "\ Find upto the COUNT'th CHAR forward on current line." "p\nc"]) (defalias 'vi-end-of-word #[(count) "m„ÀuˆÁÂÀà $…Å ‡" [nil re-search-forward "\\W*\\w+\\>" t count backward-char] 5 "\ Move forward until encountering the end of a word. With argument, do this that many times." "p"]) (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 "\ Replace char after point by CHAR. Repeat COUNT times." "p\nc"]) (defalias 'vi-replace-chars #[(arg) "ÀÁ!ˆÂ !‡" [overwrite-mode 1 vi-goto-insert-state arg] 2 "\ Replace chars over old ones." "*p"]) (defalias 'vi-substitute-chars #[(count) "ÀÁ DÄ#‡" [vi-goto-insert-state 1 #[(c) "``\\|‡" [c] 3] count t] 4 "\ Substitute COUNT chars by the input chars, enter insert state." "*p"]) (defalias 'vi-substitute-lines #[(count) "ÀÁÂà SEÅ#‡" [vi-goto-insert-state 1 vi-delete-op next-line count t] 5 "\ Substitute COUNT lines by the input chars. (=cc in vi)" "*p"]) (defalias 'vi-prefix-char-value #[(arg) "„Á‡¨ƒ Á‡:ƒA‡Á‡" [arg nil] 1 "\ Get the char part of the current prefix argument."]) (defalias 'vi-operator #[(arg) "ÀÁ‡" [vi-exit-op (byte-code " à Å!\"‰Ç=„ ‚*Ç!ˆÂ à Å!\"Ê \"ƒ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 "\ Handling vi operators (d/c//!/=/y). Current implementation requires the key bindings of the operators being fixed." "P"]) (defalias 'vi-execute-op #[(op-char motion-command arg) "ÁUƒ \"…¬ÅÂÆ ! #‡ÇUƒ- \"…¬ÈÉÂÆ ! EÊ#‡ËUƒBÌ \"…¬ÅÌÆ ! #‡ÍUƒYÎ \"…¬ÅÎÆ ! $‡ÐUƒtÑ [#…¬ÅÑÆ ! [$‡ÓUƒÑ #…¬ÅÑÆ ! $‡ÔUƒ¢Õ \"…¬ÅÕÆ ! #‡ÖU…¬× \"‡" [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 "\ Execute vi edit operator as specified by OP-CHAR, the operand is the region determined by the MOTION-COMMAND with ARG."]) (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 "\ Return the command for redo the given command."]) (defalias 'vi-effective-range #[(motion-command arg) "Š`À‰ ÂN`É À\"ˆ` Uƒ) Ê=„) ‰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 "\ 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-delete-op #[(motion-command arg) "À \n\"‰@ AÆ U?…IÈ\n!‰„&É \"ˆ‚HÊYƒ@ËXƒ@Ì— Í$ˆ‚HÎ Í$ˆÍ,‡" [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 "\ Delete range specified by MOTION-COMMAND with ARG."]) (defalias 'vi-yank-op #[(motion-command arg) "À \n\"‰@ AÆ U?…IÈ\n!‰„&É \"ˆ‚HÊYƒ@ËXƒ@Ì— Æ$ˆ‚HÍ Æ$ˆÎ,‡" [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 "\ Yank (in vi sense) range specified by MOTION-COMMAND with ARG."]) (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 "\ Yank (in vi sense) lines (= `yy' command)." "*P"]) (defalias 'vi-string-end-with-nl-p #[(string) "‰GSHÁU‡" [string 10] 2 "\ 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-put-before #[(arg &optional after-p) "À !‰ƒ# ÅW„ ÆVƒ#Ç !„#ÈÉ \"‚† „)Å ÅYƒA ÆXƒAÊ Ì ÅZÍ\"‚RÇ !;ƒNÇ !‚RÈÎ \"Ï !ƒ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 "\ 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." "P"]) (defalias 'vi-put-after #[(arg) "À Â\"‡" [vi-put-before arg t] 3 "\ Put yanked (in vi sense) text back after/below cursor." "P"]) (defalias 'vi-shell-op #[(motion-command arg &optional shell-command) "À \n\"‰@ A U?…,„ ÇÈÉ\"‰\nË Ì\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 "\ 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-shift-op #[(motion-command arg amount) "À \n\"‰@ A U?…6Æ\n!ƒ.ÈVƒ'Æ\n!ÉZ‚,ÉÆ\n!ZÊ #ˆË+‡" [vi-effective-range motion-command arg range begin end vi-prefix-char-value amount 0 48 indent-rigidly t] 5 "\ 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-indent-op #[(motion-command arg) "À \n\"‰@ A U?…Æ Ç#ˆÈ+‡" [vi-effective-range motion-command arg range begin end indent-region nil t] 5 "\ Perform indent command on range specified by MOTION-COMMAND with ARG."]) (defalias 'vi-narrow-op #[(motion-command arg) "À \n\"‰@ AÆ U?… },‡" [vi-effective-range motion-command arg range begin end nil reg] 4 "\ Narrow to region specified by MOTION-COMMAND with ARG."]) (defalias 'vi-get-mark #[(char) " žA‡" [char vi-mark-alist] 2 "\ Return contents of vi mark register named CHAR, or nil if undefined."]) (defalias 'vi-set-mark #[(char) "À Â\"ƒ ÃÄ!‡ ž‰ƒA`Ä“‚) Ç`!B‰ B‰)‡" [char-equal char 64 set-mark-command nil vi-mark-alist aelt copy-marker] 4 "\ Set contents of vi mark register named CHAR to current point. '@' is the special anonymous mark register." "c"]) (defalias 'vi-find-matching-paren #[nil "ÀÁ!ƒÂÃ!ˆÄÃ!‡ÀÅ!ƒÃuˆÆÃ!‡Ç ‡" [looking-at "[[({]" forward-sexp 1 backward-char "[])}]" backward-sexp ding] 2 "\ Locate the matching paren. It's a hack right now." nil]) (defalias 'vi-backward-blank-delimited-word #[(count) "ÀÁÂà $…o?…Åu‡" [re-search-backward "[ \n`][^ \n`]+" nil t count 1] 5 "\ Backward COUNT blank-delimited words." "p"]) (defalias 'vi-forward-blank-delimited-word #[(count) "ÀÁÂà $…m?…ÅÆ!‡" [re-search-forward "[^ \n]*[ \n]+[^ \n]" nil t count backward-char 1] 5 "\ Forward COUNT blank-delimited words." "p"]) (defalias 'vi-end-of-blank-delimited-word #[(count) "ÀÁÂà $…m?…ÅÆ!‡" [re-search-forward "[^ \n']+[ \n']" nil t count backward-char 2] 5 "\ Forward to the end of the COUNT'th blank-delimited word." "p"]) (defalias 'vi-home-window-line #[(arg) "À S!ˆÂ ‡" [move-to-window-line arg back-to-indentation] 2 "\ To window home or arg'th line from the top of the window." "p"]) (defalias 'vi-last-window-line #[(arg) "À [!ˆÂ ‡" [move-to-window-line arg back-to-indentation] 2 "\ To window last line or arg'th line from the bottom of the window." "p"]) (defalias 'vi-middle-window-line #[nil "ÀÁ!ˆÂ ‡" [move-to-window-line nil back-to-indentation] 2 "\ To the middle line of the window." nil]) (defalias 'vi-forward-word #[(count) "ÀÁÂà $ƒ ÇŠ‡" [re-search-forward "\\w*\\W+\\<" nil t count vi-ding] 5 "\ Stop at the beginning of the COUNT'th words from point." "p"]) (defalias 'vi-set-last-change-command #[(fun &rest args) " B‰‡" [fun args vi-last-change-command] 2 "\ Set (FUN . ARGS) as the `last-change-command'."]) (defalias 'vi-redo-last-change-command #[(count &optional command) "„ „ÂÃ!‡ ÅV…\"Æ@A\"ˆ S‰‚‡" [command vi-last-change-command message "No last change command available." count 0 apply] 4 "\ Redo last change command COUNT times. If the optional COMMAND is given, it is used instead of the current `last-change-command'." "p"]) (defalias 'vi-kill-char #[(count) "À Â\"ˆÃÀ Â#‡" [delete-char count t vi-set-last-change-command] 4 "\ Kill COUNT chars from current point." "*p"]) (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 "\ 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." "*P\nc"]) (defalias 'vi-query-replace #[(arg) "ƒÁ‚ ÂÄ Å\")‡" [arg query-replace-regexp query-replace rcmd call-interactively nil] 3 "\ Query replace, use regexp version if ARG is non-nil." "*P"]) (defalias 'vi-replace #[(arg) "ƒÁ‚ ÂÄ Å\")‡" [arg replace-regexp replace-string rcmd call-interactively nil] 3 "\ Replace strings, use regexp version if ARG is non-nil." "*P"]) (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 "\ Move current line to the top/center/bottom of the window." "p\nc"]) (defalias 'vi-goto-column #[(col) "`Áyˆ\nÃVƒlƒÁ‰‚Ãuˆ\nS‰‚\nÃUƒ)Ä‚.bˆÅ )‡" [opoint 0 col 1 t ding] 3 "\ Go to given column of the current line." "p"]) (defalias 'vi-name-last-change-or-macro #[(arg char) "ƒ ÁÂà !!!‡ @Æ=ƒ7 A‰@A@{É8\nË8 ÍÎ\n $ˆ,Âà !! 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 "\ 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." "P\nc"]) (defalias 'vi-call-named-change-or-macro #[(count char) "ÀÁ\n!!K;ƒÃÀÁ\n!! \"‡Å ÀÁ\n!!K\"‡" [intern char-to-string char execute-kbd-macro count vi-redo-last-change-command] 5 "\ Execute COUNT times the keyboard macro definition named by the following CHAR." "p\nc"]) (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 "\ Change the case of the char after point." "*p"]) (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 "\ Inquire status info. The next CHAR will specify the particular info requested." "c"]) (defalias 'vi-mark-region #[(arg region) "À Â\"ƒ à !‡À Å\"ƒÆ !‡À Ç\"ƒ È ‡À É\"ƒ+Ê !‡À Ë\"ƒ6Ì !‡À Í\"ƒAÎ !‡À Ï\"ƒLÐ !‡À Ñ\"ƒWÒ !‡À Ó\"ƒbÔ !‡ÕÖ!ˆ× Ø \"‡" [char-equal region 100 mark-defun arg 115 mark-sexp 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 "\ 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)." "p\nc"]) (defalias 'vi-mark-lines #[(num) "ÀyˆÁ ˆ\n‡" [0 push-mark num] 1 "\ Mark NUM of lines from current line as current region."]) (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 "\ Verify spelling for the objects specified by char UNIT : [b(uffer), r(egion), s(tring), w(ord) ]." "P\nc"]) (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 "\ This is a hack for accessing mode specific C-c commands in vi-mode." "P"]) (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 "\ Quote ARG words from the word point is on with pattern specified by CHAR. Currently, CHAR could be [,{,(,\",',`,<,*, etc." "*p\nc"]) (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 "\ Locate definition in current file for the name before the point. It assumes a `(def..' always starts at the beginning of a line." nil]) (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 "\ Insert a newline and leave point before it. With ARG, inserts that many newlines." "*p"]) emacs-19.22/lisp/view.elc100666 13437 1 27337 5474623526 13722 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:20:21 1993 ;;; from file /home/fsf/rms/e19/lisp/view.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (byte-code "ÀÁ!„ „Ëà Ä A@Å\"ˆÆ ÇÈ#ˆÆ ÉÊ#ˆÆ ËÈ#ˆÆ ÌÍ#ˆÆ ÎÏ#ˆÆ ÐÏ#ˆÆ ÑÏ#ˆÆ ÒÏ#ˆÆ ÓÏ#ˆÆ ÔÏ#ˆÆ ÕÏ#ˆÆ ÖÏ#ˆÆ ×Ï#ˆÆ ØÏ#ˆÆ ÙÚ#ˆÆ ÛÂ#ˆÆ ÜÝ#ˆÆ ÞÍ#ˆÆ ßÏ#ˆÆ àÏ#ˆÆ áÏ#ˆÆ âÏ#ˆÆ ãÏ#ˆÆ äÏ#ˆÆ åÏ#ˆÆ æÏ#ˆÆ çÏ#ˆÆ èÏ#ˆÆ éê#ˆÆ ëì#ˆÆ íî#ˆÆ ïð#ˆÆ ñð#ˆÆ òî#ˆÆ óô#ˆÆ õô#ˆÆ ö÷#ˆÆ øù#ˆÆ úû#ˆÆ üý#ˆÆ þÿ#ˆÆ @ÿ#ˆÆ AB#ˆÆ CB#ˆÆ DE#ˆÆ FG#ˆÆ HG#ˆÆ IJ!K#ˆÆ LM#ˆÆ NO#ˆÆ PQ#ˆÆ RS#ˆÆ TQ#ˆÆ US#ˆÆ VW#ˆÆ XY#ˆÆ ZW#ˆÆ [Y#ˆÆ \\]#ˆÆ ^_#ˆÂ‡" [boundp view-mode-map nil make-keymap fillarray View-undefined define-key "" view-exit "" suspend-emacs "q" "-" negative-argument "0" digit-argument "1" "2" "3" "4" "5" "6" "7" "8" "9" "" universal-argument "" "" Control-X-prefix "-" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "<" beginning-of-buffer ">" end-of-buffer "v" View-scroll-lines-backward "" View-scroll-lines-forward " " "" "\n" View-scroll-one-more-line " " " " recenter "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" Helper-describe-bindings "?" char-to-string help-char Helper-help "" next-line "" previous-line "" isearch-forward "" isearch-backward "s" "r" "/" View-search-regexp-forward "\\" View-search-regexp-backward "" "" "n" View-search-last-regexp-forward "p" View-search-last-regexp-backward] 4) (defalias 'view-file #[(file-name) "pÀ ! !Æ Ç\"ˆÈ ?…É !?…Ê\"+‡" [get-file-buffer file-name find-file-noselect buf-to-view had-a-buf old-buf switch-to-buffer t view-mode buffer-modified-p kill-buffer] 4 "\ 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-hook'." "fView file: "]) (defalias 'view-file-other-window #[(file-name) "À Á\n!Ã\n!Ç !ˆÈ ?… É !?… Ê\"+‡" [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 buffer-modified-p kill-buffer] 4 "\ 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-hook'." "fView file: "]) (defalias 'view-buffer #[(buffer-name) "pÁ\nÃ\"ˆÄÅ\")‡" [old-buf switch-to-buffer buffer-name t view-mode nil] 3 "\ 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-hook'." "bView buffer: "]) (defalias 'view-buffer-other-window #[(buffer-name not-return) "…Á à !ˆÅ\n!)‡" [not-return current-window-configuration return-to switch-to-buffer-other-window buffer-name view-mode] 2 "\ View BUFFER in View mode in another window, returning to original buffer when done *only* if prefix argument NOT-RETURN is nil (which is the default). The usual Emacs commands are not available in View mode; instead, a special set of commands (mostly letters and punctuation) are defined for moving around in the buffer. Space scrolls forward, Delete scrolls backward. For list of all View commands, type ? or h while viewing. This command runs the normal hook `view-hook'." "bView buffer:\nP"]) (defalias 'view-mode #[(&optional prev-buffer action) "ÀÁ!ˆ\nÀÃ!ˆ ÀÅ!ˆÀÇ!ˆÀÉ!ˆÊ  ÀË!ˆÌÍ!…/  ÎÏ ƒ<Ђ=ÑCÒÓÔÕÏ ƒSÖÏ !‚U× \" ÀØ!ˆÀÚ!ˆÀÜ!ˆÝ ÀÞ!ˆßÀà!ˆß áyˆß\"ã$!ˆåæ!ˆç ‡" [make-local-variable view-old-mode-line-buffer-identification mode-line-buffer-identification view-old-buffer-read-only buffer-read-only view-old-mode-name mode-name view-old-major-mode major-mode view-old-local-map current-local-map view-old-Helper-return-blurb boundp Helper-return-blurb t buffer-file-name "Viewing %f" "Viewing %b" "View" view-mode format "continue viewing %s" file-name-nondirectory buffer-name view-exit-action action view-return-here prev-buffer view-exit-position point-marker view-scroll-size nil view-last-regexp 0 goal-column use-local-map view-mode-map run-hooks view-hook view-helpful-message] 4 "\ Major mode for viewing text but not editing it. 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). \\[Helper-help] 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 or C-c exit view-mode and return to previous buffer. Entry to this mode runs the normal hook `view-hook'. \\{view-mode-map}"]) (defalias 'view-exit #[nil "\n Æ!ˆ \nbˆ\nˉ“ˆp  Ï!ƒ/Ñ!ˆ‚;Ò!ƒ;Ó!ˆ …E !*‡" [view-old-mode-line-buffer-identification mode-line-buffer-identification view-old-major-mode major-mode view-old-mode-name mode-name use-local-map view-old-local-map view-old-buffer-read-only buffer-read-only view-exit-position nil view-exit-action action viewed-buffer bufferp view-return-here switch-to-buffer window-configuration-p set-window-configuration] 3 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"‡" [defalias view-helpful-message #[nil "ÀÁÂ!!‡" [message substitute-command-keys "Type \\[Helper-help] for help, \\[Helper-describe-bindings] for commands, \\[view-exit] to quit."] 3] View-undefined #[nil "À ˆÁ ‡" [ding view-helpful-message] 1 nil nil] view-window-size #[nil "À S‡" [window-height] 1] view-scroll-size #[nil "À †À ^‡" [view-window-size view-scroll-size] 2]] 3) (defvar view-hook nil "\ Normal hook run when starting to view a buffer or file.") (defalias 'View-goto-line #[(&optional line) "À ˆÁ\n† Ã!ˆÄŠƥ!‡" [push-mark goto-line line 1 recenter view-window-size 2] 3 "\ Move to line LINE in View mode. Display is centered at LINE. Sets mark at starting position and pushes mark ring." "p"]) (defalias 'View-scroll-lines-forward #[(&optional lines) "Àd!ƒ ƒ ÂVƒà ‡ ƒÄ !‚Å ‰Æ Yƒ.ÇÈ!ˆ‚A [Æ Yƒ=ÉÈ!ˆ‚AÇ !ˆÀd!ƒTdbˆÊË!ˆÌÍÎ!!ˆÏË!ˆÂyˆÈ‡" [pos-visible-in-window-p lines 0 view-exit prefix-numeric-value view-scroll-size view-window-size scroll-up nil scroll-down recenter -1 message substitute-command-keys "End. Type \\[view-exit] to quit viewing." move-to-window-line] 4 "\ 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." "P"]) (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 "\ 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." "P"]) (defalias 'View-scroll-one-more-line #[(&optional arg) "À „ ‚\nÃ!‡" [View-scroll-lines-forward arg 1 -1] 2 "\ Scroll one more line up in View mode. With ARG scroll one line down." "P"]) (defalias 'View-scroll-lines-backward #[(&optional lines) "À ƒ  ![‚à [!‡" [View-scroll-lines-forward lines prefix-numeric-value view-scroll-size] 3 "\ 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." "P"]) (defalias 'View-search-regexp-forward #[(n regexp) "GÁV…  \"‡" [regexp 0 view-search n] 3 "\ 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." "p\nsSearch forward (regexp): "]) (defalias 'View-search-regexp-backward #[(n regexp) "À [\n\"‡" [View-search-regexp-forward n regexp] 3 "\ 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." "p\nsSearch backward (regexp): "]) (defalias 'View-search-last-regexp-forward #[(n) "À \n\"‡" [View-search-regexp-forward n view-last-regexp] 3 "\ 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." "p"]) (defalias 'View-search-last-regexp-backward #[(n) "À \n\"‡" [View-search-regexp-backward n view-last-regexp] 3 "\ 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." "p"]) (defalias 'View-back-to-mark #[(&optional ignore) "À †ebˆÁ ˆÂà ĥ!‡" [mark pop-mark recenter view-window-size 2] 3 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÃÄ!‡" [defalias view-search #[(times regexp) "ÂŠÄ ÆWƒÆ‚Ç!ˆÈÂÉ $ƒ`) ƒ5Ê ˆ bˆÆyˆËÌ Í¥!‚>ÎÏ #ˆÐÑ!)‡" [regexp view-last-regexp nil where move-to-window-line times 0 -1 re-search-forward t push-mark recenter view-window-size 2 message "Can't find occurrence %d of %s" sit-for 4] 5] provide view] 3) emacs-19.22/lisp/vip.elc100666 13437 13 163547 5416176767 13336 0ustar jimbuser;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:22:14 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/vip.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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)") (byte-code "ÀÁ!ˆÀÂ!‡" [make-variable-buffer-local vip-emacs-local-map vip-insert-local-map] 2) (defvar vip-insert-point nil "\ Remember insert point as a marker. (buffer specific)") (byte-code "ÀÁ \"ˆÃÁ!‡" [set-default vip-insert-point make-marker make-variable-buffer-local] 3) (defvar vip-com-point nil "\ Remember com point as a marker. (buffer specific)") (byte-code "ÀÁ \"ˆÃÁ!‡" [set-default vip-com-point make-marker make-variable-buffer-local] 3) (defvar vip-current-mode nil "\ Current mode. One of emacs-mode, vi-mode, insert-mode.") (byte-code "ÀÁ!ˆÂÁÃ\"‡" [make-variable-buffer-local vip-current-mode set-default emacs-mode] 3) (defvar vip-emacs-mode-line-buffer-identification nil "\ value of mode-line-buffer-identification in emacs-mode.") (byte-code "ÀÁ!ˆÂÁÃ\"‡" [make-variable-buffer-local vip-emacs-mode-line-buffer-identification set-default ("Emacs: %17b")] 3) (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 (quote 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") (byte-code "ÀÁ!„ÂÀÃ!„ÄÅÆÇ\"‡" [boundp vip-tags-file-name "TAGS" vip-inhibit-startup-message nil global-set-key "" vip-change-mode-to-vi] 3) (defalias 'vip-loop '(macro . #[(count body) "ÀÁ DCÂÃÁÄE ÆÁÇÁDEFE‡" [let count while > 0 body setq 1-] 9 "\ (COUNT BODY) Execute BODY COUNT times."])) (defalias 'vip-push-mark-silent #[(&optional location) "À ƒ\"Á ! B‰G Vƒ\" ›@ʼn“ˆ S ›Å¡ˆÆ†)`!‡" [mark copy-marker mark-marker mark-ring mark-ring-max nil set-mark location] 4 "\ Set mark at LOCATION (point, by default) and push old mark on mark ring. No message."]) (defalias 'vip-goto-col #[(arg) "À ! !ŠÅˆ iTVƒÆÇ!ˆ) ƒ\"`Å“ˆÉyˆ Suˆ …2ÊË #*‡" [vip-p-val arg vip-getcom com val nil error "" vip-com-point 0 vip-execute-com vip-goto-col] 4 "\ Go to ARG's column." "P"]) (defalias 'vip-refresh-mode-line #[nil "ÀÁ !‡" [set-buffer-modified-p buffer-modified-p] 2 "\ Redraw mode line."]) (defalias (quote vip-copy-keymap) #[(map) "„Á ‡Â!‡" [map make-sparse-keymap copy-keymap] 2]) (defalias 'vip-change-mode #[(new-mode) " =†£Â=ƒ7 Ã=ƒÄ` \"ˆÆ ˆ‚+Ç  \nËÇ ! ÍÎ!ˆÏ!ˆ‚ŸÃ=ƒ `Ñ“ˆ Ò=ƒYÇ  \nËÇ ! ‚_Ë! ÍÓ!ˆÏ !ˆÔ ÕÖ#ˆÔ ×Ø#ˆÔ ÙƒƒÛ‚„Ü#ˆÔ ÝÞ#ˆ‚ŸÒ=ƒŸÍß!ˆÏ!ˆà ‡" [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:" vip-refresh-mode-line] 4 "\ Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode."]) (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 "\ If BEG and END do not belong to the same buffer, it copies empty region."]) (defalias 'vip-change-mode-line #[(string) "Á˜ƒ\n\n‚ÃPC‰‡" [string "Emacs:" vip-emacs-mode-line-buffer-identification " %17b" mode-line-buffer-identification] 2 "\ Assuming that the mode line format contains the string \"Emacs:\", this function replaces the string by \"Vi: \" etc."]) (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 "\ Turn on VIP emulation of VI." nil]) (defalias 'vip-change-mode-to-vi #[nil "ÀÁ!‡" [vip-change-mode vi-mode] 2 "\ Change mode to vi mode." nil]) (defalias 'vip-change-mode-to-insert #[nil "ÀÁ!‡" [vip-change-mode insert-mode] 2 "\ Change mode to insert mode." nil]) (defalias 'vip-change-mode-to-emacs #[nil "ÀÁ!‡" [vip-change-mode emacs-mode] 2 "\ Change mode to emacs mode." nil]) (defalias 'vip-escape-to-emacs #[(arg &optional events) "À‰Á  ƒ É\n!ˆËŽÌÍÀ!‰!)Î \"ˆÀ‰+‡" [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 "\ 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." "P"]) (defalias 'vip-message-conditions #[(conditions) "@A „ÃÄ\n\"ˆ‚ÃÅ\nÆ !#ˆÇ *‡" [conditions msg case message "%s" "%s %s" prin1-to-string ding] 5 "\ Print CONDITIONS as a message."]) (defalias 'vip-ESC #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (27)] 3 "\ Emulate ESC key in Emacs mode." "P"]) (defalias 'vip-ctl-c #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (3)] 3 "\ Emulate C-c key in Emacs mode." "P"]) (defalias 'vip-ctl-x #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (24)] 3 "\ Emulate C-x key in Emacs mode." "P"]) (defalias 'vip-ctl-h #[(arg) "À Â\"‡" [vip-escape-to-emacs arg (8)] 3 "\ Emulate C-h key in Emacs mode." "P"]) (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 "\ 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-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 "\ Vi operator as prefix argument."]) (defalias (quote vip-describe-arg) #[(arg) "À‰à !Å !\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]) (defalias 'vip-digit-argument #[(arg) "À  :…\n A#‡" [vip-prefix-arg-value last-command-char nil arg] 4 "\ Begin numeric argument for the next command." "P"]) (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 "\ Accept a motion command as an argument." "P"]) (defalias 'vip-p-val #[(arg) "„Á‡:ƒ@„Á‡@‡‡" [arg 1] 1 "\ Get value part of prefix-argument ARG."]) (defalias 'vip-P-val #[(arg) ":ƒ@‡‡" [arg] 1 "\ Get value part of prefix-argument ARG."]) (defalias 'vip-getcom #[(arg) "„Á‡:ƒA‡Á‡" [arg nil] 1 "\ Get com part of prefix-argument ARG."]) (defalias 'vip-getCom #[(arg) "À !‰ÚƒÄ‚#\nÅšƒÆ‚#\nÇšƒ\"È‚#\n)‡" [vip-getcom arg com 99 67 100 68 121 89] 3 "\ Get com part of prefix-argument ARG and modify it."]) (defalias 'vip-append-to-register #[(reg start end) "À  !† à {P\"‡" [set-register reg get-register "" start end] 5 "\ Append region to text in register REG. START and END are buffer positions indicating what to append."]) (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 "\ (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-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 "\ (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." "P"]) (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 "\ This command is invoked interactively by the key sequence #"]) (defalias 'vip-undo #[nil "ÀÁ!ˆÂ ˆÃÄ!ˆÅ‰‡" [message "undo!" undo-start undo-more 2 vip-undo this-command] 2 "\ Undo previous change." nil]) (defalias 'vip-undo-more #[nil "ÀÁ!ˆÂÃ!ˆÄ‰‡" [message "undo more!" undo-more 1 vip-undo this-command] 2 "\ Continue undoing previous changes."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias vip-string-tail #[(str) "?†Á˜?…ÂÃO‡" [str "" 1 nil] 3] vip-yank-defun #[nil "À ˆÁ` \"‡" [mark-defun copy-region-as-kill mark] 3]] 3) (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 "\ Enlarge region between BEG and END."]) (defalias 'vip-global-execute #[nil "`À Vƒ\nÁ ˆÂyˆÃ ˆ`À W…#ÄyˆÂyˆÃ ˆ‚‡" [mark exchange-point-and-mark 0 call-last-kbd-macro 1] 2 "\ Call last keyboad macro for each line in the region."]) (defalias 'vip-quote-region #[nil "ÀÁ \"!‰Řƒ ‚ )Æ`Ç \"ˆ`Ç 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 "\ Quote region by inserting the user supplied string at the beginning of each line in the region."]) (defalias 'vip-end-with-a-newline-p #[(string) "Á˜† \n‰GSHÃU‡" [text "" string 10] 2 "\ Check if the string ends with a newline."]) (defalias (quote 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]) (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 "\ 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-insert #[(arg) "À ! !Å ÆE ƒ+ ‰É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 "\ " "P"]) (defalias 'vip-append #[(arg) "À ! !Å ÆEl„Èuˆ Æšƒ4 ‰ Ê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 "\ Append after point." "P"]) (defalias 'vip-Append #[(arg) "À ! !Å ÆEȈ Æšƒ0 ‰ Ê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 "\ Append at end of line." "P"]) (defalias 'vip-Insert #[(arg) "À ! !Å ÆEÈ ˆ Æšƒ0 ‰ Ê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 "\ Insert before first non-white." "P"]) (defalias 'vip-open-line #[(arg) "À ! !Å ÆEÈ  ÆšƒA ‰\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 "\ Open line below." "P"]) (defalias 'vip-Open-line #[(arg) "À ! !Å ÆEÈ  ÆšƒA ‰\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 "\ Open line above." "P"]) (defalias 'vip-open-line-at-point #[(arg) "À ! !Å ÆE Æšƒ1 ‰É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 "\ Open line at point." "P"]) (defalias 'vip-substitute #[(arg) "À ! !ŠÅ`!ˆ uˆ ÆšƒÇÈ `\"ˆ‚%ÉÈ `\"ˆ)Ê ÆE‰ *‡" [vip-p-val arg vip-getcom com val set-mark 114 vip-change-subr mark vip-change vip-substitute vip-d-com] 3 "\ Substitute characters." "P"]) (defalias 'vip-substitute-line #[(arg) "À ÂB!‡" [vip-line arg 67] 3 "\ Substitute lines." "p"]) (defalias (quote vip-line) #[(arg) "@A `Ä“ˆÅ\nS!ˆÆÇ\n #*‡" [arg com val vip-com-point nil next-line vip-execute-com vip-line] 4]) (defalias 'vip-yank-line #[(arg) "À !Ã\nÄB!)‡" [vip-p-val arg val vip-line 89] 3 "\ Yank ARG lines (in vi's sense)" "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias vip-region #[(arg) "À ! ! `Æ“ˆÇ ˆÈÉ #*‡" [vip-P-val arg vip-getcom com val vip-com-point nil exchange-point-and-mark vip-execute-com vip-region] 4 nil "P"] vip-Region #[(arg) "À ! ! `Æ“ˆÇ ˆÈÉ #*‡" [vip-P-val arg vip-getCom com val vip-com-point nil exchange-point-and-mark vip-execute-com vip-Region] 4 nil "P"]] 3) (defalias 'vip-replace-char #[(arg) "À ! !Å ÆEÈ Æšƒ ‚Ê \"*‡" [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 "\ Replace the following ARG chars by the character read." "P"]) (defalias (quote vip-replace-char-subr) #[(char arg) "À Â\"ˆ  ÅVƒ ‚ [‰ÅVƒ' cˆS‰‚)Ç !‡" [delete-char arg t char vip-d-char 0 count backward-char] 4]) (defalias 'vip-replace-string #[nil "À ƒ Ä‚ Å!‰Ƙƒ( ?ÇÈÉ ƒ\"Ê‚#Ë\"!‚A ƒ8Ì ÂÈÍ \"!\"‚AÎ ÂÈÏ \"!\")‡" [nil str vip-read-string vip-re-replace "Replace regexp: " "Replace string: " "" message format "Replace mode changed to %s." "regexp replace" "string replace" replace-regexp "Replace regexp \"%s\" with: " replace-string "Replace \"%s\" with: "] 7 "\ 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." nil]) (defalias 'vip-forward-char #[(arg) "À ! ! ƒ `Æ“ˆ uˆ …ÇÈ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil vip-execute-com vip-forward-char] 4 "\ Move point right ARG characters (left if ARG negative).On reaching end of buffer, stop and signal error." "P"]) (defalias 'vip-backward-char #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆ …ÈÉ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-char vip-execute-com vip-backward-char] 4 "\ Move point left ARG characters (right if ARG negative). On reaching beginning of buffer, stop and signal error." "P"]) (defalias 'vip-forward-word #[(arg) "À ! ! ƒ `Æ“ˆ vˆÇÆwˆ …K ÈU„( ÉUƒ/ÊË!ˆËvˆ ÌU„; ÍUƒFÊË!ˆËvˆÎÆwˆÏÐ #*‡" [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 "\ Forward word." "P"]) (defalias 'vip-end-of-word #[(arg) "À ! ! ƒ `Æ“ˆÆuˆ vˆÇ ˆ …&ÆuˆÈÉ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-char vip-execute-com vip-end-of-word] 4 "\ Move point to end of current word." "P"]) (defalias 'vip-backward-word #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆ …ÈÉ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-word vip-execute-com vip-backward-word] 4 "\ Backward word." "P"]) (defalias 'vip-forward-Word #[(arg) "À ! ! ƒ `Æ“ˆÇÈÆÉ $ˆ …K ÊU„( ËUƒ/ÌÍ!ˆÍvˆ ÎU„; ÏUƒFÌÍ!ˆÍvˆÐÆwˆÑÒ #*‡" [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 "\ Forward word delimited by white character." "P"]) (defalias 'vip-end-of-Word #[(arg) "À ! ! ƒ `Æ“ˆÆuˆÇÈÆÉ $ƒ Ê ˆ …,ÆuˆËÌ #*‡" [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 "\ Move forward to end of word delimited by white character." "P"]) (defalias 'vip-backward-Word #[(arg) "À ! ! ƒ `Æ“ˆÇÈÆÉ $ƒ Æuˆ‚#ebˆ …,ÊË #*‡" [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 "\ Backward word delimited by white character." "P"]) (defalias 'vip-beginning-of-line #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆ …ÈÉ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil beginning-of-line vip-execute-com vip-beginning-of-line] 4 "\ Go to beginning of line." "P"]) (defalias 'vip-bol-and-skip-white #[(arg) "À ! ! ƒ `Æ“ˆÇ ˆ …ÈÉ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil back-to-indentation vip-execute-com vip-bol-and-skip-white] 4 "\ Beginning of line at first non-white character." "P"]) (defalias 'vip-goto-eol #[(arg) "À ! ! ƒ `Æ“ˆ ˆ …ÇÈ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil vip-execute-com vip-goto-eol] 4 "\ Go to end of line." "P"]) (defalias 'vip-next-line #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆÈ …!ÊË #*‡" [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 "\ Go to next line." "P"]) (defalias 'vip-next-line-at-bol #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆÈ ˆ …!ÉÊ #*‡" [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 "\ Next line at beginning of line." "P"]) (defalias 'vip-previous-line #[(arg) "À ! ! ƒ `Æ“ˆÇ [!ˆÈ …\"ÊË #*‡" [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 "\ Go to previous line." "P"]) (defalias 'vip-previous-line-at-bol #[(arg) "À ! ! ƒ `Æ“ˆÇ [!ˆÈ ˆ …\"ÉÊ #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil next-line back-to-indentation vip-execute-com vip-previous-line] 4 "\ Previous line at beginning of line." "P"]) (defalias 'vip-change-to-eol #[(arg) "À ÂB!‡" [vip-goto-eol arg 99] 3 "\ Change to end of line." "P"]) (defalias 'vip-kill-line #[(arg) "À ÂB!‡" [vip-goto-eol arg 100] 3 "\ Delete line." "P"]) (defalias 'vip-goto-line #[(arg) "À ! ! `Æ“ˆÇ`!ˆ „dbˆ‚\"ebˆ SyˆÈ ˆ ….ÉÊ #*‡" [vip-P-val arg vip-getCom com val vip-com-point nil set-mark back-to-indentation vip-execute-com vip-goto-line] 4 "\ Go to ARG's line. Without ARG go to end of buffer." "P"]) (defalias 'vip-find-char #[(arg char forward offset) "ƒ ‚\n [ŠŒ ÄVƒ-lƒÅÆ!‚ `ÇÈ!ˆÄyˆ`}ˆ‚>nƒ7ÅÆ!‚8`Äyˆ`}ˆ ÄVƒKeTbˆ‚NdbˆÂ ÊË !ÂÄ $ˆ)` Ä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 "\ 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-forward #[(arg) "À ! !‰ÅVƒÆ È Ê ‚ [ ƒ( `Ê“ˆÍ À !ÅVƒ7‚9ÈÊ$ˆ [ …PÊuˆÏÐ #*‡" [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 "\ 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." "P"]) (defalias 'vip-goto-char-forward #[(arg) "À ! !‰ÅVƒÆ È È\n‚ [ ƒ( `Ì“ˆÍ À !ÅVƒ7‚9ȉ$ˆ [ …PÌuˆÏÐ #*‡" [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 "\ Go up to char ARG forward on line." "P"]) (defalias 'vip-find-char-backward #[(arg) "À ! !‰ÅVƒÆ È È\n‚ [ ƒ( `È“ˆÌ À !ÅVƒ7‚9 ȉ$ˆ [ …M ÎÏ #*‡" [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 "\ Find char ARG on line backward." "P"]) (defalias 'vip-goto-char-backward #[(arg) "À ! !‰ÅVƒÆ È Ê ‚ [ ƒ( `È“ˆÍ À !ÅVƒ7‚9ÈÊ$ˆ [ …MÏÐ #*‡" [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 "\ Go up to char ARG backward on line." "P"]) (defalias 'vip-repeat-find #[(arg) "À ! ! ƒ `Æ“ˆÇ  \n$ˆ …, ƒ'ÆuˆËÌ #*‡" [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 "\ Repeat previous find command." "P"]) (defalias 'vip-repeat-find-opposite #[(arg) "À ! ! ƒ `Æ“ˆÇ  ?\n$ˆ …- ƒ(ÆuˆËÌ #*‡" [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 "\ Repeat previous find command in the opposite direction." "P"]) (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 "\ Switch to other window." "p"]) (defalias 'vip-window-top #[(arg) "À ! ! ƒ `Æ“ˆÇ S!ˆ …ÈÉ #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil move-to-window-line vip-execute-com vip-window-top] 4 "\ Go to home window line." "P"]) (defalias 'vip-window-middle #[(arg) "À ! ! ƒ `Æ“ˆÇÈ SÉ¥ S\\!ˆ …%ÊË #*‡" [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 "\ Go to middle window line." "P"]) (defalias 'vip-window-bottom #[(arg) "À ! ! ƒ `Æ“ˆÇ [!ˆ …ÈÉ #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil move-to-window-line vip-execute-com vip-window-bottom] 4 "\ Go to last window line." "P"]) (defalias 'vip-line-to-top #[(arg) "À S!‡" [recenter arg] 2 "\ Put current line on the home line." "p"]) (defalias 'vip-line-to-middle #[(arg) "À S SÃ¥\\!‡" [recenter arg window-height 2] 4 "\ Put current line on the middle line." "p"]) (defalias 'vip-line-to-bottom #[(arg) "ÀÁ \nTZ!‡" [recenter window-height arg] 3 "\ Put current line on the last line." "p"]) (defalias 'vip-paren-match #[(arg) "À ! §ƒ5 ÃV„ ÄWƒÅÆ!‚€dÇVƒ)dÈ¥ _‚.d _È¥bˆÉ ‚€ÊË!ƒZ\nƒE `Í“ˆÎÄ!ˆ\nƒUÏÐÍ\n#‚€Ñ ‚€ÊÒ!ƒ}Íuˆ\nƒm `Í“ˆÓÄ!ˆ\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 "\ Go to the matching parenthesis." "P"]) (defalias 'vip-forward-sentence #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil forward-sentence vip-execute-com vip-forward-sentence] 4 "\ Forward sentence." "P"]) (defalias 'vip-backward-sentence #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getcom com val vip-com-point nil backward-sentence vip-execute-com vip-backward-sentence] 4 "\ Backward sentence." "P"]) (defalias 'vip-forward-paragraph #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil forward-paragraph vip-execute-com vip-forward-paragraph] 4 "\ Forward paragraph." "P"]) (defalias 'vip-backward-paragraph #[(arg) "À ! ! ƒ `Æ“ˆÇ !ˆ …ÈÉÆ #*‡" [vip-p-val arg vip-getCom com val vip-com-point nil backward-paragraph vip-execute-com vip-backward-paragraph] 4 "\ Backward paragraph." "P"]) (defalias 'vip-scroll #[(arg) "ÁVƒÁV…% ˆS‰‚ÁV…%à ˆT‚‡" [arg 0 scroll-up scroll-down] 3 "\ Scroll to next screen." "p"]) (defalias 'vip-scroll-back #[(arg) "À [!‡" [vip-scroll arg] 2 "\ Scroll to previous screen." "p"]) (defalias 'vip-scroll-down #[(arg) "„ Á å!‡Á!‡" [arg scroll-down window-height 2] 3 "\ Scroll up half screen." "P"]) (defalias 'vip-scroll-down-one #[(arg) "À !‡" [scroll-down arg] 2 "\ Scroll up one line." "p"]) (defalias 'vip-scroll-up #[(arg) "„ Á å!‡Á!‡" [arg scroll-up window-height 2] 3 "\ Scroll down half screen." "P"]) (defalias 'vip-scroll-up-one #[(arg) "À !‡" [scroll-up arg] 2 "\ Scroll down one line." "p"]) (defalias 'vip-buffer-in-two-windows #[nil "À ˆÁÂ!‡" [delete-other-windows split-window-vertically nil] 2 "\ Show current buffer in two windows." nil]) (defalias 'vip-search-forward #[(arg) "À ! !ÅǃɂÊ!‰ ̘ƒ6?ÍÎσ0Ђ1Ñ\"!‚MÒ Å #ˆ …MÔ Õ“ˆÖ× #*‡" [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 "\ 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." "P"]) (defalias 'vip-search-backward #[(arg) "À ! !ÅǃɂÊ!‰ ̘ƒ6?ÍÎσ0Ђ1Ñ\"!‚MÒ Å #ˆ …MÔ Å“ˆÕÖ #*‡" [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 "\ 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." "P"]) (defalias 'vip-search #[(string forward arg &optional no-offset init-point) "À ! !à !? ? †` \n   ƒ+ÎÏЂ/ÎÑÒ.‡" [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ƒà Á‰ $ˆÆ !ˆ‚(Ç Á‰ $ˆÈ !ˆÉ\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ˆÂ Å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É $ˆ‚Å\nÉ $ˆÆ!‡" [vip-re-search re-search-backward string nil val search-backward push-mark start-point] 5) ((search-failed (byte-code "ƒ ƒdbˆÂ ÅBÇ%‡bˆÉÊ A\"‡" [null-arg vip-search-wrap-around vip-search string forward 1 com t start-point signal search-failed conditions] 6)))] 6 "\ (STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of STRING. Search will be forward if FORWARD, otherwise backward."]) (defalias 'vip-search-next #[(arg) "À ! ! „ÆÇ!ˆÈ  #ˆ … ÊË #*‡" [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 "\ Repeat previous search." "P"]) (defalias 'vip-search-Next #[(arg) "À ! ! „ÆÇ!ˆÈ  ? #ˆ …!ÊË #*‡" [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 "\ Repeat previous search in the reverse direction." "P"]) (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 "\ Switch to buffer in the current window." nil]) (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 "\ Switch to buffer in another window." nil]) (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 "\ Kill a buffer." nil]) (defalias 'vip-find-file #[nil "ÀÂÃ!ÄÅ !!ˆÆ )‡" [nil file read-file-name "visit file: " switch-to-buffer find-file-noselect vip-change-mode-to-vi] 3 "\ Visit file in the current window." nil]) (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 "\ Visit file in another window." nil]) (defalias 'vip-info-on-file #[nil "ÀÁ ƒ  ‚ ÃÄe`\"TÄed\"T$‡" [message "\"%s\" line %d of %d" buffer-file-name "" count-lines] 7 "\ Give information of the file associated to the current buffer." nil]) (defalias 'vip-yank #[(text) "ŠÀ`!ˆ cˆÂ ˆ)ÃÄw‡" [vip-push-mark-silent text exchange-point-and-mark " " nil] 2 "\ yank TEXT silently."]) (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 "\ Put back after point/below line." "P"]) (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 "\ Put back at point/above line." "P"]) (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 "\ Delete character." "P"]) (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 "\ Delete previous character." "P"]) (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 "\ Join this line to next, if ARG is nil. Otherwise, join ARG lines" "*P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias vip-change #[(beg end) "ÀÁ {\"!Æ \"‡" [vip-read-string format "%s => " beg end c-string vip-change-subr] 5] 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]] 3) (defalias 'vip-query-replace #[nil "À ƒ Ä‚ Å!‰Ƙƒ& ?ÇÈ ƒ!É‚\"Ê\"‚? ƒ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 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"‡" [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] vip-mark-end-of-buffer #[nil "À`!ˆdbˆÁ ˆÂÃ!‡" [set-mark exchange-point-and-mark message "mark set at the end of buffer"] 2 nil nil] 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"]] 3) (defalias 'vip-goto-mark #[(arg) "À Á\n!Å Æ#*‡" [read-char vip-getcom arg com char vip-goto-mark-subr nil] 4 "\ Go to mark." "P"]) (defalias 'vip-goto-mark-and-skip-white #[(arg) "À Á\n!Å Æ#*‡" [read-char vip-getCom arg com char vip-goto-mark-subr t] 4 "\ Go to mark and skip to first non-white on line." "P"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias vip-goto-mark-subr #[(char com skip-white) "À XƒS ÂXƒSp ƒ `Æ“ˆÇ ÈZ!bˆ ƒ&Ê ˆË ˆ …Q pšƒDÌ ƒ=Í‚>ÎÆ #‚QÏ !ˆ bˆË ˆÐÑ!)‡ „t ÈUƒt ƒg `Æ“ˆÒ ˆ …›ÌÎÆ #‡ ƒ˜ ÓUƒ˜ ƒˆ `Æ“ˆÒ ˆÊ ˆ …›ÌÍÆ #‡ÐÑ!‡" [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] vip-exchange-point-and-mark #[nil "À ˆÁ ‡" [exchange-point-and-mark back-to-indentation] 1 nil nil]] 3) (defalias 'vip-keyboard-quit #[nil "À ‡" [nil vip-use-register keyboard-quit] 1 "\ Abort partially formed or running command." nil]) (defalias 'vip-ctl-c-equivalent #[(arg) "ÀÁ\n\"‡" [vip-ctl-key-equivalent "" arg] 3 "\ Emulate C-c in Emacs mode." "P"]) (defalias 'vip-ctl-x-equivalent #[(arg) "ÀÁ\n\"‡" [vip-ctl-key-equivalent "" arg] 3 "\ Emulate C-x in Emacs mode." "P"]) (defalias (quote 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]) (defalias 'vip-delete-backward-word #[(arg) "ŠÀ`!ˆÁ\n!ˆ`à |)‡" [set-mark backward-word arg mark] 2 "\ Delete previous word." "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 defalias vip-version #[nil "ÀÁ!‡" [message "VIP version 3.5 of September 15, 1987"] 2 nil nil]] 4) (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") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÂÆÇÈ\"‡" [boundp ex-file nil ex-variant ex-offset ex-append defalias vip-nil #[nil "ÀÁ!‡" [error ""] 2 nil nil]] 3) (defalias 'vip-looking-back #[(str) "ŠÀ ÂÃ#)…`Ä•U‡" [re-search-backward str nil t 0] 4 "\ returns t if looking back reg-exp STR before point."]) (defalias 'vip-check-sub #[(str) "G‰\nGXƒ\nà O˜ƒ\n‰‚ĉ)‡" [ex-token length str 0 "non-command" ex-token-type] 5 "\ check if ex-token is an initial segment of STR"]) (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 "\ get a complete ex command"]) (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 "\ get an ex-token which is either an address or a command. a token has type (command, address, end-mark) and value."]) (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 "\ ex commands within VIP." nil]) (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 "\ get a regular expression and set ex-variant if found"]) (defalias 'vip-get-ex-command #[nil "À‹‡" [((byte-code "ÀqˆÁÂ!ƒ ÃuˆÄÅwˆÁÆ!ƒ&Ç ˆɘ…7ÊË \"‡ÁÍ!ƒ4Îg! Ã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 "\ get an ex command"]) (defalias 'vip-get-ex-opt-gc #[nil "À‹‡" [((byte-code "ÀqˆÁÂ!ƒ ÃuˆÄÅwˆÁÆ!ƒÆÃuˆÈ‡ÁÉ!ƒ,ÉÃuˆÈ‡Å‡" [" *ex-working-space*" looking-at "/" 1 " " nil "g" ex-token t "c"] 2))] 1 "\ get an ex option g or c"]) (defalias 'vip-default-ex-addresses #[(&optional whole-flag) "„ ƒdeÂBB‚``ÂBB‰‡A?…$@B‰‡" [ex-addresses whole-flag nil] 3 "\ compute default addresses. whole-flag means whole buffer."]) (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 "\ get an ex-address as a marker and set ex-flag if a flag is found"]) (defalias 'vip-get-ex-address-subr #[(old-address dot) "À\n„  Řƒ ‚Æ Æ˜ƒ4Š\nbˆ\nÇUƒ)S‚+yˆÉ )‚Æ Ê˜ƒJŠ\nbˆ[yˆÉ )‚Æ Ë˜ƒlŠebˆÇUƒ`Ç‚hSyˆÉ )‚Æ Ì˜ƒxÍ ‚Æ Î˜„Æ Ï˜„Æ Ð˜ƒ–ŠÑÒ!ˆÉ )‚Æ Ó˜ƒ¨ŠÑÀ!ˆÉ )‚Æ Ô˜ƒÆŠ„ºÕ ˆ‚ÂÖ×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 "\ returns an address as a point"]) (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 "\ search pattern and set address"]) (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 "\ get a buffer name and set ex-count and ex-flag if found"]) (defalias (quote 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]) (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 "\ get a file name and set ex-variant, ex-append and ex-offset if found"]) (defalias 'vip-execute-ex-command #[nil "Á˜ƒ  ‡؃ÄÅ!‡ƘƒÇ ‡Șƒ%É ‡ʘƒ.Ë ‡̘ƒ8ÍÌ!‡ΘƒAÏ ‡ИƒJÏ ‡јƒSÒ ‡Ó˜ƒ]ÄÔ!‡Õ˜ƒfÖ ‡טƒoØ ‡Ù˜ƒxÚ ‡Û˜ƒÜ ‡ݘƒŠÞ ‡ߘƒ“à ‡ᘃœâ ‡㘃¦ÄÅ!‡䘃¯å ‡昃¸ç ‡蘃Áé ‡ꘃÊë ‡옃ÓÉ ‡혃ÝîÅ!‡çîÔ!‡ð˜ƒðñ ‡ò˜ƒùó ‡ô˜ƒõ ‡ö˜ƒ Í÷!‡ø˜ƒÍù!‡ú˜ƒ àÔ!‡û˜ƒ+àÔ‰\"‡ü˜„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 "\ execute ex command using the value of addresses."]) (defalias 'ex-goto #[nil "„`ÁBÂ`!ˆ@bˆÃyˆÁ‡" [ex-addresses nil push-mark 0] 2 "\ ex goto command"]) (defalias 'ex-copy #[(del-flag) "À ˆÁ \n@\nA@ bˆŠÆ !ˆÇÈ `\"ˆ ƒ)Ê`È \"ˆ‚/Ë`È \"ˆ ƒ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 "\ ex copy and move command. DEL-FLAG means delete."]) (defalias 'ex-delete #[nil "À ˆÁ ˆ\n@\nA@ VƒÅÆ!ˆŠÇ \"ˆÈ ˆ ƒ1Ê`!ˆ Syˆ‚5Ê !ˆÇ`Ë \"ˆ ƒ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 "\ ex delete"]) (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 "\ ex-edit"]) (defalias 'ex-global #[(variant) "„ ƒÂÃ!ˆ‚ ƒÅÆ‚ÆÅÇ ˆ„*ÂÉ!ˆʘƒ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 "\ ex global command"]) (defalias 'ex-line #[(com) "À ˆÁ ˆ\n@\nA@à VƒÇÈ!ˆŠÉ \"ˆÊ ˆ ƒ2Ì`!ˆ yˆ ƒOÎÏ`Ð {!‘ˆÑÒÓˆŠÔÎ!ˆ)‚WÕ`Ð #ˆ`) Sbˆ×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 "\ ex line commands. COM is join, shift-right or shift-left."]) (defalias (quote 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]) (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 "\ ex mark"]) (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 "\ ex map"]) (defalias 'ex-unmap #[nil "À‹ˆÃ \"„ÅÆ!ˆÇ à \"#ˆÇ À#)‡" [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 "\ ex unmap"]) (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 "\ ex put"]) (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 "\ ex quit"]) (defalias 'ex-read #[nil "„`‚\n@Á‰‰‰bˆ ÆU„ÇÈ!ˆÆyˆÉ‹ˆ ƒ/Ê Ë\"‚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 "\ ex read"]) (defalias (quote ex-set) #[nil "ÀÁÂÃ!ÀÄÅ!!E!‡" [eval setq read-variable "Variable: " read-minibuffer "Value: "] 6]) (defalias 'ex-shell #[nil "À ˆÁ ‡" [vip-change-mode-to-emacs shell] 1 "\ ex shell"]) (defalias 'ex-substitute #[(&optional repeat r-flag) "À‰‰‰‰ƒÀ‚È ˆ„0 ƒ'\n‚)  ‚]͘ƒ<\n‚>‰\n  È ˆ„VÍÍ ‚] Î ƒsϘƒnЂ]Ђ]Ñ ˆƒ›Šƒ†@bˆÔ`!ˆSyˆ`Õ ÀBB)‚¸„ª``ÀBB‚¸A„¸@B@A@ÐÀŠÚ\"ˆŠ`Õ ]bˆÛ )`Õ ^bˆ`WƒCÀˆÛ Ýyˆ ƒ!l„Þ Ð#ƒ\nƒßà!ƒø`á !ˆ‚øÀˆÀuˆ‚ãÞ Ð#ƒ:\nƒ4ßà!ƒ:`á !ˆÀˆÀ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 "\ ex substitute. If REPEAT use previous reg-exp which is ex-reg-exp or vip-s-string"]) (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 "\ ex tag"]) (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 "\ ex write"]) (defalias 'ex-yank #[nil "À ˆÁ ˆ\n@\nA@ VƒÅÆ!ˆŠÇ \"ˆÈ ˆ „*\nƒ.ÅË!ˆ ƒ?Í`!ˆ Syˆ‚CÍ !ˆÇ`Î \"ˆƒ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 "\ ex yank"]) (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 "\ execute shell command"]) (defalias 'ex-line-no #[nil "ÀÁÂe „ d‚ @\"T\"‡" [message "%d" count-lines ex-addresses] 5 "\ print line number"]) (byte-code "ÀÁ!ƒ\nÂÁ!ˆÀ‡" [file-exists-p "~/.vip" load] 2) emacs-19.22/lisp/vms-patch.elc100666 13437 1 10055 5416177003 14625 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:22:27 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/vms-patch.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'create-file-buffer #[(filename) "ÀÁ\n!—!‡" [generate-new-buffer file-name-nondirectory filename] 3 "\ 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 (quote make-legal-file-name) #[(fn) "À !Âà G Wƒ H‰È=ƒ5ƒ/ ÉIˆ‚xÊ‚x ËYƒA ÌX„x ÍYƒM ÎX„x ÏYƒY ÐX„x Ñ=„x É=„x Ò=ƒ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]) (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 "\ 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. This is a separate function so your .emacs file or site-init.el can redefine it. See also auto-save-file-name-p."]) (defalias 'auto-save-file-name-p #[(filename) "ÀÁ\n\"‡" [string-match "^_\\$.*\\$" filename] 3 "\ Return t if FILENAME can be yielded by make-auto-save-file-name. FILENAME should lack slashes. This is a separate function so your .emacs file or site-init.el can redefine it."]) (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 "\ When resuming suspended Emacs, check for file to be found. If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file."]) (byte-code "ÀÀ‡" [vms-suspend-resume-hook suspend-resume-hook] 1) (defalias 'vms-suspend-hook #[nil "ÀÁÂ\"ƒ ÃÄ!ˆÅ‡" [vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS" error "Can't suspend this emacs" nil] 3 "\ Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined."]) (byte-code "ÀÀ‡" [vms-suspend-hook suspend-hook] 1) (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 "\ 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\""]) (byte-code "ÀÁÂ\"ˆÃÅÀ‡" [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] "/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] 3) (autoload (quote 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) emacs-19.22/lisp/vmsproc.elc100666 13437 1 5203 5416177020 14372 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:22:40 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/vmsproc.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (byte-code "ÀÁ!„ÂÀÃ!„ „#Ä Å ÆÇ#ˆÅ ÈÉ#ˆÂ‡" [boundp subprocess-running nil command-mode-map make-sparse-keymap define-key " " command-send-input "" command-kill-line] 4) (defalias 'subprocess-input #[(name str) "ƒÁ\n!ˆp\nqˆdbˆ cˆÅcˆ q)‡" [display-subprocess-window display-buffer subprocess-buf old-buffer str 10] 2 "\ Handles input from a subprocess. Called by Emacs."]) (defalias 'subprocess-exit #[(name) "À‰‡" [nil subprocess-running] 2 "\ Called by Emacs upon subprocess exit."]) (defalias 'start-subprocess #[nil "ƒÁÂ!ˆÃÄ!Š qˆÆ!ˆ)ÈÉÊË#‰…$ÌÉÍ\"‡" [subprocess-running return 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 "\ 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 'subprocess-command-to-buffer #[(command buffer) "À‰ ÄÅÆ \"O ÅÆ \"ÀOÇ\nÀÀÉ &*‡" [nil args cmd command 0 string-match " " call-process buffer "*dcl*"] 7 "\ Execute COMMAND and redirect output into BUFFER."]) (defalias 'subprocess-command #[nil "„Á ˆ… !ˆdb‡" [subprocess-running start-subprocess pop-to-buffer subprocess-buf] 2 "\ Starts asynchronous subprocess if not running and switches to its window." nil]) (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 "\ 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." nil]) (defalias 'command-kill-line #[nil "ÀyˆÁ ‡" [0 kill-line] 1 "\ Kills the current line. Used in command mode." nil]) (define-key esc-map "$" (quote subprocess-command)) emacs-19.22/lisp/vms-pmail.elc100666 13437 1 5205 5416177010 14607 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:22:31 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/vms-pmail.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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 "\ 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)." nil]) (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 "\ 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." nil]) (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 "\ 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." nil]) (defalias 'indicate-mail-reply-text #[nil "ebˆm„ÀcˆÁyˆÂyˆ‚ÃÄ!ˆeb‡" [">" 0 1 set-buffer-modified-p nil] 2 "\ Prepares received mail for re-sending by placing >'s on each line." nil]) (defalias 'insert-signature #[nil "À ˆÁ ˆÂÃÄ\"…&ÅÂÃÄ\"!ƒÆÂÃÄ\"!‡ÅÇ!…&ÆÇ!‡" [end-of-buffer newline vms-system-info "LOGICAL" "MAIL$TRAILER" file-attributes insert-file-contents "~/.signature"] 4 "\ 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." nil]) emacs-19.22/lisp/vmsx.elc100666 13437 1 6114 5416177026 13706 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:22:46 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/vmsx.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (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.") (byte-code "ÀÁ!„ÂÀÃ!„ „#Ä Å ÆÇ#ˆÅ ÈÉ#ˆÂ‡" [boundp subprocess-running nil command-mode-map make-sparse-keymap define-key " " command-send-input "" command-kill-line] 4) (defalias 'subprocess-input #[(name str) "ƒÁ\n!ˆp\nqˆdbˆ cˆÅcˆ q)‡" [display-subprocess-window display-buffer subprocess-buf old-buffer str 10] 2 "\ Handles input from a subprocess. Called by Emacs."]) (defalias 'subprocess-exit #[(name) "À‰‡" [nil subprocess-running] 2 "\ Called by Emacs upon subprocess exit."]) (defalias 'start-subprocess #[nil "ƒÁÂ!ˆÃÄ!Š qˆÆ!ˆ)ÈÉÊË#‰…$ÌÉÍ\"‡" [subprocess-running return 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 "\ 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."]) (defvar subprocess-command-to-buffer-tmpdir "SYS$SCRATCH:" "\ *Put temporary files from subprocess-command-to-buffer here.") (defalias 'subprocess-command-to-buffer #[(command buffer) "„Á ˆŠ\nqˆ ÄÅÆ!ÇRÉ!ƒ#Ê!ˆ‚ËÌÍÎQ\"ˆËÌ\"ˆËÌÐÑR\"ˆÉ!„KÒÓ!ˆ‚=Ô!*‡" [subprocess-running start-subprocess buffer subprocess-command-to-buffer-tmpdir "OUTPUT-FOR-" getenv "USER" ".LISTING" output-filename file-attributes delete-file send-command-to-subprocess 1 "DEFINE/USER SYS$OUTPUT " "-NEW" command "RENAME " "-NEW " sleep-for 2 insert-file] 6 "\ Execute command and redirect output into buffer. BUGS: only the output up to the end of the first image activation is trapped."]) (defalias 'subprocess-command #[nil "„Á ˆ… !ˆdb‡" [subprocess-running start-subprocess pop-to-buffer subprocess-buf] 2 "\ Starts asynchronous subprocess if not running and switches to its window." nil]) (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 "\ 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." nil]) (defalias 'command-kill-line #[nil "ÀyˆÁ ‡" [0 kill-line] 1 "\ Kills the current line. Used in command mode." nil]) (define-key esc-map "$" (quote subprocess-command)) emacs-19.22/lisp/vt100-led.elc100666 13437 1 2325 5416177031 14321 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:22:49 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/vt100-led.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defvar led-state (make-vector 5 nil) "\ The internal state of the LEDs. Choices are nil, t, `flash. Element 0 is not used.") (defalias 'led-flash #[(l) " ÂIˆÃ ‡" [led-state l flash led-update] 3 "\ Flash LED l."]) (defalias 'led-off #[(&optional l) "ƒ Â!ÃIˆ‚Ä Ã\"ˆÅ ‡" [l led-state prefix-numeric-value nil fillarray led-update] 3 "\ Turn off vt100 led number L. With no argument, turn them all off." "P"]) (defalias 'led-on #[(l) " ÂIˆÃ ‡" [led-state l t led-update] 3 "\ Turn on LED l."]) (defalias 'led-update #[nil "ÀÁ ÆU„6 H‰É=ƒ\" ÊË !Q‚.ƒ. ÊË !Q) T‰‚ Ì ÍRÎ !+‡" ["[?0" "[0" 1 l o f 5 led-state s flash ";" int-to-string "q" "t" send-string-to-terminal] 5 "\ Update the terminal's LEDs to reflect the internal state."]) (provide (quote vt100-led)) emacs-19.22/lisp/window.elc100666 13437 1 10322 5427403714 14232 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Tue Aug 3 02:38:03 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/window.el ;;; emacs version 19.17.7. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (defalias 'count-windows #[(&optional minibuf) "ÀÂà \"ˆ )‡" [0 count walk-windows #[(w) "Á\\‰‡" [count 1] 2] minibuf] 3 "\ Returns the number of visible windows. Optional arg NO-MINI non-nil means don't count the minibuffer even if it is active."]) (defalias 'balance-windows #[nil "ÀÁ‰‰Æ‹ˆÇ ¥ÈÉ!ˆÈÊË\",‡" [-1 nil 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] #[(w) "À !ˆ \nžAÄ Å Z!)‡" [select-window w newsizes newsize enlarge-window window-height] 3] nomini] 4 "\ Makes all visible windows the same height (approximately)." nil]) (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.") (defalias 'split-window-vertically #[(&optional arg) "À `Á‰‰ÇÁ…É!\"\n„cŠË qˆÌ bˆÍÎ !ˆÏ `\"ˆ`Ð !Vƒ>Ñ `\"ˆÍÒ!ˆ`) `XƒRÑ S\"ˆÌ ! WƒcÑ \"ˆÓ !ˆ -‡" [selected-window nil switch bottom new-w old-point old-w split-window arg prefix-numeric-value split-window-keep-point window-buffer window-start vertical-motion window-height set-window-start window-point set-window-point -1 select-window] 5 "\ Split current window into two windows, one above the other. The uppermost window gets ARG lines and the other gets the rest. 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." "P"]) (defalias 'split-window-horizontally #[(&optional arg) "ÀÁ\n… Ã\n!Ä#‡" [split-window nil arg prefix-numeric-value t] 4 "\ Split current window into two windows side by side. This window becomes the leftmost of the two, and gets ARG columns. No arg means split equally." "P"]) (defalias 'enlarge-window-horizontally #[(arg) "À Â\"‡" [enlarge-window arg t] 3 "\ Make current window ARG columns wider." "p"]) (defalias 'shrink-window-horizontally #[(arg) "À Â\"‡" [shrink-window arg t] 3 "\ Make current window ARG columns narrower." "p"]) (defalias 'shrink-window-if-larger-than-buffer #[(&optional window) "ŠÀ !qˆÂ `Äm?…dSfÅ=ÄÆÇ p \n   ÐÑ W…rÒe \"…rÓŽÔ †B!ˆebˆÒd ƒRЂSÄZ!ƒeÆÅcˆ T ‚G ÄV…qÕ S!).\n‡" [window-buffer window selected-window buffer-file-name 0 10 nil buffer-modified-p buffer modified buffer-read-only window-min-height ignore-final-newline n p w 1 count-windows pos-visible-in-window-p ((byte-code "e`|ˆÀ !ˆ\nbˆÃ !ˆ q‡" [set-buffer-modified-p modified p select-window w buffer] 2)) select-window shrink-window] 9 "\ Shrink the WINDOW to be as small as possible to display its contents. 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 the only window of its frame." 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.22/lisp/ws-mode.elc100666 13437 1 40302 5470157274 14304 0ustar jimbdaemon;ELC ;;; compiled by roland@churchy.gnu.ai.mit.edu on Wed Nov 10 07:29:48 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/ws-mode.el ;;; emacs version 19.20.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"))) (error "This file was compiled for Emacs 19")) (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 "\ ") (byte-code "„(Á Á Á Á ÅÆÇ#ˆÅÈÉ#ˆÅÊË#ˆÅÌÍ#ˆÅÎÏ#ˆÅÐÑ#ˆÅÒÓ#ˆÅÔÕ#ˆÅÖ×#ˆÅØÙ#ˆÅÚ\n#ˆÅÛÜ#ˆÅÝÞ#ˆÅß #ˆÅàá#ˆÅâ #ˆÅãä#ˆÅåÕ#ˆÅæç#ˆÅèé#ˆÅêë#ˆÅìí#ˆÅîï#ˆÅðñ#ˆÅòó#ˆÅ\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{#ˆÅ |}#ˆÅ ôõ#ˆÅ ö~#ˆÅ ø#ˆÅ ú€#ˆÅ ü#ˆÅ þ‚#ˆÅ @ƒ#ˆÅ B„#ˆÅ D…#ˆÅ F†#ˆÅ H‡#ˆÅ ˆ‰#ˆÅ Ɖ#ˆÅ JŠ#ˆÅ ÈŠ#ˆÅ L‹#ˆÅ Ê‹#ˆÅ NŒ#ˆÅ ÌŒ#ˆÅ P#ˆÅ Ð#ˆÅ VŽ#ˆÅ ÚŽ#ˆÅ p#ˆÅ Û#ˆÅ X#ˆÅ à#ˆÅ \\‘#ˆÅ ã‘#ˆÅ ^’#ˆÅ å’#ˆÅ èé#ˆÅ f“#ˆÅ ì“#ˆÅ i”#ˆÅ ð”#ˆÅ •–#ˆõ‡" [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 " " " " 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 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) (defalias 'wordstar-mode #[nil "À ˆÁ\n!ˆÃʼn‡" [kill-all-local-variables use-local-map wordstar-mode-map "WordStar" mode-name wordstar-mode major-mode] 2 "\ 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 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 " nil]) (defalias 'center-paragraph #[nil "ŠÀ ˆn„ ÁÂ!ˆ`Ä ˆÅ` \"*‡" [forward-paragraph newline 1 end backward-paragraph center-region] 3 "\ Center each line in the paragraph at or after point. See center-line for more info." nil]) (defalias 'center-region #[(from to) " Vƒ \n)ŠŒ }ˆbˆm?…$à ˆÄyˆ‚*‡" [from to tem center-line 1] 2 "\ Center each line starting in the region. See center-line for more info." "r"]) (defalias 'center-line #[nil "ŠÀÂyˆÃ ˆÀˆÃ ˆiÂyˆ Z ZÆ¥\\j*‡" [nil line-length 0 delete-horizontal-space left-margin fill-column 2] 3 "\ 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'." nil]) (defalias 'scroll-down-line #[nil "ÀÁ!‡" [scroll-down 1] 2 "\ Scroll one line down." nil]) (defalias 'scroll-up-line #[nil "ÀÁ!‡" [scroll-up 1] 2 "\ Scroll one line up." nil]) (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.") (defalias 'ws-error #[(string) "Â!‡" [string ws-last-errormessage error] 2 "\ Report error of a WordStar special function. Error message is saved in ws-last-errormessage for recovery with C-q w."]) (defalias 'ws-set-marker-0 #[nil "À ÂÃ!‡" [point-marker ws-marker-0 message "Marker 0 set"] 2 "\ In WordStar mode: Set marker 0 to current cursor position." nil]) (defalias 'ws-set-marker-1 #[nil "À ÂÃ!‡" [point-marker ws-marker-1 message "Marker 1 set"] 2 "\ In WordStar mode: Set marker 1 to current cursor position." nil]) (defalias 'ws-set-marker-2 #[nil "À ÂÃ!‡" [point-marker ws-marker-2 message "Marker 2 set"] 2 "\ In WordStar mode: Set marker 2 to current cursor position." nil]) (defalias 'ws-set-marker-3 #[nil "À ÂÃ!‡" [point-marker ws-marker-3 message "Marker 3 set"] 2 "\ In WordStar mode: Set marker 3 to current cursor position." nil]) (defalias 'ws-set-marker-4 #[nil "À ÂÃ!‡" [point-marker ws-marker-4 message "Marker 4 set"] 2 "\ In WordStar mode: Set marker 4 to current cursor position." nil]) (defalias 'ws-set-marker-5 #[nil "À ÂÃ!‡" [point-marker ws-marker-5 message "Marker 5 set"] 2 "\ In WordStar mode: Set marker 5 to current cursor position." nil]) (defalias 'ws-set-marker-6 #[nil "À ÂÃ!‡" [point-marker ws-marker-6 message "Marker 6 set"] 2 "\ In WordStar mode: Set marker 6 to current cursor position." nil]) (defalias 'ws-set-marker-7 #[nil "À ÂÃ!‡" [point-marker ws-marker-7 message "Marker 7 set"] 2 "\ In WordStar mode: Set marker 7 to current cursor position." nil]) (defalias 'ws-set-marker-8 #[nil "À ÂÃ!‡" [point-marker ws-marker-8 message "Marker 8 set"] 2 "\ In WordStar mode: Set marker 8 to current cursor position." nil]) (defalias 'ws-set-marker-9 #[nil "À ÂÃ!‡" [point-marker ws-marker-9 message "Marker 9 set"] 2 "\ In WordStar mode: Set marker 9 to current cursor position." nil]) (defalias 'ws-begin-block #[nil "À ÂÃ!‡" [point-marker ws-block-begin-marker message "Block begin marker set"] 2 "\ In WordStar mode: Set block begin marker to current cursor position." nil]) (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 "\ In WordStar mode: Show block markers." nil]) (defalias 'ws-indent-block #[nil "ÀÁ!‡" [ws-error "Indent block not yet implemented"] 2 "\ In WordStar mode: Indent block (not yet implemented)." nil]) (defalias 'ws-end-block #[nil "À ÂÃ!‡" [point-marker ws-block-end-marker message "Block end marker set"] 2 "\ In WordStar mode: Set block end marker to current cursor position." nil]) (defalias 'ws-print-block #[nil "ÀÁ!‡" [message "Don't do this. Write block to a file (C-k w) and print this file."] 2 "\ In WordStar mode: Print block." nil]) (defalias 'ws-mark-word #[nil "ŠÀvˆÁÀ!ˆÂ ˆÃvˆÁÀ!ˆÄ )‡" [1 sit-for ws-end-block -1 ws-begin-block] 2 "\ In WordStar mode: Mark current word as block." nil]) (defalias 'ws-exdent-block #[nil "ÀÁ!‡" [ws-error "This won't be done -- not yet implemented."] 2 "\ I don't know what this (C-k u) should do." nil]) (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 "\ In WordStar mode: Move block to current cursor position." nil]) (defalias 'ws-write-block #[nil "ƒ ƒÂÃ!Å #)‡ÆƒÇ‚% ƒ$È‚%É!‡" [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 "\ In WordStar mode: Write block to file." nil]) (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 "\ In WordStar mode: Delete block." nil]) (defalias 'ws-find-marker-0 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-0 point-marker ws-last-cursorposition ws-error "Marker 0 not set"] 2 "\ In WordStar mode: Go to marker 0." nil]) (defalias 'ws-find-marker-1 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-1 point-marker ws-last-cursorposition ws-error "Marker 1 not set"] 2 "\ In WordStar mode: Go to marker 1." nil]) (defalias 'ws-find-marker-2 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-2 point-marker ws-last-cursorposition ws-error "Marker 2 not set"] 2 "\ In WordStar mode: Go to marker 2." nil]) (defalias 'ws-find-marker-3 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-3 point-marker ws-last-cursorposition ws-error "Marker 3 not set"] 2 "\ In WordStar mode: Go to marker 3." nil]) (defalias 'ws-find-marker-4 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-4 point-marker ws-last-cursorposition ws-error "Marker 4 not set"] 2 "\ In WordStar mode: Go to marker 4." nil]) (defalias 'ws-find-marker-5 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-5 point-marker ws-last-cursorposition ws-error "Marker 5 not set"] 2 "\ In WordStar mode: Go to marker 5." nil]) (defalias 'ws-find-marker-6 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-6 point-marker ws-last-cursorposition ws-error "Marker 6 not set"] 2 "\ In WordStar mode: Go to marker 6." nil]) (defalias 'ws-find-marker-7 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-7 point-marker ws-last-cursorposition ws-error "Marker 7 not set"] 2 "\ In WordStar mode: Go to marker 7." nil]) (defalias 'ws-find-marker-8 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-8 point-marker ws-last-cursorposition ws-error "Marker 8 not set"] 2 "\ In WordStar mode: Go to marker 8." nil]) (defalias 'ws-find-marker-9 #[nil "ƒ\nÁ b‡ÃÄ!‡" [ws-marker-9 point-marker ws-last-cursorposition ws-error "Marker 9 not set"] 2 "\ In WordStar mode: Go to marker 9." nil]) (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 "\ In WordStar mode: Go to block begin marker." nil]) (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 "\ In WordStar mode: Search string, remember string for repetition." "sSearch for: "]) (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 "\ In WordStar mode: Go to block end marker." nil]) (defalias 'ws-undo #[nil "À ˆÁÂ!‡" [undo message "Repeat C-q l to undo more changes."] 2 "\ In WordStar mode: Undo and give message about undoing more changes." nil]) (defalias 'ws-goto-last-cursorposition #[nil "ƒ\nÁ ‰b‡ÂÃ!‡" [ws-last-cursorposition point-marker ws-error "No last cursor position available."] 3 "\ In WordStar mode: " nil]) (defalias 'ws-last-error #[nil "ƒÁ!‡ÁÂ!‡" [ws-last-errormessage message "No WordStar error yet."] 2 "\ In WordStar mode: repeat last error message. This will only work for errors raised by WordStar mode functions." nil]) (defalias 'ws-kill-eol #[nil "`ÁˆÂ`\")‡" [p nil kill-region] 3 "\ In WordStar mode: Kill to end of line (like WordStar, not like Emacs)." nil]) (defalias 'ws-kill-bol #[nil "`ÁyˆÂ`\")‡" [p 0 kill-region] 3 "\ In WordStar mode: Kill to beginning of line (like WordStar, not like Emacs)." nil]) (defalias 'kill-complete-line #[nil "Àyˆmƒ ÁÂ!ˆ`ÄyˆÅ `\")‡" [0 error "End of buffer" beg 1 kill-region] 3 "\ Kill the complete line." nil]) (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 "\ In WordStar mode: Repeat last search." nil]) (defalias 'ws-query-replace #[(from to) "ÂÄ Æ\"‡" [from ws-search-string t ws-search-direction point-marker ws-last-cursorposition query-replace to] 3 "\ In WordStar mode: Search string, remember string for repetition." "sReplace: \nsWith: "]) (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 "\ In WordStar mode: Copy block to current cursor position." nil]) emacs-19.22/lisp/x-menu.elc100666 13437 1 6714 5416177121 14124 0ustar jimbdaemon;ELC ;;; compiled by jimb@geech.gnu.ai.mit.edu on Tue Jul 6 00:23:45 1993 ;;; from file /gd/gnu/emacs/19.0/lisp/x-menu.el ;;; emacs version 19.15.16. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes 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 "This file was compiled for Emacs 19")) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias caar (macro . #[(conscell) "À‰ DD‡" [car conscell] 3]) cdar (macro . #[(conscell) "ÀÁ\nDD‡" [cdr car conscell] 3])] 3) (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 "\ 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."]) (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÀÅ!„ ÆÀÇ!„)ÆƇ" [boundp x-menu-max-width 0 x-menu-items-per-line x-menu-item-width x-menu-items-alist nil x-menu-assoc-buffer] 2) (defvar x-menu-item-spacing 1 "\ *Minimum horizontal spacing between objects in a permanent X 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 "\ Create a permanent X menu. Returns an item which should be used as a menu object whenever referring to the menu."]) (defalias 'x-menu-change-associated-buffer #[(menu buffer) "p qˆ\nq)‡" [old menu buffer x-menu-assoc-buffer] 1 "\ Change associated buffer of MENU to BUFFER. BUFFER should be a buffer object."]) (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 "\ Adds 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-delete-item #[(menu item) "pÀ qˆÄ \"‰ƒ À ˆ\nqˆ *‡" [nil elt old menu assoc item x-menu-items-alist] 3 "\ Deletes from MENU the item named ITEM. x-menu-compute should be called before the menu is made available to the user."]) (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 "\ Computes 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-pick-entry #[(position event) "Si ¥^Ãe`\"iÄUƒÄ‚ÅZ\n_\\‰8A‰ ƒ2 \n!ˆ,Ë !‡" [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 "\ Internal function for dispatching on mouse/menu events"]) emacs-19.22/lisp/xscheme.elc100666 13437 1 60334 5474623622 14373 0ustar jimbdaemon;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Nov 24 04:21:20 1993 ;;; from file /home/fsf/rms/e19/lisp/xscheme.el ;;; emacs version 19.21.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 "This file was compiled for Emacs 19")) (require (quote 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.\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" "\ 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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÁ !ˆÃ !‡" [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] 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] scheme-mode-map] 3) (defalias 'run-scheme #[(command-line) "ÂÃ!!‡" [command-line xscheme-process-command-line switch-to-buffer xscheme-start-process] 3 "\ Run an inferior Scheme process. Output goes to the buffer `*scheme*'. With argument, asks for a command line." (list (let ((default (or xscheme-process-command-line (xscheme-default-command-line)))) (if current-prefix-arg (read-string "Run Scheme: " default) default)))]) (defalias 'reset-scheme #[nil "ÀÁ!‰ƒÃ\n!Ä=ƒÅÆ!…+ÇÈ!ˆ\nƒ#É\nÊ\"ˆË !ˆÇÍ!)‡" [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 "\ Reset the Scheme process." nil]) (defalias (quote xscheme-default-command-line) #[nil "Á\nƒ Ã\nP‚ Ä ƒÆ P‚ÄR‡" [scheme-program-name " -emacs" scheme-program-arguments " " "" scheme-band-name " -band "] 5]) (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 "\ 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." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„Ç„0È É!ˆÊ!ˆË!ˆÃ!ˆÀÌÍ\"ˆÎÏM‡" [defalias scheme-interaction-mode-initialize #[nil "À !ˆÂĉ‡" [use-local-map scheme-interaction-mode-map scheme-interaction-mode major-mode "Scheme Interaction" mode-name] 2] scheme-interaction-mode-commands #[(keymap) "À ÂÃ#ˆÀ ÄÅ#ˆÀ ÆÇ#‡" [define-key keymap " " xscheme-send-current-line "" xscheme-send-proceed "" xscheme-yank-previous-send] 4] boundp scheme-interaction-mode-map nil make-keymap scheme-mode-commands xscheme-interrupt-commands xscheme-evaluation-commands xscheme-enter-interaction-mode #[nil "ŠÀ qˆ Â=?… Ã=ƒÄ ‚ )‡" [xscheme-process-buffer major-mode scheme-interaction-mode scheme-debugger-mode scheme-interaction-mode-initialize] 2] advertised-xscheme-send-previous-expression xscheme-send-previous-expression] 3) (defalias 'scheme-debugger-mode #[nil "ÀÁ!‡" [error "Illegal entry to scheme-debugger-mode"] 2 "\ 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}"]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÅÆ!„Ç„+È É!ˆÊ!ˆÃ!ˆÇ‡" [defalias scheme-debugger-mode-initialize #[nil "À !ˆÂĉ‡" [use-local-map scheme-debugger-mode-map scheme-debugger-mode major-mode "Scheme Debugger" mode-name] 2] scheme-debugger-mode-commands #[(keymap) "ÀÀÂW…à Š!Æ#ˆ T‰‚)‡" [32 char 127 define-key keymap char-to-string scheme-debugger-self-insert] 5] boundp scheme-debugger-mode-map nil make-keymap scheme-mode-commands xscheme-interrupt-commands] 3) (defalias 'scheme-debugger-self-insert #[nil "À !‡" [xscheme-send-char last-command-char] 2 "\ Transmit this character to the Scheme process." nil]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias xscheme-enter-debugger-mode #[(prompt-string) "ŠÀ qˆ Â=?… Ã=„à ˆÄ )‡" [xscheme-process-buffer major-mode scheme-debugger-mode scheme-interaction-mode scheme-debugger-mode-initialize] 2] xscheme-debugger-mode-p #[nil "À ‰…Š qˆ\n)Ã=)‡" [xscheme-process-buffer buffer major-mode scheme-debugger-mode] 3]] 3) (defalias 'xscheme-send-string #[(&rest strings) "À „ÁÂ!…:à ˆÄ ˆdbˆÅÆ\"ˆÈ!‡É ƒ(ÊË!‡ „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 "\ Send the string arguments to the Scheme process. The strings are concatenated and terminated by a newline."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias xscheme-send-string-1 #[(strings) "ÀÁ\n\"Ä !ˆ Æ=… ‰)‡" [apply concat strings string xscheme-send-string-2 major-mode scheme-interaction-mode xscheme-previous-send] 3] xscheme-send-string-2 #[(string) "ÀÁ!Ã\n ÅP\"ˆÆ …Ç\n!`È“)‡" [get-process "scheme" process send-string string "\n" xscheme-process-buffer-current-p process-mark nil] 4]] 3) (defalias 'xscheme-yank-previous-send #[nil "À ˆ c‡" [push-mark xscheme-previous-send] 1 "\ Insert the most recent expression at point." nil]) (defalias 'xscheme-select-process-buffer #[nil "ÀÁ!† ÂÃ!Å !†ÂÆ!È!‰ ƒ'Ê !ˆ‚,Ë!ˆÌ !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 "\ Select the Scheme process buffer and move to its output point." nil]) (defalias 'xscheme-send-region #[(start end) "À ƒ bˆÂÃÄ!! Å“ˆÆ {!‡" [xscheme-process-buffer-current-p end process-mark get-process "scheme" nil xscheme-send-string start] 3 "\ Send the current region to the Scheme process. The region is sent terminated by a newline." "r"]) (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 "\ 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." nil]) (defalias 'xscheme-send-next-expression #[nil "`ÁŠÂ ˆ`)\")‡" [start xscheme-send-region forward-sexp] 3 "\ Send the expression to the right of `point' to the Scheme process." nil]) (defalias 'xscheme-send-previous-expression #[nil "`ÁŠÂ ˆ`)\")‡" [end xscheme-send-region backward-sexp] 3 "\ Send the expression to the left of `point' to the Scheme process." nil]) (defalias 'xscheme-send-current-line #[nil "ŠÀyˆ`ˆ `{*ˆÄcˆÅ !)‡" [0 start nil line 10 xscheme-send-string-2] 2 "\ Send the current line to the Scheme process. Useful for working with debugging Scheme under adb." nil]) (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 "\ Send the current buffer to the Scheme process." nil]) (defalias 'xscheme-send-char #[(char) "ÀÁ !\"‡" [send-string "scheme" char-to-string char] 4 "\ Prompt for a character and send it to the Scheme process." "cCharacter to send: "]) (defalias 'xscheme-send-breakpoint-interrupt #[nil "ÀÁÂ\"‡" [xscheme-send-interrupt 98 nil] 3 "\ Cause the Scheme process to enter a breakpoint." nil]) (defalias 'xscheme-send-proceed #[nil "ÀÁÂ\"‡" [send-string "scheme" "(proceed)\n"] 3 "\ Cause the Scheme process to proceed from a breakpoint." nil]) (defalias 'xscheme-send-control-g-interrupt #[nil "À\n„ ÃÄ!‚& ƒÆÇ!‚&ÀÆÈ!ˆÃÄ!ˆÉÄÊË!\")‡" [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 "\ Cause the Scheme processor to halt and flush input. Control returns to the top level rep loop." nil]) (defalias 'xscheme-send-control-u-interrupt #[nil "ÀÁÂ\"‡" [xscheme-send-interrupt 117 t] 3 "\ Cause the Scheme process to halt, returning to previous rep loop." nil]) (defalias 'xscheme-send-control-x-interrupt #[nil "ÀÁÂ\"‡" [xscheme-send-interrupt 120 t] 3 "\ Cause the Scheme process to halt, returning to current rep loop." nil]) (defalias 'xscheme-send-interrupt #[(char mark-p) "ÀÁ!ˆÂÁà !\"ˆ ……ÂÁÃÇ!\"‡" [quit-process "scheme" send-string char-to-string char mark-p xscheme-control-g-synchronization-p 0] 4 "\ Send a ^A type interrupt to the Scheme process." "cInterrupt character to send: "]) (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 (quote 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.") (byte-code "ÀÁ!„ÂÀÃ!„ÂÀÄ!„ÂÅÆÇ\"ˆÅÈÉ\"ˆÅÊË\"‡" [boundp xscheme-runlight-string nil xscheme-mode-string xscheme-filter-input defalias xscheme-start-process #[(command-line) "ÀÁ!Ã\n!Š\nqˆ ƒ\"Å !Æ>ƒ\"Ç !dÈ“ˆ‚g ƒ*É !ˆdbˆÊ ˆoƒ;ËÌ !!ˆÈÏÐÑ\nÒ!BB\")Ç !dÈ“ˆÔÕ!ˆÖ ˆ× Ø\"ˆÙ Ú\"ˆÛÜ!ˆ*\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] xscheme-parse-command-line #[(string) "À !Âà ƒAÆÇ #‰„\" ÃO BÂ< Uƒ1ÆÉ #‚< O BT)‚ Ÿ*‡" [substitute-in-file-name string 0 nil result start string-match "[ ]" index "[^ ]"] 5] xscheme-wait-for-process #[nil "ÀÁ!ˆ\n…ÀÃ!ˆ‚‡" [sleep-for 2 xscheme-running-p 1] 2]] 3) (defalias 'xscheme-process-running-p #[nil "ÀÁ!‰… Ã\n!Ä=)‡" [get-process "scheme" process process-status run] 3 "\ True iff there is a Scheme process whose status is `run'."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias xscheme-process-buffer #[nil "ÀÁ!‰… Ã\n!)‡" [get-process "scheme" process process-buffer] 3] xscheme-process-buffer-window #[nil "À ‰…\n !)‡" [xscheme-process-buffer buffer get-buffer-window] 3]] 3) (defalias 'xscheme-process-buffer-current-p #[nil "À p=‡" [xscheme-process-buffer] 2 "\ True iff the current buffer is the Scheme process buffer."]) (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"‡" [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] 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] 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] xscheme-process-filter-output #[(&rest args) "…NÁ \"ŠÅ ˆÆÇ \"ƒJȔȕ \nË È\nO!ˆ \nHÌUƒ<n„5ËÍ!ˆËÌ!ˆ‚?Î ˆ \nTÏO*‚ Ë !*‡" [xscheme-allow-output-p apply concat args string xscheme-goto-output-point string-match "\\(\\| \\)" 0 end start insert-before-markers 12 10 beep nil] 4] xscheme-guarantee-newlines #[(n) "…;ŠÁ ˆÂ „%nƒ% Soƒʼn‚ Æ ˆ‚\n)Á ˆ ÇV…:ÈÉ!ˆ S‰‚*)‡" [xscheme-allow-output-p xscheme-goto-output-point nil stop n t backward-char 0 insert-before-markers 10] 3] xscheme-goto-output-point #[nil "ÀÁ!Ã\n!qˆÄ\n!b)‡" [get-process "scheme" process process-buffer process-mark] 2] xscheme-modeline-initialize #[nil "ÀÀɇ" ["" xscheme-runlight-string xscheme-mode-string ("Scheme: " xscheme-mode-string) mode-line-buffer-identification] 2] xscheme-set-runlight #[(runlight) " ‡" [runlight xscheme-runlight-string xscheme-modeline-redisplay] 1] xscheme-modeline-redisplay #[nil "ŠÀ qˆ)Á !ˆÃÄ!‡" [other-buffer set-buffer-modified-p buffer-modified-p sit-for 0] 2]] 3) (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))) "\ 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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"‡" [defalias xscheme-process-filter:simple-action #[(action) "À\n ‡" [idle xscheme-process-filter-state action] 1] xscheme-process-filter:string-action #[(action) "Âĉ‡" [action xscheme-string-receiver "" xscheme-string-accumulator reading-string xscheme-process-filter-state] 2]] 3) (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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÀÇÈ\"ˆÀÉÊ\"ˆÀËÌ\"ˆÀÍÎ\"ˆÀÏÐ\"ˆÀÑÒ\"ˆÀÓÔ\"ˆÀÕÖ\"ˆÀ×Ø\"ˆÀÙÚ\"ˆÀÛÜ\"ˆÀÝÞ\"‡" [defalias xscheme-start-gc #[nil "À !‡" [xscheme-set-runlight xscheme-runlight:gc] 2] xscheme-finish-gc #[nil "À ƒ \n‚\n !‡" [xscheme-set-runlight xscheme-running-p xscheme-runlight:running xscheme-runlight:input] 2] xscheme-enter-input-wait #[nil "À !ˆÂ‰‡" [xscheme-set-runlight xscheme-runlight:input nil xscheme-running-p] 2] xscheme-exit-input-wait #[nil "À !ˆÂ‰‡" [xscheme-set-runlight xscheme-runlight:running t xscheme-running-p] 2] xscheme-enable-control-g #[nil "À‰‡" [nil xscheme-control-g-disabled-p] 2] 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] xscheme-unsolicited-read-char (lambda nil) xscheme-eval #[(string) "ÀÁ\n!@!‡" [eval read-from-string string] 3] xscheme-message #[(string) "GÁU?…ÂÃÄ\"\"‡" [string 0 xscheme-write-message-1 format ";%s"] 5] xscheme-write-value #[(string) "GÁUƒ ÂÃÄ\"‡ÂÅÆ\"\"‡" [string 0 xscheme-write-message-1 "(no value)" ";No value" format ";Value: %s"] 5] 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] xscheme-set-prompt-variable #[(string) "‰‡" [string xscheme-prompt] 2] xscheme-set-prompt #[(string) "ÂÃ!ˆÄ!Æ ‡" [string xscheme-prompt xscheme-guarantee-newlines 2 xscheme-coerce-prompt xscheme-mode-string xscheme-modeline-redisplay] 2] xscheme-output-goto #[nil "À ˆÁÂ!‡" [xscheme-goto-output-point xscheme-guarantee-newlines 2] 2] xscheme-coerce-prompt #[(string) "ÀÁ\n\"ƒ,Õ\nà O\n ÅOÇ\"‰ ƒ& A‚(*P)‡\n‡" [string-match "^[0-9]+ " string 0 end nil prompt assoc xscheme-prompt-alist entry] 5]] 3) (defvar xscheme-prompt-alist (quote (("[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.") (byte-code "ÀÁÂ\"ˆÀÃÄ\"ˆÀÅÆ\"ˆÇÈ!„É„*Ê !ÌÍÎ#ˆÀÎÏ\"ˆÀÐÑ\"ˆÒÓ!‡" [defalias xscheme-cd #[(directory-string) "ŠÀ qˆÁ\n!)‡" [xscheme-process-buffer cd directory-string] 2] xscheme-prompt-for-confirmation #[(prompt-string) "ÀÁ\n!ƒ  Ä!‡" [xscheme-send-char y-or-n-p prompt-string 121 110] 3] xscheme-prompt-for-expression #[(prompt-string) "ÀÁ\nà #!‡" [xscheme-send-string-2 read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map] 5] boundp xscheme-prompt-for-expression-map nil copy-keymap minibuffer-local-map substitute-key-definition exit-minibuffer xscheme-prompt-for-expression-exit #[nil "Àed\"Á=ƒ  ‡ÃÄ!‡" [xscheme-region-expression-p one exit-minibuffer error "input must be a single, complete expression"] 3 nil nil] xscheme-region-expression-p #[(start end) "ŠÀ ÂŽÃ !ˆÅ\"‰@É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 xscheme] 4) emacs-19.22/lisp/yow.elc100666 13437 1 3015 5451136472 13523 0ustar jimbdaemon;ELC ;;; compiled by @churchy.gnu.ai.mit.edu on Sat Sep 25 17:50:50 1993 ;;; from file /home/gd/gnu/emacs/19.0/lisp/yow.el ;;; emacs version 19.20.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 "This file was compiled for Emacs 19")) (require (quote cookie1)) (defvar yow-file (concat data-directory "yow.lines") "\ Pertinent pinhead phrases.") (defalias 'yow #[(&optional interactive) "À ÂÃ# „ ‚,ÆÇ \"„\"ÈÉÊ!!ˆËÌ \"‚,ËÍ!ˆÊÎ !‘)‡" [cookie yow-file "Am I CONSING yet?..." "I have SEEN the CONSING!!" yow interactive string-match "\n" delete-windows-on get-buffer-create "*Help*" message "%s" "Yow!" princ] 4 "\ Return or display a random Zippy quotation." "p"]) (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 "\ Read a Zippyism from the minibuffer with completion, prompting with PROMPT. If optional second arg is non-nil, require input to match a completion."]) (put (quote read-zippyism) (quote byte-optimizer) (quote byte-compile-inline-expand)) (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 "\ Zippy goes to the analyst." nil]) (provide (quote yow)) emacs-19.22/lisp/forms-d2.dat100666 12120 1 1065 5037412147 14206 0ustar rmsdaemoncomp.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.22/lisp/ChangeLog100666 12120 1 505213 5475717612 13714 0ustar rmsdaemonSat 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. emacs-19.22/lisp/OChangeLog100666 12120 1 1641144 5431110104 14027 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. emacs-19.22/lisp/README100666 12120 1 713 5224127373 12724 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.22/lisp/dired.todo100666 12241 12 32040 5204744140 14417 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.22/site-lisp/ 40777 12120 24 0 5475722327 12643 5ustar rmsotheremacs-19.22/src/ 40777 12120 24 0 5475722562 11522 5ustar rmsotheremacs-19.22/src/m/ 40777 12120 24 0 5475726312 11753 5ustar rmsotheremacs-19.22/src/m/README100666 13437 1 603 5174232274 13133 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.22/src/m/7300.h100444 12120 1 6043 5427526370 12703 0ustar rmsdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* 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 #define USE_UTIME /* 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.22/src/m/delta.h100444 12120 1 17053 5475726163 13433 0ustar rmsdaemon/* 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 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ #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 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 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 */ /* Define these if you want to edit files up to 32Mbytes. Leaving them undefined (files up to 8 Mbytes) should be more efficient. */ /* #define VALBITS 26 #define GCTYPEBITS 5 */ /* Undefine this if you don't want the machine slow down when a buffer is modified. */ #define CLASH_DETECTION /* configure fails to find these two. */ #define HAVE_RANDOM #define HAVE_XSCREENNUMBEROFSCREEN /* pearce@ll.mit.edu says this is needed. */ #define BROKEN_FIONREAD /* No shared X library. */ #undef LIB_X11_LIB #define LIB_X11_LIB -lX11 /* We have no 'pt' library as usg5-3.h expects. */ #undef LIBX11_SYSTEM #define LIBX11_SYSTEM -lnls -lnsl_s #undef USG_SHARED_LIBRARIES /* Machine specific stuff */ #define HAVE_PTYS #define SYSV_PTYS #define HAVE_SELECT #define HAVE_SOCKETS /***** only if NSE has been installed *****/ #define HAVE_UNISTD_H #define HAVE_TIMEVAL #define SIGNALS_VIA_CHARACTERS #define memmove safe_bcopy #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 /* I have not tested X, but I think these are obsolete, so let's commment them -pot@cnuce.cnr.it */ /* debug switches enabled because of some difficulties w/X11 # define C_DEBUG_SWITCH -g # define OBJECTS_MACHINE -lg # define C_OPTIMIZE_SWITCH # define CANNOT_DUMP # define XDEBUG */ /* X library is in 'nonstandard' location. */ /* This should be taken care of by configure -pot@cnuce.cnr.it # define LD_SWITCH_MACHINE -L/usr/lib/X11/ */ #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 */ /* There are three ways to use the gnucc provided with R3V7. Either link /bin/ccd/cc to /bin/cc and then configure (supposing that CC is unset or set to cc). Or configure like this: `CC=/bin/ccd/cc configure', or else configure like this: `CC=gnucc configure'. */ # ifdef __STDC__ /* Compiling with gnucc (not through ccd). This means -traditional is not set. Let us set it, because I didn't manage yet to make it compile without -traditional. -pot@cnuce.cnr.it. */ # define C_SWITCH_MACHINE -traditional -mfp0ret -m68881 -Dconst= # define LIB_GCC /lib/gnulib881 # endif /* __STDC__ */ #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 # else /* We are using the standard AT&T Portable C Compiler */ # define SWITCH_ENUM_BUG # endif #endif /* not __GNUC__ */ emacs-19.22/src/m/alliant-2800.h100444 13437 1 11305 5410407735 14471 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef 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. */ #define VALBITS 26 #define GCTYPEBITS 5 /* 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 /* 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 emacs-19.22/src/m/alliant.h100444 13437 1 11067 5406451555 14113 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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.22/src/m/alliant1.h100444 13437 1 424 5122175713 14121 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.22/src/m/alliant4.h100444 13437 1 1411 5122176233 14137 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.22/src/m/altos.h100444 13437 1 3555 5406450236 13567 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Vax is not big-endian: lowest numbered byte is least significant, but 68000's are. */ #define 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.22/src/m/amdahl.h100444 13437 1 12010 5406450243 13673 0ustar jimbdaemon/* 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. */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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.22/src/m/apollo.h100444 13437 1 5233 5406450251 13723 0ustar jimbdaemon/* machine description file for Apollo machine. 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define 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 */ /* Define CANNOT_DUMP because it is impossible to dump. */ #define CANNOT_DUMP /* Define VIRT_ADDR_VARIES because the virtual addresses of pure and impure space as loaded can vary, and even their relative order cannot be relied on. */ #define VIRT_ADDR_VARIES /* Define HAVE_ALLOCA because we use the system's version of alloca. */ #define HAVE_ALLOCA /* DN460 has a 28 bit virtual address space, and 26 bits are often used */ #define VALBITS 26 #define GCTYPEBITS 5 /* Prevent -lg from being used for debugging. Not needed. */ #define LIBS_DEBUG /* Must use the system's termcap. It does special things. */ #define LIBS_TERMCAP -ltermcap /* Must use the system's malloc and alloca. */ #define SYSTEM_MALLOC /* No crt0 is needed, but control where environ is allocated. */ #define START_FILES pre-crt0.o /* Apollo's bcopy said to lose on more than 16k bytes in SR9.5. */ #ifndef APOLLO_SR10 #undef BSTRING #endif /* The function x_destroy_database doesn't exist in the version of X on the Apollo. */ #define NO_X_DESTROY_DATABASE emacs-19.22/src/m/att3b.h100444 12120 1 12175 5423450566 13351 0ustar rmsdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically */ #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 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 /* #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 VALMASK (((1<> VALBITS) & 0x7F)) #define GCTYPEBITS 5 #define XADDRFIX(a) ((a) |= 0X80000000) /* Because of high order */ #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.22/src/m/aviion.h100444 13437 1 11233 5406450263 13742 0ustar jimbdaemon/* 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. */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #define WORD_MACHINE /* 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 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 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 /* Use 26 bits instead of 24 for internal pointer values */ #define VALBITS 26 #define GCTYPEBITS 5 /* 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.22/src/m/celerity.h100444 13437 1 3771 5406450270 14263 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* 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.22/src/m/clipper.h100444 13437 1 7050 5406450275 14100 0ustar jimbdaemon/* 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. */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* #define BIG_ENDIAN */ /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically */ #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.22/src/m/cnvrgnt.h100444 13437 1 7224 5406450302 14115 0ustar jimbdaemon/* 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. */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically. */ #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.22/src/m/convex.h100444 13437 1 11563 5410407741 13763 0ustar jimbdaemon/* machine description file for convex C1. 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="bsd4-3" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. * 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. */ /* convex already defined... */ /* 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 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) /* 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 */ /* Addresses on the Convex have the high bit set. */ #define DATA_SEG_BITS (1 << (INTBITS-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 C_SWITCH_MACHINE -pcc #define LD_SWITCH_MACHINE \ -e__start -L /usr/lib \ '-A__iob=___ap$$iob' '-A_use_libc_sema=___ap$$use_libc_sema' /* Use setsid when starting up inferiors. */ #define HAVE_SETSID /* 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 emacs-19.22/src/m/cydra5.h100444 13437 1 10570 5406450315 13645 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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.22/src/m/delta88k.h100444 12120 1 12204 5425157154 13750 0ustar rmsdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ #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. */ #define C_ALLOCA #define STACK_DIRECTION -1 /* grows towards lower addresses. */ /* 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 LIBX11_SYSTEM #define LIBX11_SYSTEM -lnsl -lbsd #endif /* USG5_4 */ /* * we have Berkeley style */ #define HAVE_TIMEVAL /* SysV88 has select(). */ #define HAVE_SELECT #define BROKEN_FIONREAD /* * don't use utimes, we ain't got one - use utime() instead */ #define USE_UTIME /* 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 NEED_TERMIOS #define NO_SIOCTL_H #ifdef USG5_4 #ifdef HAVE_X_WINDOWS #if 0 /* autoconf should take care of this. */ #define HAVE_RANDOM #endif #else #undef BSTRING #endif /* HAVE_X_WINDOWS */ #endif /* USG5_4 */ #define NO_PTY_H emacs-19.22/src/m/dpx2.h100444 12120 1 14375 5432763241 13212 0ustar rmsdaemon/* machine description for Bull DPX/2 range Copyright (C) 1985, 1986 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="usg5-3" */ /* * You need to either un-comment one of these lines, or copy one * of them to config.h before you include this file. * Note that some simply define a constant and others set a value. */ /* #define ncl_el /* DPX/2 210,220 etc */ /* #define ncl_mr 1 /* DPX/2 320,340 (and 360,380 ?) */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE /**/ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ /* /bin/cc on ncl_el and ncl_mr define m68k and mc68000 */ /* Use type int rather than a union, to represent Lisp_Object */ /* This is desirable for most machines. */ #define NO_UNION_TYPE /* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend the 24-bit bit field into an int. In other words, if bit fields are always unsigned. If you use NO_UNION_TYPE, this flag does not matter. */ #define EXPLICIT_SIGN_EXTEND /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE long /* Convert that into an integer that is 100 for a load average of 1.0 */ #define FSCALE 1000.0 #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) /* Define CANNOT_DUMP on machines where unexec does not work. Then the function dump-emacs will not be defined and temacs will do (load "loadup") automatically unless told otherwise. */ /*#define CANNOT_DUMP /**/ /* Define VIRT_ADDR_VARIES if the virtual addresses of pure and impure space as loaded can vary, and even their relative order cannot be relied on. Otherwise Emacs assumes that text space precedes data space, numerically. */ /* #define VIRT_ADDR_VARIES /**/ /* Define C_ALLOCA if this machine does not support a true alloca and the one written in C should be used instead. Define HAVE_ALLOCA to say that the system provides a properly working alloca function and it should be used. Define neither one if an assembler-language alloca in the file alloca.s should be used. */ #define C_ALLOCA /* #define HAVE_ALLOCA /**/ /* Define NO_REMAP if memory segmentation makes it not work well to change the boundary between the text section and data section when Emacs is dumped. If you define this, the preloaded Lisp code will not be sharable; but that's better than failing completely. */ #define NO_REMAP /* * end of the standard macro's */ /* * a neat identifier to handle source mods (if needed) */ #ifndef DPX2 #define DPX2 #endif /* Disable support for shared libraries in unexec. */ #undef USG_SHARED_LIBRARIES /* * if we use X11, libX11.a has these... */ # 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 /* * X support _needs_ this */ #define HAVE_SELECT /* * and select requires these */ #define HAVE_TIMEVAL #define USE_UTIME /* select also needs this header file--but not in ymakefile. */ #ifndef NOT_C_CODE #include #include #endif #define TEXT_START 0 /* * Define the direction of stack growth. */ #define STACK_DIRECTION -1 /* we have termios */ #undef HAVE_TERMIO #define HAVE_TERMIOS #define HAVE_TCATTR /* we also have this */ #define HAVE_PTYS #define SYSV_PTYS /* It doesn't seem we have sigpause */ #undef HAVE_SYSV_SIGPAUSE /* on bos2.00.45 there is a bug that makes the F_SETOWN fcntl() call enters in an infinite loop. Avoid calling it */ #define F_SETOWN_BUG /* 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 /* end of dpx2.h */ emacs-19.22/src/m/dual.h100444 13437 1 4345 5406450323 13365 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* 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.22/src/m/elxsi.h100444 13437 1 10721 5406450327 13603 0ustar jimbdaemon/* 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. */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /*#define BIG_ENDIAN*/ /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /*#define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /*#define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: 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.22/src/m/gec63.h100444 13437 1 4365 5406450334 13353 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* GEC63 is big-endian: lowest numbered byte is most significant. */ #define 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 sizes of portions of a Lisp_Object. */ #define VALBITS 22 #define GCTYPEBITS 5 #define VALAMASK (((1<> VALBITS) & GCTYPEMASK)) #define XSETTYPE(a, b) ((a) = ((a) & VALAMASK) + ((int)(b) << VALBITS)) #define XPNTR(a) ((a) & VALAMASK) #define XSETPNTR(a, b) ((a) = ((a) & ~VALAMASK) + ((b) & 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) #define DONT_COPY_FLAG (1 << 26) #define NO_REMAP emacs-19.22/src/m/gould-np1.h100444 13437 1 4746 5122176136 14255 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.22/src/m/gould.h100444 13437 1 14061 5406450341 13566 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically */ #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.22/src/m/hp9000s300.h100444 12120 1 15110 5423713640 13645 0ustar rmsdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* Under BSD, defines this to be 4321; rather than fight with it, we'll just give in. Compatibility, akido style. */ #ifndef BIG_ENDIAN #define BIG_ENDIAN 4321 #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 */ /* 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)) /* 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.22/src/m/hp9000s800.h100444 12120 1 13627 5475115155 13671 0ustar rmsdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #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 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. */ #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 VALBITS 26 #define GCTYPEBITS 5 #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) << INTBITS-VALBITS) >> INTBITS-VALBITS) #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + (((unsigned) (ptr) << INTBITS-VALBITS) >> INTBITS-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 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) << INTBITS-GCTYPEBITS-VALBITS) >> INTBITS-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" #define CPTIME_SYMBOL "cp_time" #define DKXFER_SYMBOL "dk_xfer" #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.22/src/m/i860.h100444 13437 1 7201 5406450361 13122 0ustar jimbdaemon/* 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="" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* i860 is not big-endian: lowest numbered byte is least significant. */ #undef 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 emacs-19.22/src/m/ibm370aix.h100444 12120 1 1222 5433331662 14002 0ustar rmsdaemon/* m/ file for IBM 370 running AIX. */ #include "ibmps2-aix.h" #define AIX /* these were defined in "ibmps2-aix.h" */ #undef INTEL386 #undef aix386 /* i370 is big-endian */ #define 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.22/src/m/ibmps2-aix.h100444 12120 1 16240 5430272604 14275 0ustar rmsdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* i386 is not big-endian: lowest numbered byte is least significant. */ /* #undef 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_SELECT #define HAVE_TIMEVAL #define HAVE_VFORK #define HAVE_SETSID #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 /* But don't use utimes() -- it causes SIGSEGV! Use utime() instead. */ #define USE_UTIME /* 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.22/src/m/ibmrs6000.h100444 12120 1 11262 5444771664 13762 0ustar rmsdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* This conflicts with something in the system headers, and isn't currently used, since NO_UNION_TYPE is defined. */ #if 0 #define 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. */ /* #define CANNOT_DUMP */ #define UNEXEC unexaix.o /* Define addresses, macros, change some setup for dump */ #define NO_REMAP #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 #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 */ #define OBJECTS_MACHINE hftctl.o #define C_SWITCH_MACHINE -D_BSD #ifdef AIX3_2 /* IBM's X11R5 use -lIM and -liconv in AIX 3.2.2. */ #define LIBS_MACHINE -lrts -lIM -liconv #else #define LIBS_MACHINE -lIM #endif #define START_FILES #define HAVE_SYSVIPC #define HAVE_SETSID #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 /* sfreed@unm.edu says add -bI:/usr/lpp/X11/bin/smt.exp for AIX 3.2.4. */ #ifdef HAVE_AIX_SMT_EXP #define LD_SWITCH_MACHINE -Wl,-bnso,-bnodelcsect,-bI:/lib/syscalls.exp,-bI:/usr/lpp/X11/bin/smt.exp #else #define LD_SWITCH_MACHINE -Wl,-bnso,-bnodelcsect,-bI:/lib/syscalls.exp #endif /* AIX supposedly doesn't use this interface, but on thr RS/6000 it apparently does. */ #define NLIST_STRUCT emacs-19.22/src/m/ibmrt-aix.h100444 13437 1 13274 5406450431 14355 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* 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_SELECT #define HAVE_TIMEVAL #define HAVE_VFORK /* But don't use utimes() -- it causes SIGSEGV! Use utime() instead. */ #define USE_UTIME /* AIX defines FIONREAD, but it does not work. */ #define BROKEN_FIONREAD /* rocky@watson.ibm.com says this is needed. */ #define HAVE_FTIME emacs-19.22/src/m/ibmrt.h100444 12120 1 10402 5475115610 13433 0ustar rmsdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #define WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically. */ #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 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 /* 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 #define VALBITS 26 #define GCTYPEBITS 5 /* 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.22/src/m/intel386.h100444 13437 1 13046 5406450444 14036 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ /* Linux defines these in , but they can't be used in #if's */ #undef SHORTBITS #undef INTBITS #undef LONGBITS #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* i386 is not big-endian: lowest numbered byte is least significant. */ /* #undef 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 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 /* 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 VALBITS 26 #define GCTYPEBITS 5 /* 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 /* not 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 emacs-19.22/src/m/iris4d.h100444 12120 1 13672 5475221714 13533 0ustar rmsdaemon/* machine description file for Iris-4D machines. Use with s/irix[45]-*.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 three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #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 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 /* 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 that bit to be or'd in with any pointers which * are trying to access pure strings (as gnu-emacs only allows 24 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 #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 */ #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) << INTBITS-VALBITS) >> INTBITS-VALBITS) #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + (((unsigned) (ptr) << INTBITS-VALBITS) >> INTBITS-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 XMARKBIT(a) ((a) < 0) #define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | ((b) ? MARKBIT : 0)) #define XUNMARK(a) ((a) = (((unsigned)(a) << INTBITS-GCTYPEBITS-VALBITS) >> INTBITS-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.22/src/m/iris5d.h100444 13437 1 13736 5406450456 13672 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #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 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 /* 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 that bit to be or'd in with any pointers which * are trying to access pure strings (as gnu-emacs only allows 24 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) << INTBITS-VALBITS) >> INTBITS-VALBITS) #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + (((unsigned) (ptr) << INTBITS-VALBITS) >> INTBITS-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 XMARKBIT(a) ((a) < 0) #define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | ((b) ? MARKBIT : 0)) #define XUNMARK(a) ((a) = (((unsigned)(a) << INTBITS-GCTYPEBITS-VALBITS) >> INTBITS-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.22/src/m/irist.h100444 13437 1 12205 5406450463 13611 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ #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.22/src/m/is386.h100444 13437 1 1463 5122176144 13313 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.22/src/m/isi-ov.h100444 13437 1 5066 5406450470 13652 0ustar jimbdaemon/* 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 /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define 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.22/src/m/masscomp.h100444 13437 1 11056 5406450475 14307 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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.22/src/m/mega68.h100444 13437 1 3227 5406450503 13525 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define 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.22/src/m/mg1.h100444 13437 1 11053 5406450507 13142 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* ns16000 is not big-endian: lowest numbered byte is least significant. */ #undef 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.22/src/m/mips.h100444 13437 1 15436 5407113124 13427 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #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. */ #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 */ #ifdef NEWSOS5 #define LIBS_MACHINE -lmld #define START_FILES pre-crt0.o /usr/ccs/lib/crt1.o #define LIB_STANDARD -lsocket -lnsl -lc /usr/ccs/lib/crtn.o /usr/ccs/lib/values-Xt.o #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 #endif #else /* not NEWSOS5 */ #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 NEWSOS5 */ #endif /* not BSD */ /* The standard definitions of these macros would work ok, but these are faster because the constants are short. */ #define XUINT(a) (((unsigned)(a) << (INTBITS-VALBITS)) >> (INTBITS-VALBITS)) #define XSET(var, type, ptr) \ ((var) = \ ((int)(type) << VALBITS) \ + (((unsigned) (ptr) << (INTBITS-VALBITS)) >> (INTBITS-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) << (INTBITS-GCTYPEBITS-VALBITS)) \ >> (INTBITS-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 #define HAVE_TIMEVAL #if defined(emacs) && !defined(INHIBIT_BSD_TIME) #include #endif /* #define HAVE_SELECT The `select' in the system won't work for pipes, so don't use it. */ #define HAVE_GETWD #define HAVE_GETTIMEOFDAY #define HAVE_PTYS #define HAVE_SOCKETS #undef NOMULTIPLEJOBS #define utimes utime /* Someone should check this. */ /* ??? */ #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.22/src/m/mips4.h100444 12120 1 2276 5445417711 13350 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 #ifdef MIPS2 #define C_DEBUG_SWITCH -DMips -systype bsd43 -g3 -O -Olimit 2000 -mips2 #else #define C_DEBUG_SWITCH -DMips -systype bsd43 -g3 -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 emacs-19.22/src/m/news-risc.h100444 13437 1 1050 5410361706 14341 0ustar jimbdaemon/* news-risc.h is for the "RISC News". */ #include "mips.h" /* The following line tells the configuration script what sort of operating system this machine is likely to run. USUAL-OPSYS="bsd4-3" */ #define LIBS_MACHINE -lmld #define COFF #undef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE -x -D 800000 /* #define C_OPTIMIZE_SWITCH -O2 */ #define C_OPTIMIZE_SWITCH -O #define C_DEBUG_SWITCH -g3 #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 emacs-19.22/src/m/news.h100444 13437 1 3665 5406450514 13422 0ustar jimbdaemon/* 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 /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define BIG_ENDIAN /* One CRT0 Dummy variable */ #define CRT0_DUMMIES one_dummy, /* 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.22/src/m/next.h100444 12120 1 7032 5423041746 13262 0ustar rmsdaemon/* 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 /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Let the compiler tell us what byte order architecture we're compiling for */ #ifdef __BIG_ENDIAN__ #define 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) /* Use dk.h, not dkstat.h, in loadst.c. */ #define DK_HEADER_FILE /* 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 emacs-19.22/src/m/ns16000.h100444 13437 1 5604 5406450526 13453 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 16000 is little-endian (lowest-numbered byte is least significant) */ /* #define BIG_ENDIAN */ /* So don't define this. */ /* 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.22/src/m/ns32000.h100444 13437 1 7325 5410213607 13443 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* #define BIG_ENDIAN */ /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ /* 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 TEXT_START 0 #define STACK_DIRECTION -1 #define EXEC_MAGIC 0410 #define PURESIZE 140000 #define START_FILES pre-crt0.o /lib/crt0.o emacs-19.22/src/m/nu.h100444 13437 1 4373 5406450533 13066 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* 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.22/src/m/orion.h100444 13437 1 4501 5406450540 13561 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef 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.22/src/m/orion105.h100444 13437 1 4634 5406450545 14023 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #undef 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.22/src/m/pfa50.h100444 13437 1 5332 5410407745 13355 0ustar jimbdaemon/* 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. */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define 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 need it. */ #define LD_SWITCH_MACHINE -e __start #if pfa50 || pfa70 /* On A-50/60/70/80, data space has high order byte use. */ #define VALMASK (((1<> VALBITS) & 0x1f)) #define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & 0x1f)) #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_TIMEVAL #define HAVE_SELECT #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 USG_SYS_TIME #define USE_UTIME #define NO_SIOCTL_H #undef SIGIO emacs-19.22/src/m/plexus.h100444 13437 1 7634 5406450552 13770 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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.22/src/m/pmax.h100444 13437 1 5027 5416220764 13410 0ustar jimbdaemon/* 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 BIG_ENDIAN #undef LIB_STANDARD #undef START_FILES #undef COFF #undef TERMINFO #define MAIL_USE_FLOCK #define HAVE_UNION_WAIT /* 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 /* 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 m-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 #ifdef OSF1 #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" /* 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. */ #define C_SWITCH_X_MACHINE -DNeedFunctionPrototypes=0 emacs-19.22/src/m/pyramid.h100444 13437 1 4133 5406450557 14111 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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.22/src/m/pyrmips.h100666 12120 1 303 5265211704 13764 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.22/src/m/sequent.h100444 13437 1 13751 5406450564 14154 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ /* #define BIG_ENDIAN */ /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: 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.22/src/m/sgi3000.h100444 13437 1 23 5122175717 13460 0ustar jimbdaemon#include "irist.h" emacs-19.22/src/m/sparc.h100444 12120 1 7001 5403555676 13422 0ustar rmsdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* SPARC has lowest-numbered byte as most significant */ #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 /* 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 #if __GNUC__ < 2 /* Modern versions of GCC handle alloca directly. */ #include #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 /* 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)) emacs-19.22/src/m/sps7.h100444 13437 1 6366 5406450571 13346 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define 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_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 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.22/src/m/stride.h100444 13437 1 7475 5406450577 13754 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #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. */ #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_TIMEVAL #define HAVE_SELECT #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.22/src/m/sun1.h100444 13437 1 5117 5406450604 13326 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define 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.22/src/m/sun2.h100444 13437 1 6375 5406450611 13334 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ #define 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 ${etcdir}emacstool #define LIBS_MACHINE -lsuntool -lsunwindow -lpixrect #define OBJECTS_MACHINE sunfns.o #define SYMS_MACHINE syms_of_sunfns () #define PURESIZE 132000 #endif emacs-19.22/src/m/sun3-68881.h100444 13437 1 1532 5122175721 14020 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.22/src/m/sun3-fpa.h100444 13437 1 1515 5122175721 14071 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.22/src/m/sun3-soft.h100444 13437 1 1632 5122175722 14277 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.22/src/m/sun3.h100444 13437 1 3317 5122176162 13327 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.22/src/m/sun386.h100444 13437 1 4715 5406450616 13514 0ustar jimbdaemon/* 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 emacs-19.22/src/m/symmetry.h100444 13437 1 7031 5406450623 14327 0ustar jimbdaemon/* 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" /* define HAVE_GETPAGESIZE for Symmetry */ #define HAVE_GETPAGESIZE /* 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.22/src/m/tad68k.h100444 13437 1 10736 5406450630 13563 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically */ /* 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.22/src/m/tahoe.h100444 13437 1 4465 5406450636 13552 0ustar jimbdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* lowest-numbered byte is most significant */ #define 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 /* Control header files used by loadst.c. Some users report machines have dkstat.h while others report dk.h, so it's hard to tell what this should say. */ #ifdef BSD #define DKSTAT_HEADER_FILE #endif emacs-19.22/src/m/tandem-s2.h100444 13437 1 1410 5122176165 14224 0ustar jimbdaemon/* 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 S2 does not know about utimes() */ #define USE_UTIME /* 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.22/src/m/targon31.h100444 13437 1 7272 5406450643 14105 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #define WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: 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.22/src/m/tek4300.h100644 12120 1 6521 5475115662 13410 0ustar rmsdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* 68000 has lowest-numbered byte as most significant */ /* This value matches the value the system gives it. */ #define BIG_ENDIAN 4321 /* 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. */ #define tek4300 /* 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 emacs-19.22/src/m/tekxd88.h100444 12120 1 12643 5432010763 13622 0ustar rmsdaemon/* 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. */ /* The following symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ #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 HAVE_TIMEVAL /* we have Berkeley style */ #define HAVE_SELECT /* XD88 has select(). */ #define BROKEN_FIONREAD /* is this needed ? */ #define BSTRING /* its in libc but not declared in any header file. */ #define HAVE_SETSID #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.22/src/m/template.h100444 13437 1 10722 5406450655 14277 0ustar jimbdaemon/* 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="" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #define NO_ARG_ARRAY /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ #define WORD_MACHINE /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ /* 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.22/src/m/tower32.h100444 13437 1 10076 5406450662 13771 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: 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.22/src/m/tower32v3.h100444 13437 1 10613 5410214330 14220 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: 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. */ #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 /* This is needed since many Tower models start the data/bss segment at an address as large as 0x2000000. */ #define VALBITS 26 #define GCTYPEBITS 5 /* 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.22/src/m/vax.h100444 12120 1 6264 5427633674 13123 0ustar rmsdaemon/* 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 */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Vax is not big-endian: lowest numbered byte is least significant. */ /* #undef 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.22/src/m/ustation.h100444 13437 1 11003 5406450667 14326 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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 HAVE_SELECT #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 #undef HAVE_TIMEVAL emacs-19.22/src/m/wicat.h100444 13437 1 11007 5406450703 13562 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ #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.22/src/m/xps100.h100444 13437 1 7345 5406450707 13504 0ustar jimbdaemon/* 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" */ /* The following three symbols give information on the size of various data types. */ #define SHORTBITS 16 /* Number of bits in a short */ #define INTBITS 32 /* Number of bits in an int */ #define LONGBITS 32 /* Number of bits in a long */ /* Define BIG_ENDIAN iff lowest-numbered byte in a word is the most significant byte. */ #define BIG_ENDIAN /* Define NO_ARG_ARRAY if you cannot take the address of the first of a * group of arguments and treat it as an array of the arguments. */ /* #define NO_ARG_ARRAY */ /* Define WORD_MACHINE if addresses and such have * to be corrected before they can be used as byte counts. */ /* #define WORD_MACHINE */ /* Now define a symbol for the cpu type, if your compiler does not define it automatically: Ones defined so far include vax, m68000, ns16000, pyramid, orion, tahoe, APOLLO and many others */ /* 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.22/src/s/ 40777 12120 24 0 5475722500 11754 5ustar rmsotheremacs-19.22/src/s/README100666 13437 1 623 5174232335 13141 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.22/src/s/3700.h100444 12241 12 0 5444561054 13155 0ustar rolandstaffemacs-19.22/src/s/386-ix.h100444 13437 1 674 5266606012 13367 0ustar jimbdaemon/* Interactive 386/ix. */ #include "usg5-3.h" #define HAVE_SELECT #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 #define HAVE_TIMEVAL #define USE_UTIME */ /* 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.22/src/s/386bsd.h100444 12120 1 1403 5445363246 13325 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 /* Reread the time zone on startup. */ #define LOCALTIME_CACHE /* rich@lamprey.utmb.edu says needed for job control in subshells. */ #define HAVE_SETSID emacs-19.22/src/s/aix3-1.h100444 13437 1 14065 5406450715 13475 0ustar jimbdaemon/* 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-v3" /* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 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 /* AIX doesn't define this. */ #define unix 1 emacs-19.22/src/s/aix3-2.h100444 12120 1 1006 5444771546 13323 0ustar rmsdaemon/* 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__ #define C_SWITCH_SYSTEM -ma #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 emacs-19.22/src/s/alliant-2800.h100444 13437 1 0 5266607437 14377 0ustar jimbdaemonemacs-19.22/src/s/alliant.h100444 13437 1 0 5266607445 14007 0ustar jimbdaemonemacs-19.22/src/s/altos.h100444 13437 1 0 5266607453 13504 0ustar jimbdaemonemacs-19.22/src/s/amdahl.h100444 13437 1 0 5266607460 13606 0ustar jimbdaemonemacs-19.22/src/s/apollo.h100444 13437 1 0 5406456264 13646 0ustar jimbdaemonemacs-19.22/src/s/bsd386.h100666 12120 1 642 5402471004 13300 0ustar rmsdaemon/* s/ file for bsd386 system. */ #include "bsd4-3.h" #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 HAVE_SETSID #define LIBS_DEBUG #define LIB_X11_LIB -L/usr/X11/lib -lX11 #define LIBS_SYSTEM -lutil -lkvm -lcompat #define HAVE_GETLOADAVG emacs-19.22/src/s/bsd4-1.h100444 13437 1 7451 5406450724 13446 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #undef HAVE_TIMEVAL /* * 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 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.22/src/s/bsd4-2.h100444 12120 1 6725 5431120765 13313 0ustar rmsdaemon/* Definitions file for GNU Emacs running on bsd 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. */ #ifndef BSD4_2 #define BSD4_2 #endif /* BSD4_2 */ #ifndef BSD #define BSD #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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 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.22/src/s/bsd4-3.h100444 12120 1 7153 5431121042 13275 0ustar rmsdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 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.22/src/s/convexos.h100444 12120 1 417 5470253435 14140 0ustar rmsdaemon/* Definitions file for GNU Emacs running on ConvexOS. */ #include "bsd4-3.h" /* First pty name is /dev/pty?0. We have to search for it. */ #undef FIRST_PTY_LETTER #define FIRST_PTY_LETTER first_pty_letter /* getpgrp requires no arguments. */ #define GETPGRP_NO_ARG emacs-19.22/src/s/dgux.h100444 12120 1 26530 5473627417 13317 0ustar rmsdaemon/* Definitions file for GNU Emacs running on Data General's DG/UX version 4.32 and above. 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 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 #define SVR4 /* SYSTEM_TYPE should indicate the kind of system you are using. It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "dgc-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. NOTE: On DGUX, there is a problem using INTERRUPT_INPUT: When invoked under X11 using a job control shell (csh, ksh) in the background, emacs will stop on tty output. I suspect this is a kernel problem and have reported it and a sample program to DGC. Meanwhile, a workaround is to define BROKEN_FIONREAD and not use INTERRUPT_INPUT. -pmr@rock.concert.net */ #define BROKEN_FIONREAD /* #define INTERRUPT_INPUT */ /* * Define HAVE_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * Define HAVE_SELECT if the system supports the `select' system call. */ #define HAVE_SELECT /* * Define HAVE_SETSID if the system supports POSIX disassociate * terminal. */ #define HAVE_SETSID /* * 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 /* * 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! */ /* pmr now says the GNU malloc works. */ /* pmr@rock.concert.net says Emacs fails without this. We don't know why. */ /* #define SYSTEM_MALLOC */ /* MAKING_MAKEFILE must be defined in "ymakefile" before including config.h */ #ifndef THIS_IS_YMAKEFILE /* 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 SYSV4_PTYS #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) #else /* THIS_IS_YMAKEFILE */ /* force gcc to be used */ CC=gcc #endif /* not THIS_IS_YMAKEFILE */ #define LD_SWITCH_SYSTEM #define START_FILES pre-crt0.o #define LIBS_SYSTEM -ldgc #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_COMPILER \ TARGET_BINARY_INTERFACE=m88kdguxcoff gcc -traditional #define LINKER \ TARGET_BINARY_INTERFACE=m88kdguxcoff gcc #define MAKE_COMMAND \ TARGET_BINARY_INTERFACE=m88kdguxcoff make #define C_DEBUG_SWITCH -g #else /* not COFF */ /* 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); #define C_COMPILER \ TARGET_BINARY_INTERFACE=m88kdguxelf gcc -traditional #define LINKER \ TARGET_BINARY_INTERFACE=m88kdguxelf gcc #define MAKE_COMMAND \ TARGET_BINARY_INTERFACE=m88kdguxelf make #define C_DEBUG_SWITCH -g -V2 -mversion-03.00 -mstandard #endif /* COFF */ /* Extra stuff which probably should be someplace else but is here out of expediency. */ #define LIB_X11_LIB -lX11 emacs-19.22/src/s/esix.h100444 12120 1 1317 5400475740 13262 0ustar rmsdaemon/* 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" #define HAVE_TIMEVAL /* 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 USG_SYS_TIME #define USE_UTIME #define BROKEN_FIONREAD emacs-19.22/src/s/esix5r4.h100444 12120 1 1236 5403557370 13620 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.22/src/s/hpux.h100444 13437 1 16315 5406450756 13464 0ustar jimbdaemon/* 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 /* Says to include time.h, and not include sys/time.h. */ #define NEED_TIME_H /* * Define HAVE_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* With HAVE_TIMEVAL define, Emacs expects to use `utimes'. But HPUX does not have one. */ #define MISSING_UTIMES /* * 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 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 #if 0 /* The 48-bit versions are more winning for Emacs. */ #define rand lrand48 #define srand srand48 #endif /* 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.22/src/s/hpux8.h100444 12120 1 3503 5475302041 13360 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 /* 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__ #define LD_SWITCH_SYSTEM -Xlinker -a -Xlinker archive /* No need to specify roundabout way of linking temacs. */ #define ORDINARY_LINK #else #if defined(hp9000s700) || defined(__hp9000s700) #define LD_SWITCH_SYSTEM -a archive -L/lib/pa1.1 #else #define LD_SWITCH_SYSTEM -a archive #endif #endif #if 0 /* This should no longer be necessary now that C_SWITCH_... are passed down when compiling oldXMenu. */ /* Specify compiler options for compiling oldXMenu. */ #define OLDXMENU_OPTIONS CFLAGS="-I/usr/include/X11R5 -I/usr/include/X11R4" #endif /* 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 emacs-19.22/src/s/hpux9.h100444 13437 1 524 5425546041 13502 0ustar jimbdaemon/* 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 emacs-19.22/src/s/iris3-5.h100444 13437 1 12420 5406450763 13662 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* `utime' system call doesn't understand timevals. */ #define IRIS_UTIME /* * 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 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.22/src/s/iris3-6.h100444 13437 1 12425 5406450772 13670 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* `utime' system call doesn't understand timevals. */ #define IRIS_UTIME /* * 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 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.22/src/s/irix3-3.h100444 12120 1 11547 5475223060 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* `utime' system call doesn't understand timevals. */ #define IRIS_UTIME /* * 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 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 /* Use setsid to handle terminals for subprocesses. */ #define HAVE_SETSID /* sioctl.h should be included where appropriate. */ #define NEED_SIOCTL /* This affects child_setup. */ #define SETPGRP_RELEASES_CTTY emacs-19.22/src/s/linux.h100444 12120 1 16137 5473207630 13500 0ustar rmsdaemon/* This file is the configuration file for the Linux operating system. 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. */ /* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 /* 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() */ #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_pptr - (FILE)->_pbase) /* Linux has crt0.o in a non-standard place */ #define START_FILES pre-crt0.o /usr/lib/crt0.o /* Linux has SIGIO defined, but not implemented, as of version 0.99.8 * What an ugly kludge! This will not be necessary if the * INTERRUPT_INPUT define gets fully implemented. */ #ifdef emacs #include #undef SIGIO #undef signal #define signal sys_signal #include #endif #define HAVE_SETSID /* This is needed for sysdep.c */ #define NO_SIOCTL_H /* don't have sioctl.h */ #if 0 /* autoconf should take care of this. */ #define HAVE_UNISTD_H /* for getpagesize.h */ #define HAVE_RANDOM /* is builtin */ #endif #define HAVE_GETPAGESIZE #define HAVE_VFORK #define HAVE_SYS_SIGLIST #define HAVE_GETWD /* cure conflict with getcwd? */ #define USE_UTIME /* don't have utimes */ #define SYSV_SYSTEM_DIR /* use dirent.h */ #define USG_SYS_TIME /* use sys/time.h, not time.h */ #define POSIX /* affects getpagesize.h and systty.h */ #define POSIX_SIGNALS /* 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) /* 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*/ #define LIB_STANDARD -lc /* avoid -lPW */ #define C_OPTIMIZE_SWITCH /* configure can guess this just fine */ #ifdef HAVE_X11 #define LD_SWITCH_SYSTEM -L/usr/X386/lib #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_MACHINE -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_MACHINE #define C_SWITCH_SYSTEM -D_BSD_SOURCE #endif #define HAVE_SYSVIPC emacs-19.22/src/s/irix4-0.h100444 12120 1 2673 5475223133 13513 0ustar rmsdaemon#include "irix3-3.h" #define USG5_3 #define IRIX4 #define HAVE_ALLOCA #ifndef NOT_C_CODE #include #endif #undef IRIS_UTIME #undef NEED_SIOCTL /* 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_MACHINE -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.22/src/s/irix5-0.h100444 12120 1 5052 5475457075 13524 0ustar rmsdaemon#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. */ /* It is necessary to prevent SIGCHLD signals within _getpty. So we block them. But since all of Emacs uses classic SYSV signal() signals, there is no reliable way to do this (unlike BSD sighold or POSIX sigaction). On Irix 5.* systems, the implementation of sigaction is as close as you can get to a universal. */ #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); \ } /* 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 emacs-19.22/src/s/isc2-2.h100444 11732 1 4670 5446745052 13471 0ustar bfoxdaemon/* system description file for Interactive (ISC) Unix version 2.2 on the 386. */ #include "usg5-3.h" /* With this defined, subprocesses made by (e.g.) M-x grep don't exit cleanly, they just hang. ISC 2.2.1 does have select, in the -linet library, but I guess it's not what Emacs needs. --karl@cs.umb.edu #define HAVE_SELECT */ /* 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 pepople saus ISC's renames doesn't work correctly with Emacs so we use Emacs' emulation instead. */ #if defined (__GNUC__) # define LIB_STANDARD -lcposix -lc #else /* !__GNUC__ */ # define LIB_STANDARD -lPW -lc #endif /* !__GNUC__ */ /* mt00@etherm.co.uk says this is needed for process.c. */ #define USE_UTIME #define NO_X_DESTROY_DATABASE /* This communicates with m-intel386.h. */ #define DONT_DEFINE_SIGNAL /* 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 #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.22/src/s/isc3-0.h100444 12120 1 2262 5426402330 13301 0ustar rmsdaemon/* s- file for Interactive (ISC) Unix version 3.0 on the 386. */ #include "isc2-2.h" /* These have been moved into isc2-2.h. */ /* #define HAVE_SOCKETS #define HAVE_SELECT */ /* This appears on 3.0, presumably as part of what SunSoft call X2. */ #undef NO_X_DESTROY_DATABASE /* mt00@etherm.co.uk says this is needed for process.c. */ #define HAVE_TIMEVAL /* 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 -lc /* marko@tekelec.com (Marko Rauhamaa) says that his linker couldn't find memmove, but that sounds crazy - I thought all SYSV descendants had that. Let us know if this turns out to be wrong. */ /* 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) emacs-19.22/src/s/mach2.h100444 13437 1 3215 5406451005 13431 0ustar jimbdaemon/* Definitions for Emacs running on Mach version 2 (non-kernelized system). 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. */ #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" #define LD_SWITCH_SYSTEM -X -noseglinkedit /* Don't use -lc on the NeXT. */ #define LIB_STANDARD -lsys_s #define LIB_MATH -lm #define environ _environ #define START_FILES pre-crt0.o #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 () /* Defining KERNEL_FILE causes lossage because sys/file.h stupidly gets confused by it. */ #undef KERNEL_FILE emacs-19.22/src/s/netbsd.h100444 12241 1 1123 5444005165 14244 0ustar rolanddaemon/* s/ file for netbsd system. */ /* Get most of the stuff from bsd4.3 */ #include "bsd4-3.h" #undef SYSTEM_TYPE #define SYSTEM_TYPE "netbsd" #undef KERNEL_FILE #define KERNEL_FILE "/netbsd" #undef LDAV_SYMBOL #define LDAV_SYMBOL "_averunnable" #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 HAVE_SETSID #define LIBS_DEBUG #define LIBS_SYSTEM -lutil #define HAVE_GETLOADAVG /* For mem-limits.h. */ #define BSD4_2 emacs-19.22/src/s/newsos5.h100444 13437 1 2245 5406451012 14042 0ustar jimbdaemon/* Definitions file for GNU Emacs running on Sony's NEWS-OS 5.0.1 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. */ /* Use the SysVr4 file for at least base configuration. */ #include "s-usg5-4.h" #define NEWSOS5 /* These will be defined by "m-mips.h". */ #undef START_FILES #undef LIB_STANDARD /* Disable use of "unexelf.c" and shared libraries, because NEWS-OS on MIPS doesn't support ELF. */ #undef UNEXEC #undef USG_SHARED_LIBRARIES #ifndef HAVE_SOCKETS #define HAVE_SOCKETS #endif emacs-19.22/src/s/osf1.h100444 13437 1 462 5405345256 13301 0ustar jimbdaemon#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 LD_SWITCH_SYSTEM -non_shared #define SYSV_SYSTEM_DIR emacs-19.22/src/s/rtu.h100444 12120 1 12372 5431121243 13135 0ustar rmsdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 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 emacs-19.22/src/s/sco4.h100644 12120 1 7076 5475065002 13172 0ustar rmsdaemon/* System description file for SCO 3.2v4. 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. */ /* Contributed by Ian Lance Taylor, ian@cygnus.com. */ /* SCO is sort of like SVR3. */ #include "usg5-3.h" #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 timeval. */ #define HAVE_TIMEVAL /* 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); /* SCO perhaps has bcopy, et. al. */ #ifdef HAVE_BCOPY #define BSTRING #endif /* 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 /* 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 emacs-19.22/src/s/sol2.h100444 12120 1 2345 5423033041 13160 0ustar rmsdaemon#include "usg5-4.h" /* 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. The -R option says where to find X windows at run time. */ #ifndef __GNUC__ #define LD_SWITCH_SYSTEM -R/usr/openwin/lib #else /* GCC */ #define LD_SWITCH_SYSTEM -Xlinker -R/usr/openwin/lib #endif /* GCC */ /* Compile in non-ansi fashion to work around bugs in system header files. */ #ifndef __GNUC__ #define C_SWITCH_SYSTEM -Xs #else /* GCC */ #define C_SWITCH_SYSTEM -traditional #endif /* GCC */ #define const /* Karl Berry writes: If you have the misfortune to be running Solaris 2.1, you may have noticed that the access system call does not check the readonlyness of the filesystem the path refers to. This is a bug, according to access(2), but in the meantime, some of us need the right behavior. */ /* Well, we released Emacs with this change, and fixed a typo, but people keep saying that it doesn't work, and that the patch is easy to install. Patch number is 100947-02. */ #undef SOLARIS_BROKEN_ACCESS emacs-19.22/src/s/sunos4-0.h100444 13437 1 764 5122177613 14022 0ustar jimbdaemon#include "bsd4-2.h" #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 #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 emacs-19.22/src/s/sunos4-1-2.h100666 11732 1 62 5446745053 14160 0ustar bfoxdaemon #include "sunos4-1.h" /* #undef SYSTEM_MALLOC */ emacs-19.22/src/s/sunos4-1-3.h100644 12120 1 1316 5475216233 14046 0ustar rmsdaemon#include "sunos4-1.h" #if 0 /* jik@gza.com says this didn't work. Too bad. Can anyone find out why this loses? */ /* The bug that corrupts GNU malloc's memory pool is fixed in SunOS 4.1.3. */ #undef SYSTEM_MALLOC #endif #if 0 /* This causes failure in process_send_signal (tcgetattr loses) and may also cause hanging at Emacs startup when parent is not a job control shell. */ /* murray@chemical-eng.edinburgh.ac.uk says this works, and avoids the problem of spurious ^M in subprocess output. */ #define HAVE_TERMIOS /* This enables some #undefs in systty.h. */ #define BSD_TERMIOS #endif /* barrie@calvin.demon.co.uk says memmove is missing. */ #ifndef SYSTEM_MALLOC #define MEMMOVE_MISSING #endif emacs-19.22/src/s/sunos4-1.h100444 12120 1 1432 5474055623 13706 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 /* 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 res_init, use -lresolv to supplement libc.a. */ #ifdef HAVE_RES_INIT #define LIBS_SYSTEM -lresolv #endif /* Tell GNU malloc to compensate for a bug in localtime. */ #define SUNOS_LOCALTIME_BUG emacs-19.22/src/s/sunos4shr.h100444 12120 1 2171 5472070477 14270 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. */ #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 LINKER cc #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) emacs-19.22/src/s/template.h100444 13437 1 14206 5405345271 14302 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 /* 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.22/src/s/umax.h100444 12120 1 12331 5431121322 13266 0ustar rmsdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 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 emacs-19.22/src/s/umips.h100444 12241 12 3474 5444561077 14030 0ustar rolandstaff/* 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 #define HAVE_TIMEVAL #if defined(emacs) #include #endif /* #define HAVE_SELECT The `select' in the system won't work for pipes, so don't use it. */ #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.22/src/s/unipl5-0.h100444 13437 1 12334 5406451031 14031 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ /* #define HAVE_TIMEVAL */ /* * 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 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.22/src/s/unipl5-2.h100444 13437 1 11617 5406451037 14044 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ #define HAVE_TIMEVAL /* * 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 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.22/src/s/usg5-0.h100444 13437 1 11761 5406451043 13506 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ /* #define HAVE_TIMEVAL */ /* * 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 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.22/src/s/usg5-2-2.h100444 13437 1 12040 5406451047 13642 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ /* #define HAVE_TIMEVAL */ /* * 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 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.22/src/s/usg5-2.h100444 13437 1 12055 5406451054 13507 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ /* #define HAVE_TIMEVAL */ /* * 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 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.22/src/s/usg5-3.h100444 13437 1 14520 5406451062 13506 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ /* #define HAVE_TIMEVAL */ /* * Define HAVE_SELECT if the system supports the `select' system call. */ /* SVr3.2 ports of X include an emulation of select in the libraries. */ #ifdef HAVE_X_WINDOWS #define HAVE_SELECT #endif /* * 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 /* SVr3 does not have utimes(2) */ #define USE_UTIME /* 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.22/src/s/usg5-4-2.h100444 12120 1 3127 5432353532 13475 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 /* 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; \ } emacs-19.22/src/s/usg5-4.h100444 12120 1 13367 5425646646 13402 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 #define LIBS_STANDARD -lc /* No */ #define NO_SIOCTL_H /* Undump with ELF */ #undef COFF #define UNEXEC unexelf.o /* 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. */ #ifdef emacs #include #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 /* libc has this stuff, but not utimes. */ #define HAVE_SELECT #define HAVE_TIMEVAL /* *defines* stat(2) as a static function. If "static" * is blank, then many files will have a public definition for stat(2). */ #undef static /* 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_SETSID #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) \ fatal("could not grant slave pty"); \ sigrelse(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); /* 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) memcpy(dst,src,n) #define bcmp(src,dst,n) memcmp(src,dst,n) #define bzero(s,n) memset(s,0,n) emacs-19.22/src/s/vms.h100444 13437 1 17352 5406451074 13301 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ /* #define HAVE_TIMEVAL */ /* * Define HAVE_SELECT if the system supports the `select' system call. */ #define HAVE_SELECT /* There is an emulation in vmsproc.c */ /* * 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 EXEC_SUFFIXES ".exe:.com" /* Case conflict with Xlib XFree () */ #define xfree emacs_xfree /* What separator do we use in paths? */ #define SEPCHAR ',' emacs-19.22/src/s/vms4-0.h100444 13437 1 40 5122177635 13427 0ustar jimbdaemon#include "vms.h" #define VMS4_0 emacs-19.22/src/s/vms4-2.h100444 13437 1 41 5122177636 13433 0ustar jimbdaemon#include "vms.h" #define VMS4_2 emacs-19.22/src/s/vms4-4.h100444 13437 1 41 5122177636 13435 0ustar jimbdaemon#include "vms.h" #define VMS4_4 emacs-19.22/src/s/vms5-5.h100666 12120 1 361 5267476204 13341 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.22/src/s/xenix.h100444 13437 1 14737 5406451102 13623 0ustar jimbdaemon/* 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_TIMEVAL if the system supports the BSD style clock values. * Look in for a timeval structure. */ /* #define HAVE_TIMEVAL */ /* * 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 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.22/src/bitmaps/ 40777 12120 24 0 5475722463 13161 5ustar rmsotheremacs-19.22/src/bitmaps/README100666 13437 1 206 5350754306 14336 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.22/src/bitmaps/cntrpmsk.xbm100444 13437 13 450 5354211420 15545 0ustar jimbuser#define cntr_ptrmsk_width 16 #define cntr_ptrmsk_height 16 static 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.22/src/bitmaps/cntrptr.xbm100444 13437 13 521 5354211420 15377 0ustar jimbuser#define cntr_ptr_width 16 #define cntr_ptr_height 16 #define cntr_ptr_x_hot 7 #define cntr_ptr_y_hot 1 static 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.22/src/bitmaps/crosswv.xbm100444 13437 13 450 5354211420 15412 0ustar jimbuser#define cross_weave_width 16 #define cross_weave_height 16 static 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.22/src/bitmaps/dimple1.xbm100444 13437 13 434 5354211417 15247 0ustar jimbuser#define dimple1_width 16 #define dimple1_height 16 static 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.22/src/bitmaps/dimple3.xbm100444 13437 13 434 5354211417 15251 0ustar jimbuser#define dimple3_width 16 #define dimple3_height 16 static 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.22/src/bitmaps/gray.xbm100644 13437 1 127 5350754056 15130 0ustar jimbdaemon#define gray_width 2 #define gray_height 2 static char gray_bits[] = { 0x01, 0x02}; emacs-19.22/src/bitmaps/gray1.xbm100444 13437 13 132 5354211420 14724 0ustar jimbuser#define gray1_width 2 #define gray1_height 2 static char gray1_bits[] = { 0x01, 0x02}; emacs-19.22/src/bitmaps/gray3.xbm100444 13437 13 146 5354211420 14733 0ustar jimbuser#define gray3_width 4 #define gray3_height 4 static char gray3_bits[] = { 0x01, 0x00, 0x04, 0x00}; emacs-19.22/src/bitmaps/leftpmsk.xbm100444 13437 13 450 5354211420 15531 0ustar jimbuser#define left_ptrmsk_width 16 #define left_ptrmsk_height 16 static 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.22/src/bitmaps/leftptr.xbm100444 13437 13 521 5354211420 15363 0ustar jimbuser#define left_ptr_width 16 #define left_ptr_height 16 #define left_ptr_x_hot 3 #define left_ptr_y_hot 1 static 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.22/src/bitmaps/rtpmsk.xbm100444 13437 13 453 5354211420 15227 0ustar jimbuser#define right_ptrmsk_width 16 #define right_ptrmsk_height 16 static 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.22/src/bitmaps/rtptr.xbm100444 13437 13 527 5354211420 15064 0ustar jimbuser#define right_ptr_width 16 #define right_ptr_height 16 #define right_ptr_x_hot 12 #define right_ptr_y_hot 1 static 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.22/src/bitmaps/stipple.xbm100444 13437 13 205 5354211420 15362 0ustar jimbuser#define stipple_width 16 #define stipple_height 4 static char stipple_bits[] = { 0x55, 0x55, 0xee, 0xee, 0x55, 0x55, 0xba, 0xbb}; emacs-19.22/src/abbrev.c100444 12120 1 42261 5445053543 13331 0ustar rmsdaemon/* 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" /* 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) || (XTYPE (oexp) == Lisp_String && XTYPE (expansion) == Lisp_String && (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); if (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 (FETCH_CHAR (wordstart) == '-') del_range (wordstart, wordstart + 1); } else 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 (XTYPE (current_buffer->abbrev_table) == Lisp_Vector) sym = oblookup (current_buffer->abbrev_table, buffer, p - buffer); else XFASTINT (sym) = 0; if (XTYPE (sym) == Lisp_Int || NILP (XSYMBOL (sym)->value)) sym = oblookup (Vglobal_abbrev_table, buffer, p - buffer); if (XTYPE (sym) == Lisp_Int || NILP (XSYMBOL (sym)->value)) return value; if (INTERACTIVE && !EQ (minibuf_window, selected_window)) { 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 (XTYPE (XSYMBOL (sym)->plist) == Lisp_Int) 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)) { upcase_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 old_zv = ZV; int old_pt = point; /* Don't let Fcapitalize_word operate on text after point. */ ZV = point; SET_PT (wordstart); Fcapitalize_word (make_number (1)); SET_PT (old_pt); ZV = old_zv; } 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 (XTYPE (Vlast_abbrev_text) == Lisp_String) { /* This isn't correct if Vlast_abbrev->function was used to do the expansion */ Lisp_Object val; val = XSYMBOL (Vlast_abbrev)->value; if (XTYPE (val) != Lisp_String) 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); XSET (name, Lisp_String, 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); XSET (stream, Lisp_Buffer, 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.22/src/alloc.c100444 12120 1 164023 5470243400 13172 0ustar rmsdaemon/* Storage allocation and gc for GNU Emacs Lisp interpreter. Copyright (C) 1985, 1986, 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. */ #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" #endif #include "syssignal.h" #define max(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; \ XSET (val, Lisp_Cons, (char *) address + size); \ if ((char *) XCONS (val) != (char *) address + size) \ { \ xfree (address); \ memory_full (); \ } \ } while (0) /* Number of bytes of consing done since the last gc */ int consing_since_gc; /* 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; /* Non-nil means defun should do purecopy on the function definition */ Lisp_Object Vpurify_flag; #ifndef HAVE_SHM int pure[PURESIZE / sizeof (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. */ 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; /* Maximum amount of C stack to save when a GC happens. */ #ifndef MAX_SAVE_STACK #define MAX_SAVE_STACK 16000 #endif /* 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; static void mark_object (), mark_buffer (); 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 () { error ("Memory exhausted"); } /* 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) (); static void emacs_blocked_free (ptr) void *ptr; { BLOCK_INPUT; __free_hook = old_free_hook; free (ptr); __free_hook = emacs_blocked_free; UNBLOCK_INPUT; } static void * emacs_blocked_malloc (size) unsigned size; { void *value; BLOCK_INPUT; __malloc_hook = old_malloc_hook; 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 () { interval_block = (struct interval_block *) malloc (sizeof (struct interval_block)); interval_block->next = 0; bzero (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 = (struct interval_block *) xmalloc (sizeof (struct interval_block)); 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); 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 () { float_block = (struct float_block *) malloc (sizeof (struct float_block)); float_block->next = 0; bzero (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; { XFASTINT (ptr->type) = (int) float_free_list; float_free_list = ptr; } Lisp_Object make_float (float_value) double float_value; { register Lisp_Object val; if (float_free_list) { XSET (val, Lisp_Float, float_free_list); float_free_list = (struct Lisp_Float *) XFASTINT (float_free_list->type); } else { if (float_block_index == FLOAT_BLOCK_SIZE) { register struct float_block *new = (struct float_block *) xmalloc (sizeof (struct float_block)); VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = float_block; float_block = new; float_block_index = 0; } XSET (val, Lisp_Float, &float_block->floats[float_block_index++]); } XFLOAT (val)->data = float_value; XFLOAT (val)->type = 0; /* bug chasing -wsr */ consing_since_gc += sizeof (struct Lisp_Float); 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 () { cons_block = (struct cons_block *) malloc (sizeof (struct cons_block)); cons_block->next = 0; bzero (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; { XFASTINT (ptr->car) = (int) 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) { XSET (val, Lisp_Cons, cons_free_list); cons_free_list = (struct Lisp_Cons *) XFASTINT (cons_free_list->car); } else { if (cons_block_index == CONS_BLOCK_SIZE) { register struct cons_block *new = (struct cons_block *) xmalloc (sizeof (struct cons_block)); VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = cons_block; cons_block = new; cons_block_index = 0; } XSET (val, Lisp_Cons, &cons_block->conses[cons_block_index++]); } XCONS (val)->car = car; XCONS (val)->cdr = cdr; consing_since_gc += sizeof (struct Lisp_Cons); 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 len, val, val_tail; XFASTINT (len) = nargs; val = Fmake_list (len, Qnil); val_tail = val; while (!NILP (val_tail)) { XCONS (val_tail)->car = *args++; val_tail = XCONS (val_tail)->cdr; } 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; if (XTYPE (length) != Lisp_Int || XINT (length) < 0) length = wrong_type_argument (Qnatnump, length); size = XINT (length); val = Qnil; while (size-- > 0) val = Fcons (init, val); return val; } /* Allocation of vectors */ struct Lisp_Vector *all_vectors; 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; { register int sizei, index; register Lisp_Object vector; register struct Lisp_Vector *p; if (XTYPE (length) != Lisp_Int || XINT (length) < 0) length = wrong_type_argument (Qnatnump, length); sizei = XINT (length); p = (struct Lisp_Vector *) xmalloc (sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object)); VALIDATE_LISP_STORAGE (p, 0); XSET (vector, Lisp_Vector, p); consing_since_gc += sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object); p->size = sizei; p->next = all_vectors; all_vectors = p; for (index = 0; index < sizei; index++) p->contents[index] = init; 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; XFASTINT (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; XFASTINT (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]; } XSETTYPE (val, Lisp_Compiled); 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 () { symbol_block = (struct symbol_block *) malloc (sizeof (struct symbol_block)); symbol_block->next = 0; bzero (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) { XSET (val, Lisp_Symbol, symbol_free_list); symbol_free_list = (struct Lisp_Symbol *) XFASTINT (symbol_free_list->value); } else { if (symbol_block_index == SYMBOL_BLOCK_SIZE) { struct symbol_block *new = (struct symbol_block *) xmalloc (sizeof (struct symbol_block)); VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = symbol_block; symbol_block = new; symbol_block_index = 0; } XSET (val, Lisp_Symbol, &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); return val; } /* Allocation of markers. Works like allocation of conses. */ #define MARKER_BLOCK_SIZE \ ((1020 - sizeof (struct marker_block *)) / sizeof (struct Lisp_Marker)) struct marker_block { struct marker_block *next; struct Lisp_Marker markers[MARKER_BLOCK_SIZE]; }; struct marker_block *marker_block; int marker_block_index; struct Lisp_Marker *marker_free_list; void init_marker () { marker_block = (struct marker_block *) malloc (sizeof (struct marker_block)); marker_block->next = 0; bzero (marker_block->markers, sizeof marker_block->markers); marker_block_index = 0; marker_free_list = 0; } 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; if (marker_free_list) { XSET (val, Lisp_Marker, marker_free_list); marker_free_list = (struct Lisp_Marker *) XFASTINT (marker_free_list->chain); } else { if (marker_block_index == MARKER_BLOCK_SIZE) { struct marker_block *new = (struct marker_block *) xmalloc (sizeof (struct marker_block)); VALIDATE_LISP_STORAGE (new, sizeof *new); new->next = marker_block; marker_block = new; marker_block_index = 0; } XSET (val, Lisp_Marker, &marker_block->markers[marker_block_index++]); } p = XMARKER (val); p->buffer = 0; p->bufpos = 0; p->chain = Qnil; consing_since_gc += sizeof (struct Lisp_Marker); 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; 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 (int)) #if 0 #define STRING_FULLSIZE(SIZE) \ (((SIZE) + 2 * sizeof (int)) & ~(sizeof (int) - 1)) #endif void init_strings () { current_string_block = (struct string_block *) malloc (sizeof (struct string_block)); 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; if (XTYPE (length) != Lisp_Int || XINT (length) < 0) length = wrong_type_argument (Qnatnump, length); CHECK_NUMBER (init, 1); val = make_uninit_string (XINT (length)); c = XINT (init); p = XSTRING (val)->data; end = p + XSTRING (val)->size; while (p != end) *p++ = c; *p = 0; 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 */ { XSET (val, Lisp_String, (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 = (struct string_block *) xmalloc (sizeof (struct string_block_head) + fullsize); 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; XSET (val, Lisp_String, (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 = (struct string_block *) xmalloc (sizeof (struct string_block)); 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; XSET (val, Lisp_String, (struct Lisp_String *) current_string_block->chars); } 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 (XTYPE (args[i]) != Lisp_Int || (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 = 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 (int) + INTERVAL_PTR_SIZE + length + 1; if (pureptr + size > PURESIZE) error ("Pure Lisp storage exhausted"); XSET (new, Lisp_String, 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 (int) - 1) / sizeof (int) * sizeof (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"); XSET (new, Lisp_Cons, 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"); XSET (new, Lisp_Float, PUREBEG + pureptr); pureptr += sizeof (struct Lisp_Float); XFLOAT (new)->data = num; XFLOAT (new)->type = 0; /* bug chasing -wsr */ return new; } #endif /* LISP_FLOAT_TYPE */ Lisp_Object make_pure_vector (len) int len; { register Lisp_Object new; register int size = sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object); if (pureptr + size > PURESIZE) error ("Pure Lisp storage exhausted"); XSET (new, Lisp_Vector, 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; { register Lisp_Object new, tem; register int i; 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; #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (obj)) #else switch (XTYPE (obj)) #endif { case Lisp_Marker: error ("Attempt to copy a marker to pure storage"); case Lisp_Cons: return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr); #ifdef LISP_FLOAT_TYPE case Lisp_Float: return make_pure_float (XFLOAT (obj)->data); #endif /* LISP_FLOAT_TYPE */ case Lisp_String: return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size); case Lisp_Compiled: case Lisp_Vector: new = make_pure_vector (XVECTOR (obj)->size); for (i = 0; i < XVECTOR (obj)->size; i++) { tem = XVECTOR (obj)->contents[i]; XVECTOR (new)->contents[i] = Fpurecopy (tem); } XSETTYPE (new, XTYPE (obj)); return new; default: return obj; } } /* Recording what needs to be marked for gc. */ struct gcpro *gcprolist; #define NSTATICS 512 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; }; /* Two flags that are set during GC in the `size' component of a string or vector. On some machines, these flags are defined by the m- file to be different bits. */ /* On vector, means it has been marked. On string size field or a reference to a string, means not the last reference in the chain. */ #ifndef ARRAY_MARK_FLAG #define ARRAY_MARK_FLAG ((MARKBIT >> 1) & ~MARKBIT) #endif /* no ARRAY_MARK_FLAG */ /* Any slot that is a Lisp_Object can point to a string and thus can be put on a string's reference-chain and thus may need to have its ARRAY_MARK_FLAG set. This includes the slots whose markbits are used to mark the containing objects. */ #if ARRAY_MARK_FLAG == MARKBIT you lose #endif /* 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 */ 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; char stack_top_variable; register int i; /* 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 ((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 ("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]); } } 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) message1 (omessage); else if (!noninteractive) message1 ("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++) XUNMARK (sblk->markers[i].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 (objptr) Lisp_Object *objptr; { register Lisp_Object obj; obj = *objptr; XUNMARK (obj); loop: 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; #ifdef SWITCH_ENUM_BUG switch ((int) XGCTYPE (obj)) #else switch (XGCTYPE (obj)) #endif { 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. The address OBJPTR is even, so if the address includes MARKBIT, put it in the low bit when we store OBJPTR into the size field. */ if (XMARKBIT (*objptr)) { XFASTINT (*objptr) = ptr->size; XMARK (*objptr); } else XFASTINT (*objptr) = ptr->size; if ((int)objptr & 1) abort (); ptr->size = (int) objptr & ~MARKBIT; if ((int) objptr & MARKBIT) ptr->size ++; } } break; case Lisp_Vector: case Lisp_Window: case Lisp_Process: case Lisp_Window_Configuration: { register struct Lisp_Vector *ptr = XVECTOR (obj); register 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 */ for (i = 0; i < size; i++) /* and then mark its elements */ mark_object (&ptr1->contents[i]); } break; case Lisp_Compiled: /* 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 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 */ for (i = 0; i < size; i++) /* and then mark its elements */ { if (i != COMPILED_CONSTANTS) mark_object (&ptr1->contents[i]); } objptr = &ptr1->contents[COMPILED_CONSTANTS]; obj = *objptr; goto loop; } #ifdef MULTI_FRAME case Lisp_Frame: { /* See comment above under Lisp_Vector for why this is volatile. */ register struct frame *volatile ptr = XFRAME (obj); register 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->focus_frame); mark_object (&ptr->width); mark_object (&ptr->height); 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); } break; #endif /* MULTI_FRAME */ 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) { ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */ XSETSYMBOL (obj, ptrx); goto loop; } } break; case Lisp_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_Cons: case Lisp_Buffer_Local_Value: case Lisp_Some_Buffer_Local_Value: case Lisp_Overlay: { 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; obj = ptr->car; XUNMARK (obj); goto loop; } mark_object (&ptr->car); /* See comment above under Lisp_Vector for why not use ptr here. */ objptr = &XCONS (obj)->cdr; obj = ptr->cdr; goto loop; } #ifdef LISP_FLOAT_TYPE case Lisp_Float: XMARK (XFLOAT (obj)->type); break; #endif /* LISP_FLOAT_TYPE */ case Lisp_Buffer: if (!XMARKBIT (XBUFFER (obj)->name)) mark_buffer (obj); break; case Lisp_Int: case Lisp_Void: case Lisp_Subr: case Lisp_Intfwd: case Lisp_Boolfwd: case Lisp_Objfwd: case Lisp_Buffer_Objfwd: case Lisp_Internal_Stream: /* 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; 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; /* This is the buffer's markbit */ mark_object (&buffer->name); XMARK (buffer->name); MARK_INTERVAL_TREE (buffer->intervals); #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. */ XSET (*(Lisp_Object *)&buffer->upcase_table, Lisp_String, buffer->upcase_table); mark_object ((Lisp_Object *)&buffer->upcase_table); XSET (*(Lisp_Object *)&buffer->downcase_table, Lisp_String, buffer->downcase_table); mark_object ((Lisp_Object *)&buffer->downcase_table); XSET (*(Lisp_Object *)&buffer->sort_table, Lisp_String, buffer->sort_table); mark_object ((Lisp_Object *)&buffer->sort_table); XSET (*(Lisp_Object *)&buffer->folding_sort_table, Lisp_String, 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); } /* 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)) { XFASTINT (cblk->conses[i].car) = (int) cons_free_list; num_free++; 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)) { XFASTINT (fblk->floats[i].type) = (int) float_free_list; num_free++; 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)) { XFASTINT (sblk->symbols[i].value) = (int) 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. */ { register struct marker_block *mblk; struct Lisp_Marker *tem1; 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; for (i = 0; i < lim; i++) if (!XMARKBIT (mblk->markers[i].chain)) { Lisp_Object tem; tem1 = &mblk->markers[i]; /* tem1 avoids Sun compiler bug */ XSET (tem, Lisp_Marker, tem1); unchain_marker (tem); XFASTINT (mblk->markers[i].chain) = (int) marker_free_list; marker_free_list = &mblk->markers[i]; num_free++; } else { num_used++; XUNMARK (mblk->markers[i].chain); } 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 (buffer->intervals); #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; 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 int size = nextstr->size; /* NEXTSTR is the old address of the next string. Just skip it if it isn't marked. */ if ((unsigned) size > 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 ((unsigned) size > STRING_BLOCK_SIZE) { if (size & 1) size ^= MARKBIT | 1; size = *(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 (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 ((unsigned) size > STRING_BLOCK_SIZE) { register Lisp_Object *objptr; if (size & 1) size ^= MARKBIT | 1; objptr = (Lisp_Object *)size; size = XFASTINT (*objptr) & ~MARKBIT; if (XMARKBIT (*objptr)) { XSET (*objptr, Lisp_String, newaddr); XMARK (*objptr); } else XSET (*objptr, Lisp_String, 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); XSET (* (Lisp_Object *) &newaddr->intervals->parent, Lisp_String, 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, "", "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; XSET (end, Lisp_Int, (int) sbrk (0) / 1024); return end; } /* 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; ignore_warnings = 0; gcprolist = 0; staticidx = 0; consing_since_gc = 0; gc_cons_threshold = 100000; #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; defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); defsubr (&Smake_string); defsubr (&Smake_symbol); defsubr (&Smake_marker); defsubr (&Spurecopy); defsubr (&Sgarbage_collect); defsubr (&Smemory_limit); } emacs-19.22/src/alloca.c100666 11732 1 33212 5446744777 13513 0ustar bfoxdaemon/* 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 /* 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. */ 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. */ } 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.22/src/buffer.c100444 12241 1 235560 5473272512 14051 0ustar rolanddaemon/* Buffer manipulation primitives for GNU Emacs. Copyright (C) 1985, 1986, 1987, 1988, 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. */ #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 "syntax.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 (); static void call_overlay_mod_hooks (); /* 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 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 before changing an unmodified buffer. */ Lisp_Object Vfirst_change_hook; Lisp_Object Qfirst_change_hook; 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 Qoverlayp; 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 (XTYPE (spec) == Lisp_String) 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); } 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 (XTYPE (name) == Lisp_Buffer) return name; CHECK_STRING (name, 0); return Fcdr (Fassoc (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\ If there is no such live buffer, return nil.") (filename) register Lisp_Object filename; { register Lisp_Object tail, buf, tem; CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr) { buf = Fcdr (XCONS (tail)->car); if (XTYPE (buf) != Lisp_Buffer) continue; if (XTYPE (XBUFFER (buf)->filename) != Lisp_String) continue; tem = Fstring_equal (XBUFFER (buf)->filename, 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, function, tem; int count = specpdl_ptr - specpdl; register struct buffer *b; buf = Fget_buffer (name); if (!NILP (buf)) return buf; b = (struct buffer *) xmalloc (sizeof (struct buffer)); BUF_GAP_SIZE (b) = 20; BLOCK_INPUT; BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b)); UNBLOCK_INPUT; if (! BUF_BEG_ADDR (b)) 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; /* Put this on the chain of all buffers including killed ones. */ b->next = all_buffers; all_buffers = b; b->mark = Fmake_marker (); /*b->number = make_number (++buffer_count);*/ b->name = name; if (XSTRING (name)->data[0] != ' ') b->undo_list = Qnil; else b->undo_list = Qt; reset_buffer (b); /* Put this in the alist of all live buffers. */ XSET (buf, Lisp_Buffer, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); b->mark = Fmake_marker (); b->markers = Qnil; b->name = name; function = buffer_defaults.major_mode; if (NILP (function)) { tem = Fget (current_buffer->major_mode, Qmode_class); if (EQ (tem, Qnil)) function = current_buffer->major_mode; } if (NILP (function) || EQ (function, Qfundamental_mode)) return buf; /* 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, buf); } /* Reinitialize everything about a buffer except its name and contents. */ void reset_buffer (b) register struct buffer *b; { b->filename = Qnil; b->directory = (current_buffer) ? current_buffer->directory : Qnil; b->modtime = 0; b->save_modified = 1; XFASTINT (b->save_length) = 0; b->last_window_start = 1; b->backed_up = Qnil; b->auto_save_modified = 0; b->auto_save_file_name = Qnil; b->read_only = Qnil; b->overlays_before = Qnil; b->overlays_after = Qnil; XFASTINT (b->overlay_center) = 1; b->mark_active = Qnil; /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ INITIALIZE_INTERVAL (b, NULL_INTERVAL); reset_buffer_local_variables(b); } 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; b->downcase_table = Vascii_downcase_table; b->upcase_table = Vascii_upcase_table; b->case_canon_table = Vascii_downcase_table; b->case_eqv_table = Vascii_upcase_table; #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 int == sizeof Lisp_Object */ if (*(int *)(offset + (char *) &buffer_local_flags) > 0 || *(int *)(offset + (char *) &buffer_local_flags) == -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-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; { /* Reference each variable in the alist in our current buffer. 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. */ register Lisp_Object tail; for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object val, elt; elt = XCONS (tail)->car; if (buf == current_buffer) val = find_symbol_value (XCONS (elt)->car); else val = XCONS (elt)->cdr; /* If symbol is unbound, put just the symbol in the list. */ if (EQ (val, Qunbound)) result = Fcons (XCONS (elt)->car, result); /* Otherwise, put (symbol . value) in the list. */ else result = Fcons (Fcons (XCONS (elt)->car, val), result); } } /* Add on all the variables stored in special slots. */ { register int offset, mask; for (offset = (char *)&buffer_local_symbols.name - (char *)&buffer_local_symbols; offset < sizeof (struct buffer); offset += (sizeof (int))) /* sizeof int == sizeof Lisp_Object */ { mask = *(int *)(offset + (char *) &buffer_local_flags); if (mask == -1 || (buf->local_var_flags & mask)) if (XTYPE (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols)) == Lisp_Symbol) result = Fcons (Fcons (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols), *(Lisp_Object *)(offset + (char *)buf)), result); } } return result; } 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_modified < 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->filename; if (!NILP (fn)) { already = current_buffer->save_modified < MODIFF; if (!already && !NILP (flag)) lock_file (fn); else if (already && NILP (flag)) unlock_file (fn); } #endif /* CLASH_DETECTION */ current_buffer->save_modified = 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).") (name, unique) register Lisp_Object name, unique; { register Lisp_Object tem, buf; CHECK_STRING (name, 0); tem = Fget_buffer (name); /* 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 NAME)). */ if (NILP (unique) && XBUFFER (tem) == current_buffer) return current_buffer->name; if (!NILP (tem)) { if (!NILP (unique)) name = Fgenerate_new_buffer_name (name, current_buffer->name); else error ("Buffer name \"%s\" is in use", XSTRING (name)->data); } current_buffer->name = name; /* Catch redisplay's attention. Unless we do this, the mode lines for any windows displaying current_buffer will stay unchanged. */ update_mode_lines++; XSET (buf, Lisp_Buffer, current_buffer); Fsetcar (Frassq (buf, Vbuffer_alist), name); if (NILP (current_buffer->filename) && !NILP (current_buffer->auto_save_file_name)) call0 (intern ("rename-auto-save-file")); return 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; 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, 1,1, 0, "Make BUFFER stop keeping undo information.") (buffer) register Lisp_Object buffer; { Lisp_Object real_buffer; if (NILP (buffer)) XSET (real_buffer, Lisp_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)) XSET (real_buffer, Lisp_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); /* Query if the buffer is still modified. */ if (INTERACTIVE && !NILP (b->filename) && BUF_MODIFF (b) > b->save_modified) { 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 kill-buffer hook with the buffer to be killed the current buffer. */ { register Lisp_Object val; int count = specpdl_ptr - specpdl; record_unwind_protect (save_excursion_restore, save_excursion_save ()); set_buffer_internal (b); 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; /* 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 (XTYPE (b->auto_save_file_name) == Lisp_String) { Lisp_Object tem; tem = Fsymbol_value (intern ("delete-auto-save-files")); if (! NILP (tem)) unlink (XSTRING (b->auto_save_file_name)->data); } /* Unchain all markers of this buffer and leave them pointing nowhere. */ for (tem = b->markers; !EQ (tem, Qnil); ) { m = XMARKER (tem); m->buffer = 0; tem = m->chain; m->chain = Qnil; } b->markers = Qnil; /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ INITIALIZE_INTERVAL (b, NULL_INTERVAL); /* Perhaps we should explicitly free the interval tree here... */ b->name = Qnil; BLOCK_INPUT; BUFFER_FREE (BUF_BEG_ADDR (b)); 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 ("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_create (bufname); 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_create (bufname); 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; XSET (buf, Lisp_Buffer, 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; enum Lisp_Type tem; if (current_buffer == b) return; windows_or_buffers_changed = 1; old_buf = current_buffer; current_buffer = b; last_known_column_point = -1; /* invalidate indentation cache */ /* 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 ((XTYPE (valcontents) == Lisp_Buffer_Local_Value || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value) && (tem = XTYPE (XCONS (valcontents)->car), (tem == Lisp_Boolfwd || tem == Lisp_Intfwd || tem == Lisp_Objfwd))) /* 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 ((XTYPE (valcontents) == Lisp_Buffer_Local_Value || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value) && (tem = XTYPE (XCONS (valcontents)->car), (tem == Lisp_Boolfwd || tem == Lisp_Intfwd || tem == Lisp_Objfwd))) /* Just reference the variable to cause it to become set for this buffer. */ Fsymbol_value (XCONS (XCONS (tail)->car)->car); } } 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)) { XSET (buf, Lisp_Buffer, 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. */ XFASTINT (current_buffer->save_length) = 0; return Qnil; } validate_region (b, e) register Lisp_Object *b, *e; { register int i; CHECK_NUMBER_COERCE_MARKER (*b, 0); CHECK_NUMBER_COERCE_MARKER (*e, 1); if (XINT (*b) > XINT (*e)) { i = XFASTINT (*b); /* This is legit even if *b is < 0 */ *b = *e; XFASTINT (*e) = i; /* because this is all we do with i. */ } if (!(BEGV <= XINT (*b) && XINT (*b) <= XINT (*e) && XINT (*e) <= ZV)) args_out_of_range (*b, *e); } Lisp_Object list_buffers_1 (files) Lisp_Object files; { register Lisp_Object tail, tem, buf; Lisp_Object col1, col2, col3, minspace; register struct buffer *old = current_buffer, *b; Lisp_Object desired_point; Lisp_Object other_file_symbol; desired_point = Qnil; other_file_symbol = intern ("list-buffers-directory"); XFASTINT (col1) = 19; XFASTINT (col2) = 25; XFASTINT (col3) = 40; XFASTINT (minspace) = 1; Fset_buffer (Vstandard_output); tail = intern ("Buffer-menu-mode"); if (!EQ (tail, current_buffer->major_mode) && (tem = Ffboundp (tail), !NILP (tem))) call0 (tail); Fbuffer_disable_undo (Vstandard_output); current_buffer->read_only = Qnil; write_string ("\ MR Buffer Size Mode File\n\ -- ------ ---- ---- ----\n", -1); for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail)) { buf = Fcdr (Fcar (tail)); b = XBUFFER (buf); /* Don't mention the minibuffers. */ if (XSTRING (b->name)->data[0] == ' ') continue; /* Optionally don't mention buffers that lack files. */ if (!NILP (files) && NILP (b->filename)) continue; /* Identify the current buffer. */ if (b == old) XFASTINT (desired_point) = point; write_string (b == old ? "." : " ", -1); /* Identify modified buffers */ write_string (BUF_MODIFF (b) > b->save_modified ? "*" : " ", -1); write_string (NILP (b->read_only) ? " " : "% ", -1); Fprinc (b->name, Qnil); Findent_to (col1, make_number (2)); XFASTINT (tem) = BUF_Z (b) - BUF_BEG (b); Fprin1 (tem, Qnil); Findent_to (col2, minspace); Fprinc (b->mode_name, Qnil); Findent_to (col3, minspace); if (!NILP (b->filename)) Fprinc (b->filename, Qnil); else { /* No visited file; check local value of list-buffers-directory. */ Lisp_Object tem; set_buffer_internal (b); tem = Fboundp (other_file_symbol); if (!NILP (tem)) { tem = Fsymbol_value (other_file_symbol); Fset_buffer (Vstandard_output); if (XTYPE (tem) == Lisp_String) Fprinc (tem, Qnil); } else Fset_buffer (Vstandard_output); } write_string ("\n", -1); } current_buffer->read_only = Qt; set_buffer_internal (old); return desired_point; } DEFUN ("list-buffers", Flist_buffers, Slist_buffers, 0, 1, "P", "Display a list of names of existing buffers.\n\ The list is displayed in a buffer named `*Buffer List*'.\n\ Note that buffers with names starting with spaces are omitted.\n\ Non-null optional arg FILES-ONLY means mention only file buffers.\n\ \n\ The M column contains a * for buffers that are modified.\n\ The R column contains a % for buffers that are read-only.") (files) Lisp_Object files; { Lisp_Object desired_point; desired_point = internal_with_output_to_temp_buffer ("*Buffer List*", list_buffers_1, files); if (NUMBERP (desired_point)) { int count = specpdl_ptr - specpdl; record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); Fset_buffer (build_string ("*Buffer List*")); SET_PT (XINT (desired_point)); return unbind_to (count, Qnil); } return Qnil; } 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.") () { register Lisp_Object alist, sym, tem; Lisp_Object oalist; oalist = current_buffer->local_var_alist; /* Make sure no local variables remain set up with this buffer for their current values. */ 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 (XCONS (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 (XCONS (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 below, we don't lose the value. */ XCONS (XCONS (tem)->car)->cdr = XCONS (XSYMBOL (sym)->value)->car; /* Switch to the symbol's default-value alist entry. */ XCONS (tem)->car = tem; /* Mark it as current for the current buffer. */ XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Fcurrent_buffer (); /* Store the current value into any forwarding in the symbol. */ store_symval_forwarding (sym, XCONS (XSYMBOL (sym)->value)->car, XCONS (tem)->cdr); } } /* 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; } /* 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. *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) int pos; int extend; Lisp_Object **vec_ptr; int *len_ptr; int *next_ptr; { Lisp_Object tail, overlay, start, end, result; int idx = 0; int len = *len_ptr; Lisp_Object *vec = *vec_ptr; int next = ZV; int inhibit_storing = 0; for (tail = current_buffer->overlays_before; CONSP (tail); tail = XCONS (tail)->cdr) { int startpos; overlay = XCONS (tail)->car; if (! OVERLAY_VALID (overlay)) abort (); start = OVERLAY_START (overlay); end = OVERLAY_END (overlay); if (OVERLAY_POSITION (end) <= pos) break; 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; CONSP (tail); tail = XCONS (tail)->cdr) { int startpos; overlay = XCONS (tail)->car; if (! OVERLAY_VALID (overlay)) abort (); start = OVERLAY_START (overlay); end = OVERLAY_END (overlay); startpos = OVERLAY_POSITION (start); if (pos < startpos) { if (startpos < next) next = startpos; break; } if (pos < OVERLAY_POSITION (end)) { 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++; } } *next_ptr = next; return idx; } /* 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; } } XFASTINT (buf->overlay_center) = pos; } 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, 3, 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.") (beg, end, buffer) Lisp_Object beg, end, buffer; { Lisp_Object overlay; struct buffer *b; if (NILP (buffer)) XSET (buffer, Lisp_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 = beg; beg = end; end = temp; } b = XBUFFER (buffer); beg = Fset_marker (Fmake_marker (), beg, buffer); end = Fset_marker (Fmake_marker (), end, buffer); overlay = Fcons (Fcons (beg, end), Qnil); XSETTYPE (overlay, Lisp_Overlay); /* 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)) XSET (buffer, Lisp_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); specbind (Qinhibit_quit, Qt); if (XINT (beg) > XINT (end)) { Lisp_Object temp = beg; beg = end; end = temp; } 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)) windows_or_buffers_changed = 1; 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 (Fcdr_safe (XCONS (overlay)->cdr)); } 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; int endpos; 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, &endpos); /* 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.") (pos) Lisp_Object pos; { int noverlays; int endpos; Lisp_Object *overlay_vec; int len; Lisp_Object result; 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); /* 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); } /* 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 before 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; CHECK_OVERLAY (overlay, 0); for (plist = Fcdr_safe (XCONS (overlay)->cdr); CONSP (plist) && CONSP (XCONS (plist)->cdr); plist = XCONS (XCONS (plist)->cdr)->cdr) { if (EQ (XCONS (plist)->car, prop)) return XCONS (XCONS (plist)->cdr)->car; } return Qnil; } 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 plist, tail; CHECK_OVERLAY (overlay, 0); tail = Fmarker_buffer (OVERLAY_START (overlay)); if (! NILP (tail)) redisplay_region (XMARKER (OVERLAY_START (overlay))->buffer, marker_position (OVERLAY_START (overlay)), marker_position (OVERLAY_END (overlay))); plist = Fcdr_safe (XCONS (overlay)->cdr); for (tail = plist; CONSP (tail) && CONSP (XCONS (tail)->cdr); tail = XCONS (XCONS (tail)->cdr)->cdr) { if (EQ (XCONS (tail)->car, prop)) return XCONS (XCONS (tail)->cdr)->car = value; } if (! CONSP (XCONS (overlay)->cdr)) XCONS (overlay)->cdr = Fcons (Qnil, Qnil); XCONS (XCONS (overlay)->cdr)->cdr = Fcons (prop, Fcons (value, plist)); return value; } /* Run the modification-hooks of overlays that include any part of the text in START to END. Run the insert-before-hooks of overlay starting at END, and the insert-after-hooks of overlay ending at START. */ void verify_overlay_modification (start, end) Lisp_Object start, end; { Lisp_Object prop, overlay, tail; int insertion = EQ (start, end); for (tail = current_buffer->overlays_before; CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; 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 (XFASTINT (end) == startpos && insertion) { prop = Foverlay_get (overlay, Qinsert_in_front_hooks); call_overlay_mod_hooks (prop, overlay, start, end); } if (XFASTINT (start) == endpos && insertion) { prop = Foverlay_get (overlay, Qinsert_behind_hooks); call_overlay_mod_hooks (prop, overlay, start, end); } if (insertion ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos) : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos)) { prop = Foverlay_get (overlay, Qmodification_hooks); call_overlay_mod_hooks (prop, overlay, start, end); } } for (tail = current_buffer->overlays_after; CONSP (tail); tail = XCONS (tail)->cdr) { int startpos, endpos; 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 (XFASTINT (end) == startpos && insertion) { prop = Foverlay_get (overlay, Qinsert_in_front_hooks); call_overlay_mod_hooks (prop, overlay, start, end); } if (XFASTINT (start) == endpos && insertion) { prop = Foverlay_get (overlay, Qinsert_behind_hooks); call_overlay_mod_hooks (prop, overlay, start, end); } if (insertion ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos) : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos)) { prop = Foverlay_get (overlay, Qmodification_hooks); call_overlay_mod_hooks (prop, overlay, start, end); } } } static void call_overlay_mod_hooks (list, overlay, start, end) Lisp_Object list, overlay, start, end; { struct gcpro gcpro1; GCPRO1 (list); while (!NILP (list)) { call3 (Fcar (list), overlay, start, end); list = Fcdr (list); } UNGCPRO; } /* Somebody has tried to store NEWVAL into the buffer-local slot with offset XUINT (valcontents), and NEWVAL has an unacceptable type. */ void buffer_slot_type_mismatch (valcontents, newval) Lisp_Object valcontents, newval; { unsigned int offset = XUINT (valcontents); unsigned char *symbol_name = (XSYMBOL (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols)) ->name->data); char *type_name; 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_Marker: type_name = "markers"; break; case Lisp_Symbol: type_name = "symbols"; break; case Lisp_Cons: type_name = "lists"; break; case Lisp_Vector: type_name = "vectors"; break; default: abort (); } error ("only %s should be stored in the buffer-local variable %s", type_name, symbol_name); } 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 (&buffer_local_symbols); XSET (Vbuffer_defaults, Lisp_Buffer, &buffer_defaults); XSET (Vbuffer_local_symbols, Lisp_Buffer, &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.overlays_before = Qnil; buffer_defaults.overlays_after = Qnil; XFASTINT (buffer_defaults.overlay_center) = 1; XFASTINT (buffer_defaults.tab_width) = 8; buffer_defaults.truncate_lines = Qnil; buffer_defaults.ctl_arrow = Qt; XFASTINT (buffer_defaults.fill_column) = 70; XFASTINT (buffer_defaults.left_margin) = 0; /* 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 (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); XFASTINT (buffer_local_flags.filename) = -1; XFASTINT (buffer_local_flags.directory) = -1; XFASTINT (buffer_local_flags.backed_up) = -1; XFASTINT (buffer_local_flags.save_length) = -1; XFASTINT (buffer_local_flags.auto_save_file_name) = -1; XFASTINT (buffer_local_flags.read_only) = -1; XFASTINT (buffer_local_flags.major_mode) = -1; XFASTINT (buffer_local_flags.mode_name) = -1; XFASTINT (buffer_local_flags.undo_list) = -1; XFASTINT (buffer_local_flags.mark_active) = -1; XFASTINT (buffer_local_flags.mode_line_format) = 1; XFASTINT (buffer_local_flags.abbrev_mode) = 2; XFASTINT (buffer_local_flags.overwrite_mode) = 4; XFASTINT (buffer_local_flags.case_fold_search) = 8; XFASTINT (buffer_local_flags.auto_fill_function) = 0x10; XFASTINT (buffer_local_flags.selective_display) = 0x20; #ifndef old XFASTINT (buffer_local_flags.selective_display_ellipses) = 0x40; #endif XFASTINT (buffer_local_flags.tab_width) = 0x80; XFASTINT (buffer_local_flags.truncate_lines) = 0x100; XFASTINT (buffer_local_flags.ctl_arrow) = 0x200; XFASTINT (buffer_local_flags.fill_column) = 0x400; XFASTINT (buffer_local_flags.left_margin) = 0x800; XFASTINT (buffer_local_flags.abbrev_table) = 0x1000; XFASTINT (buffer_local_flags.display_table) = 0x2000; XFASTINT (buffer_local_flags.syntax_table) = 0x8000; 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; 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 && *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. */ if (buf[strlen (buf) - 1] != '/') strcat (buf, "/"); #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 (&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); staticpro (&Qoverlayp); staticpro (&Qmodification_hooks); Qmodification_hooks = intern ("modification-hooks"); staticpro (&Qinsert_in_front_hooks); Qinsert_in_front_hooks = intern ("insert-in-front-hooks"); staticpro (&Qinsert_behind_hooks); Qinsert_behind_hooks = intern ("insert-behind-hooks"); Qoverlayp = intern ("overlayp"); Fput (Qprotected_field, Qerror_conditions, Fcons (Qprotected_field, Fcons (Qerror, Qnil))); Fput (Qprotected_field, Qerror_message, build_string ("Attempt to modify a protected field")); Fput (intern ("erase-buffer"), Qdisabled, Qt); /* 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)."); 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. %m -- print value of mode-name (obsolete).\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\ %n -- print Narrow if appropriate.\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."); 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-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\ If non-nil and not `overwrite-mode-binary', 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 vector created with `make-display-table'.\n\ The first 256 elements control how to display each possible text character.\n\ Each value should be a vector of characters or nil;\n\ nil means display the character in the default fashion.\n\ The remaining five elements control the display of\n\ the end of a truncated screen line (element 256, a single character);\n\ the end of a continued line (element 257, a single character);\n\ the escape character used to display character codes in octal\n\ (element 258, a single character);\n\ the character used as an arrow for control characters (element 259,\n\ a single character);\n\ the decoration indicating the presence of invisible lines (element 260,\n\ a vector of characters).\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, ""); /*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\ position of the change\n\ \n\ While executing the `before-change-function', changes to buffers do not\n\ cause calls to any `before-change-function' or `after-change-function'."); 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\ While executing the `after-change-function', changes to buffers do not\n\ cause calls to any `before-change-function' or `after-change-function'."); Vafter_change_function = 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; Qfirst_change_hook = intern ("first-change-hook"); staticpro (&Qfirst_change_hook); #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 (START . END) represents an insertion which begins at\n\ position START 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 HIGHWORD LOWWORD) indicates that the buffer had been\n\ previously unmodified. HIGHWORD and LOWWORD are the high and low\n\ 16-bit words of the buffer's modification count at the time. If the\n\ modification count of the most recent save is different, this entry is\n\ obsolete.\n\ \n\ An entry (nil PROP VAL BEG . END) indicates that a text property\n\ was modified between BEG and END. PROP is the property name,\n\ and VAL 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, ""); 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_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; defsubr (&Sbuffer_list); defsubr (&Sget_buffer); defsubr (&Sget_file_buffer); defsubr (&Sget_buffer_create); defsubr (&Sgenerate_new_buffer_name); defsubr (&Sbuffer_name); /*defsubr (&Sbuffer_number);*/ defsubr (&Sbuffer_file_name); 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 (&Sswitch_to_buffer); defsubr (&Spop_to_buffer); defsubr (&Scurrent_buffer); defsubr (&Sset_buffer); defsubr (&Sbarf_if_buffer_read_only); defsubr (&Sbury_buffer); defsubr (&Slist_buffers); 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 (&Snext_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"); initial_define_key (control_x_map, Ctl ('B'), "list-buffers"); } emacs-19.22/src/bytecode.c100444 12241 12 54765 5444474540 14251 0ustar rolandstaff/* 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 (XTYPE (vector) != Lisp_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 (XTYPE (v1) != Lisp_Symbol) v2 = Fsymbol_value (v1); else { v2 = XSYMBOL (v1)->value; #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (v2)) #else switch (XTYPE (v2)) #endif { case Lisp_Symbol: if (!EQ (v2, Qunbound)) break; case Lisp_Intfwd: case Lisp_Boolfwd: case Lisp_Objfwd: case Lisp_Buffer_Local_Value: case Lisp_Some_Buffer_Local_Value: case Lisp_Buffer_Objfwd: case Lisp_Void: 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 && XTYPE (TOP) == Lisp_Symbol) { v1 = TOP; v2 = Fget (v1, Qbyte_code_meter); if (XTYPE (v2) == Lisp_Int && 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 = XTYPE (TOP) == Lisp_Symbol ? Qt : Qnil; break; case Bconsp: TOP = CONSP (TOP) ? Qt : Qnil; break; case Bstringp: TOP = XTYPE (TOP) == Lisp_String ? 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 (XTYPE (v1) == Lisp_Int) { XSETINT (v1, XINT (v1) - 1); TOP = v1; } else TOP = Fsub1 (v1); break; case Badd1: v1 = TOP; if (XTYPE (v1) == Lisp_Int) { 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); TOP = (XFLOATINT (v1) == XFLOATINT (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 (XTYPE (v1) == Lisp_Int) { 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: XFASTINT (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: XFASTINT (v1) = ZV; PUSH (v1); break; case Bpoint_min: XFASTINT (v1) = BEGV; PUSH (v1); break; case Bchar_after: TOP = Fchar_after (TOP); break; case Bfollowing_char: XFASTINT (v1) = PT == ZV ? 0 : FETCH_CHAR (point); PUSH (v1); break; case Bpreceding_char: XFASTINT (v1) = point <= BEGV ? 0 : FETCH_CHAR (point - 1); PUSH (v1); break; case Bcurrent_column: XFASTINT (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); XFASTINT (TOP) = syntax_code_spec[(int) SYNTAX (0xFF & 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 (XTYPE (TOP) == Lisp_Cons) { /* 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 (XTYPE (v1) == Lisp_Cons) TOP = XCONS (v1)->car; else TOP = Qnil; break; case Bcdr_safe: v1 = TOP; if (XTYPE (v1) == Lisp_Cons) 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 = XTYPE (TOP) == Lisp_Int ? 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.22/src/callint.c100444 12241 12 51316 5444474541 14067 0ustar rolandstaff/* Call a Lisp function interactively. 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 "buffer.h" #include "commands.h" #include "keyboard.h" #include "window.h" #include "mocklisp.h" extern char *index (); Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus; 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 Qlist; Lisp_Object preserved_fns; /* 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 (string).\n\ m -- Value of mark as number. Does not do I/O.\n\ n -- Number read using minibuffer.\n\ N -- Prefix arg converted to number, 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 (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String && !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 = 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, 2, 0, "Call FUNCTION, reading args according to its interactive calling specs.\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) Lisp_Object function, record; { 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 prompt[100]; char prompt1[100]; char *tem1; int arg_from_tty = 0; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Save this now, since use of minibuffer will clobber it. */ prefix_arg = Vcurrent_prefix_arg; retry: if (XTYPE (function) == Lisp_Symbol) 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 (XTYPE (fun) == Lisp_Subr) { string = (unsigned char *) XSUBR (fun)->prompt; if (!string) { lose: function = wrong_type_argument (Qcommandp, function); goto retry; } if ((int) string == 1) /* Let SPECS (which is nil) be used as the args. */ string = 0; } else if (XTYPE (fun) == Lisp_Compiled) { if (XVECTOR (fun)->size <= 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)) return ml_apply (fun, Qinteractive); else goto lose; /* If either specs or string is set to a string, use it. */ if (XTYPE (specs) == Lisp_String) { /* 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. */ car = Fcar (input); 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); } 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 < this_command_key_count; next_event++) if (EVENT_HAS_PARAMETERS (XVECTOR (this_command_keys)->contents[next_event])) break; /* Handle special starting chars `*' and `@'. */ while (1) { if (*string == '*') { string++; if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only (); } else if (*string == '@') { Lisp_Object event = XVECTOR (this_command_keys)->contents[next_event]; if (EVENT_HAS_PARAMETERS (event) && XTYPE (event = XCONS (event)->cdr) == Lisp_Cons && XTYPE (event = XCONS (event)->car) == Lisp_Cons && XTYPE (event = XCONS (event)->car) == Lisp_Window) 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; doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1); switch (*tem) { case 'a': /* Symbol defined as a function */ visargs[i] = Fcompleting_read (build_string (prompt), 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 (prompt), args[i], Qt); break; case 'B': /* Name of buffer, possibly nonexistent */ args[i] = Fread_buffer (build_string (prompt), Fother_buffer (Fcurrent_buffer (), Qnil), Qnil); break; case 'c': /* Character */ message1 (prompt); 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 (prompt), 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. */ XFASTINT (args[i]) = point; /* visargs[i] = Qnil; */ varies[i] = 1; break; case 'D': /* Directory name. */ args[i] = Fread_file_name (build_string (prompt), Qnil, current_buffer->directory, Qlambda, Qnil); break; case 'f': /* Existing file name. */ args[i] = Fread_file_name (build_string (prompt), Qnil, Qnil, Qlambda, Qnil); break; case 'F': /* Possibly nonexistent file name. */ args[i] = Fread_file_name (build_string (prompt), Qnil, Qnil, Qnil, Qnil); break; case 'k': /* Key sequence (string) */ args[i] = Fread_key_sequence (build_string (prompt), Qnil); teml = args[i]; visargs[i] = Fkey_description (teml); break; case 'e': /* The invoking event. */ if (next_event >= this_command_key_count) error ("%s must be bound to an event with parameters", (XTYPE (function) == Lisp_Symbol ? (char *) XSYMBOL (function)->name->data : "command")); args[i] = XVECTOR (this_command_keys)->contents[next_event++]; varies[i] = -1; /* Find the next parameterized event. */ while (next_event < this_command_key_count && ! (EVENT_HAS_PARAMETERS (XVECTOR (this_command_keys)->contents[next_event]))) next_event++; break; case 'm': /* Value of mark. Does not do I/O. */ check_mark (); /* visargs[i] = Qnil; */ XFASTINT (args[i]) = marker_position (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 (prompt), 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 (); /* visargs[i+1] = Qnil; */ foo = marker_position (current_buffer->mark); /* visargs[i] = Qnil; */ XFASTINT (args[i]) = point < foo ? point : foo; varies[i] = 3; XFASTINT (args[++i]) = point > foo ? point : foo; varies[i] = 4; break; case 's': /* String read via minibuffer. */ args[i] = Fread_string (build_string (prompt), Qnil); break; case 'S': /* Any symbol. */ visargs[i] = Fread_string (build_string (prompt), 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 (prompt)); visargs[i] = last_minibuf_string; break; case 'x': /* Lisp expression read but not evaluated */ args[i] = Fread_minibuffer (build_string (prompt), Qnil); visargs[i] = last_minibuf_string; break; case 'X': /* Lisp expression read and evaluated */ args[i] = Feval_minibuffer (build_string (prompt), Qnil); visargs[i] = last_minibuf_string; break; 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]) && XTYPE (args[i]) == Lisp_String) 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); } { 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; /* Tag val as an integer, so the rest of the assignments may use XSETINT. */ XFASTINT (val) = 0; if (NILP (raw)) XFASTINT (val) = 1; else if (EQ (raw, Qminus)) XSETINT (val, -1); else if (CONSP (raw)) XSETINT (val, XINT (XCONS (raw)->car)); else if (XTYPE (raw) == Lisp_Int) val = raw; else XFASTINT (val) = 1; return val; } syms_of_callint () { 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); Qminus = intern ("-"); staticpro (&Qminus); 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); DEFVAR_LISP ("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\")."); Vprefix_arg = Qnil; 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; defsubr (&Sinteractive); defsubr (&Scall_interactively); defsubr (&Sprefix_numeric_value); } emacs-19.22/src/callproc.c100444 12120 1 51052 5475221473 13667 0ustar rmsdaemon/* Synchronous subprocess invocation for GNU Emacs. 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 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. */ #include #include #include extern int errno; #ifndef VMS extern char *sys_errlist[]; #endif /* Define SIGCHLD as an alias for SIGCLD. */ #if !defined (SIGCHLD) && defined (SIGCLD) #define SIGCHLD SIGCLD #endif /* SIGCLD */ #include #include #ifdef USG5 #include #endif #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" #ifdef VMS extern noshare char **environ; #else extern char **environ; #endif #define max(a, b) ((a) > (b) ? (a) : (b)) Lisp_Object Vexec_path, Vexec_directory, Vdata_directory; Lisp_Object Vconfigure_info_directory; Lisp_Object Vshell_file_name; Lisp_Object Vprocess_environment; /* 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; #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; { register int pid = XFASTINT (Fcdr (fdpid)); 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))); 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\ Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ Remaining arguments are strings passed as command arguments to PROGRAM.\n\ If BUFFER is 0, returns immediately with value nil.\n\ Otherwise 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[1024]; int count = specpdl_ptr - specpdl; register unsigned char **new_argv = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *)); struct buffer *old = current_buffer; #if 0 int mask; #endif CHECK_STRING (args[0], 0); 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) { register Lisp_Object tem; buffer = tem = args[2]; if (!(EQ (tem, Qnil) || EQ (tem, Qt) || XFASTINT (tem) == 0)) { buffer = Fget_buffer (tem); 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; { register int i; for (i = 4; i < nargs; i++) { CHECK_STRING (args[i], i); new_argv[i - 3] = XSTRING (args[i])->data; } /* Program name is first command arg */ new_argv[0] = XSTRING (args[0])->data; new_argv[i - 3] = 0; } 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. */ openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1); if (NILP (path)) { close (filefd); report_file_error ("Searching for program", Fcons (args[0], Qnil)); } new_argv[0] = XSTRING (path)->data; if (XTYPE (buffer) == Lisp_Int) fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1; else { pipe (fd); #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]; #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; 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, fd1, new_argv, 0, current_dir); } #if 0 /* Tell SIGCHLD handler to look for this pid. */ synch_process_pid = pid; /* Now let SIGCHLD come through. */ sigsetmask (mask); #endif environ = save_environ; close (filefd); close (fd1); } if (pid < 0) { close (fd[0]); report_file_error ("Doing vfork", Qnil); } if (XTYPE (buffer) == Lisp_Int) { #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; } record_unwind_protect (call_process_cleanup, Fcons (make_number (fd[0]), make_number (pid))); if (XTYPE (buffer) == Lisp_Buffer) Fset_buffer (buffer); immediate_quit = 1; QUIT; { register int nread; while ((nread = read (fd[0], buf, sizeof buf)) > 0) { immediate_quit = 0; if (!NILP (buffer)) insert (buf, nread); if (!NILP (display) && INTERACTIVE) redisplay_preserve_echo_area (); immediate_quit = 1; QUIT; } } /* Wait for it to terminate, unless it already has. */ wait_for_termination (pid); immediate_quit = 0; set_buffer_internal (old); 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; { unlink (XSTRING (name)->data); } 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\ 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\ 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\ If BUFFER is nil, returns immediately with value nil.\n\ Otherwise 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; { register Lisp_Object filename_string, start, end; char tempfile[20]; int count = specpdl_ptr - specpdl; #ifdef VMS strcpy (tempfile, "tmp:emacsXXXXXX."); #else strcpy (tempfile, "/tmp/emacsXXXXXX"); #endif mktemp (tempfile); filename_string = build_string (tempfile); start = args[0]; end = args[1]; Fwrite_region (start, end, filename_string, Qnil, Qlambda); record_unwind_protect (delete_temp_file, filename_string); if (!NILP (args[3])) Fdelete_region (start, end); args[3] = filename_string; return 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; { char **env; register int pid = getpid(); { extern int emacs_priority; nice (- emacs_priority); } #ifdef subprocesses /* Close Emacs's descriptors that this process should not have. */ close_process_descs (); #endif /* 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 unsigned char *temp; register int i; i = XSTRING (current_dir)->size; temp = (unsigned char *) alloca (i + 2); bcopy (XSTRING (current_dir)->data, temp, i); if (temp[i - 1] != '/') temp[i++] = '/'; 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); } /* 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; (XTYPE (tem) == Lisp_Cons && XTYPE (XCONS (tem)->car) == Lisp_String); tem = XCONS (tem)->cdr) new_length++; /* new_length + 1 to include terminating 0. */ env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *)); /* Copy the Vprocess_environment strings into new_env. */ for (tem = Vprocess_environment; (XTYPE (tem) == Lisp_Cons && XTYPE (XCONS (tem)->car) == Lisp_String); 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; } /* 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, our, or error closed, as might happen under X. */ in = relocate_fd (in, 3); out = relocate_fd (out, 3); 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); #ifdef USG #ifndef SETPGRP_RELEASES_CTTY setpgrp (); /* No arguments but equivalent in this case */ #endif #else setpgrp (pid, pid); #endif /* USG */ setpgrp_of_tty (pid); #ifdef vipc something missing here; #endif /* vipc */ /* 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, "Couldn't exec the program ", 26); write (1, new_argv[0], strlen (new_argv[0])); _exit (1); } /* 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 *message2 = "\n"; write (2, message1, strlen (message1)); write (2, sys_errlist[errno], strlen (sys_errlist[errno])); 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 = XCONS (scan)->car; if (XTYPE (entry) == Lisp_String && XSTRING (entry)->size > varlen && XSTRING (entry)->data[varlen] == '=' && ! bcmp (XSTRING (entry)->data, var, varlen)) { *value = (char *) XSTRING (entry)->data + (varlen + 1); *valuelen = XSTRING (entry)->size - (varlen + 1); return 1; } } return 0; } DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 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"); Vdata_directory = Ffile_name_as_directory (build_string (data_dir ? data_dir : PATH_DATA)); /* 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, so that Vinvocation_directory is valid. */ init_callproc () { char *data_dir = egetenv ("EMACSDATA"); register char * sh; Lisp_Object tempdir; if (initialized && !NILP (Vinvocation_directory)) { /* Add to the path the ../lib-src dir of the Emacs executable, if that dir exists. */ Lisp_Object tem, tem1; tem = Fexpand_file_name (build_string ("../lib-src"), Vinvocation_directory); tem1 = Ffile_exists_p (tem); if (!NILP (tem1) && NILP (Fmember (tem, Vexec_path))) { Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil)); Vexec_directory = Ffile_name_as_directory (tem); /* If we use ../lib-src, maybe use ../etc as well. Do so if ../etc exists and has our DOC-... file in it. */ if (data_dir == 0) { Lisp_Object tem, tem2, tem3; tem = Fexpand_file_name (build_string ("../etc"), Vinvocation_directory); tem2 = Fexpand_file_name (Vdoc_file_name, tem); tem3 = Ffile_exists_p (tem2); if (!NILP (tem3)) Vdata_directory = Ffile_name_as_directory (tem); } } } tempdir = Fdirectory_file_name (Vexec_directory); if (access (XSTRING (tempdir)->data, 0) < 0) { printf ("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) { printf ("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 () { 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 ("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.22/src/casefiddle.c100444 12241 12 16572 5444474542 14532 0ustar rolandstaff/* GNU Emacs case conversion functions. 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 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. */ #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 (XTYPE (obj) == Lisp_Int) { c = XINT (obj); if (c >= 0 && c <= 0400) { if (inword) XFASTINT (obj) = DOWNCASE (c); else if (!UPPERCASEP (c)) XFASTINT (obj) = UPCASE1 (c); } return obj; } if (XTYPE (obj) == Lisp_String) { obj = Fcopy_sequence (obj); len = XSTRING (obj)->size; for (i = 0; i < len; i++) { c = XSTRING (obj)->data[i]; if (inword) c = DOWNCASE (c); else if (!UPPERCASEP (c)) c = UPCASE1 (c); XSTRING (obj)->data[i] = c; if (flag == 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. See also `capitalize'.") (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.") (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.") (obj) Lisp_Object obj; { return casify_object (CASE_CAPITALIZE, 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; if (EQ (b, e)) /* Not modifying because nothing marked */ return; validate_region (&b, &e); modify_region (current_buffer, XFASTINT (b), XFASTINT (e)); record_change (XFASTINT (b), XFASTINT (e) - XFASTINT (b)); for (i = XFASTINT (b); i < XFASTINT (e); 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 (XFASTINT (b), XFASTINT (e) - XFASTINT (b), XFASTINT (e) - XFASTINT (b)); } 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 but change only the initials. */ Lisp_Object upcase_initials_region (b, e) Lisp_Object b, e; { casify_region (CASE_CAPITALIZE_UP, b, e); return Qnil; } Lisp_Object operate_on_word (arg) Lisp_Object arg; { Lisp_Object val; int end, farend; CHECK_NUMBER (arg, 0); farend = scan_words (point, XINT (arg)); if (!farend) farend = XINT (arg) > 0 ? ZV : BEGV; end = point > farend ? point : farend; SET_PT (end); XFASTINT (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 opoint; XFASTINT (opoint) = point; casify_region (CASE_UP, opoint, operate_on_word (arg)); 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 opoint; XFASTINT (opoint) = point; casify_region (CASE_DOWN, opoint, operate_on_word (arg)); 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 opoint; XFASTINT (opoint) = point; casify_region (CASE_CAPITALIZE, opoint, operate_on_word (arg)); return Qnil; } syms_of_casefiddle () { defsubr (&Supcase); defsubr (&Sdowncase); defsubr (&Scapitalize); defsubr (&Supcase_region); defsubr (&Sdowncase_region); defsubr (&Scapitalize_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.22/src/casetab.c100444 12241 12 16420 5444474542 14041 0ustar rolandstaff/* GNU Emacs routines to deal with case 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 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. */ /* Written by Howard Gayle. See chartab.c for details. */ #include #include "lisp.h" #include "buffer.h" Lisp_Object Qcase_table_p; Lisp_Object Vascii_downcase_table, Vascii_upcase_table; Lisp_Object Vascii_canon_table, Vascii_eqv_table; 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 down, up, canon, eqv; down = Fcar_safe (table); up = Fcar_safe (Fcdr_safe (table)); canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table))); eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table)))); #define STRING256_P(obj) \ (XTYPE (obj) == Lisp_String && XSTRING (obj)->size == 256) return (STRING256_P (down) && (NILP (up) || STRING256_P (up)) && ((NILP (canon) && NILP (eqv)) || (STRING256_P (canon) && STRING256_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.") () { Lisp_Object down, up, canon, eqv; down = current_buffer->downcase_table; up = current_buffer->upcase_table; canon = current_buffer->case_canon_table; eqv = current_buffer->case_eqv_table; return Fcons (down, Fcons (up, Fcons (canon, Fcons (eqv, Qnil)))); } 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 Fcons (Vascii_downcase_table, Fcons (Vascii_upcase_table, Fcons (Vascii_canon_table, Fcons (Vascii_eqv_table, Qnil)))); } 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 list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)\n\ where each element is either nil or a string of length 256.\n\ DOWNCASE maps each character to its lower-case equivalent.\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.\n\ EQUIVALENCES is a map that cyclicly permutes each equivalence class\n\ (of characters with the same canonical equivalent).\n\ Both CANONICALIZE and EQUIVALENCES may be nil, in which case\n\ both are deduced from DOWNCASE and UPCASE.") (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 down, up, canon, eqv; check_case_table (table); down = Fcar_safe (table); up = Fcar_safe (Fcdr_safe (table)); canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table))); eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table)))); if (NILP (up)) { up = Fmake_string (make_number (256), make_number (0)); compute_trt_inverse (XSTRING (down)->data, XSTRING (up)->data); } if (NILP (canon)) { register int i; unsigned char *upvec = XSTRING (up)->data; unsigned char *downvec = XSTRING (down)->data; canon = Fmake_string (make_number (256), make_number (0)); eqv = Fmake_string (make_number (256), make_number (0)); /* 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++) XSTRING (canon)->data[i] = downvec[upvec[downvec[i]]]; compute_trt_inverse (XSTRING (canon)->data, XSTRING (eqv)->data); } if (standard) { Vascii_downcase_table = down; Vascii_upcase_table = up; Vascii_canon_table = canon; Vascii_eqv_table = eqv; } else { current_buffer->downcase_table = down; current_buffer->upcase_table = up; current_buffer->case_canon_table = canon; current_buffer->case_eqv_table = eqv; } 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. */ void compute_trt_inverse (trt, inverse) register unsigned char *trt; register unsigned char *inverse; { register int i = 0400; register unsigned char c, q; while (i--) inverse[i] = i; i = 0400; while (i--) { if ((q = trt[i]) != (unsigned char) i) { c = inverse[q]; inverse[q] = i; inverse[i] = c; } } } init_casetab_once () { register int i; Lisp_Object tem; tem = Fmake_string (make_number (256), make_number (0)); Vascii_downcase_table = tem; Vascii_canon_table = tem; for (i = 0; i < 256; i++) XSTRING (tem)->data[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; tem = Fmake_string (make_number (256), make_number (0)); Vascii_upcase_table = tem; Vascii_eqv_table = tem; for (i = 0; i < 256; i++) XSTRING (tem)->data[i] = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a') : i)); } syms_of_casetab () { Qcase_table_p = intern ("case-table-p"); staticpro (&Qcase_table_p); staticpro (&Vascii_downcase_table); staticpro (&Vascii_upcase_table); staticpro (&Vascii_canon_table); staticpro (&Vascii_eqv_table); defsubr (&Scase_table_p); defsubr (&Scurrent_case_table); defsubr (&Sstandard_case_table); defsubr (&Sset_case_table); defsubr (&Sset_standard_case_table); #if 0 DEFVAR_LISP ("ascii-downcase-table", &Vascii_downcase_table, "String mapping ASCII characters to lowercase equivalents."); DEFVAR_LISP ("ascii-upcase-table", &Vascii_upcase_table, "String mapping ASCII characters to uppercase equivalents."); #endif } emacs-19.22/src/cm.c100444 12241 12 23750 5444474543 13043 0ustar rolandstaff/* Cursor motion subroutines for GNU Emacs. Copyright (C) 1985 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 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. */ #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++; } void cmputc (c) char c; { if (termscript) fputc (c & 0177, termscript); putchar (c & 0177); } /* 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 /* * (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.22/src/cmds.c100444 12120 1 25652 5472402134 13015 0ustar rmsdaemon/* Simple built-in editing commands. Copyright (C) 1985, 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 "commands.h" #include "buffer.h" #include "syntax.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; 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)) XFASTINT (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)) XFASTINT (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, count - negp, &shortage); 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)) XFASTINT (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)) XFASTINT (n) = 1; else CHECK_NUMBER (n, 0); if (XINT (n) != 1) Fforward_line (make_number (XINT (n) - 1)); pos = point; stop = ZV; while (pos < stop && FETCH_CHAR (pos) != '\n') pos++; SET_PT (pos); 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 (XTYPE (last_command_char) != Lisp_Int) bitch_at_user (); else while (XINT (arg) > 0) { XFASTINT (arg)--; /* Ok since old and new vals both nonneg */ internal_self_insert (XINT (last_command_char), XFASTINT (arg) != 0); } return Qnil; } DEFUN ("newline", Fnewline, Snewline, 0, 1, "P", "Insert a newline. With arg, insert that many newlines.\n\ In Auto Fill mode, if no numeric arg, break the preceding line if it's long.") (arg1) Lisp_Object arg1; { int flag; Lisp_Object arg; char c1 = '\n'; arg = Fprefix_numeric_value (arg1); if (!NILP (current_buffer->read_only)) Fbarf_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. We can't use internal_self_insert in that case since it won't do the insertion correctly. Luckily, internal_self_insert's special features all do nothing in that case. */ flag = point > BEGV && FETCH_CHAR (point - 1) == '\n'; #ifdef USE_TEXT_PROPERTIES /* We cannot use this optimization if properties change in the vicinity. ??? We need to check for change hook properties, etc. */ if (flag) if (! (point - 1 > BEGV && ! property_change_between_p (point - 2, point))) flag = 0; #endif if (flag) SET_PT (point - 1); while (XINT (arg) > 0) { if (flag) insert (&c1, 1); else internal_self_insert ('\n', !NILP (arg1)); XFASTINT (arg)--; /* Ok since old and new vals both nonneg */ } if (flag) SET_PT (point + 1); 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. */ 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 = current_buffer->overwrite_mode; if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)) 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 = 1; } 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 = 1; } if ((c == ' ' || c == '\n') && !noautofill && !NILP (current_buffer->auto_fill_function) && current_column () > XFASTINT (current_buffer->fill_column)) { if (c1 != '\n') insert (&c1, 1); call0 (current_buffer->auto_fill_function); if (c1 == '\n') insert (&c1, 1); hairy = 1; } else insert (&c1, 1); synt = SYNTAX (c); if ((synt == Sclose || synt == Smath) && !NILP (Vblink_paren_function) && INTERACTIVE) { call0 (Vblink_paren_function); hairy = 1; } 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 ("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); defsubr (&Snewline); } keys_of_cmds () { int n; initial_define_key (global_map, Ctl('M'), "newline"); 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"); 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.22/src/crt0.c100666 12241 1 34301 5444000661 13414 0ustar rolanddaemon/* 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 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 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 #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)); } #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 */ emacs-19.22/src/data.c100444 12120 1 174331 5461123221 13012 0ustar rmsdaemon/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. Copyright (C) 1985, 1986, 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 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. */ #include #include #include "lisp.h" #include "puresize.h" #ifndef standalone #include "buffer.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, 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 Qcdr; 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 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 (XTYPE (value) == Lisp_String && (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p))) return Fstring_to_number (value); if (XTYPE (value) == Lisp_Int && EQ (predicate, Qstringp)) return Fnumber_to_string (value); } 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; XSET (val, Lisp_Int, 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) int num; { if (num & (1 << (VALBITS - 1))) return num | ((-1) << VALBITS); else return num & ((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.") (obj) Lisp_Object obj; { if (NILP (obj)) return Qt; return Qnil; } DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "T if OBJECT is a cons cell.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Cons) return Qt; return Qnil; } DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell. This includes nil.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Cons) return Qnil; return Qt; } DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list. This includes nil.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Cons || NILP (obj)) return Qt; return Qnil; } DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list. Lists include nil.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Cons || NILP (obj)) return Qnil; return Qt; } DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Symbol) return Qt; return Qnil; } DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Vector) return Qt; return Qnil; } DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_String) return Qt; return Qnil; } DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String) return Qt; return Qnil; } DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, "T if OBJECT is a sequence (list or array).") (obj) register Lisp_Object obj; { if (CONSP (obj) || NILP (obj) || XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String) return Qt; return Qnil; } DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "T if OBJECT is an editor buffer.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Buffer) return Qt; return Qnil; } DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "T if OBJECT is a marker (editor pointer).") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Marker) return Qt; return Qnil; } DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Subr) 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.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Compiled) 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 (a number) or a string.") (obj) register Lisp_Object obj; { if (XTYPE (obj) == Lisp_Int || XTYPE (obj) == Lisp_String) return Qt; return Qnil; } DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "T if OBJECT is a number.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Int) 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).") (obj) register Lisp_Object obj; { if (XTYPE (obj) == Lisp_Marker || XTYPE (obj) == Lisp_Int) return Qt; return Qnil; } DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, "T if OBJECT is a nonnegative number.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Int && XINT (obj) >= 0) return Qt; return Qnil; } DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, "T if OBJECT is a number (floating point or integer).") (obj) Lisp_Object obj; { if (NUMBERP (obj)) 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.") (obj) Lisp_Object obj; { if (NUMBERP (obj) || XTYPE (obj) == Lisp_Marker) return Qt; return Qnil; } #ifdef LISP_FLOAT_TYPE DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, "T if OBJECT is a floating point number.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Float) 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 CONSCELL. 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 (XTYPE (list) == Lisp_Cons) 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 (XTYPE (object) == Lisp_Cons) return XCONS (object)->car; else return Qnil; } DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, "Return the cdr of CONSCELL. 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 (XTYPE (list) == Lisp_Cons) 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 (XTYPE (object) == Lisp_Cons) return XCONS (object)->cdr; else return Qnil; } DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, "Set the car of CONSCELL to be NEWCAR. Returns NEWCAR.") (cell, newcar) register Lisp_Object cell, newcar; { if (XTYPE (cell) != Lisp_Cons) 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 CONSCELL to be NEWCDR. Returns NEWCDR.") (cell, newcdr) register Lisp_Object cell, newcdr; { if (XTYPE (cell) != Lisp_Cons) 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; #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (valcontents)) #else switch (XTYPE (valcontents)) #endif { case Lisp_Buffer_Local_Value: case Lisp_Some_Buffer_Local_Value: valcontents = swap_in_symval_forwarding (sym, valcontents); } return (XTYPE (valcontents) == Lisp_Void || 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 (XTYPE (XSYMBOL (sym)->function) == Lisp_Void || 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); 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); XSET (name, Lisp_String, 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 (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound)) Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function), Vautoload_queue); XSYMBOL (sym)->function = newdef; 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; 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; 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; #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (valcontents)) #else switch (XTYPE (valcontents)) #endif { case Lisp_Intfwd: XSET (val, Lisp_Int, *XINTPTR (valcontents)); return val; case Lisp_Boolfwd: if (*XINTPTR (valcontents)) return Qt; return Qnil; case Lisp_Objfwd: return *XOBJFWD (valcontents); case Lisp_Buffer_Objfwd: return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer); } 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; { #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (valcontents)) #else switch (XTYPE (valcontents)) #endif { case Lisp_Intfwd: CHECK_NUMBER (newval, 1); *XINTPTR (valcontents) = XINT (newval); break; case Lisp_Boolfwd: *XINTPTR (valcontents) = NILP(newval) ? 0 : 1; break; case Lisp_Objfwd: *XOBJFWD (valcontents) = newval; break; case Lisp_Buffer_Objfwd: { unsigned int offset = XUINT (valcontents); Lisp_Object type = *(Lisp_Object *)(offset + (char *)&buffer_local_types); if (! NILP (type) && ! NILP (newval) && XTYPE (newval) != XINT (type)) buffer_slot_type_mismatch (valcontents, newval); *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer) = newval; break; } default: valcontents = XSYMBOL (sym)->value; if (XTYPE (valcontents) == Lisp_Buffer_Local_Value || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value) XCONS (XSYMBOL (sym)->value)->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 list (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 (XCONS (valcontents)->cdr)->car; if (NILP (tem1) || current_buffer != XBUFFER (tem1)) { tem1 = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car; Fsetcdr (tem1, do_symval_forwarding (XCONS (valcontents)->car)); tem1 = assq_no_quit (sym, current_buffer->local_var_alist); if (NILP (tem1)) tem1 = XCONS (XCONS (valcontents)->cdr)->cdr; XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car = tem1; XSET (XCONS (XCONS (valcontents)->cdr)->car, Lisp_Buffer, current_buffer); store_symval_forwarding (sym, XCONS (valcontents)->car, Fcdr (tem1)); } return XCONS (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; retry: #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (valcontents)) #else switch (XTYPE (valcontents)) #endif { case Lisp_Buffer_Local_Value: case Lisp_Some_Buffer_Local_Value: valcontents = swap_in_symval_forwarding (sym, valcontents); goto retry; case Lisp_Intfwd: XSET (val, Lisp_Int, *XINTPTR (valcontents)); return val; case Lisp_Boolfwd: if (*XINTPTR (valcontents)) return Qt; return Qnil; case Lisp_Objfwd: return *XOBJFWD (valcontents); case Lisp_Buffer_Objfwd: return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer); case Lisp_Void: return Qunbound; } 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 = 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 = (XTYPE (newval) == Lisp_Void || EQ (newval, Qunbound)); #ifndef RTPC_REGISTER_BUG register Lisp_Object valcontents, tem1, current_alist_element; #else /* RTPC_REGISTER_BUG */ register Lisp_Object tem1; Lisp_Object valcontents, current_alist_element; #endif /* RTPC_REGISTER_BUG */ CHECK_SYMBOL (sym, 0); if (NILP (sym) || EQ (sym, Qt)) return Fsignal (Qsetting_constant, Fcons (sym, Qnil)); valcontents = XSYMBOL (sym)->value; if (XTYPE (valcontents) == Lisp_Buffer_Objfwd) { register int idx = XUINT (valcontents); register int mask = *(int *)(idx + (char *) &buffer_local_flags); if (mask > 0) current_buffer->local_var_flags |= mask; } else if (XTYPE (valcontents) == Lisp_Buffer_Local_Value || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value) { /* valcontents is actually a pointer to a cons heading 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 (XCONS (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 (XCONS (valcontents)->cdr)->car)) || (XTYPE (valcontents) == Lisp_Buffer_Local_Value && 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 (XCONS (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 (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value) tem1 = XCONS (XCONS (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 (XCONS (valcontents)->cdr)->cdr)->car = tem1; /* Set BUFFER, now that CURRENT-ALIST-ELEMENT is accurate. */ XSET (XCONS (XCONS (valcontents)->cdr)->car, Lisp_Buffer, current_buffer); } valcontents = XCONS (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 or a Lisp_Void object 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 (XTYPE (valcontents) == Lisp_Buffer_Objfwd) { register int idx = XUINT (valcontents); if (*(int *) (idx + (char *) &buffer_local_flags) != 0) return *(Lisp_Object *)(idx + (char *) &buffer_defaults); } /* Handle user-created local variables. */ if (XTYPE (valcontents) == Lisp_Buffer_Local_Value || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value) { /* 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 (XCONS (valcontents)->cdr)->cdr)->car; alist_element_car = XCONS (current_alist_element)->car; if (EQ (alist_element_car, current_alist_element)) return do_symval_forwarding (XCONS (valcontents)->car); else return XCONS (XCONS (XCONS (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 (XTYPE (value) == Lisp_Void || 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 (XTYPE (value) == Lisp_Void || 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 (XTYPE (valcontents) == Lisp_Buffer_Objfwd) { register int idx = XUINT (valcontents); #ifndef RTPC_REGISTER_BUG register struct buffer *b; #else struct buffer *b; #endif register int mask = *(int *) (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 (XTYPE (valcontents) != Lisp_Buffer_Local_Value && XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value) return Fset (sym, value); /* Store new value into the DEFAULT-VALUE slot */ XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->cdr = value; /* If that slot is current, we must set the REALVALUE slot too */ current_alist_element = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car; alist_element_buffer = Fcar (current_alist_element); if (EQ (alist_element_buffer, current_alist_element)) store_symval_forwarding (sym, XCONS (valcontents)->car, value); return value; } DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0, "\ (setq-default SYM VAL SYM VAL ...): set each SYM's default value to its VAL.\n\ VAL is evaluated; SYM is not. The default value is seen in buffers that do\n\ not have their own values for this variable.") (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; CHECK_SYMBOL (sym, 0); if (EQ (sym, Qnil) || EQ (sym, Qt)) error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data); valcontents = XSYMBOL (sym)->value; if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value) || (XTYPE (valcontents) == Lisp_Buffer_Objfwd)) return sym; if (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value) { XSETTYPE (XSYMBOL (sym)->value, Lisp_Buffer_Local_Value); return sym; } if (EQ (valcontents, Qunbound)) XSYMBOL (sym)->value = Qnil; tem = Fcons (Qnil, Fsymbol_value (sym)); XCONS (tem)->car = tem; XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Fcurrent_buffer (), tem)); XSETTYPE (XSYMBOL (sym)->value, Lisp_Buffer_Local_Value); 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\ 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 if the variable were set.") (sym) register Lisp_Object sym; { register Lisp_Object tem, valcontents; CHECK_SYMBOL (sym, 0); if (EQ (sym, Qnil) || EQ (sym, Qt)) error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data); valcontents = XSYMBOL (sym)->value; if (XTYPE (valcontents) == Lisp_Buffer_Local_Value || XTYPE (valcontents) == Lisp_Buffer_Objfwd) { 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 (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value) { if (EQ (valcontents, Qunbound)) XSYMBOL (sym)->value = Qnil; tem = Fcons (Qnil, do_symval_forwarding (valcontents)); XCONS (tem)->car = tem; XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Qnil, tem)); XSETTYPE (XSYMBOL (sym)->value, Lisp_Some_Buffer_Local_Value); } /* Make sure this buffer has its own value of sym */ tem = Fassq (sym, current_buffer->local_var_alist); if (NILP (tem)) { current_buffer->local_var_alist = Fcons (Fcons (sym, XCONS (XCONS (XCONS (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 */ { /* This local variable avoids "expression too complex" on IBM RT. */ Lisp_Object xs; xs = XSYMBOL (sym)->value; if (current_buffer == XBUFFER (XCONS (XCONS (xs)->cdr)->car)) XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = 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 = XCONS (XSYMBOL (sym)->value)->car; if (XTYPE (valcontents) == Lisp_Intfwd || XTYPE (valcontents) == Lisp_Boolfwd || XTYPE (valcontents) == Lisp_Objfwd) 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 (XTYPE (valcontents) == Lisp_Buffer_Objfwd) { register int idx = XUINT (valcontents); register int mask = *(int *) (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 (XTYPE (valcontents) != Lisp_Buffer_Local_Value && XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value) 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 sv; sv = XSYMBOL (sym)->value; if (current_buffer == XBUFFER (XCONS (XCONS (sv)->cdr)->car)) XCONS (XCONS (sv)->cdr)->car = Qnil; } return sym; } /* 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 (XTYPE (hare) != Lisp_Symbol || EQ (hare, Qunbound)) break; hare = XSYMBOL (hare)->function; if (XTYPE (hare) != Lisp_Symbol || 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 or a string, 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 (XTYPE (array) != Lisp_Vector && XTYPE (array) != Lisp_String && XTYPE (array) != Lisp_Compiled) array = wrong_type_argument (Qarrayp, array); if (idxval < 0 || idxval >= XVECTOR (array)->size) args_out_of_range (array, idx); if (XTYPE (array) == Lisp_String) { Lisp_Object val; XFASTINT (val) = (unsigned char) XSTRING (array)->data[idxval]; return val; } else return XVECTOR (array)->contents[idxval]; } DEFUN ("aset", Faset, Saset, 3, 3, 0, "Store into the element of ARRAY at index INDEX the value NEWVAL.\n\ ARRAY may be a vector or a string. INDEX 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 (XTYPE (array) != Lisp_Vector && XTYPE (array) != Lisp_String) array = wrong_type_argument (Qarrayp, array); if (idxval < 0 || idxval >= XVECTOR (array)->size) args_out_of_range (array, idx); CHECK_IMPURE (array); if (XTYPE (array) == Lisp_Vector) XVECTOR (array)->contents[idxval] = newelt; else { CHECK_NUMBER (newelt, 2); XSTRING (array)->data[idxval] = XINT (newelt); } return newelt; } Lisp_Object Farray_length (array) register Lisp_Object array; { register Lisp_Object size; if (XTYPE (array) != Lisp_Vector && XTYPE (array) != Lisp_String && XTYPE (array) != Lisp_Compiled) array = wrong_type_argument (Qarrayp, array); XFASTINT (size) = XVECTOR (array)->size; return size; } /* 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 (XTYPE (num1) == Lisp_Float || XTYPE (num2) == Lisp_Float) { floatp = 1; f1 = (XTYPE (num1) == Lisp_Float) ? XFLOAT (num1)->data : XINT (num1); f2 = (XTYPE (num2) == Lisp_Float) ? 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 (XTYPE(num) == Lisp_Float) { 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 32-bit values and pairs of lispy 24-bit values. */ 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 == 0xFFFF) 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[20]; #ifndef LISP_FLOAT_TYPE CHECK_NUMBER (num, 0); #else CHECK_NUMBER_OR_FLOAT (num, 0); if (XTYPE(num) == Lisp_Float) { char pigbuf[350]; /* see comments in float_to_string */ float_to_string (pigbuf, XFLOAT(num)->data); return build_string (pigbuf); } #endif /* LISP_FLOAT_TYPE */ sprintf (buffer, "%d", XINT (num)); 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.") (str) register Lisp_Object str; { 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 */ return make_number (atoi (p)); } 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 int accum; register int next; #ifdef SWITCH_ENUM_BUG switch ((int) code) #else switch (code) #endif { 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 (XTYPE (val) == Lisp_Float) /* 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]); #ifdef SWITCH_ENUM_BUG switch ((int) code) #else switch (code) #endif { 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; } } XSET (val, Lisp_Int, accum); return val; } #ifdef LISP_FLOAT_TYPE 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 (XTYPE (val) == Lisp_Float) { next = XFLOAT (val)->data; } else { args[argnum] = val; /* runs into a compiler bug. */ next = XINT (args[argnum]); } #ifdef SWITCH_ENUM_BUG switch ((int) code) #else switch (code) #endif { 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 || next > accum) accum = next; break; case Amin: if (!argnum || 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); XSET (val, Lisp_Int, XINT (num1) % XINT (num2)); return val; } 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; int i1, i2; #ifdef LISP_FLOAT_TYPE CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 1); if (XTYPE (num1) == Lisp_Float || XTYPE (num2) == Lisp_Float) { double f1, f2; f1 = XTYPE (num1) == Lisp_Float ? XFLOAT (num1)->data : XINT (num1); f2 = XTYPE (num2) == Lisp_Float ? XFLOAT (num2)->data : XINT (num2); if (f2 == 0) Fsignal (Qarith_error, Qnil); #if defined (USG) || defined (sun) || defined (ultrix) || defined (hpux) f1 = fmod (f1, f2); #else f1 = drem (f1, f2); #endif /* If the "remainder" comes out with the wrong sign, fix it. */ if ((f1 < 0) != (f2 < 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 ((i1 < 0) != (i2 < 0)) i1 += i2; XSET (val, Lisp_Int, 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.") (num1, num2) register Lisp_Object num1, num2; { register Lisp_Object val; CHECK_NUMBER (num1, 0); CHECK_NUMBER (num2, 1); if (XINT (num2) > 0) XSET (val, Lisp_Int, XINT (num1) << XFASTINT (num2)); else XSET (val, Lisp_Int, XINT (num1) >> -XINT (num2)); 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.") (num1, num2) register Lisp_Object num1, num2; { register Lisp_Object val; CHECK_NUMBER (num1, 0); CHECK_NUMBER (num2, 1); if (XINT (num2) > 0) XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) << XFASTINT (num2)); else XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) >> -XINT (num2)); 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 (XTYPE (num) == Lisp_Float) return (make_float (1.0 + XFLOAT (num)->data)); #else CHECK_NUMBER_COERCE_MARKER (num, 0); #endif /* LISP_FLOAT_TYPE */ XSETINT (num, XFASTINT (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 (XTYPE (num) == Lisp_Float) return (make_float (-1.0 + XFLOAT (num)->data)); #else CHECK_NUMBER_COERCE_MARKER (num, 0); #endif /* LISP_FLOAT_TYPE */ XSETINT (num, XFASTINT (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, ~XFASTINT (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"); 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 */ Qcdr = intern ("cdr"); 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 (&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 (&Qboundp); staticpro (&Qfboundp); staticpro (&Qcdr); defsubr (&Seq); defsubr (&Snull); 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 (&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 (&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); } 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.22/src/dired.c100444 11732 1 44216 5446745011 13325 0ustar bfoxdaemon/* Lisp functions for making directory listings. 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 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. */ #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 #ifdef NONSYSTEM_DIR_LIBRARY #include "ndir.h" #else /* not NONSYSTEM_DIR_LIBRARY */ #include #endif /* not NONSYSTEM_DIR_LIBRARY */ #define DIRENTRY struct direct extern DIR *opendir (); extern struct direct *readdir (); #endif #include "lisp.h" #include "buffer.h" #include "commands.h" #include "regex.h" /* A search buffer, with a fastmap allocated and ready to go. */ extern struct re_pattern_buffer searchbuf; #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 Ffind_file_name_handler (); 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 length; Lisp_Object list, name, dirfilename; Lisp_Object handler; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (dirname); 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 compile_pattern (match, &searchbuf, 0, buffer_defaults.downcase_table->contents); #else compile_pattern (match, &searchbuf, 0, 0); #endif } /* Now searchbuf 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; length = XSTRING (dirname)->size; /* Loop reading blocks */ while (1) { DIRENTRY *dp = readdir (d); int len; if (!dp) break; len = NAMLEN (dp); if (dp->d_ino) { if (NILP (match) || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0))) { if (!NILP (full)) { int index = XSTRING (dirname)->size; int total = len + index; #ifndef VMS if (length == 0 || XSTRING (dirname)->data[length - 1] != '/') total++; #endif /* VMS */ name = make_uninit_string (total); bcopy (XSTRING (dirname)->data, XSTRING (name)->data, index); #ifndef VMS if (length == 0 || XSTRING (dirname)->data[length - 1] != '/') XSTRING (name)->data[index++] = '/'; #endif /* VMS */ bcopy (dp->d_name, XSTRING (name)->data + index, 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; /* Don't waste time trying to complete a null string. Besides, this case happens when user is being asked for a directory name and has supplied one ending in a /. We would not want to add anything in that case even if there are some unique characters in that directory. */ if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0) return file; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (dirname); 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 file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (dirname); 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; #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 */ dirname = Fexpand_file_name (dirname, Qnil); bestmatch = 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 (!dp->d_ino || 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) { /* 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 (XTYPE (elt) != Lisp_String) 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; } } /* Unless an ignored-extensions match was found, process this name as a completion */ if (passcount || !CONSP (tem)) { /* 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 && p1[matchsize] == '/') matchsize++; bestmatchsize = matchsize; } } } closedir (d); } unbind_to (count, Qnil); 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; char *fullname = (char *) alloca (len + pos + 2); bcopy (XSTRING (dirname)->data, fullname, pos); #ifndef VMS if (fullname[pos - 1] != '/') fullname[pos++] = '/'; #endif bcopy (dp->d_name, fullname + pos, len); fullname[pos + len] = 0; return stat (fullname, st_addr); } #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); if (!NILP (handler)) return call2 (handler, Qfile_attributes, filename); if (lstat (XSTRING (filename)->data, &s) < 0) return Qnil; 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 (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 */ values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; #endif /* BSD4_2 (or BSD4_3) */ #ifdef BSD4_3 #undef BSD4_2 /* ok, you can look again without throwing up */ #endif values[10] = make_number (s.st_ino); values[11] = make_number (s.st_dev); 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.22/src/dispnew.c100444 12120 1 171414 5473336120 13560 0ustar rmsdaemon/* Updating of data structures for redisplay. 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. */ #include #include #include #include #include "lisp.h" #include "termchar.h" #include "termopts.h" #include "termhooks.h" #include "cm.h" #include "dispextern.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 "systime.h" #ifdef HAVE_X_WINDOWS #include "xterm.h" #endif /* HAVE_X_WINDOWS */ #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) #ifndef PENDING_OUTPUT_COUNT /* 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. */ #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base) #endif /* 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; /* The currently selected frame. In a single-frame version, this variable always remains 0. */ 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 remains 0. */ 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; XSET (frame, Lisp_Frame, f); Fredraw_frame (frame); } #else DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 1, 1, "", "Clear frame FRAME and output again what is supposed to appear on it.") (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->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_X_WINDOWS if (FRAME_X_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 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); new->total_contents = (GLYPH *) xmalloc (total_glyphs); bzero (new->total_contents, 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; } return new; } static void free_frame_glyphs (frame, glyphs) FRAME_PTR frame; struct frame_glyphs *glyphs; { if (glyphs->total_contents) xfree (glyphs->total_contents); xfree (glyphs->used); xfree (glyphs->glyphs); xfree (glyphs->highlight); xfree (glyphs->enable); xfree (glyphs->bufp); #ifdef HAVE_X_WINDOWS if (FRAME_X_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 xfree (glyphs); } static 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); 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)); } /* 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] > hpos) 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) register FRAME_PTR frame; int from, end, amount; { register int i; register struct frame_glyphs *current_frame = FRAME_CURRENT_GLYPHS (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 *)); 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]); /* 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->enable[i] = 1; } safe_bcopy (current_frame->bufp + from, current_frame->bufp + from + amount, (end - from) * sizeof current_frame->bufp[0]); #ifdef HAVE_X_WINDOWS if (FRAME_X_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_X_WINDOWS */ 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 *)); 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]); /* 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->enable[i] = 1; } safe_bcopy (current_frame->bufp + from, current_frame->bufp + from + amount, (end - from) * sizeof current_frame->bufp[0]); #ifdef HAVE_X_WINDOWS if (FRAME_X_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_X_WINDOWS */ 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])); 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) desired_frame->glyphs[vpos][desired_frame->used[vpos]++] = SPACEGLYPH; bcopy (current_frame->glyphs[vpos] + end, desired_frame->glyphs[vpos] + end, ((current_frame->used[vpos] - end) * sizeof (current_frame->glyphs[vpos]))); 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 /* 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 has 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 (XFASTINT (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; { #ifdef HAVE_X_WINDOWS int dummy; int face = compute_char_face (frame, w, point - 1, -1, -1, &dummy, point); #else int face = 0; #endif current_frame->glyphs[vpos][hpos] = MAKE_GLYPH (g, face); } unchanged_modified = MODIFF; beg_unchanged = GPT - BEG; XFASTINT (w->last_point) = point; XFASTINT (w->last_point_x) = hpos; XFASTINT (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); int position; /* 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; #ifdef USE_TEXT_PROPERTIES /* Don't use direct output next to an invisible character since we might need to do something special. */ XFASTINT (position) = point; if (XFASTINT (position) < ZV && ! NILP (Fget_text_property (position, Qinvisible, Fcurrent_buffer ()))) return; XFASTINT (position) = point - 1; if (XFASTINT (position) >= BEGV && ! NILP (Fget_text_property (position, Qinvisible, Fcurrent_buffer ()))) return; #endif FRAME_CURSOR_X (frame) += n; XFASTINT (w->last_point_x) = FRAME_CURSOR_X (frame); XFASTINT (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 = FRAME_CURRENT_GLYPHS (f); register struct frame_glyphs *desired_frame = FRAME_DESIRED_GLYPHS (f); register int i; int pause; int preempt_count = baud_rate / 2400 + 1; extern input_pending; #ifdef HAVE_X_WINDOWS register int downto, leftmost; #endif 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; /* 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_X_WINDOWS if (FRAME_X_P (f)) { leftmost = downto = f->display.x->internal_border_width; 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) - f->display.x->internal_border_width - current_frame->pix_height[FRAME_HEIGHT (f) - 1]; current_frame->top_left_x[0] = leftmost; current_frame->top_left_y[0] = downto; } } #endif /* HAVE_X_WINDOWS */ /* 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 > 0) sleep (outq / baud_rate); } } if ((i - 1) % preempt_count == 0) detect_input_pending (); } update_line (f, i); #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) { current_frame->top_left_y[i] = downto; current_frame->top_left_x[i] = leftmost; } #endif /* HAVE_X_WINDOWS */ } #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) downto += current_frame->pix_height[i]; #endif } 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 && FRAME_HAS_MINIBUF_P (f)) { 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 (desired_frame->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 (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 (); } /* 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)); 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); } /* If changed lines are few, don't allow preemption, don't scroll. */ if (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 (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_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 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); /* 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 == 1 ? minibuf_prompt_width : 0), ZV, line, col, window_width, XINT (window->hscroll), 0); 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 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 (obody[olen - 1] == SPACEGLYPH && olen > 0) 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_X_WINDOWS if (FRAME_X_P (frame)) { current_frame->pix_width[vpos] = current_frame->used[vpos] * FONT_WIDTH (frame->display.x->font); current_frame->pix_height[vpos] = FONT_HEIGHT (frame->display.x->font); } #endif /* HAVE_X_WINDOWS */ 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; 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; 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; } 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 () { 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 (frame, newheight, newwidth, pretend, delay) register FRAME_PTR frame; int newheight, newwidth, pretend; { /* 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); XFASTINT (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; 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)) XSET (milliseconds, Lisp_Int, 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; XFASTINT (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 just 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 XSET (read_kbd, Lisp_Int, 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)) XSET (milliseconds, Lisp_Int, 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 */ /* 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 (&Sopen_termscript); defsubr (&Sding); defsubr (&Ssit_for); defsubr (&Ssleep_for); defsubr (&Ssend_string_to_terminal); 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 `x-set-face')."); 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.22/src/doc.c100444 12120 1 34010 5445053643 12627 0ustar rmsdaemon/* Record indices of function doc strings stored in a file. 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 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. */ #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 #include "lisp.h" #include "buffer.h" #include "keyboard.h" Lisp_Object Vdoc_file_name; Lisp_Object get_doc_string (filepos) long filepos; { char buf[512 * 32 + 1]; register int fd; register char *name; register char *p, *p1; register int count; extern char *index (); if (XTYPE (Vdata_directory) != Lisp_String || XTYPE (Vdoc_file_name) != Lisp_String) return Qnil; name = (char *) alloca (XSTRING (Vdata_directory)->size + XSTRING (Vdoc_file_name)->size + 8); strcpy (name, XSTRING (Vdata_directory)->data); strcat (name, XSTRING (Vdoc_file_name)->data); #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) error ("Cannot open doc string file \"%s\"", name); if (0 > lseek (fd, filepos, 0)) { close (fd); error ("Position %ld out of range in doc string file \"%s\"", filepos, name); } p = buf; while (p != buf + sizeof buf - 1) { count = read (fd, p, 512); p[count] = 0; if (!count) break; p1 = index (p, '\037'); if (p1) { *p1 = 0; p = p1; break; } p += count; } close (fd); return make_string (buf, p - buf); } 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); switch (XTYPE (fun)) { case Lisp_Subr: if (XSUBR (fun)->doc == 0) return Qnil; if ((int) XSUBR (fun)->doc >= 0) doc = build_string (XSUBR (fun)->doc); else doc = get_doc_string (- (int) XSUBR (fun)->doc); break; case Lisp_Compiled: if (XVECTOR (fun)->size <= COMPILED_DOC_STRING) return Qnil; tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING]; if (XTYPE (tem) == Lisp_String) doc = tem; else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) doc = get_doc_string (XFASTINT (tem)); else return Qnil; break; case Lisp_String: case Lisp_Vector: return build_string ("Keyboard macro."); case Lisp_Cons: funcar = Fcar (fun); if (XTYPE (funcar) != Lisp_Symbol) 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)) { tem = Fcar (Fcdr (Fcdr (fun))); if (XTYPE (tem) == Lisp_String) doc = tem; else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) doc = get_doc_string (XFASTINT (tem)); else return Qnil; break; } else if (EQ (funcar, Qmocklisp)) return Qnil; else if (EQ (funcar, Qmacro)) return Fdocumentation (Fcdr (fun), raw); /* Fall through to the default to report an error. */ default: return 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, 2, 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 (XTYPE (tem) == Lisp_Int) tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem)); if (NILP (raw) && XTYPE (tem) == Lisp_String) 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; int offset; { fun = indirect_function (fun); /* The type determines where the docstring is stored. */ /* Lisp_Subrs have a slot for it. */ if (XTYPE (fun) == Lisp_Subr) 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) && XTYPE (XCONS (tem)->car) == Lisp_Int) XFASTINT (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 (XTYPE (fun) == Lisp_Compiled) { /* This bytecode object must have a slot for the docstring, since we've found a docstring for it. */ if (XVECTOR (fun)->size <= COMPILED_DOC_STRING) abort (); XFASTINT (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 (Vdata_directory, 0); name = (char *) alloca (XSTRING (filename)->size + XSTRING (Vdata_directory)->size + 1); strcpy (name, XSTRING (Vdata_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 (XTYPE (sym) == Lisp_Symbol) { /* 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 = current_buffer->keymap; 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] == '[') { 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, Qnil, Qt, 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, 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.22/src/doprnt.c100444 12120 1 12664 5472176753 13413 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 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. */ #include #include #include /* 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. */ doprnt (buffer, bufsize, format, format_end, nargs, args) 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 */ 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]) + 50; /* Avoid pitfall of negative "size" parameter ("%-200d"). */ if (size_bound < 0) size_bound = -size_bound; /* 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 ("Format string wants too many arguments"); 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 ("Format string wants too many arguments"); 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 ("Format string wants too many arguments"); string = args[cnt++]; if (fmtcpy[1] != 's') minlen = atoi (&fmtcpy[1]); /* Copy string into final output, truncating if no room. */ doit: tem = strlen (string); if (minlen > 0) { while (minlen > tem && bufsize > 0) { *bufptr++ = ' '; bufsize--; minlen--; } minlen = 0; } if (tem > bufsize) tem = bufsize; strncpy (bufptr, string, 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 ("Format string wants too many arguments"); *bufptr++ = (int) args[cnt++]; bufsize--; continue; 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.22/src/editfns.c100444 12120 1 126616 5474357071 13560 0ustar rmsdaemon/* Lisp functions pertaining to editing. Copyright (C) 1985, 1986, 1987, 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 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. */ #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)) /* Some static data, and a function to initialize it for each run */ Lisp_Object Vsystem_name; Lisp_Object Vuser_real_name; /* login name of current user ID */ Lisp_Object Vuser_full_name; /* full name of current user */ Lisp_Object Vuser_name; /* user name from USER or LOGNAME. */ 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. */ Vsystem_name = build_string (get_system_name ()); p = XSTRING (Vsystem_name)->data; while (*p) { if (*p == ' ' || *p == '\t') *p = '-'; p++; } #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 ()); Vuser_real_name = build_string (pw ? pw->pw_name : "unknown"); /* Get the effective user name, by consulting environment variables, or the effective uid if those are unset. */ user_name = (char *) getenv ("USER"); if (!user_name) user_name = (char *) getenv ("LOGNAME"); if (!user_name) { pw = (struct passwd *) getpwuid (geteuid ()); user_name = (char *) (pw ? pw->pw_name : "unknown"); } Vuser_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_name, Vuser_real_name); if (NILP (tem)) pw = (struct passwd *) getpwnam (XSTRING (Vuser_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 = (char *) index (p, '&'); /* Substitute the login name for the &, upcasing the first character. */ if (q) { r = (char *) alloca (strlen (p) + XSTRING (Vuser_name)->size + 1); bcopy (p, r, q - p); r[q - p] = 0; strcat (r, XSTRING (Vuser_name)->data); r[q - p] = UPCASE (r[q - p]); strcat (r, q + 1); Vuser_full_name = build_string (r); } #endif /* AMPERSAND_FULL_NAME */ } 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) XFASTINT (val) = ((unsigned char *) p->data)[0]; else XFASTINT (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; XFASTINT (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)); } #if 0 /* now in lisp code */ DEFUN ("mark", Fmark, Smark, 0, 0, 0, "Return this buffer's mark value as integer, or nil if no mark.\n\ If you are using this in an editing command, you are most likely making\n\ a mistake; see the documentation of `set-mark'.") () { return Fmarker_position (current_buffer->mark); } #endif /* commented out code */ 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; } #if 0 /* this is now in lisp code */ DEFUN ("set-mark", Fset_mark, Sset_mark, 1, 1, 0, "Set this buffer's mark to POS. Don't use this function!\n\ That is to say, don't use this function unless you want\n\ the user to see that the mark has moved, and you want the previous\n\ mark position to be lost.\n\ \n\ Normally, when a new mark is set, the old one should go on the stack.\n\ This is why most applications should use push-mark, not set-mark.\n\ \n\ Novice programmers often try to use the mark for the wrong purposes.\n\ The mark saves a location for the user's convenience.\n\ Most editing commands should not alter the mark.\n\ To remember a location for internal use in the Lisp program,\n\ store it in a Lisp variable. Example:\n\ \n\ (let ((beg (point))) (forward-line 1) (delete-region beg (point))).") (pos) Lisp_Object pos; { if (NILP (pos)) { current_buffer->mark = Qnil; return Qnil; } CHECK_NUMBER_COERCE_MARKER (pos, 0); if (NILP (current_buffer->mark)) current_buffer->mark = Fmake_marker (); Fset_marker (current_buffer->mark, pos, Qnil); return pos; } #endif /* commented-out code */ 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), Fcons (visible ? Qt : Qnil, current_buffer->mark_active))); } Lisp_Object save_excursion_restore (info) register Lisp_Object info; { register Lisp_Object tem, tem1; 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)); Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ()); 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 (current_buffer->mark_active)) call1 (Vrun_hooks, intern ("activate-mark-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; XFASTINT (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; XFASTINT (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; XFASTINT (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) XFASTINT (temp) = 0; else XFASTINT (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) XFASTINT (temp) = 0; else XFASTINT (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; XFASTINT (val) = FETCH_CHAR (n); return val; } DEFUN ("user-login-name", Fuser_login_name, Suser_login_name, 0, 0, 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 USER or LOGNAME is set,\n\ that determines the value of this function.") () { return Vuser_name; } 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\ Differs from `user-login-name' when running under `su'.") () { return Vuser_real_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; } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, "Return the current time, as the number of seconds since 12:00 AM January 1970.\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); XSET (result[0], Lisp_Int, (EMACS_SECS (t) >> 16) & 0xffff); XSET (result[1], Lisp_Int, (EMACS_SECS (t) >> 0) & 0xffff); XSET (result[2], Lisp_Int, 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 (XTYPE (low) == Lisp_Cons) low = Fcar (low); CHECK_NUMBER (low, 0); *result = (XINT (high) << 16) + (XINT (low) & 0xffff); return *result >> 16 == XINT (high); } } 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); return ( ( ( /* 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 )*24 + (a->tm_hour - b->tm_hour) )*60 + (a->tm_min - b->tm_min) )*60 + (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 = 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); } 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 (XTYPE (tem) == Lisp_Int) { str[0] = XINT (tem); insert (str, 1); } else if (XTYPE (tem) == Lisp_String) { 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 (XTYPE (tem) == Lisp_Int) { str[0] = XINT (tem); insert (str, 1); } else if (XTYPE (tem) == Lisp_String) { 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 (XTYPE (tem) == Lisp_Int) { str[0] = XINT (tem); insert_before_markers (str, 1); } else if (XTYPE (tem) == Lisp_String) { 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 (XTYPE (tem) == Lisp_Int) { str[0] = XINT (tem); insert_before_markers (str, 1); } else if (XTYPE (tem) == Lisp_String) { 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, 2, 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.") (chr, count) Lisp_Object chr, count; { 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) { insert (string, strlen); n -= strlen; } if (n > 0) 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; 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)); #ifdef USE_TEXT_PROPERTIES if (XINT (tem) != end) 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.") () { 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, len, opoint, start; 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; /* Move the gap or create enough gap in the current buffer. */ if (point != GPT) move_gap (point); if (GAP_SIZE < end - beg) make_gap (end - beg - GAP_SIZE); len = end - beg; start = beg; opoint = point; if (!(BUF_BEGV (bp) <= beg && beg <= end && end <= BUF_ZV (bp))) args_out_of_range (b, e); /* Now the actual insertion will not do any gap motion, so it matters not if BUF is the current buffer. */ if (beg < BUF_GPT (bp)) { insert (BUF_CHAR_ADDRESS (bp, beg), min (end, BUF_GPT (bp)) - beg); beg = min (end, BUF_GPT (bp)); } if (beg < end) insert (BUF_CHAR_ADDRESS (bp, beg), end - beg); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ graft_intervals_into_buffer (copy_intervals (bp->intervals, start, len), opoint, len, current_buffer, 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); } 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; validate_region (&start, &end); CHECK_NUMBER (fromchar, 2); CHECK_NUMBER (tochar, 3); pos = XINT (start); stop = XINT (end); look = XINT (fromchar); if (! NILP (noundo)) { if (MODIFF - 1 == current_buffer->save_modified) current_buffer->save_modified++; if (MODIFF - 1 == current_buffer->auto_save_modified) current_buffer->auto_save_modified++; } while (pos < stop) { if (FETCH_CHAR (pos) == look) { if (! changed) { modify_region (current_buffer, XINT (start), stop); 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)); 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; } } } XFASTINT (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); 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; { register int i; CHECK_NUMBER_COERCE_MARKER (b, 0); CHECK_NUMBER_COERCE_MARKER (e, 1); if (XINT (b) > XINT (e)) { i = XFASTINT (b); b = e; XFASTINT (e) = i; } 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)); 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. */ XFASTINT (bottom) = BEGV - BEG; XFASTINT (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); 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); } DEFUN ("message", Fmessage, Smessage, 1, MANY, 0, "Print a one-line message at the bottom of the screen.\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); message ("%s", XSTRING (val)->data); return val; } } 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\ %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 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) total += minlen; else total -= minlen; while ((*format >= '0' && *format <= '9') || *format == '-' || *format == ' ' || *format == '.') format++; if (*format == '%') format++; else if (++n >= nargs) ; 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 (XTYPE (args[n]) == Lisp_Symbol) { XSET (args[n], Lisp_String, XSYMBOL (args[n])->name); goto string; } else if (XTYPE (args[n]) == Lisp_String) { string: total += XSTRING (args[n])->size; } /* Would get MPV otherwise, since Lisp_Int's `point' to low memory. */ else if (XTYPE (args[n]) == Lisp_Int && *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 += 10; } #ifdef LISP_FLOAT_TYPE else if (XTYPE (args[n]) == Lisp_Float && *format != 's') { if (! (*format == 'e' || *format == 'f' || *format == 'g')) args[n] = Ftruncate (args[n]); total += 20; } #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 (XTYPE (args[n]) == Lisp_Int) /* We checked above that the corresponding format effector isn't %s, which would cause MPV. */ strings[i++] = (unsigned char *) XINT (args[n]); #ifdef LISP_FLOAT_TYPE else if (XTYPE (args[n]) == Lisp_Float) { union { double d; int 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 strings[i++] = XSTRING (args[n])->data; } /* 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 (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) int arg0, arg1, arg2, arg3, arg4; #else format1 (string1) #endif char *string1; { char buf[100]; #ifdef NO_ARG_ARRAY int args[5]; args[0] = arg0; args[1] = arg1; args[2] = arg2; args[3] = arg3; args[4] = arg4; doprnt (buf, sizeof buf, string1, 0, 5, args); #else doprnt (buf, sizeof buf, string1, 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; { unsigned char *downcase = DOWNCASE_TABLE; CHECK_NUMBER (c1, 0); CHECK_NUMBER (c2, 1); if (!NILP (current_buffer->case_fold_search) ? (downcase[0xff & XFASTINT (c1)] == downcase[0xff & XFASTINT (c2)] && (XFASTINT (c1) & ~0xff) == (XFASTINT (c2) & ~0xff)) : XINT (c1) == XINT (c2)) return Qt; return Qnil; } void syms_of_editfns () { staticpro (&Vuser_name); staticpro (&Vuser_full_name); staticpro (&Vuser_real_name); staticpro (&Vsystem_name); 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 (&Scurrent_time); defsubr (&Scurrent_time_string); defsubr (&Scurrent_time_zone); defsubr (&Ssystem_name); defsubr (&Smessage); 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); } emacs-19.22/src/emacs.c100444 12120 1 55773 5475043114 13170 0ustar rmsdaemon/* Fully extensible Emacs, running on Unix, intended for GNU. 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. */ #include #include #include #include #include #include #ifdef VMS #include #endif #ifdef BSD #include #endif #ifdef APOLLO #ifndef APOLLO_SR10 #include #endif #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 /* 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; /* 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; /* 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; #ifdef BSD /* 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_X_WINDOWS extern Lisp_Object Vwindow_system; #endif /* HAVE_X_WINDOWS */ #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; /* 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. */ sigunblock (sigmask (fatal_error_code)); kill (getpid (), fatal_error_code); #endif /* not VMS */ } /* 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; 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); } 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__ __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 }; __main () {} #endif /* __GNUC__ */ #endif /* ORDINARY_LINK */ /* 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; extern char *sys_errlist[]; extern void malloc_warning (); /* Map in shared memory, if we are using that. */ #ifdef HAVE_SHM if (argc > 1 && !strcmp (argv[1], "-nl")) { 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 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. */ { int i; for (i = 1; (i < argc && ! display_arg); i++) if (!strcmp (argv[i], "-d") || !strcmp (argv[i], "-display")) display_arg = 1; } #endif #ifdef VMS /* If -map specified, map the data file in */ if (argc > 2 && ! strcmp (argv[1], "-map")) { skip_args = 2; mapin_data (argv[2]); } #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 (bss_end); #endif clearerr (stdin); #ifdef BSD { inherited_pgroup = EMACS_GETPGRP (0); setpgrp (0, getpid ()); } #endif #ifdef APOLLO #ifndef APOLLO_SR10 /* If USE_DOMAIN_ACLS environment variable exists, use ACLs rather than UNIX modes. */ if (egetenv ("USE_DOMAIN_ACLS")) default_acl (USE_DEFACL); #endif #endif /* APOLLO */ #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 PRIO_PROCESS if (emacs_priority) nice (emacs_priority); setuid (getuid ()); #endif /* PRIO_PROCESS */ inhibit_window_system = 0; /* Handle the -t switch, which specifies filename to use as terminal */ if (skip_args + 2 < argc && !strcmp (argv[skip_args + 1], "-t")) { int result; skip_args += 2; close (0); close (1); result = open (argv[skip_args], O_RDWR, 2 ); if (result < 0) { char *errstring; if (errno >= 0 && errno < sys_nerr) errstring = sys_errlist[errno]; else errstring = "undocumented error code"; fprintf (stderr, "emacs: %s: %s\n", argv[skip_args], errstring); exit (1); } dup (0); if (! isatty (0)) { fprintf (stderr, "emacs: %s: not a tty\n", argv[skip_args]); exit (1); } fprintf (stderr, "Using %s\n", argv[skip_args]); #ifdef HAVE_X_WINDOWS inhibit_window_system = 1; /* -t => -nw */ #endif } if (skip_args + 1 < argc && (!strcmp (argv[skip_args + 1], "-nw"))) { skip_args += 1; inhibit_window_system = 1; } /* Handle the -batch switch, which means don't do interactive display. */ noninteractive = 0; if (skip_args + 1 < argc && !strcmp (argv[skip_args + 1], "-batch")) { skip_args += 1; noninteractive = 1; } #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 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 AIX signal (SIGDANGER, fatal_error_signal); signal (20, fatal_error_signal); signal (21, fatal_error_signal); signal (22, fatal_error_signal); signal (24, fatal_error_signal); #if 0 /* mvn@library.ucla.edu says these are SIGIO on AIX 3.2.4. */ signal (23, fatal_error_signal); #ifdef SIGIO signal (SIGAIO, fatal_error_signal); signal (SIGPTY, fatal_error_signal); #endif #endif #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 (); /* 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 (); 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_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 */ #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) { /* Handle -l loadup-and-dump, args passed by Makefile. */ if (argc > 2 + skip_args && !strcmp (argv[1 + skip_args], "-l")) Vtop_level = Fcons (intern ("load"), Fcons (build_string (argv[2 + skip_args]), Qnil)); #ifdef CANNOT_DUMP /* Unless next switch is -nl, load "loadup.el" first thing. */ if (!(argc > 1 + skip_args && !strcmp (argv[1 + skip_args], "-nl"))) Vtop_level = Fcons (intern ("load"), Fcons (build_string ("loadup.el"), Qnil)); #endif /* CANNOT_DUMP */ } initialized = 1; #if defined (sun) || defined (LOCALTIME_CACHE) /* sun's localtime has a bug. it caches 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 (sun) || defined (LOCALTIME_CACHE) */ /* Enter editor command loop. This never returns. */ Frecursive_edit (); /* NOTREACHED */ } 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); exit ((XTYPE (arg) == Lisp_Int) ? 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; { /* 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 #ifdef HAVE_X_WINDOWS if (!noninteractive && EQ (Vwindow_system, intern ("x")) && ! no_x) Fx_close_current_connection (); #endif /* HAVE_X_WINDOWS */ #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 /* Nothing like this can be implemented on an Apollo. What a loss! */ #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 int my_edata; Lisp_Object tem; extern void malloc_warning (); 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 int my_edata; Lisp_Object tem; extern void malloc_warning (); 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 memory_warnings (&my_edata, malloc_warning); #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; extern char *index (); 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) : Qnil, 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_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."); 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.)"); emacs_priority = 0; staticpro (&Vinvocation_name); Vinvocation_name = Qnil; staticpro (&Vinvocation_directory); Vinvocation_directory = Qnil; } emacs-19.22/src/eval.c100444 12120 1 206547 5450410755 13046 0ustar rmsdaemon/* Evaluator for GNU Emacs Lisp interpreter. 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 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. */ #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 funcall_lambda (); extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */ init_eval_once () { specpdl_size = 50; specpdl = (struct specbinding *) malloc (specpdl_size * sizeof (struct specbinding)); max_specpdl_size = 600; max_lisp_eval_depth = 200; } init_eval () { specpdl_ptr = specpdl; catchlist = 0; handlerlist = 0; backtrace_list = 0; Vquit_flag = Qnil; debug_on_next_call = 0; lisp_eval_depth = 0; when_entered_debugger = 0; } 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), XTYPE (tem) == Lisp_Symbol)) { 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, "(prog1 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 SYMs are not evaluated. Thus (setq x y) sets x to the value of y.\n\ Each SYM is set before the next VAL is computed.") (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 (XTYPE (fun) == Lisp_Subr && (struct Lisp_Subr *) XPNTR (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 (XTYPE (fun) == Lisp_Subr) 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; sym = Fcar (args); tem = Fcdr (args); if (!NILP (tem)) { tem = Fdefault_boundp (sym); if (NILP (tem)) 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 ("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); 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 (XTYPE (documentation) == Lisp_Int && XINT (documentation) < 0) return Qt; if ((XTYPE (documentation) == Lisp_String) && ((unsigned char) XSTRING (documentation)->data[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 (XTYPE (elt) == Lisp_Symbol) 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 (XTYPE (elt) == Lisp_Symbol) 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 (XTYPE (elt) == Lisp_Symbol) 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 (XTYPE (form) != Lisp_Cons) 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 (XTYPE (def) == Lisp_Symbol) { 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) || XTYPE (def) != Lisp_Cons) /* 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 (XCONS (tem)->car, Qt) || EQ (XCONS (tem)->car, 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\ 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) || (XTYPE (XCONS (tem)->car) != Lisp_Symbol))) 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, Fcdr (c.val)); val = Fprogn (Fcdr (Fcar (c.val))); /* 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; 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) (Fcdr (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; } static Lisp_Object find_handler_clause (); DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, "Signal an error. Args are SIGNAL-NAME, and associated DATA.\n\ This function does not return.\n\n\ A signal name 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'.") (sig, data) Lisp_Object sig, 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 (sig, Qerror_conditions); for (; handlerlist; handlerlist = handlerlist->next) { register Lisp_Object clause; clause = find_handler_clause (handlerlist->handler, conditions, sig, 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 (sig, Qquit)) return Qnil; else error ("Cannot return from the debugger in an error"); } #endif if (!NILP (clause)) { struct handler *h = handlerlist; handlerlist = allhandlers; unwind_to_catch (h->tag, Fcons (clause, Fcons (sig, 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, sig, 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; register Lisp_Object tem1; 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)) { tem1 = Fcar (h); if (!CONSP (tem1)) continue; tem = Fmemq (Fcar (tem1), conditions); if (!NILP (tem)) return tem1; } return Qnil; } /* dump an error message; called like printf */ /* VARARGS 1 */ void error (m, a1, a2, a3) char *m; { char buf[200]; sprintf (buf, m, a1, a2, a3); while (1) Fsignal (Qerror, Fcons (build_string (buf), 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 (XTYPE (fun) == Lisp_Subr) { 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 (XTYPE (fun) == Lisp_Compiled) return (XVECTOR (fun)->size > COMPILED_INTERACTIVE ? Qt : Qnil); /* Strings and vectors are keyboard macros. */ if (XTYPE (fun) == Lisp_String || XTYPE (fun) == Lisp_Vector) return Qt; /* Lists may represent commands. */ if (!CONSP (fun)) return Qnil; funcar = Fcar (fun); if (XTYPE (funcar) != Lisp_Symbol) 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) && !(XTYPE (XSYMBOL (function)->function) == Lisp_Cons && 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 (XTYPE (form) == Lisp_Symbol) { if (EQ (Vmocklisp_arguments, Qt)) return Fsymbol_value (form); val = Fsymbol_value (form); if (NILP (val)) XFASTINT (val) = 0; else if (EQ (val, Qt)) XFASTINT (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 (XTYPE (fun) == Lisp_Subr) { 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 (XTYPE (fun) == Lisp_Compiled) val = apply_lambda (fun, original_args, 1); else { if (!CONSP (fun)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); funcar = Fcar (fun); if (XTYPE (funcar) != Lisp_Symbol) 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)) XFASTINT (val) = 0; else if (EQ (val, Qt)) XFASTINT (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\ 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 (XTYPE (fun) == Lisp_Subr) { 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)); } /* 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\ 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 (XTYPE (fun) == Lisp_Subr) { if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XFASTINT (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 (XTYPE (fun) == Lisp_Compiled) val = funcall_lambda (fun, numargs, args + 1); else { if (!CONSP (fun)) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); funcar = Fcar (fun); if (XTYPE (funcar) != Lisp_Symbol) 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! */ XFASTINT (numargs) = nargs; if (XTYPE (fun) == Lisp_Cons) syms_left = Fcar (Fcdr (fun)); else if (XTYPE (fun) == Lisp_Compiled) 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 (XTYPE (next) != Lisp_Symbol) 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 (XTYPE (fun) == Lisp_Cons) val = Fprogn (Fcdr (Fcdr (fun))); else val = Fbyte_code (XVECTOR (fun)->contents[COMPILED_BYTECODE], XVECTOR (fun)->contents[COMPILED_CONSTANTS], XVECTOR (fun)->contents[COMPILED_STACK_DEPTH]); return unbind_to (count, val); } 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; { extern void store_symval_forwarding (); /* in eval.c */ Lisp_Object ovalue; CHECK_SYMBOL (symbol, 0); if (specpdl_ptr == specpdl + specpdl_size) grow_specpdl (); specpdl_ptr->symbol = symbol; specpdl_ptr->func = 0; ovalue = XSYMBOL (symbol)->value; specpdl_ptr->old_value = EQ (ovalue, Qunbound) ? Qunbound : Fsymbol_value (symbol); specpdl_ptr++; if (XTYPE (ovalue) == Lisp_Buffer_Objfwd) 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; XFASTINT (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); } 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; 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)."); Vrun_hooks = Qnil; 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 (&Sbacktrace_debug); defsubr (&Sbacktrace); defsubr (&Sbacktrace_frame); } emacs-19.22/src/fileio.c100444 12120 1 310756 5474360447 13374 0ustar rmsdaemon/* File IO for GNU Emacs. 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. */ #include #include #include #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 #include #ifdef VMS #include "dir.h" #include #include #include #endif #include #ifndef vax11c extern int errno; extern char *sys_errlist[]; extern int sys_nerr; #endif #define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error") #ifdef APOLLO #include #endif #ifndef USG #ifndef VMS #ifndef BSD4_1 #define HAVE_FSYNC #endif #endif #endif #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "window.h" #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 #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; /* 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; /* 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; 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; if (errno >= 0 && errno < sys_nerr) errstring = build_string (sys_errlist[errno]); else errstring = build_string ("undocumented error code"); /* 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)); } Lisp_Object Qexpand_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; 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_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, 1, 1, 0, "Return FILENAME's handler function, if its syntax is handled specially.\n\ Otherwise, return nil.\n\ A file name is handled if one of the regular expressions in\n\ `file-name-handler-alist' matches it.") (filename) Lisp_Object filename; { /* This function must not munge the match data. */ Lisp_Object chain; CHECK_STRING (filename, 0); for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons; chain = XCONS (chain)->cdr) { Lisp_Object elt; elt = XCONS (chain)->car; if (XTYPE (elt) == Lisp_Cons) { Lisp_Object string; string = XCONS (elt)->car; if (XTYPE (string) == Lisp_String && fast_string_match (string, filename) >= 0) return XCONS (elt)->cdr; } 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); if (!NILP (handler)) return call2 (handler, Qfile_name_directory, file); beg = XSTRING (file)->data; p = beg + XSTRING (file)->size; while (p != beg && p[-1] != '/' #ifdef VMS && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ ) p--; if (p == beg) return Qnil; 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); if (!NILP (handler)) return call2 (handler, Qfile_name_nondirectory, file); beg = XSTRING (file)->data; end = p = beg + XSTRING (file)->size; while (p != beg && 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); 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 (out[size] != '/') strcat (out, "/"); #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); 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); if (slen > 1 && dst[slen - 1] == '/') dst[slen - 1] = 0; 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); 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 */ 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); 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); /* 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)->data[0] != '/') { 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 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 */ ) { /* 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 "/". */ /* "//" anywhere isn't necessarily hairy; we just start afresh with the second slash. */ if (p[0] == '/' && p[1] == '/' #ifdef APOLLO /* // at start of filename is meaningful on Apollo system */ && nm != p #endif /* APOLLO */ ) nm = p + 1; /* "~" is hairy as the start of any path element. */ if (p[0] == '/' && p[1] == '~') nm = p + 1, lose = 1; /* "." and ".." are hairy. */ 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) /* ~ by itself */ { 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 */ { for (p = nm; *p && (*p != '/' #ifdef VMS && *p != ':' #endif /* VMS */ ); p++); o = (unsigned char *) alloca (p - nm + 1); bcopy ((char *) nm, o, p - nm); o [p - nm] = 0; 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 */ } /* If we don't find a user of that name, leave the name unchanged; don't move nm forward to p. */ } } if (nm[0] != '/' #ifdef VMS && !index (nm, ':') #endif /* not VMS */ && !newdir) { newdir = XSTRING (defalt)->data; } 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. */ if (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; 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)) { /* If "/." is the entire filename, keep the "/". Otherwise, just delete the whole "/.". */ if (o == target && p[2] == '\0') *o++ = *p; 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); } #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; CHECK_STRING (string, 0); nm = XSTRING (string)->data; 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 */ p[0] == '/' #endif /* not APOLLO */ ) && p != nm && #ifdef VMS (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' || #endif /* VMS */ p[-1] == '/') #ifdef VMS ) #endif /* VMS */ { nm = p; substituted = 1; } } #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; /* Get variable value */ o = (unsigned char *) egetenv (target); /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */ #if 0 #ifdef USG if (!o && !strcmp (target, "USER")) o = egetenv ("LOGNAME"); #endif /* USG */ #endif /* 0 */ 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; /* Get variable value */ o = (unsigned char *) egetenv (target); /* The presence of this code makes vax 5.0 crash, for reasons yet unknown */ #if 0 #ifdef USG if (!o && !strcmp (target, "USER")) o = egetenv ("LOGNAME"); #endif /* USG */ #endif /* 0 */ 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 */ p[0] == '/' #endif /* not APOLLO */ ) && p != nm && p[-1] == '/') xnm = p; 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 && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/') /* We cannot take shortcuts; they might be wrong for magic file names. */ abspath = Fdirectory_file_name (abspath); #endif return abspath; } barf_or_query_if_file_exists (absname, querystring, interactive) Lisp_Object absname; unsigned char *querystring; int interactive; { register Lisp_Object tem; struct gcpro gcpro1; if (access (XSTRING (absname)->data, 4) >= 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))); } 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; Lisp_Object handler; struct gcpro gcpro1, gcpro2; int count = specpdl_ptr - specpdl; Lisp_Object args[6]; 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); /* Likewise for output file name. */ if (NILP (handler)) handler = Ffind_file_name_handler (newname); if (!NILP (handler)) return call5 (handler, Qcopy_file, filename, newname, ok_if_already_exists, keep_date); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "copy to it", XTYPE (ok_if_already_exists) == Lisp_Int); ifd = open (XSTRING (filename)->data, 0); 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); #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 ofd = creat (XSTRING (newname)->data, 0666); #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; 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); EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime); } #ifdef APOLLO if (!egetenv ("USE_DOMAIN_ACLS")) #endif chmod (XSTRING (newname)->data, st.st_mode & 07777); } /* Discard the unwind protects. */ specpdl_ptr = specpdl + count; close (ifd); if (close (ofd) < 0) report_file_error ("I/O error", Fcons (newname, Qnil)); 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); if (!NILP (handler)) return call3 (handler, Qmake_directory, dirname, Qnil); dir = XSTRING (dirname)->data; if (mkdir (dir, 0777) != 0) 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 string.") (dirname) Lisp_Object dirname; { unsigned char *dir; Lisp_Object handler; CHECK_STRING (dirname, 0); dirname = Fexpand_file_name (dirname, Qnil); dir = XSTRING (dirname)->data; handler = Ffind_file_name_handler (dirname); 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); 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; } 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); if (NILP (handler)) handler = Ffind_file_name_handler (newname); if (!NILP (handler)) return call4 (handler, Qrename_file, filename, newname, ok_if_already_exists); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "rename to it", XTYPE (ok_if_already_exists) == Lisp_Int); #ifndef BSD4_1 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data)) #else if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data) || 0 > unlink (XSTRING (filename)->data)) #endif { if (errno == EXDEV) { 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); if (!NILP (handler)) return call4 (handler, Qadd_name_to_file, filename, newname, ok_if_already_exists); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "make it a new name", XTYPE (ok_if_already_exists) == Lisp_Int); 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 } 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 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 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 0 /* This made it impossible to make a link to a relative name. */ filename = Fexpand_file_name (filename, Qnil); #endif 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); if (!NILP (handler)) return call4 (handler, Qmake_symbolic_link, filename, linkname, ok_if_already_exists); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (linkname, "make it a link", XTYPE (ok_if_already_exists) == Lisp_Int); 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)) 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 (*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 */ ) return Qt; else return Qnil; } 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; 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); if (!NILP (handler)) return call2 (handler, Qfile_exists_p, abspath); return (access (XSTRING (abspath)->data, 0) >= 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); if (!NILP (handler)) return call2 (handler, Qfile_executable_p, abspath); return (access (XSTRING (abspath)->data, 1) >= 0) ? 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; 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); if (!NILP (handler)) return call2 (handler, Qfile_readable_p, abspath); return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil; } DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, "If file FILENAME is the name of a symbolic link\n\ returns 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); 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 */ } #ifdef SOLARIS_BROKEN_ACCESS /* In Solaris 2.1, the readonly-ness of the filesystem is not considered by the access system call. This is Sun's bug, but we still have to make Emacs work. */ #include static int ro_fsys (path) char *path; { struct statvfs statvfsb; if (statvfs(path, &statvfsb)) return 1; /* error from statvfs, be conservative and say not wrtable */ else /* Otherwise, fsys is ro if bit is set. */ return statvfsb.f_flag & ST_RDONLY; } #else /* But on every other os, access has already done the right thing. */ #define ro_fsys(path) 0 #endif /* 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; 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); if (!NILP (handler)) return call2 (handler, Qfile_writable_p, abspath); if (access (XSTRING (abspath)->data, 0) >= 0) return ((access (XSTRING (abspath)->data, 2) >= 0 && ! ro_fsys ((char *) XSTRING (abspath)->data)) ? Qt : Qnil); dir = Ffile_name_directory (abspath); #ifdef VMS if (!NILP (dir)) dir = Fdirectory_file_name (dir); #endif /* VMS */ return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0 && ! ro_fsys ((char *) XSTRING (dir)->data)) ? Qt : Qnil); } 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); 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; /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call2 (handler, Qfile_accessible_directory_p, filename); if (NILP (Ffile_directory_p (filename)) || NILP (Ffile_executable_p (filename))) return Qnil; else return Qt; } 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); if (!NILP (handler)) return call2 (handler, Qfile_modes, abspath); if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; 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); if (!NILP (handler)) return call3 (handler, Qset_file_modes, abspath, mode); #ifndef APOLLO if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (abspath, Qnil)); #else /* APOLLO */ if (!egetenv ("USE_DOMAIN_ACLS")) { struct stat st; struct timeval tvp[2]; /* chmod on apollo also change the file's modtime; need to save the modtime and then restore it. */ if (stat (XSTRING (abspath)->data, &st) < 0) { report_file_error ("Doing chmod", Fcons (abspath, Qnil)); return (Qnil); } if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (abspath, Qnil)); /* reset the old accessed and modified times. */ tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */ tvp[0].tv_usec = 0; tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */ tvp[1].tv_usec = 0; if (utimes (XSTRING (abspath)->data, tvp) < 0) report_file_error ("Doing utimes", Fcons (abspath, Qnil)); } #endif /* APOLLO */ 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); XSET (value, Lisp_Int, (~ 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); if (NILP (handler)) handler = Ffind_file_name_handler (abspath2); 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; } DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, 1, 4, 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.") (filename, visit, beg, end) Lisp_Object filename, visit, beg, end; { struct stat st; register int fd; register int inserted = 0; register int how_much; int count = specpdl_ptr - specpdl; struct gcpro gcpro1, gcpro2; Lisp_Object handler, val, insval; Lisp_Object p; int total; val = Qnil; p = Qnil; GCPRO2 (filename, p); if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only(); 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); if (!NILP (handler)) { val = call5 (handler, Qinsert_file_contents, filename, visit, beg, end); st.st_mtime = 0; goto handled; } fd = -1; #ifndef APOLLO if (stat (XSTRING (filename)->data, &st) < 0 || (fd = open (XSTRING (filename)->data, 0)) < 0) #else if ((fd = open (XSTRING (filename)->data, 0)) < 0 || fstat (fd, &st) < 0) #endif /* not APOLLO */ { if (fd >= 0) close (fd); if (NILP (visit)) report_file_error ("Opening input file", Fcons (filename, Qnil)); st.st_mtime = -1; how_much = 0; goto notfound; } record_unwind_protect (close_file_unwind, make_number (fd)); #ifdef S_IFSOCK /* 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 ((st.st_mode & S_IFMT) == S_IFSOCK) Fsignal (Qfile_error, Fcons (build_string ("reading from named pipe"), Fcons (filename, Qnil))); #endif /* 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 XFASTINT (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"); } total = XINT (end) - XINT (beg); { register Lisp_Object temp; /* Make sure point-max won't overflow after this insertion. */ XSET (temp, Lisp_Int, 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) { if (lseek (fd, XINT (beg), 0) < 0) report_file_error ("Setting file position", Fcons (filename, Qnil)); } while (1) { int try = 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, try); immediate_quit = 0; if (this <= 0) { how_much = this; break; } GPT += this; GAP_SIZE -= this; ZV += this; Z += this; inserted += this; } 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 */ specpdl_ptr = specpdl + count; if (how_much < 0) error ("IO error reading %s: %s", XSTRING (filename)->data, err_str (errno)); notfound: handled: if (!NILP (visit)) { current_buffer->undo_list = Qnil; #ifdef APOLLO stat (XSTRING (filename)->data, &st); #endif current_buffer->modtime = st.st_mtime; current_buffer->save_modified = MODIFF; current_buffer->auto_save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; #ifdef CLASH_DETECTION if (NILP (handler)) { if (!NILP (current_buffer->filename)) unlock_file (current_buffer->filename); unlock_file (filename); } #endif /* CLASH_DETECTION */ current_buffer->filename = filename; /* If visiting nonexistent file, return nil. */ if (current_buffer->modtime == -1) report_file_error ("Opening input file", Fcons (filename, Qnil)); } if (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)) RETURN_UNGCPRO (val); RETURN_UNGCPRO (Fcons (filename, Fcons (make_number (inserted), Qnil))); } static Lisp_Object build_annotations (); DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5, "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\ 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) Lisp_Object start, end, filename, append, visit; { register int desc; int failure; int save_errno; unsigned char *fn; struct stat st; int tem; int count = specpdl_ptr - specpdl; #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; /* Special kludge to simplify auto-saving */ if (NILP (start)) { XFASTINT (start) = BEG; XFASTINT (end) = Z; } else if (XTYPE (start) != Lisp_String) validate_region (&start, &end); filename = Fexpand_file_name (filename, Qnil); if (XTYPE (visit) == Lisp_String) visit_file = Fexpand_file_name (visit, Qnil); else visit_file = filename; visiting = (EQ (visit, Qt) || XTYPE (visit) == Lisp_String); quietly = !NILP (visit); annotations = Qnil; GCPRO4 (start, filename, annotations, visit_file); /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename); if (!NILP (handler)) { Lisp_Object val; val = call6 (handler, Qwrite_region, start, end, filename, append, visit); /* 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 = 0; current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; current_buffer->filename = visit_file; } UNGCPRO; return val; } annotations = build_annotations (start, end); #ifdef CLASH_DETECTION if (!auto_saving) lock_file (visit_file); #endif /* CLASH_DETECTION */ fn = XSTRING (filename)->data; desc = -1; if (!NILP (append)) desc = open (fn, O_WRONLY); 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 (XTYPE (current_buffer->filename) == Lisp_String ? 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 */ desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); #endif /* not VMS */ UNGCPRO; if (desc < 0) { #ifdef CLASH_DETECTION save_errno = errno; if (!auto_saving) unlock_file (visit_file); 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 (visit_file); #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 (XTYPE (start) == Lisp_String) { 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; } if (nwritten == 0) { /* 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) 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 */ specpdl_ptr = specpdl + count; #ifdef CLASH_DETECTION if (!auto_saving) unlock_file (visit_file); #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, err_str (save_errno)); if (visiting) { current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; current_buffer->filename = visit_file; } 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. */ 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)) { res = call2 (Fcar (p), start, end); Flength (res); /* Check basic validity of return value */ 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 (1) { 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 (XTYPE (b->filename) != Lisp_String) 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); 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 (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); 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 () { unsigned char *name = XSTRING (current_buffer->name)->data; ring_bell (); message ("Autosaving...error for %s", name); Fsleep_for (make_number (1), Qnil); message ("Autosaving...error!for %s", name); Fsleep_for (make_number (1), Qnil); message ("Autosaving...error for %s", name); 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); } 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\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; extern int minibuf_level; int do_handled_files; Lisp_Object oquit; /* 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. */ auto_saving = 1; if (minibuf_level) no_message = Qt; /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will eventually call do-auto-save, so don't err here in that case. */ if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("auto-save-hook")); /* 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; XGCTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { buf = XCONS (XCONS (tail)->car)->cdr; b = XBUFFER (buf); if (!NILP (current_only) && b != current_buffer) continue; /* Check for auto save enabled and file changed since last auto save and file changed since last real save. */ if (XTYPE (b->auto_save_file_name) == Lisp_String && b->save_modified < BUF_MODIFF (b) && b->auto_save_modified < BUF_MODIFF (b) && (do_handled_files || NILP (Ffind_file_name_handler (b->auto_save_file_name)))) { 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); /* User can reenable saving with M-x auto-save. */ b->auto_save_file_name = Qnil; /* Prevent warning from repeating if user does so. */ XFASTINT (b->save_length) = 0; 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); XFASTINT (current_buffer->save_length) = Z - BEG; set_buffer_internal (old); } } /* Prevent another auto save till enough input events come in. */ record_auto_save (); if (auto_saved && NILP (no_message)) message1 (omessage ? omessage : "Auto-saving...done"); Vquit_flag = oquit; auto_saving = 0; 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; XFASTINT (current_buffer->save_length) = Z - BEG; 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 (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil; } /* Reading and completing file names */ extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions (); 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; realdir = dir; name = string; orig_string = Qnil; specdir = Qnil; changed = 0; /* No need to protect ACTION--we only compare it with t and nil. */ GCPRO4 (string, realdir, name, specdir); 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 (XTYPE (val) != Lisp_String) { if (changed) return string; return val; } if (!NILP (specdir)) val = concat2 (specdir, val); #ifndef VMS { 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++; } } } #endif /* Not VMS */ return val; } 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\ 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)) defalt = current_buffer->filename; /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); if (homedir != 0 && XTYPE (dir) == Lisp_String && !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 (insert_default_directory) { insdef = dir; insdef1 = dir; if (!NILP (initial)) { Lisp_Object args[2], pos; args[0] = insdef; args[1] = initial; insdef = Fconcat (2, args); pos = make_number (XSTRING (dir)->size); insdef1 = Fcons (insdef, pos); } } 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)) return defalt; return Fsubstitute_in_file_name (val); } #if 0 /* Old version */ 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\ 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, 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 && XTYPE (dir) == Lisp_String && !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"); 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 = intern ("make-directory"); 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_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 (&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); 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_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); 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; 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_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 (&Srecent_auto_save_p); defsubr (&Sread_file_name_internal); defsubr (&Sread_file_name); #ifdef unix defsubr (&Sunix_sync); #endif } emacs-19.22/src/filelock.c100444 12241 12 25653 5444475274 14242 0ustar rolandstaff/* 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. */ #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" extern int errno; extern char *egetenv (); extern char *strcpy (); #if defined (__bsdi__) || defined (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_path; /* The name of the file in the lock directory which is used to arbitrate access to the entire directory. */ #define SUPERLOCK_NAME "!!!SuperLock!!!" /* The path to the superlock file. This is SUPERLOCK_NAME appended to lock_path. */ char *superlock_path; /* 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_PATH(lock, file) \ (lock = (char *) alloca (14 + strlen (lock_path) + 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_path, 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_PATH(lock, file) \ (lock = (char *) alloca (XSTRING (file)->size + strlen (lock_path) + 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_path); 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; register char *lfname; MAKE_LOCK_PATH (lfname, fn); /* See if this file is visited and has changed on disk since it was visited. */ { register Lisp_Object subject_buf = Fget_file_buffer (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_path); 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; MAKE_LOCK_PATH (lfname, fn); lock_superlock (lfname); if (current_lock_owner_1 (lfname) == getpid ()) unlink (lfname); unlink (superlock_path); } lock_superlock (lfname) char *lfname; { register int i, fd; for (i = -20; i < 0 && (fd = open (superlock_path, O_WRONLY | O_EXCL | O_CREAT, 0666)) < 0; i++) { if (errno != EEXIST) return; sleep (1); } if (fd >= 0) { #ifdef USG chmod (superlock_path, 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; XGCTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { b = XBUFFER (XCONS (XCONS (tail)->car)->cdr); if (XTYPE (b->filename) == Lisp_String && b->save_modified < BUF_MODIFF (b)) unlock_file (b->filename); } } 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->filename; else CHECK_STRING (fn, 0); if (current_buffer->save_modified < 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 (current_buffer->save_modified < MODIFF && XTYPE (current_buffer->filename) == Lisp_String) unlock_file (current_buffer->filename); return Qnil; } /* Unlock the file visited in buffer BUFFER. */ unlock_buffer (buffer) struct buffer *buffer; { if (buffer->save_modified < BUF_MODIFF (buffer) && XTYPE (buffer->filename) == Lisp_String) unlock_file (buffer->filename); } 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_PATH (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 () { lock_path = egetenv ("EMACSLOCKDIR"); if (! lock_path) lock_path = PATH_LOCK; /* Make sure it ends with a slash. */ if (lock_path[strlen (lock_path) - 1] != '/') { char *new_path = (char *) xmalloc (strlen (lock_path) + 2); strcpy (new_path, lock_path); lock_path = new_path; strcat (lock_path, "/"); } superlock_path = (char *) xmalloc ((strlen (lock_path) + sizeof (SUPERLOCK_NAME))); strcpy (superlock_path, lock_path); strcat (superlock_path, SUPERLOCK_NAME); } syms_of_filelock () { defsubr (&Sunlock_buffer); defsubr (&Slock_buffer); defsubr (&Sfile_locked_p); } #endif /* CLASH_DETECTION */ emacs-19.22/src/filemode.c100666 74504 13 14111 5454341003 14434 0ustar meyeringuser/* 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 #if defined (emacs) || defined (CONFIG_BROKETS) #include #else #include "config.h" #endif #endif #include #include #ifndef S_IREAD #define S_IREAD S_IRUSR #define S_IWRITE S_IWUSR #define S_IEXEC S_IXUSR #endif #if !defined(S_ISREG) || defined(NO_MODE_T) /* Doesn't have POSIX.1 stat stuff or doesn't have mode_t. */ #define mode_t unsigned short #endif #ifdef STAT_MACROS_BROKEN #ifdef S_ISBLK #undef S_ISBLK #endif #ifdef S_ISCHR #undef S_ISCHR #endif #ifdef S_ISDIR #undef S_ISDIR #endif #ifdef S_ISFIFO #undef S_ISFIFO #endif #ifdef S_ISLNK #undef S_ISLNK #endif #ifdef S_ISMPB #undef S_ISMPB #endif #ifdef S_ISMPC #undef S_ISMPC #endif #ifdef S_ISNWK #undef S_ISNWK #endif #ifdef S_ISREG #undef S_ISREG #endif #ifdef S_ISSOCK #undef S_ISSOCK #endif #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 (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) mode_t 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_IREAD) ? 'r' : '-'; chars[1] = (bits & S_IWRITE) ? 'w' : '-'; chars[2] = (bits & S_IEXEC) ? '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.22/src/floatfns.c100444 11732 1 55400 5462655737 14064 0ustar bfoxdaemon/* Primitive operations on floating point for GNU Emacs Lisp interpreter. Copyright (C) 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. */ /* 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) extern double logb (); #endif /* !hpux && HAVE_LOGB */ #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 #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 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 (XTYPE (num) == Lisp_Float) 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 X ** Y.") (arg1, arg2) register Lisp_Object arg1, arg2; { double f1, f2; CHECK_NUMBER_OR_FLOAT (arg1, 0); CHECK_NUMBER_OR_FLOAT (arg2, 0); if (XTYPE (arg1) == Lisp_Int /* common lisp spec */ && XTYPE (arg2) == Lisp_Int) /* don't promote, if both are ints */ { /* this can be improved by pre-calculating */ 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 { for (; y > 0; y--) while (y > 0) { if (y & 1) acc *= x; x *= x; y = (unsigned)y >> 1; } } XSET (val, Lisp_Int, acc); return val; } f1 = (XTYPE (arg1) == Lisp_Float) ? XFLOAT (arg1)->data : XINT (arg1); f2 = (XTYPE (arg2) == Lisp_Float) ? 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 (XTYPE (arg) == Lisp_Float) IN_FLOAT (arg = make_float (fabs (XFLOAT (arg)->data)), "abs", arg); else if (XINT (arg) < 0) XSETINT (arg, - XFASTINT (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 (XTYPE (arg) == Lisp_Int) 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; int value; double f = extract_float (arg); #ifdef HAVE_LOGB IN_FLOAT (value = logb (f), "logb", arg); XSET (val, Lisp_Int, value); #else #ifdef HAVE_FREXP { int exp; IN_FLOAT (frexp (f, &exp), "logb", arg); XSET (val, Lisp_Int, exp-1); } #else /* Would someone like to write code to emulate logb? */ error ("`logb' not implemented on this operating system"); #endif #endif 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 (XTYPE (arg) == Lisp_Float) IN_FLOAT (XSET (arg, Lisp_Int, ceil (XFLOAT (arg)->data)), "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)) { int i1, i2; CHECK_NUMBER_OR_FLOAT (divisor, 1); #ifdef LISP_FLOAT_TYPE if (XTYPE (arg) == Lisp_Float || XTYPE (divisor) == Lisp_Float) { double f1, f2; f1 = XTYPE (arg) == Lisp_Float ? XFLOAT (arg)->data : XINT (arg); f2 = (XTYPE (divisor) == Lisp_Float ? XFLOAT (divisor)->data : XINT (divisor)); if (f2 == 0) Fsignal (Qarith_error, Qnil); IN_FLOAT2 (XSET (arg, Lisp_Int, floor (f1 / f2)), "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)); XSET (arg, Lisp_Int, i1); return arg; } #ifdef LISP_FLOAT_TYPE if (XTYPE (arg) == Lisp_Float) IN_FLOAT (XSET (arg, Lisp_Int, floor (XFLOAT (arg)->data)), "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 (XTYPE (arg) == Lisp_Float) /* Screw the prevailing rounding mode. */ IN_FLOAT (XSET (arg, Lisp_Int, rint (XFLOAT (arg)->data)), "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 (XTYPE (arg) == Lisp_Float) XSET (arg, Lisp_Int, (int) XFLOAT (arg)->data); return arg; } #if 0 /* 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 (XFLOAT (arg)->data), "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), arg); return make_float (d); } #endif #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); defsubr (&Sfceiling); defsubr (&Sffloor); defsubr (&Sfround); defsubr (&Sftruncate); #endif 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.22/src/fns.c100444 12241 12 104756 5444474561 13260 0ustar rolandstaff/* Random utility Lisp functions. 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 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. */ #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" Lisp_Object Qstring_lessp, Qprovide, Qrequire; Lisp_Object Qyes_or_no_p_history; static Lisp_Object internal_equal (); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, "Return the argument unchanged.") (arg) Lisp_Object arg; { return arg; } DEFUN ("random", Frandom, Srandom, 0, 1, 0, "Return a pseudo-random number.\n\ On most systems all integers representable in Lisp are equally likely.\n\ This is 24 bits' worth.\n\ With 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; { int val; extern long random (); extern srandom (); extern long time (); if (EQ (limit, Qt)) srandom (getpid () + time (0)); val = random (); if (XTYPE (limit) == Lisp_Int && XINT (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. */ val &= 0xfffffff; /* Ensure positive. */ val >>= 5; if (XINT (limit) < 10000) val >>= 6; val %= XINT (limit); } return make_number (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 (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String || XTYPE (obj) == Lisp_Compiled) return Farray_length (obj); else if (CONSP (obj)) { for (i = 0, tail = obj; !NILP(tail); i++) { QUIT; tail = Fcdr (tail); } XFASTINT (val) = i; return val; } else if (NILP(obj)) { XFASTINT (val) = 0; return val; } else { obj = wrong_type_argument (Qsequencep, obj); goto retry; } } DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0, "T if two strings have identical contents.\n\ Case is significant.\n\ Symbols are also allowed; their print names are used instead.") (s1, s2) register Lisp_Object s1, s2; { if (XTYPE (s1) == Lisp_Symbol) XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String); if (XTYPE (s2) == Lisp_Symbol) XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String); 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 (XTYPE (s1) == Lisp_Symbol) XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String); if (XTYPE (s2) == Lisp_Symbol) XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String); 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 */ } 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, a list of numbers, or a vector of numbers.") (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_Vector, 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 (!CONSP (arg) && XTYPE (arg) != Lisp_Vector && XTYPE (arg) != Lisp_String) 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) || XTYPE (this) == Lisp_Vector || XTYPE (this) == Lisp_String || XTYPE (this) == Lisp_Compiled)) { if (XTYPE (this) == Lisp_Int) 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); } XFASTINT (len) = leni; if (target_type == Lisp_Cons) val = Fmake_list (len, Qnil); else if (target_type == Lisp_Vector) 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 (XTYPE (this) == Lisp_String && XTYPE (val) == Lisp_String && ! 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 (XTYPE (this) == Lisp_String) XFASTINT (elt) = XSTRING (this)->data[thisindex++]; else elt = XVECTOR (this)->contents[thisindex++]; } /* Store into result */ if (toindex < 0) { XCONS (tail)->car = elt; prev = tail; tail = XCONS (tail)->cdr; } else if (XTYPE (val) == Lisp_Vector) XVECTOR (val)->contents[toindex++] = elt; else { while (XTYPE (elt) != Lisp_Int) 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 (XTYPE (seq) == Lisp_Cons || NILP (seq)) return Fcar (Fnthcdr (n, seq)); else if (XTYPE (seq) == Lisp_String || XTYPE (seq) == Lisp_Vector) 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 ELT is `eq' to the car of an element of LIST.\n\ The value is actually the element of LIST whose car is ELT.\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 ELT is `equal' to the car of an element of LIST.\n\ The value is actually the element of LIST whose car 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 = 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 ("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, there is no way to remove it by side effect;\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 ("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)'.") (sym, prop) Lisp_Object sym; register Lisp_Object prop; { register Lisp_Object tail; for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail))) { register Lisp_Object tem; tem = Fcar (tail); if (EQ (prop, tem)) return Fcar (Fcdr (tail)); } return Qnil; } DEFUN ("put", Fput, Sput, 3, 3, 0, "Store SYMBOL's PROPNAME property with value VALUE.\n\ It can be retrieved with `(get SYMBOL PROPNAME)'.") (sym, prop, val) Lisp_Object sym; register Lisp_Object prop; Lisp_Object val; { register Lisp_Object tail, prev; Lisp_Object newcell; prev = Qnil; for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail))) { register Lisp_Object tem; tem = Fcar (tail); if (EQ (prop, tem)) return Fsetcar (Fcdr (tail), val); prev = tail; } newcell = Fcons (prop, Fcons (val, Qnil)); if (NILP (prev)) Fsetplist (sym, newcell); else Fsetcdr (Fcdr (prev), newcell); return val; } 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); } static Lisp_Object internal_equal (o1, o2, depth) register Lisp_Object o1, o2; int depth; { if (depth > 200) error ("Stack overflow in equal"); do_cdr: QUIT; if (EQ (o1, o2)) return Qt; #ifdef LISP_FLOAT_TYPE if (FLOATP (o1) && FLOATP (o2)) return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil; #endif if (XTYPE (o1) != XTYPE (o2)) return Qnil; if (XTYPE (o1) == Lisp_Cons || XTYPE (o1) == Lisp_Overlay) { Lisp_Object v1; v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1); if (NILP (v1)) return v1; o1 = Fcdr (o1), o2 = Fcdr (o2); goto do_cdr; } if (XTYPE (o1) == Lisp_Marker) { return ((XMARKER (o1)->buffer == XMARKER (o2)->buffer && (XMARKER (o1)->buffer == 0 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)) ? Qt : Qnil); } if (XTYPE (o1) == Lisp_Vector || XTYPE (o1) == Lisp_Compiled) { register int index; if (XVECTOR (o1)->size != XVECTOR (o2)->size) return Qnil; for (index = 0; index < XVECTOR (o1)->size; index++) { Lisp_Object v, v1, v2; v1 = XVECTOR (o1)->contents [index]; v2 = XVECTOR (o2)->contents [index]; v = internal_equal (v1, v2, depth + 1); if (NILP (v)) return v; } return Qt; } if (XTYPE (o1) == Lisp_String) { if (XSTRING (o1)->size != XSTRING (o2)->size) return Qnil; if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size)) return Qnil; return Qt; } return Qnil; } DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0, "Store each element of ARRAY with ITEM. ARRAY is a vector or string.") (array, item) Lisp_Object array, item; { register int size, index, charval; retry: if (XTYPE (array) == Lisp_Vector) { register Lisp_Object *p = XVECTOR (array)->contents; size = XVECTOR (array)->size; for (index = 0; index < size; index++) p[index] = item; } else if (XTYPE (array) == Lisp_String) { 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 { array = wrong_type_argument (Qarrayp, array); goto retry; } return array; } /* 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 (XTYPE (seq) == Lisp_Vector) { for (i = 0; i < leni; i++) { dummy = XVECTOR (seq)->contents[i]; vals[i] = call1 (fn, dummy); } } else if (XTYPE (seq) == Lisp_String) { for (i = 0; i < leni; i++) { XFASTINT (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 return 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) { cursor_in_echo_area = 1; message ("%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; 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 ("%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 as been confirmed.") (prompt) Lisp_Object prompt; { register Lisp_Object ans; Lisp_Object args[2]; struct gcpro gcpro1; CHECK_STRING (prompt, 0); 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 (&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 (&Sdelq); defsubr (&Sdelete); defsubr (&Snreverse); defsubr (&Sreverse); defsubr (&Ssort); defsubr (&Sget); defsubr (&Sput); defsubr (&Sequal); defsubr (&Sfillarray); 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.22/src/frame.c100444 12120 1 140270 5475060674 13207 0ustar rmsdaemon/* Generic frame functions. 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 #include "lisp.h" #include "frame.h" #ifdef MULTI_FRAME #include "buffer.h" #include "window.h" #include "termhooks.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; Lisp_Object Vterminal_frame; Lisp_Object Vdefault_minibuffer_frame; Lisp_Object Vdefault_frame_alist; /* 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))))) */ /*&&& 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; extern Lisp_Object Vminibuffer_list; extern Lisp_Object get_minibuffer (); extern Lisp_Object Fhandle_switch_frame (); extern Lisp_Object Fredirect_frame_focus (); 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\ Also see `live-frame-p'.") (object) Lisp_Object object; { if (XTYPE (object) != Lisp_Frame) return Qnil; switch (XFRAME (object)->output_method) { case output_termcap: return Qt; case output_x_window: return Qx; 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; frame = Fmake_vector (((sizeof (struct frame) - (sizeof (Lisp_Vector) - sizeof (Lisp_Object))) / sizeof (Lisp_Object)), make_number (0)); XSETTYPE (frame, Lisp_Frame); f = XFRAME (frame); f->cursor_x = 0; f->cursor_y = 0; f->current_glyphs = 0; f->desired_glyphs = 0; f->visible = 0; f->async_visible = 0; f->display.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; 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; XFASTINT (XWINDOW (root_window)->width) = 10; XFASTINT (XWINDOW (root_window)->height) = (mini_p ? 9 : 10); if (mini_p) { XFASTINT (XWINDOW (mini_window)->width) = 10; XFASTINT (XWINDOW (mini_window)->top) = 9; XFASTINT (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. */ XFASTINT (XWINDOW (f->selected_window)->use_time) = ++window_select_count; Vframe_list = Fcons (frame, Vframe_list); 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) register Lisp_Object mini_window; { register struct frame *f; /* Choose the minibuffer window to use. */ if (NILP (mini_window)) { if (XTYPE (Vdefault_minibuffer_frame) != Lisp_Frame) error ("default-minibuffer-frame must be set when creating minibufferless frames"); if (! FRAME_LIVE_P (XFRAME (Vdefault_minibuffer_frame))) error ("default-minibuffer-frame must be a live frame"); mini_window = XFRAME (Vdefault_minibuffer_frame)->minibuffer_window; } else { CHECK_LIVE_WINDOW (mini_window, 0); } /* Make a frame containing just a root window. */ f = make_frame (0); /* 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; XSET (frame, Lisp_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). */ struct frame * make_terminal_frame () { register struct frame *f; Vframe_list = Qnil; f = make_frame (1); f->name = build_string ("terminal"); FRAME_SET_VISIBLE (f, 1); f->display.nothing = 1; /* Nonzero means frame isn't deleted. */ XSET (Vterminal_frame, Lisp_Frame, f); return f; } 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 Fhandle_switch_frame (frame, no_enter); } 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; { /* 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; CHECK_LIVE_FRAME (frame, 0); if (selected_frame == XFRAME (frame)) return frame; /* 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. */ { Lisp_Object tail; for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object focus; if (XTYPE (XCONS (tail)->car) != Lisp_Frame) abort (); focus = FRAME_FOCUS_FRAME (XFRAME (XCONS (tail)->car)); if (XTYPE (focus) == Lisp_Frame && XFRAME (focus) == selected_frame) Fredirect_frame_focus (XCONS (tail)->car, frame); } } selected_frame = XFRAME (frame); if (! FRAME_MINIBUF_ONLY_P (selected_frame)) last_nonminibuf_frame = selected_frame; Fselect_window (XFRAME (frame)->selected_window); choose_minibuf_frame (); /* 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 ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, "Return the frame that is now selected.") () { Lisp_Object tem; XSET (tem, Lisp_Frame, 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-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)) XSET (frame, Lisp_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)) XSET (frame, Lisp_Frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); return XFRAME (frame)->selected_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 frames using that window for their minibuffer. If MINIBUF is non-nil, and not a window, 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 = XCONS (tail)->car; if (passed) { /* 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 (XTYPE (minibuf) == Lisp_Window) { if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)) 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 frames using that window for their minibuffer. If MINIBUF is non-nil and not a window, 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 = XCONS (tail)->car; if (XTYPE (f) != Lisp_Frame) abort (); if (EQ (frame, f) && !NILP (prev)) return prev; /* 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 (XTYPE (minibuf) == Lisp_Window) { if (EQ (FRAME_MINIBUF_WINDOW (XFRAME (f)), minibuf)) 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\ 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 frames using that window for their\n\ minibuffer.\n\ If MINIFRAME is non-nil and not a window, include all frames.") (frame, miniframe) Lisp_Object frame, miniframe; { Lisp_Object tail; if (NILP (frame)) XSET (frame, Lisp_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\ 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 frames using that window for their\n\ minibuffer.\n\ If MINIFRAME is non-nil and not a window, include all frames.") (frame, miniframe) Lisp_Object frame, miniframe; { Lisp_Object tail; if (NILP (frame)) XSET (frame, Lisp_Frame, selected_frame); else CHECK_LIVE_FRAME (frame, 0); return prev_frame (frame, miniframe); } 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; if (EQ (frame, Qnil)) { f = selected_frame; XSET (frame, Lisp_Frame, f); } else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } if (! FRAME_LIVE_P (f)) return Qnil; /* If all other frames are invisible, refuse to delete. (Exception: allow deleting the terminal frame when using X.) */ if (f == selected_frame && NILP (force)) { Lisp_Object frames; int count = 0; for (frames = Vframe_list; CONSP (frames); frames = XCONS (frames)->cdr) { Lisp_Object this = XCONS (frames)->car; if (FRAME_VISIBLE_P (XFRAME (this)) || FRAME_ICONIFIED_P (XFRAME (this)) /* Allow deleting the terminal frame when at least one X frame exists! */ || (FRAME_X_P (XFRAME (this)) && !FRAME_X_P (f))) count++; } if (count == 1) error ("Attempt to delete the only 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 = 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"); } } /* Don't let the frame remain selected. */ if (f == selected_frame) Fhandle_switch_frame (next_frame (frame, Qt), Qnil); /* 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; } /* 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); /* 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_X_WINDOWS if (FRAME_X_P (f)) x_destroy_window (f); #endif f->display.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 Vdefault_minibuffer_frame, try to find another one. Prefer minibuffer-only frames, but also notice frames with other windows. */ if (EQ (frame, Vdefault_minibuffer_frame)) { Lisp_Object frames; /* The last frame we saw with a minibuffer, minibuffer-only or not. */ Lisp_Object frame_with_minibuf = Qnil; for (frames = Vframe_list; CONSP (frames); frames = XCONS (frames)->cdr) { Lisp_Object this = XCONS (frames)->car; if (XTYPE (this) != Lisp_Frame) abort (); f = XFRAME (this); if (FRAME_HAS_MINIBUF_P (f)) { frame_with_minibuf = this; if (FRAME_MINIBUF_ONLY_P (f)) break; } } /* 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 (); Vdefault_minibuffer_frame = frame_with_minibuf; } 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; unsigned long long_dummy; f = selected_frame; x = y = Qnil; /* It's okay for the hook to refrain from storing anything. */ if (mouse_position_hook) (*mouse_position_hook) (&f, &lispy_dummy, &party_dummy, &x, &y, &long_dummy); XSET (lispy_dummy, Lisp_Frame, 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\ WARNING: If you use this under X, you should do `unfocus-frame' afterwards.") (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_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ x_set_mouse_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)) XSET (frame, Lisp_Frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) { FRAME_SAMPLE_VISIBILITY (XFRAME (frame)); x_make_frame_visible (XFRAME (frame)); } #endif return frame; } DEFUN ("make-frame-invisible", Fmake_frame_invisible, Smake_frame_invisible, 0, 1, "", "Make the frame FRAME invisible (assuming it is an X-window).\n\ If omitted, FRAME defaults to the currently selected frame.") (frame) Lisp_Object frame; { if (NILP (frame)) XSET (frame, Lisp_Frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); /* Don't let the frame remain selected. */ if (XFRAME (frame) == selected_frame) Fhandle_switch_frame (next_frame (frame, Qt), Qnil); /* 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_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) x_make_frame_invisible (XFRAME (frame)); #endif 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)) XSET (frame, Lisp_Frame, selected_frame); CHECK_LIVE_FRAME (frame, 0); /* Don't let the frame remain selected. */ if (XFRAME (frame) == selected_frame) Fhandle_switch_frame (next_frame (frame, Qt), Qnil); /* 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_X_WINDOWS if (FRAME_X_P (XFRAME (frame))) x_iconify_frame (XFRAME (frame)); #endif 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); 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 (XTYPE (frame) != Lisp_Frame) continue; f = XFRAME (frame); if (FRAME_VISIBLE_P (f)) value = Fcons (frame, value); } return value; } DEFUN ("raise-frame", Fraise_frame, Sraise_frame, 1, 1, 0, "Bring FRAME to the front, so it occludes any frames it overlaps.\n\ If FRAME is invisible, make it visible.\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; { 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, 1, 1, 0, "Send FRAME to the back, so it is occluded by any frames that overlap it.\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; { 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_X_WINDOWS if (!NILP (focus_frame) && ! EQ (focus_frame, frame) && FRAME_X_P (XFRAME (focus_frame))) Ffocus_frame (focus_frame); #endif if (frame_rehighlight_hook) (*frame_rehighlight_hook) (); 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)); } 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); } 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, Qminibuffer) && XTYPE (val) == Lisp_Window) { 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; struct frame *f; if (EQ (frame, Qnil)) f = selected_frame; else { CHECK_FRAME (frame, 0); f = XFRAME (frame); } if (f->display.nothing == 0) return Qnil; alist = Fcopy_alist (f->param_alist); store_in_alist (&alist, Qname, f->name); store_in_alist (&alist, Qheight, make_number (f->height)); store_in_alist (&alist, Qwidth, make_number (f->width)); store_in_alist (&alist, Qmodeline, (f->wants_modeline ? 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, (f->no_split ? Qt : Qnil)); store_in_alist (&alist, Qmenu_bar_lines, (FRAME_MENU_BAR_LINES (f))); /* I think this should be done with a hook. */ #ifdef HAVE_X_WINDOWS if (FRAME_X_P (f)) x_report_frame_params (f, &alist); #endif 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_X_WINDOWS if (FRAME_X_P (f)) #if 1 x_set_frame_parameters (f, alist); #else for (tail = alist; !EQ (tail, Qnil); tail = Fcdr (tail)) { elt = Fcar (tail); prop = Fcar (elt); val = Fcdr (elt); x_set_frame_param (f, prop, val, get_frame_param (f, prop)); store_frame_param (f, prop, val); } #endif #endif 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_X_WINDOWS if (FRAME_X_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_X_WINDOWS if (FRAME_X_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_X_WINDOWS if (FRAME_X_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_X_WINDOWS if (FRAME_X_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_X_WINDOWS if (FRAME_X_P (f)) { if (XINT (rows) != f->width) x_set_window_size (f, 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_X_WINDOWS if (FRAME_X_P (f)) { if (XINT (cols) != f->width) x_set_window_size (f, 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_X_WINDOWS if (FRAME_X_P (f)) { if (XINT (rows) != f->height || XINT (cols) != f->width) x_set_window_size (f, 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_X_WINDOWS if (FRAME_X_P (f)) x_set_offset (f, XINT (xoffset), XINT (yoffset)); #endif return Qt; } choose_minibuf_frame () { /* For lowest-level minibuf, put it on currently selected frame if frame has a minibuffer. */ if (minibuf_level == 0 && selected_frame != 0 && !EQ (minibuf_window, selected_frame->minibuffer_window)) { /* 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; } } syms_of_frame () { /*&&& 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); Qwidth = intern ("width"); staticpro (&Qwidth); Qx = intern ("x"); staticpro (&Qx); Qmenu_bar_lines = intern ("menu-bar-lines"); staticpro (&Qmenu_bar_lines); 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_LISP ("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."); Vdefault_minibuffer_frame = Qnil; 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)))\n\ These override values given in window system configuration data, like\n\ 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'."); Vdefault_frame_alist = Qnil; defsubr (&Sframep); defsubr (&Sframe_live_p); defsubr (&Shandle_switch_frame); defsubr (&Sselect_frame); defsubr (&Sselected_frame); defsubr (&Swindow_frame); defsubr (&Sframe_root_window); defsubr (&Sframe_selected_window); defsubr (&Sframe_list); defsubr (&Snext_frame); defsubr (&Sprevious_frame); defsubr (&Sdelete_frame); defsubr (&Smouse_position); defsubr (&Sset_mouse_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"); } #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, "Return the frame that is now selected.") () { Lisp_Object tem; XFASTINT (tem) = 0; return tem; } 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\ Also see `live-frame-p'.") (object) Lisp_Object object; { return Qnil; } 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; { 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, "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; { 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, "Sets size of FRAME to COLS by ROWS, measured in characters.") (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, "Return number of lines available for display on FRAME.\n\ If FRAME is omitted, describe the currently selected frame.") (frame) Lisp_Object frame; { return make_number (FRAME_HEIGHT (selected_frame)); } DEFUN ("frame-width", Fframe_width, Sframe_width, 0, 1, 0, "Return number of columns available for display on FRAME.\n\ If FRAME is omitted, describe the currently selected frame.") (frame) Lisp_Object frame; { return make_number (FRAME_WIDTH (selected_frame)); } 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; { 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; { return make_number (1); } DEFUN ("frame-pixel-height", Fframe_pixel_height, Sframe_pixel_height, 0, 1, 0, "Return 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; { 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; { 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, "Tell redisplay that the screen has 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.") (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, "Tell redisplay that the screen has 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 screen should not be changed.") (cols, pretend) Lisp_Object cols, pretend; { CHECK_NUMBER (cols, 0); change_frame_size (0, 0, XINT (cols), !NILP (pretend), 0); return Qnil; } syms_of_frame () { defsubr (&Sselected_frame); 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")); } keys_of_frame () { } #endif /* not MULTI_FRAME */ emacs-19.22/src/getloadavg.c100666 12241 1 51700 5465726274 14705 0ustar rolanddaemon/* Get the system load averages. Copyright (C) 1985, 86, 87, 88, 89, 91, 92, 93 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. 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. */ #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 #ifdef HAVE_CONFIG_H #if defined (emacs) || defined (CONFIG_BROKETS) /* We use instead of "config.h" so that a compilation using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h (which it would do because it found this file in $srcdir). */ #include #else #include "config.h" #endif #endif /* Exclude all the code except the test program at the end if the system has its own `getloadavg' function. */ #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 #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 #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 #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 #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 tex4300 #define NLIST_STRUCT #endif #ifdef butterfly #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))) #define LDAV_SYMBOL "avenrun" #endif #ifdef HAVE_UNISTD_H #include #endif #include #include #ifndef errno extern int errno; #endif /* 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 (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 (nlist (KERNEL_FILE, nl) >= 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) 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.22/src/gmalloc.c100444 12120 1 111052 5472420417 13517 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 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__) #include #else #define CHAR_BIT 8 #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. */ #ifdef __STDC__ #include #else #undef size_t #define size_t unsigned int #undef ptrdiff_t #define ptrdiff_t int #endif #ifndef NULL #define NULL 0 #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 _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 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. */ extern __ptr_t (*__morecore) __P ((ptrdiff_t __size)); /* Default value of `__morecore'. */ extern __ptr_t __default_morecore __P ((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)); /* 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 /* How to really get more memory. */ __ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __default_morecore; /* Debugging hook for `malloc'. */ __ptr_t (*__malloc_hook) __P ((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 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 () { 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; __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) { (*__morecore) (-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; /* 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_hook != NULL) return (*__malloc_hook) (size); 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 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)); 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) { /* 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 += (blocks - lastblocks); _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; } #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) size_t size; { return malloc (size); } void _free (ptr) __ptr_t ptr; { free (ptr); } __ptr_t _realloc (ptr, size) __ptr_t ptr; size_t size; { return realloc (ptr, size); } #endif /* 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 /* 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; 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; (*__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 < (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); } /* Copyright (C) 1991, 1993 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 Library General Public License as published by the Free Software Foundation; either version 2 of the License, 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with the GNU C 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 #undef cfree #ifdef _LIBC #include #include function_alias(cfree, free, void, (ptr), DEFUN(cfree, (ptr), PTR ptr)) #else void cfree (ptr) __ptr_t ptr; { free (ptr); } #endif /* 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 #if (defined (MEMMOVE_MISSING) || \ !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) /* Snarfed directly from Emacs src/dispnew.c: XXX Should use system bcopy if it handles overlap. */ #ifndef emacs /* Like bcopy except never gets confused by overlap. */ static 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); } } } #endif /* Not emacs. */ #define memmove(to, from, size) safe_bcopy ((from), (to), (size)) #endif #define min(A, B) ((A) < (B) ? (A) : (B)) /* Debugging hook for realloc. */ __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, 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 (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_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; _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 (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_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 > (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, 1993 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)); #else #if defined (HPUX8) || defined (HAVE_UNISTD_H) #include #endif #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) ptrdiff_t increment; { __ptr_t result = (__ptr_t) __sbrk ((int) increment); if (result == (__ptr_t) -1) return NULL; 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. */ #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; } /* Allocate memory on a page boundary. Copyright (C) 1991, 1992, 1993 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. */ #if defined (__GNU_LIBRARY__) || defined (_LIBC) #include #include extern size_t __getpagesize __P ((void)); #else #include "getpagesize.h" #define __getpagesize() getpagesize() #endif #ifndef _MALLOC_INTERNAL #define _MALLOC_INTERNAL #include #endif static size_t pagesize; __ptr_t valloc (size) size_t size; { if (pagesize == 0) pagesize = __getpagesize (); return memalign (pagesize, size); } emacs-19.22/src/hftctl.c100444 12120 1 26525 5473764540 13370 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.22/src/indent.c100444 12120 1 52242 5474770163 13357 0ustar rmsdaemon/* Indentation functions. 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 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. */ #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" /* 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_Vector * buffer_display_table () { Lisp_Object thisbuf; thisbuf = current_buffer->display_table; if (XTYPE (thisbuf) == Lisp_Vector && XVECTOR (thisbuf)->size == DISP_TABLE_SIZE) return XVECTOR (thisbuf); if (XTYPE (Vstandard_display_table) == Lisp_Vector && XVECTOR (Vstandard_display_table)->size == DISP_TABLE_SIZE) return XVECTOR (Vstandard_display_table); return 0; } 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; XFASTINT (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_Vector *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 (c >= 040 && c < 0177 && (dp == 0 || XTYPE (DISP_CHAR_VECTOR (dp, c)) != Lisp_Vector)) { 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 if (dp != 0 && XTYPE (DISP_CHAR_VECTOR (dp, c)) == Lisp_Vector) col += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; 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; } 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)) XFASTINT (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; XFASTINT (n) = mincol / tab_width - fromcol / tab_width; if (XFASTINT (n) != 0) { Finsert_char (make_number ('\t'), n); fromcol = (mincol / tab_width) * tab_width; } } XFASTINT (col) = mincol - fromcol; Finsert_char (make_number (' '), col); 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; XFASTINT (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; } } } DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, 0, "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.") (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_Vector *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 (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 (dp != 0 && XTYPE (DISP_CHAR_VECTOR (dp, c)) == Lisp_Vector) col += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; 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; XFASTINT (val) = col; return val; } 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. 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. I'm not clear on what the other members are. 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 ? VERTICAL_SCROLL_BAR_WIDTH : (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, window_internal_width (w) - 1 The `-1' accounts for the continuation-line backslashes; the rest accounts for window borders if the window is split vertically, and the scroll bars if the frame supports them. */ struct position * compute_motion (from, fromvpos, fromhpos, to, tovpos, tohpos, width, hscroll, tab_offset) int from, fromvpos, fromhpos, to, tovpos, tohpos; register int width; int hscroll, tab_offset; { 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_Vector *dp = buffer_display_table (); int selective = XTYPE (current_buffer->selective_display) == Lisp_Int ? XINT (current_buffer->selective_display) : !NILP (current_buffer->selective_display) ? -1 : 0; int prev_vpos, prev_hpos; int selective_rlen = (selective && dp && XTYPE (DISP_INVIS_VECTOR (dp)) == Lisp_Vector ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : 0); #ifdef USE_TEXT_PROPERTIES /* The next location where the `invisible' property changes */ int next_invisible = from; Lisp_Object prop, position; #endif if (tab_width <= 0 || tab_width > 1000) tab_width = 8; for (pos = from; pos < to; pos++) { /* Stop if past the target screen position. */ if (vpos > tovpos || (vpos == tovpos && hpos >= tohpos)) break; prev_vpos = vpos; prev_hpos = hpos; #ifdef USE_TEXT_PROPERTIES /* if the `invisible' property is set, we can skip to the next property change */ while (pos == next_invisible && pos < to) { XFASTINT (position) = pos; prop = Fget_text_property (position, Qinvisible, Fcurrent_buffer ()); { Lisp_Object end, limit; /* This is just an estimate to give reasonable performance; nothing should go wrong if it is too small. */ XFASTINT (limit) = pos + 100; end = Fnext_single_property_change (position, Qinvisible, Fcurrent_buffer (), limit); if (INTEGERP (end)) next_invisible = XINT (end); else next_invisible = to; if (! NILP (prop)) pos = next_invisible; } } if (pos >= to) break; #endif c = FETCH_CHAR (pos); if (c >= 040 && c < 0177 && (dp == 0 || XTYPE (DISP_CHAR_VECTOR (dp, c)) != Lisp_Vector)) hpos++; else if (c == '\t') { hpos += tab_width - ((hpos + tab_offset + hscroll - (hscroll > 0) /* Add tab_width here to make sure positive. hpos can be negative after continuation but can't be less than -tab_width. */ + tab_width) % tab_width); } else if (c == '\n') { if (selective > 0 && position_indentation (pos + 1) >= selective) { /* Skip any number of invisible lines all at once */ do { while (++pos < to && FETCH_CHAR (pos) != '\n'); } while (pos < to && position_indentation (pos + 1) >= selective); pos--; /* Allow for the " ..." that is displayed for them. */ if (selective_rlen) { hpos += selective_rlen; if (hpos >= width) hpos = width; } /* We have skipped the invis text, but not the newline after. */ } else { /* A visible line. */ vpos++; hpos = 0; hpos -= hscroll; if (hscroll > 0) hpos++; /* Count the ! on column 0 */ 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 */ while (pos < to && FETCH_CHAR (pos) != '\n') pos++; /* Stop *before* the real newline. */ pos--; /* Allow for the " ..." that is displayed for them. */ if (selective_rlen) { hpos += selective_rlen; if (hpos >= width) hpos = width; } } else if (dp != 0 && XTYPE (DISP_CHAR_VECTOR (dp, c)) == Lisp_Vector) hpos += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; else hpos += (ctl_arrow && c < 0200) ? 2 : 4; /* Handle right margin. */ if (hpos >= width && (hpos > width || (pos < ZV - 1 && FETCH_CHAR (pos + 1) != '\n'))) { if (vpos > tovpos || (vpos == tovpos && hpos >= tohpos)) break; if (hscroll || (truncate_partial_width_windows && width + 1 < FRAME_WIDTH (selected_frame)) || !NILP (current_buffer->truncate_lines)) { /* Truncating: skip to newline. */ while (pos < to && FETCH_CHAR (pos) != '\n') pos++; pos--; hpos = width; } else { /* Continuing. */ vpos++; hpos -= width; tab_offset += width; } } } 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; } /* Return the column of position POS in window W's buffer, 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 = point; int col; int width = window_internal_width (w) - 1; if (pos == BEGV || FETCH_CHAR (pos - 1) == '\n') return 0; SET_PT (pos); col = current_column (); SET_PT (opoint); return col - (col % width); } /* start_hpos is the hpos of the first character of the buffer: zero except for the minibuffer window, where it is the width of the prompt. */ struct position val_vmotion; struct position * vmotion (from, vtarget, width, hscroll, window) register int from, vtarget, width; int hscroll; Lisp_Object window; { struct position pos; /* vpos is cumulative vertical position, changed as from is changed */ register int vpos = 0; register int prevline; register int first; int lmargin = hscroll > 0 ? 1 - hscroll : 0; int selective = XTYPE (current_buffer->selective_display) == Lisp_Int ? XINT (current_buffer->selective_display) : !NILP (current_buffer->selective_display) ? -1 : 0; int start_hpos = (EQ (window, minibuf_window) ? minibuf_prompt_width : 0); retry: if (vtarget > vpos) { /* 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') { prevline = find_next_newline (from, -1); while (prevline > BEGV && ((selective > 0 && position_indentation (prevline) >= selective) #ifdef USE_TEXT_PROPERTIES /* watch out for newlines with `invisible' property */ || ! NILP (Fget_text_property (XFASTINT (prevline), Qinvisible, Fcurrent_buffer ())) #endif )) prevline = find_next_newline (prevline - 1, -1); pos = *compute_motion (prevline, 0, lmargin + (prevline == 1 ? start_hpos : 0), from, 1 << (INTBITS - 2), 0, width, hscroll, 0); } else { pos.hpos = lmargin + (from == 1 ? start_hpos : 0); pos.vpos = 0; } return compute_motion (from, vpos, pos.hpos, ZV, vtarget, - (1 << (INTBITS - 2)), width, hscroll, pos.vpos * width); } /* 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) { prevline = from; while (1) { prevline = find_next_newline (prevline - 1, -1); if (prevline == BEGV || ((selective <= 0 || position_indentation (prevline) < selective) #ifdef USE_TEXT_PROPERTIES /* watch out for newlines with `invisible' property */ && NILP (Fget_text_property (XFASTINT (prevline), Qinvisible, Fcurrent_buffer ())) #endif )) break; } pos = *compute_motion (prevline, 0, lmargin + (prevline == 1 ? start_hpos : 0), from, 1 << (INTBITS - 2), 0, width, hscroll, 0); vpos -= pos.vpos; first = 0; from = 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 */ goto retry; } DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 1, 0, "Move to start of screen line LINES lines down.\n\ If LINES is negative, this is moving up.\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) Lisp_Object lines; { struct position pos; register struct window *w = XWINDOW (selected_window); int width = window_internal_width (w) - 1; CHECK_NUMBER (lines, 0); pos = *vmotion (point, XINT (lines), width, /* Not XFASTINT since perhaps could be negative */ XINT (w->hscroll), selected_window); SET_PT (pos.bufpos); return make_number (pos.vpos); } 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); } emacs-19.22/src/insdel.c100444 12120 1 36061 5475050040 13337 0ustar rmsdaemon/* Buffer insertion/deletion and gap motion for GNU Emacs. 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 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. */ #include #include "lisp.h" #include "intervals.h" #include "buffer.h" #include "window.h" #include "blockinput.h" /* Move gap to position `pos'. Note that this can quit! */ 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. */ 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; } 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'. */ adjust_markers (from, to, amount) register int from, to, amount; { Lisp_Object marker; register struct Lisp_Marker *m; register int mpos; marker = current_buffer->markers; 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; } } /* Make the gap INCREMENT characters longer. */ 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; BLOCK_INPUT; result = BUFFER_REALLOC (BEG_ADDR, (Z - BEG + GAP_SIZE + increment)); UNBLOCK_INPUT; if (result == 0) memory_full (); BEG_ADDR = result; /* 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! prepare_to_modify_buffer could relocate the string. */ insert (string, length) register unsigned char *string; register length; { register Lisp_Object temp; if (length < 1) return; /* Make sure point-max won't overflow after this insertion. */ XSET (temp, Lisp_Int, length + Z); if (length + Z != XINT (temp)) error ("maximum buffer size exceeded"); prepare_to_modify_buffer (point, point); if (point != GPT) move_gap (point); if (GAP_SIZE < length) make_gap (length - GAP_SIZE); record_insert (point, length); MODIFF++; bcopy (string, GPT_ADDR, length); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ offset_intervals (current_buffer, point, length); GAP_SIZE -= length; GPT += length; ZV += length; Z += length; SET_PT (point + length); signal_after_change (point-length, 0, length); } /* 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. */ insert_from_string (string, pos, length, inherit) Lisp_Object string; register int pos, length; int inherit; { register Lisp_Object temp; struct gcpro gcpro1; if (length < 1) return; /* Make sure point-max won't overflow after this insertion. */ XSET (temp, Lisp_Int, length + Z); if (length + Z != XINT (temp)) error ("maximum buffer size exceeded"); GCPRO1 (string); prepare_to_modify_buffer (point, point); if (point != GPT) move_gap (point); if (GAP_SIZE < length) make_gap (length - GAP_SIZE); record_insert (point, length); MODIFF++; UNGCPRO; bcopy (XSTRING (string)->data, GPT_ADDR, length); /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ offset_intervals (current_buffer, point, length); GAP_SIZE -= length; GPT += length; ZV += length; Z += length; /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ graft_intervals_into_buffer (XSTRING (string)->intervals, point, length, current_buffer, inherit); SET_PT (point + length); signal_after_change (point-length, 0, length); } /* 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. */ insert_before_markers (string, length) unsigned char *string; register int length; { register int opoint = point; insert (string, length); adjust_markers (opoint - 1, opoint, length); } /* Insert part of a Lisp string, relocating markers after. */ insert_from_string_before_markers (string, pos, length, inherit) Lisp_Object string; register int pos, length; int inherit; { register int opoint = point; insert_from_string (string, pos, length, inherit); adjust_markers (opoint - 1, opoint, length); } /* Delete characters in current buffer from FROM up to (but not including) TO. */ del_range (from, to) register int from, to; { 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); prepare_to_modify_buffer (from, to); record_delete (from, numdel); MODIFF++; /* Relocate point as if it were a marker. */ if (from < point) { if (point < to) SET_PT (from); else SET_PT (point - numdel); } /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ offset_intervals (current_buffer, point, - 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); 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; 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. */ 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; MODIFF++; 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. */ 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 */ verify_interval_modification (current_buffer, start, end); verify_overlay_modification (start, end); #ifdef CLASH_DETECTION if (!NILP (current_buffer->filename) && current_buffer->save_modified >= MODIFF) lock_file (current_buffer->filename); #else /* At least warn if this file has changed on disk since it was visited. */ if (!NILP (current_buffer->filename) && current_buffer->save_modified >= 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); Vdeactivate_mark = Qt; } static Lisp_Object before_change_function_restore (value) Lisp_Object value; { Vbefore_change_function = value; } static Lisp_Object after_change_function_restore (value) Lisp_Object value; { Vafter_change_function = value; } /* 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. */ signal_before_change (start, end) Lisp_Object start, end; { /* If buffer is unmodified, run a special hook for that case. */ if (current_buffer->save_modified >= MODIFF && !NILP (Vfirst_change_hook) && !NILP (Vrun_hooks)) call1 (Vrun_hooks, Qfirst_change_hook); /* Now in any case run the before-change-function if any. */ if (!NILP (Vbefore_change_function)) { int count = specpdl_ptr - specpdl; Lisp_Object function; function = Vbefore_change_function; record_unwind_protect (after_change_function_restore, Vafter_change_function); record_unwind_protect (before_change_function_restore, Vbefore_change_function); Vafter_change_function = Qnil; Vbefore_change_function = Qnil; call2 (function, start, end); unbind_to (count, 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. */ signal_after_change (pos, lendel, lenins) int pos, lendel, lenins; { if (!NILP (Vafter_change_function)) { int count = specpdl_ptr - specpdl; Lisp_Object function; function = Vafter_change_function; record_unwind_protect (after_change_function_restore, Vafter_change_function); record_unwind_protect (before_change_function_restore, Vbefore_change_function); Vafter_change_function = Qnil; Vbefore_change_function = Qnil; call3 (function, make_number (pos), make_number (pos + lenins), make_number (lendel)); unbind_to (count, Qnil); } } emacs-19.22/src/intervals.c100444 12120 1 143200 5475061364 14115 0ustar rmsdaemon/* Code for doing intervals. 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. */ /* 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" /* The rest of the file is within this conditional. */ #ifdef USE_TEXT_PROPERTIES /* Factor for weight-balancing interval trees. */ Lisp_Object interval_balance_threshold; 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 (XTYPE (parent) == Lisp_Buffer) { new->total_length = (BUF_Z (XBUFFER (parent)) - BUF_BEG (XBUFFER (parent))); XBUFFER (parent)->intervals = new; } else if (XTYPE (parent) == Lisp_String) { 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 len = LENGTH (interval); /* Deal with any Parent of A; make it point to B. */ if (! ROOT_INTERVAL_P (interval)) if (AM_LEFT_CHILD (interval)) interval->parent->left = interval->left; else interval->parent->right = interval->left; interval->left->parent = interval->parent; /* B gets the same length as A, since it get A's position in the tree. */ interval->left->total_length = interval->total_length; /* B becomes the parent of A. */ i = interval->left->right; interval->left->right = interval; interval->parent = interval->left; /* A gets c as left child. */ interval->left = i; if (! NULL_INTERVAL_P (i)) i->parent = interval; interval->total_length = (len + LEFT_TOTAL_LENGTH (interval) + RIGHT_TOTAL_LENGTH (interval)); 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 len = LENGTH (interval); /* Deal with the parent of A. */ if (! ROOT_INTERVAL_P (interval)) if (AM_LEFT_CHILD (interval)) interval->parent->left = interval->right; else interval->parent->right = interval->right; interval->right->parent = interval->parent; /* B must have the same total length of A. */ interval->right->total_length = interval->total_length; /* Make B the parent of A */ i = interval->right->left; interval->right->left = interval; interval->parent = interval->right; /* Make A point to c */ interval->right = i; if (! NULL_INTERVAL_P (i)) i->parent = interval; interval->total_length = (len + LEFT_TOTAL_LENGTH (interval) + RIGHT_TOTAL_LENGTH (interval)); return B; } /* 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 (LEAF_INTERVAL_P (interval) || 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; 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 + LEFT_TOTAL_LENGTH (new); 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 */ 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 it's 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; /* 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 = NULL_INTERVAL_P (prev) ? Qnil : prev->plist; Lisp_Object pright = NULL_INTERVAL_P (i) ? Qnil : i->plist; struct interval newi; 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; } return tree; } Lisp_Object merge_properties_sticky (pleft, pright) Lisp_Object pleft, pright; { register Lisp_Object props = Qnil, front = Qnil, rear = Qnil; Lisp_Object lfront = textget (pleft, Qfront_sticky); Lisp_Object lrear = textget (pleft, Qrear_nonsticky); Lisp_Object rfront = textget (pright, Qfront_sticky); Lisp_Object rrear = textget (pright, Qrear_nonsticky); register Lisp_Object tail1, tail2, sym; /* Go through each element of PLEFT. */ for (tail1 = pleft; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) { sym = Fcar (tail1); /* Sticky properties get special treatment. */ if (EQ (sym, Qrear_nonsticky) || EQ (sym, Qfront_sticky)) continue; if (CONSP (lrear) ? NILP (Fmemq (sym, lrear)) : NILP (lrear)) { /* rear-sticky is dominant, we needn't search in PRIGHT. */ props = Fcons (sym, Fcons (Fcar (Fcdr (tail1)), props)); if ((CONSP (lfront) || NILP (lfront)) && ! NILP (Fmemq (sym, lfront))) front = Fcons (sym, front); } else { /* Go through PRIGHT, looking for sym. */ for (tail2 = pright; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2))) if (EQ (sym, Fcar (tail2))) { if (CONSP (rfront) ? ! NILP (Fmemq (sym, rfront)) : ! NILP (rfront)) { /* Nonsticky at the left and sticky at the right, so take the right one. */ props = Fcons (sym, Fcons (Fcar (Fcdr (tail2)), props)); front = Fcons (sym, front); if ((CONSP (rrear) || NILP (rrear)) && ! NILP (Fmemq (sym, rrear))) rear = Fcons (sym, rear); } break; } } } /* Now let's see what to keep from PRIGHT. */ for (tail2 = pright; ! 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 it ain't sticky, we don't take it. */ if (CONSP (rfront) ? NILP (Fmemq (sym, rfront)) : NILP (rfront)) continue; /* If sym is in PLEFT we already got it. */ for (tail1 = pleft; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1))) if (EQ (sym, Fcar (tail1))) break; if (NILP (tail1)) { props = Fcons (sym, Fcons (Fcar (Fcdr (tail2)), props)); front = Fcons (sym, front); if ((CONSP (rrear) || NILP (rrear)) && ! NILP (Fmemq (sym, rrear))) rear = Fcons (sym, rear); } } if (! NILP (front)) props = Fcons (Qfront_sticky, Fcons (front, props)); if (! NILP (rear)) props = Fcons (Qrear_nonsticky, Fcons (rear, 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 = (Lisp_Object) i->parent; parent = delete_node (i); if (! NULL_INTERVAL_P (parent)) parent->parent = (INTERVAL) owner; if (XTYPE (owner) == Lisp_Buffer) XBUFFER (owner)->intervals = parent; else if (XTYPE (owner) == Lisp_String) 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 = buffer->intervals; 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)) { buffer->intervals = 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 = buffer->intervals; if (left_to_delete == tree->total_length) { buffer->intervals = 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 (buffer->intervals) || length == 0) return; if (length > 0) adjust_intervals_for_insertion (buffer->intervals, 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 = buffer->intervals; int middle; /* 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) { XSET (buf, Lisp_Buffer, buffer); Fset_text_properties (make_number (position), make_number (position + length), Qnil, buf); } 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; XSET (buf, Lisp_Buffer, buffer); buffer->intervals = 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; XSET (buf, Lisp_Buffer, 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. */ { buffer->intervals = 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) + 1 < 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); } buffer->intervals = balance_intervals (buffer->intervals); return; } /* Get the value of property PROP from PLIST, which is the plist of an interval. We check for direct properties and for categories with property PROP. */ 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)) fallback = Fget (Fcar (Fcdr (tail)), prop); } return fallback; } /* Get the value of property PROP from PLIST, which is the plist of an interval. We check for direct properties only! */ Lisp_Object textget_direct (plist, prop) Lisp_Object plist; register Lisp_Object prop; { register Lisp_Object tail; for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) { if (EQ (prop, Fcar (tail))) return Fcar (Fcdr (tail)); } return Qnil; } /* Set point in BUFFER to POSITION. If the target position is before an invisible character which is not displayed with a special glyph, move back to an ok place to display. */ 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 = buffer->text.pt; if (position == buffer->text.pt) 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 (buffer->intervals)) { buffer->text.pt = 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 (buffer->intervals, 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 (buffer->intervals, 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)) { buffer->text.pt = position; return; } /* If the new position is before an invisible character that has an `invisible' property of value `hidden', move forward over all such. */ while (! NULL_INTERVAL_P (to) && EQ (textget (to->plist, Qinvisible), Qhidden) && ! DISPLAY_INVISIBLE_GLYPH (to)) { toprev = to; to = next_interval (to); if (NULL_INTERVAL_P (to)) position = BUF_ZV (buffer); else position = to->position; } buffer->text.pt = 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; { buffer->text.pt = 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; { register INTERVAL interval; Lisp_Object prop, tem; if (NULL_INTERVAL_P (buffer->intervals)) return current_buffer->keymap; /* Perhaps we should just change `position' to the limit. */ if (position > BUF_Z (buffer) || position < BUF_BEG (buffer)) abort (); interval = find_interval (buffer->intervals, position); prop = textget (interval->plist, Qlocal_map); if (NILP (prop)) return current_buffer->keymap; /* Use the local map only if it is valid. */ tem = Fkeymapp (prop); if (!NILP (tem)) return prop; return current_buffer->keymap; } /* 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) TO. 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; 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; 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)) && (! NILP (Fmemq (Qread_only, textget (i->plist, Qfront_sticky))) || (NILP (textget_direct (i->plist, Qread_only)) && ! NILP (Fmemq (Qcategory, textget (i->plist, Qfront_sticky)))))) error ("Attempt to insert within read-only text"); } else after = Qnil; 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)) && NILP (Fmemq (Qread_only, textget (prev->plist, Qrear_nonsticky))) && (! NILP (textget_direct (prev->plist,Qread_only)) || NILP (Fmemq (Qcategory, textget (prev->plist, Qrear_nonsticky))))) error ("Attempt to insert within read-only text"); } else before = Qnil; } else if (! NULL_INTERVAL_P (i)) before = after = textget (i->plist, Qread_only); if (! NULL_INTERVAL_P (i) && ! NULL_INTERVAL_P (prev)) { /* If I and PREV differ, neither of them has a sticky read-only property. It only remains to check, whether they have a common read-only property. */ if (! NILP (before) && EQ (before, after)) error ("Attempt to insert within read-only text"); } } /* Run both insert hooks (just once if they're the same). */ if (!NULL_INTERVAL_P (prev)) prev_mod_hooks = textget (prev->plist, Qinsert_behind_hooks); if (!NULL_INTERVAL_P (i)) mod_hooks = textget (i->plist, Qinsert_in_front_hooks); GCPRO1 (mod_hooks); if (! NILP (prev_mod_hooks)) call_mod_hooks (prev_mod_hooks, make_number (start), make_number (end)); UNGCPRO; if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks)) call_mod_hooks (mod_hooks, make_number (start), make_number (end)); } 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; } } /* Balance an interval node if the amount of text in its left and right subtrees differs by more than the percentage specified by `interval-balance-threshold'. */ static INTERVAL balance_an_interval (i) INTERVAL i; { register int total_children_size = (LEFT_TOTAL_LENGTH (i) + RIGHT_TOTAL_LENGTH (i)); register int threshold = (XFASTINT (interval_balance_threshold) * (total_children_size / 100)); /* Balance within each side. */ balance_intervals (i->left); balance_intervals (i->right); if (LEFT_TOTAL_LENGTH (i) > RIGHT_TOTAL_LENGTH (i) && (LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i)) > threshold) { i = rotate_right (i); /* If that made it unbalanced the other way, take it back. */ if (RIGHT_TOTAL_LENGTH (i) > LEFT_TOTAL_LENGTH (i) && (RIGHT_TOTAL_LENGTH (i) - LEFT_TOTAL_LENGTH (i)) > threshold) return rotate_left (i); return i; } if (RIGHT_TOTAL_LENGTH (i) > LEFT_TOTAL_LENGTH (i) && (RIGHT_TOTAL_LENGTH (i) - LEFT_TOTAL_LENGTH (i)) > threshold) { i = rotate_left (i); if (LEFT_TOTAL_LENGTH (i) > RIGHT_TOTAL_LENGTH (i) && (LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i)) > threshold) return rotate_right (i); return i; } return i; } /* Balance the interval tree TREE. Balancing is by weight (the amount of text). */ INTERVAL balance_intervals (tree) register INTERVAL tree; { register INTERVAL new_tree; if (NULL_INTERVAL_P (tree)) return NULL_INTERVAL; new_tree = tree; do { tree = new_tree; new_tree = balance_an_interval (new_tree); } while (new_tree != tree); return new_tree; } /* 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_intervals (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 (XBUFFER (buffer)->intervals, position, length); if (NULL_INTERVAL_P (interval_copy)) return; interval_copy->parent = (INTERVAL) string; XSTRING (string)->intervals = interval_copy; } #endif /* USE_TEXT_PROPERTIES */ emacs-19.22/src/keyboard.c100644 12120 1 472270 5475500603 13716 0ustar rmsdaemon/* Keyboard and mouse input; editor command loop. Copyright (C) 1985, 1986, 1987, 1988, 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. */ /* Allow config.h to undefine symbols found here. */ #include #include #include #undef NULL #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 #ifndef VMS #include #endif #include "syssignal.h" #include "systty.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; #ifdef HAVE_X_WINDOWS extern Lisp_Object Vmouse_grabbed; /* 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; }; /* 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; 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; /* Nonzero means C-G should cause immediate error-signal. */ int immediate_quit; /* Character to recognize as the help char. */ Lisp_Object Vhelp_char; /* 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; /* 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; /* 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 unread_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; /* Last command executed by the editor command loop, not counting commands that set the prefix argument. */ Lisp_Object last_command; /* The command being executed by the command loop. Commands may set this, and the value set will be copied into last_command instead of the actual command. */ Lisp_Object this_command; #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; /* 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; #endif /* 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; /* Keymap mapping ASCII function key sequences onto their preferred forms. */ 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, Qpost_command_hook; Lisp_Object Vpre_command_hook, Vpost_command_hook; /* 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]. */ #ifdef __STDC__ volatile #endif static 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_write_count. When we dequeue a non-hook event, we increment kbd_read_count. We say that there is input available iff the two counters 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-zero, we check mouse_moved to see when the mouse moves, and motion events will appear in the input stream. If it is zero, mouse motion is ignored. */ static int do_mouse_tracking; /* 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. Code assumes that if this is set, it can call mouse_position_hook to get the promised position, so don't set it unless you're prepared to substantiate the claim! */ int mouse_moved; /* True iff there is an event in kbd_buffer, or if mouse tracking is enabled and there is a new mouse position in the mouse movement buffer. Note that if this is false, that doesn't mean that there is readable input; all the events in the queue might be button-up events, and do_mouse_tracking might be off. */ #define EVENT_QUEUES_EMPTY \ ((kbd_fetch_ptr == kbd_store_ptr) && (!do_mouse_tracking || !mouse_moved)) /* Symbols to head events. */ Lisp_Object Qmouse_movement; Lisp_Object Qscroll_bar_movement; Lisp_Object Qswitch_frame; /* 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; /* 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 X Windows, turn on the code to poll periodically to detect C-g. It isn't actually used when doing interrupt input. */ #ifdef HAVE_X_WINDOWS #define POLL_FOR_INPUT #endif /* 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_menu_prompt (); static Lisp_Object make_lispy_event (); static Lisp_Object make_lispy_movement (); static Lisp_Object modify_event_symbol (); static Lisp_Object make_lispy_switch_frame (); /* > 0 if we are to echo keystrokes. */ static int echo_keystrokes; /* Nonzero means echo each character as typed. */ static int immediate_echo; /* The text we're echoing in the modeline - partial key sequences, usually. '\0'-terminated. This really shouldn't have a fixed size. */ static char echobuf[300]; /* Where to append more text to echobuf if we want to. */ static char *echoptr; #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 > sizeof echobuf - 4) len = sizeof echobuf - 4; bcopy (str, echobuf, len); echoptr = echobuf + len; *echoptr = '\0'; 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 (immediate_echo) { char *ptr = echoptr; if (ptr != echobuf) *ptr++ = ' '; /* If someone has passed us a composite event, use its head symbol. */ c = EVENT_HEAD (c); if (XTYPE (c) == Lisp_Int) { if (ptr - echobuf > sizeof echobuf - 6) return; ptr = push_key_description (XINT (c), ptr); } else if (XTYPE (c) == Lisp_Symbol) { struct Lisp_String *name = XSYMBOL (c)->name; if (((ptr - echobuf) + name->size + 4) > sizeof echobuf) return; bcopy (name->data, ptr, name->size); ptr += name->size; } if (echoptr == echobuf && EQ (c, Vhelp_char)) { strcpy (ptr, " (Type ? for further options)"); ptr += strlen (ptr); } *ptr = 0; 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 (!immediate_echo && echoptr == echobuf) return; /* Do nothing if not echoing at all. */ if (echoptr == 0) return; /* Put a dash at the end of the buffer temporarily, but make it go away when the next character is added. */ echoptr[0] = '-'; echoptr[1] = 0; echo (); } /* Display the current echo string, and begin echoing if not already doing so. */ echo () { if (!immediate_echo) { int i; immediate_echo = 1; for (i = 0; i < this_command_key_count; i++) echo_char (XVECTOR (this_command_keys)->contents[i]); echo_dash (); } echoing = 1; message1 (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 () { immediate_echo = 0; echoptr = echobuf; } /* Return the length of the current echo string. */ static int echo_length () { return echoptr - 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; { echobuf[len] = '\0'; echoptr = echobuf + len; } /* Functions for manipulating this_command_keys. */ static void add_command_key (key) Lisp_Object key; { int size = XVECTOR (this_command_keys)->size; if (this_command_key_count >= size) { Lisp_Object 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; } 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; } Lisp_Object cmd_error (data) Lisp_Object data; { Lisp_Object errmsg, tail, errname, file_error; Lisp_Object stream; struct gcpro gcpro1; int i; Vquit_flag = Qnil; Vinhibit_quit = Qt; Vstandard_output = Qt; Vstandard_input = Qt; Vexecuting_macro = Qnil; 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; } 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 (XTYPE (errmsg) == Lisp_String) 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)); } Vquit_flag = Qnil; Vinhibit_quit = Qnil; return make_number (0); } 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 (); 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; Vprefix_arg = Qnil; Vdeactivate_mark = Qnil; waiting_for_input = 0; cancel_echoing (); /* Don't clear out last_command at the beginning of a macro. */ if (XTYPE (Vexecuting_macro) != Lisp_String) last_command = Qt; 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. */ if (!NILP (Vpost_command_hook)) call1 (Vrun_hooks, Qpost_command_hook); while (1) { /* Install chars successfully executed in kbd macro. */ if (defining_kbd_macro && NILP (Vprefix_arg)) finalize_kbd_macro_chars (); /* 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) { /* 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; unread_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 (XTYPE (internal_last_event_frame) == Lisp_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); #if 0 /* This is done in xdisp.c now. */ #ifdef MULTI_FRAME for (tem = Vframe_list; CONSP (tem); tem = XCONS (tem)->cdr) { struct frame *f = XFRAME (XCONS (tem)->car); struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); /* 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 || update_mode_lines || (XFASTINT (w->last_modified) < MODIFF && (XFASTINT (w->last_modified) <= XBUFFER (w->buffer)->save_modified))) { struct buffer *prev = current_buffer; current_buffer = XBUFFER (w->buffer); FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (); current_buffer = prev; } } #endif /* MULTI_FRAME */ #endif /* 0 */ /* Read next key sequence; i gets its length. */ i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])), Qnil); ++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; continue; } 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. */ XWINDOW (selected_window)->force_start = Qnil; 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. */ no_redisplay = 0; prev_buffer = current_buffer; prev_modiff = MODIFF; /* Execute the command. */ this_command = cmd; if (!NILP (Vpre_command_hook)) call1 (Vrun_hooks, Qpre_command_hook); if (NILP (this_command)) { /* nil means key is undefined. */ bitch_at_user (); defining_kbd_macro = 0; update_mode_lines = 1; Vprefix_arg = Qnil; } else { if (NILP (Vprefix_arg) && ! no_direct) { /* Recognize some common commands in common situations and do them directly. */ if (EQ (this_command, Qforward_char) && point < ZV) { struct Lisp_Vector *dp = window_display_table (XWINDOW (selected_window)); lose = FETCH_CHAR (point); SET_PT (point + 1); if ((dp ? (XTYPE (DISP_CHAR_VECTOR (dp, lose)) != Lisp_Vector && XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1) : (lose >= 0x20 && lose < 0x7f)) && (XFASTINT (XWINDOW (selected_window)->last_modified) >= MODIFF) && (XFASTINT (XWINDOW (selected_window)->last_point) == point - 1) && !windows_or_buffers_changed && EQ (current_buffer->selective_display, Qnil) && !detect_input_pending () && NILP (Vexecuting_macro)) no_redisplay = direct_output_forward_char (1); goto directly_done; } else if (EQ (this_command, Qbackward_char) && point > BEGV) { struct Lisp_Vector *dp = window_display_table (XWINDOW (selected_window)); SET_PT (point - 1); lose = FETCH_CHAR (point); if ((dp ? (XTYPE (DISP_CHAR_VECTOR (dp, lose)) != Lisp_Vector && XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1) : (lose >= 0x20 && lose < 0x7f)) && (XFASTINT (XWINDOW (selected_window)->last_modified) >= MODIFF) && (XFASTINT (XWINDOW (selected_window)->last_point) == point + 1) && !windows_or_buffers_changed && EQ (current_buffer->selective_display, Qnil) && !detect_input_pending () && 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. */ && XTYPE (last_command_char) == Lisp_Int) { unsigned char c = XINT (last_command_char); 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) != point) || MODIFF <= current_buffer->save_modified || windows_or_buffers_changed || !EQ (current_buffer->selective_display, Qnil) || detect_input_pending () || !NILP (Vexecuting_macro); if (internal_self_insert (c, 0)) { lose = 1; nonundocount = 0; } if (!lose && (point == ZV || FETCH_CHAR (point) == '\n')) { struct Lisp_Vector *dp = window_display_table (XWINDOW (selected_window)); int lose = c; if (dp) { Lisp_Object obj = DISP_CHAR_VECTOR (dp, lose); if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 1 && (XTYPE (obj = XVECTOR (obj)->contents[0]) == Lisp_Int)) 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 (Vprefix_arg)) Fundo_boundary (); Fcommand_execute (this_command, Qnil); } directly_done: ; if (!NILP (Vpost_command_hook)) call1 (Vrun_hooks, Qpost_command_hook); /* If there is a prefix argument, 1) We don't want last_command to be ``universal-argument'' (that would be dumb), so don't set last_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 (NILP (Vprefix_arg)) { last_command = this_command; cancel_echoing (); this_command_key_count = 0; } if (!NILP (current_buffer->mark_active)) { 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")); } } } /* Number of seconds between polling for input. */ int polling_period; /* Nonzero means polling for input is temporarily suppressed. */ int poll_suppress_count; #ifdef POLL_FOR_INPUT int polling_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 () { 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 } /* 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 } /* Applying 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 (); /* 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-zero, then we set *USED_MOUSE_MENU to 1 if we used a mouse menu to read the input, or zero otherwise. If USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone. Value is t if we showed a menu and the user rejected it. */ Lisp_Object 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 save_jump; if (CONSP (unread_command_events)) { c = XCONS (unread_command_events)->car; unread_command_events = XCONS (unread_command_events)->cdr; if (this_command_key_count == 0) goto reread_first; else goto reread; } if (unread_command_char != -1) { XSET (c, Lisp_Int, unread_command_char); unread_command_char = -1; if (this_command_key_count == 0) goto reread_first; else goto reread; } 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))) { XSET (c, Lisp_Int, -1); return c; } c = Faref (Vexecuting_macro, make_number (executing_macro_index)); if (XTYPE (Vexecuting_macro) == Lisp_String && (XINT (c) & 0x80)) XFASTINT (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; } /* Save outer setjmp data, in case called recursively. */ save_getcjmp (save_jump); stop_polling (); if (commandflag >= 0 && !input_pending && !detect_input_pending ()) redisplay (); if (_setjmp (getcjmp)) { XSET (c, Lisp_Int, quit_char); #ifdef MULTI_FRAME XSET (internal_last_event_frame, Lisp_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; goto non_reread; } /* Message turns off echoing unless more keystrokes turn it on again. */ if (echo_area_glyphs && *echo_area_glyphs && echo_area_glyphs != echobuf) cancel_echoing (); else /* If already echoing, continue. */ echo_dash (); /* If in middle of key sequence and minibuffer not active, start echoing if enough time elapses. */ if (minibuf_level == 0 && !immediate_echo && this_command_key_count > 0 && ! noninteractive && echo_keystrokes > 0 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0)) { 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 { tem0 = sit_for (echo_keystrokes, 0, 1, 1); if (EQ (tem0, Qt)) echo (); } } /* Maybe auto save due to number of keystrokes or idle time. */ if (commandflag != 0 && auto_save_interval > 0 && num_nonmacro_input_chars - last_auto_save > max (auto_save_interval, 20) && !detect_input_pending ()) { jmp_buf temp; save_getcjmp (temp); Fdo_auto_save (Qnil, Qnil); restore_getcjmp (temp); } /* Try reading a character via menu prompting. Try this before the sit-for, because the sit-for would do the wrong thing if we are supposed to do menu prompting. */ c = Qnil; if (INTERACTIVE && !NILP (prev_event)) c = read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu); /* Slow down auto saves logarithmically in size of current buffer, and garbage collect while we're at it. */ if (INTERACTIVE && NILP (c)) { int delay_level, buffer_size; 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 && XTYPE (Vauto_save_timeout) == Lisp_Int && XINT (Vauto_save_timeout) > 0) { Lisp_Object tem0; int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4; tem0 = sit_for (delay, 0, 1, 1); if (EQ (tem0, Qt)) { jmp_buf temp; save_getcjmp (temp); Fdo_auto_save (Qnil, Qnil); restore_getcjmp (temp); /* 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 (); } } } } /* Actually read a character, waiting if necessary. */ while (NILP (c)) { c = kbd_buffer_get_event (); if (!NILP (c)) break; if (commandflag >= 0 && !input_pending && !detect_input_pending ()) redisplay (); } /* Terminate Emacs in batch mode if at eof. */ if (noninteractive && XTYPE (c) == Lisp_Int && XINT (c) < 0) Fkill_emacs (make_number (1)); if (XTYPE (c) == Lisp_Int) { /* 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: restore_getcjmp (save_jump); start_polling (); echo_area_glyphs = 0; /* Handle things that only apply to characters. */ if (XTYPE (c) == Lisp_Int) { /* If kbd_buffer_get_event gave us an EOF, return that. */ if (XINT (c) == -1) return c; if (XTYPE (Vkeyboard_translate_table) == Lisp_String && XSTRING (Vkeyboard_translate_table)->size > XFASTINT (c)) XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (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 (XTYPE (c) == Lisp_Int) putc (XINT (c), dribble); else { Lisp_Object dribblee = c; /* If it's a structured event, take the event header. */ dribblee = EVENT_HEAD (dribblee); if (XTYPE (dribblee) == Lisp_Symbol) { 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++; from_macro: reread_first: /* Record this character as part of the current key. Don't record mouse motion; it should never matter. */ if (! (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) { echo_char (c); add_command_key (c); } /* Re-reading in the middle of a command */ reread: last_input_char = c; num_input_chars++; /* Process the help character specially if enabled */ if (EQ (c, Vhelp_char) && !NILP (Vhelp_form)) { Lisp_Object tem0; count = specpdl_ptr - specpdl; record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (Qnil)); tem0 = Feval (Vhelp_form); if (XTYPE (tem0) == Lisp_String) internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); cancel_echoing (); c = read_char (0, 0, 0, Qnil, 0); /* Remove the help from the frame */ unbind_to (count, Qnil); redisplay (); if (EQ (c, make_number (040))) { cancel_echoing (); c = read_char (0, 0, 0, Qnil, 0); } } return c; } Lisp_Object print_help (object) Lisp_Object object; { Fprinc (object, Qnil); 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); } /* 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; { if (! XFASTINT (old_value)) { do_mouse_tracking = 0; /* 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; XSET (val, Lisp_Int, do_mouse_tracking); record_unwind_protect (tracking_off, val); do_mouse_tracking = 1; val = Fprogn (args); return unbind_to (count, val); } /* Low level keyboard/mouse input. kbd_buffer_store_event places events in kbd_buffer, and kbd_buffer_get_event retrieves them. mouse_moved indicates when the mouse has moved again, and *mouse_position_hook provides the mouse position. */ /* 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 () { return ! EVENT_QUEUES_EMPTY; } /* Set this for debugging, to have a way to get out */ int stop_character; /* 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 = XFASTINT (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_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 = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window)); if (NILP (focus)) internal_last_event_frame = event->frame_or_window; else internal_last_event_frame = focus; Vlast_event_frame = internal_last_event_frame; } #endif last_event_timestamp = event->timestamp; interrupt_signal (); return; } if (c && c == stop_character) { sys_suspend (); 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) { kbd_store_ptr->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, kbd_store_ptr, sizeof (*event)); } else { kbd_store_ptr->code = event->code; kbd_store_ptr->part = event->part; kbd_store_ptr->frame_or_window = event->frame_or_window; kbd_store_ptr->modifiers = event->modifiers; kbd_store_ptr->x = event->x; kbd_store_ptr->y = event->y; kbd_store_ptr->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 () { register int c; Lisp_Object obj; if (noninteractive) { c = getchar (); XSET (obj, Lisp_Int, c); return obj; } /* Wait until there is input available. */ for (;;) { if (!EVENT_QUEUES_EMPTY) break; /* 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 (EVENT_QUEUES_EMPTY) { Lisp_Object minus_one; XSET (minus_one, Lisp_Int, -1); wait_reading_process_input (0, 0, minus_one, 1); if (!interrupt_input && EVENT_QUEUES_EMPTY) { read_avail_input (0); } } #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; 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 x_handle_selection_request (event); kbd_fetch_ptr = event + 1; #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 x_handle_selection_clear (event); kbd_fetch_ptr = event + 1; #else /* We're getting selection request events, but we don't have a window system. */ abort (); #endif } #ifdef HAVE_X11 else if (event->kind == delete_window_event) { Lisp_Object tail, frame; struct frame *f; /* If the user destroys the only frame, Emacs should exit. Count visible frames and iconified frames. */ for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (XTYPE (frame) != Lisp_Frame || EQ (frame, event->frame_or_window)) continue; f = XFRAME (frame); if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) break; } if (! CONSP (tail)) kill (getpid (), SIGHUP); Fdelete_frame (event->frame_or_window, Qt); kbd_fetch_ptr = event + 1; } #endif /* Just discard these, by returning nil. (They shouldn't be found in the buffer, but on some machines it appears they do show up.) */ 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 = event->frame_or_window; Lisp_Object focus; if (XTYPE (frame) == Lisp_Window) 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); /* 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; } } } /* Try generating a mouse motion event. */ else if (do_mouse_tracking && mouse_moved) { FRAME_PTR f = 0; Lisp_Object bar_window; enum scroll_bar_part part; Lisp_Object x, y; unsigned long time; (*mouse_position_hook) (&f, &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 (f) { Lisp_Object frame = FRAME_FOCUS_FRAME (f); if (NILP (frame)) XSET (frame, Lisp_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 (obj)) obj = make_lispy_movement (f, bar_window, part, x, y, time); } 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 x_handle_selection_request (event); kbd_fetch_ptr = event + 1; #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 x_handle_selection_clear (event); kbd_fetch_ptr = event + 1; #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 func_key_syms; static Lisp_Object mouse_syms; /* 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 */ "remove", 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 */ /* Here are some keys found mostly on HP keyboards. The X event handling code will strip bit 29, which flags vendor-specific keysyms. */ "reset", /* 0x1000ff6c */ "system", "user", "clearline", "insertline", "deleteline", "insertchar", "deletechar", "backtab", "kp-backtab", /* 0x1000ff75 */ 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", 0, /* 0xff95 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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" }; 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; { #ifdef SWITCH_ENUM_BUG switch ((int) event->kind) #else switch (event->kind) #endif { /* A simple keystroke. */ case ascii_keystroke: { int c = XFASTINT (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; return c; } /* A function key. The symbol may need to have modifier prefixes tacked onto it. */ case non_ascii_keystroke: button_down_time = 0; return modify_event_symbol (XFASTINT (event->code), event->modifiers, Qfunction_key, lispy_function_keys, &func_key_syms, (sizeof (lispy_function_keys) / sizeof (lispy_function_keys[0]))); break; /* 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 = XFASTINT (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 = window_from_coordinates (f, XINT (event->x), XINT (event->y), &part); Lisp_Object posn; if (XINT (event->y) < FRAME_MENU_BAR_LINES (f)) { int hpos; Lisp_Object items; items = FRAME_MENU_BAR_ITEMS (f); for (; CONSP (items); items = XCONS (items)->cdr) { Lisp_Object pos, string; pos = Fcdr (Fcdr (Fcar (items))); string = Fcar (Fcdr (Fcar (items))); if (XINT (event->x) >= XINT (pos) && XINT (event->x) < XINT (pos) + XSTRING (string)->size) break; } position = Fcons (event->frame_or_window, Fcons (Qmenu_bar, Fcons (Fcons (event->x, event->y), Fcons (make_number (event->timestamp), Qnil)))); if (CONSP (items)) return Fcons (Fcar (Fcar (items)), Fcons (position, Qnil)); else return Fcons (Qnil, Fcons (position, Qnil)); } else if (XTYPE (window) != Lisp_Window) posn = Qnil; else { XSETINT (event->x, (XINT (event->x) - XINT (XWINDOW (window)->left))); XSETINT (event->y, (XINT (event->y) - XINT (XWINDOW (window)->top))); if (part == 1) posn = Qmode_line; else if (part == 2) posn = Qvertical_line; else XSET (posn, Lisp_Int, buffer_posn_from_coords (XWINDOW (window), XINT (event->x), XINT (event->y))); } position = Fcons (window, Fcons (posn, Fcons (Fcons (event->x, event->y), Fcons (make_number (event->timestamp), Qnil)))); } else { Lisp_Object window = event->frame_or_window; Lisp_Object portion_whole = Fcons (event->x, event->y); Lisp_Object 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 (XTYPE (start_pos) != Lisp_Cons) return Qnil; event->modifiers &= ~up_modifier; #if 0 /* Formerly we treated an up with no down as a click event. */ if (XTYPE (start_pos) != Lisp_Cons) event->modifiers |= click_modifier; else #endif { /* The third element of every position should be the (x,y) pair. */ Lisp_Object down = Fnth (make_number (2), start_pos); if (EQ (event->x, XCONS (down)->car) && EQ (event->y, XCONS (down)->cdr)) { if (is_double && double_click_count > 1) event->modifiers |= ((double_click_count > 2) ? triple_modifier : double_modifier); else event->modifiers |= click_modifier; } else { button_down_time = 0; event->modifiers |= drag_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 = modify_event_symbol (button, event->modifiers, Qmouse_click, 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)); } } /* The 'kind' field of the event is something we don't recognize. */ default: abort (); } } 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; { /* Is it a scroll bar movement? */ if (frame && ! NILP (bar_window)) { Lisp_Object 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 { int area; Lisp_Object window = (frame ? window_from_coordinates (frame, XINT (x), XINT (y), &area) : Qnil); Lisp_Object posn; if (XTYPE (window) == Lisp_Window) { XSETINT (x, XINT (x) - XINT (XWINDOW (window)->left)); XSETINT (y, XINT (y) - XINT (XWINDOW (window)->top)); if (area == 1) posn = Qmode_line; else if (area == 2) posn = Qvertical_line; else XSET (posn, Lisp_Int, buffer_posn_from_coords (XWINDOW (window), XINT (x), XINT (y))); } else { window = Qnil; posn = Qnil; XFASTINT (x) = 0; XFASTINT (y) = 0; } return Fcons (Qmouse_movement, Fcons (Fcons (window, Fcons (posn, Fcons (Fcons (x, y), Fcons (make_number (time), Qnil)))), Qnil)); } } /* 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; ) switch (name->data[i]) { #define SINGLE_LETTER_MOD(bit) \ if (name->data[i+1] != '-') \ goto no_more_modifiers; \ modifiers |= bit; \ i += 2; 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; case 'd': if (i + 5 > name->size) goto no_more_modifiers; if (! strncmp (name->data + i, "drag-", 5)) { modifiers |= drag_modifier; i += 5; } else if (! strncmp (name->data + i, "down-", 5)) { modifiers |= down_modifier; i += 5; } else if (i + 7 <= name->size && ! strncmp (name->data + i, "double-", 7)) { modifiers |= double_modifier; i += 7; } else goto no_more_modifiers; break; case 't': if (i + 7 > name->size) goto no_more_modifiers; if (! strncmp (name->data + i, "triple-", 7)) { modifiers |= triple_modifier; i += 7; } else goto no_more_modifiers; break; default: goto no_more_modifiers; #undef SINGLE_LETTER_MOD } no_more_modifiers: /* 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 = 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, "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 = Fget (symbol, Qevent_symbol_element_mask); if (CONSP (elements)) return elements; else { int end; int modifiers = parse_modifiers_uncached (symbol, &end); Lisp_Object unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end, XSYMBOL (symbol)->name->size - end), Qnil); Lisp_Object mask; if (modifiers & ~((1<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. */ XFASTINT (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 = 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 = parse_modifiers (symbol); return apply_modifiers (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. 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. 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_table, symbol_table, table_size) int symbol_num; unsigned modifiers; Lisp_Object symbol_kind; char **name_table; Lisp_Object *symbol_table; int table_size; { Lisp_Object *slot; /* Is this a request for a valid symbol? */ if (symbol_num < 0 || symbol_num >= table_size) abort (); /* 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. */ if (XTYPE (*symbol_table) != Lisp_Vector || XVECTOR (*symbol_table)->size != table_size) { Lisp_Object size; XFASTINT (size) = table_size; *symbol_table = Fmake_vector (size, Qnil); } slot = & XVECTOR (*symbol_table)->contents[symbol_num]; /* Have we already used this symbol before? */ if (NILP (*slot)) { /* No; let's create it. */ if (name_table[symbol_num]) *slot = intern (name_table[symbol_num]); else { char buf[20]; sprintf (buf, "key-%d", symbol_num); *slot = intern (buf); } /* 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, *slot); Fput (*slot, Qevent_kind, symbol_kind); } /* Apply modifiers to that symbol. */ return apply_modifiers (modifiers, *slot); } /* 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 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 #endif read_avail_input (expected); #endif } #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) (0, 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]; #ifdef FIONREAD /* Find out how much input is available. */ if (ioctl (0, FIONREAD, &nread) < 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 (nread == 0) return 0; if (nread > sizeof cbuf) nread = sizeof cbuf; #else /* no FIONREAD */ #if defined(USG) || defined(DGUX) /* Read some input if available, but don't wait. */ nread = sizeof cbuf; fcntl (fileno (stdin), F_SETFL, O_NDELAY); #else you lose; #endif #endif /* Now read; for one reason or another, this will not block. */ while (1) { nread = read (fileno (stdin), cbuf, nread); #ifdef AIX /* 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 (SIGHUP, 0); #endif /* This code is wrong, but at least it gets the right results. Fix it for 19.23. */ /* Retry the read if it is interrupted. */ if (nread >= 0 || ! (errno == EAGAIN || errno == EFAULT #ifdef EBADSLT || errno == EBADSLT #endif )) break; } #ifndef FIONREAD #ifdef USG fcntl (fileno (stdin), F_SETFL, 0); #endif /* USG */ #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; XSET (buf[i].code, Lisp_Int, cbuf[i]); #ifdef MULTI_FRAME XSET (buf[i].frame_or_window, Lisp_Frame, 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 && XINT(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 (XTYPE (tem) == Lisp_String) return tem; map = Fcdr (map); } return Qnil; } static Lisp_Object menu_bar_item (); static Lisp_Object menu_bar_one_keymap (); /* Return a list of menu items for a menu bar, appropriate to the current buffer. The elements have the form (KEY STRING . nil). */ Lisp_Object menu_bar_items () { /* 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; /* 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; /* 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; nmaps = current_minor_maps (0, &tmaps) + 2; maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0])); bcopy (tmaps, maps, (nmaps - 2) * sizeof (maps[0])); #ifdef USE_TEXT_PROPERTIES maps[nmaps-2] = get_local_map (PT, current_buffer); #else maps[nmaps-2] = current_buffer->keymap; #endif maps[nmaps-1] = 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)) result = menu_bar_one_keymap (def, result); } for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object elt; elt = Fassq (XCONS (tail)->car, result); if (!NILP (elt)) result = Fcons (elt, Fdelq (elt, result)); } result = Fnreverse (result); Vinhibit_quit = oquit; return result; } /* Scan one map KEYMAP, accumulating any menu items it defines that have not yet been seen in RESULT. Return the updated RESULT. */ static Lisp_Object menu_bar_one_keymap (keymap, result) Lisp_Object keymap, result; { Lisp_Object tail, item, key, binding, item_string, table; /* Loop over all keymap entries that have menu strings. */ for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { item = XCONS (tail)->car; if (XTYPE (item) == Lisp_Cons) { key = XCONS (item)->car; binding = XCONS (item)->cdr; if (XTYPE (binding) == Lisp_Cons) { item_string = XCONS (binding)->car; if (XTYPE (item_string) == Lisp_String) result = menu_bar_item (key, item_string, Fcdr (binding), result); } else if (EQ (binding, Qundefined)) result = menu_bar_item (key, item_string, binding, result); } else if (XTYPE (item) == Lisp_Vector) { /* 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; XFASTINT (character) = c; binding = XVECTOR (item)->contents[c]; if (XTYPE (binding) == Lisp_Cons) { item_string = XCONS (binding)->car; if (XTYPE (item_string) == Lisp_String) result = menu_bar_item (key, item_string, Fcdr (binding), result); } else if (EQ (binding, Qundefined)) result = menu_bar_item (key, item_string, binding, result); } } } return result; } static Lisp_Object menu_bar_item (key, item_string, def, result) Lisp_Object key, item_string, def, result; { Lisp_Object tem; Lisp_Object enabled; if (EQ (def, Qundefined)) { /* If a map has an explicit nil as definition, discard any previously made menu bar item. */ tem = Fassq (key, result); return Fdelq (tem, result); } /* See if this entry is enabled. */ enabled = Qt; 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)) enabled = Feval (tem); } /* Add an entry for this key and string if there is none yet. */ tem = Fassq (key, result); if (!NILP (enabled) && NILP (tem)) result = Fcons (Fcons (key, Fcons (item_string, Qnil)), result); return result; } static int echo_flag; static int echo_now; /* Read a character using menus based on maps in the array MAPS. NMAPS is the length of MAPS. Return nil if there are no menus in the maps. Return t if we displayed a menu but the user rejected it. PREV_EVENT is the previous input event, or nil if we are reading the first event of a key sequence. If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1 if we used a mouse menu to read the input, or zero otherwise. If USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone. The prompting is done based on the prompt-string of the map and the strings associated with various map elements. */ static Lisp_Object read_char_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; int nlength; int width = FRAME_WIDTH (selected_frame) - 4; char *menu = (char *) alloca (width + 4); int idx = -1; Lisp_Object rest, vector; if (used_mouse_menu) *used_mouse_menu = 0; /* Use local over global Menu maps */ 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; #ifdef HAVE_X_WINDOWS #ifdef HAVE_X_MENU /* If we got to this point via a mouse click, use a real menu for mouse selection. */ if (EVENT_HAS_PARAMETERS (prev_event)) { /* 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)) { /* 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. */ unread_command_events = nconc2 (XCONS (value)->cdr, unread_command_events); value = XCONS (value)->car; } if (NILP (value)) value = Qt; if (used_mouse_menu) *used_mouse_menu = 1; return value; } #endif /* HAVE_X_MENU */ #endif /* HAVE_X_WINDOWS */ /* 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; /* 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) { if (notfirst) break; else mapno = 0; } 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 && XTYPE (elt) == Lisp_Vector) { /* 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. */ s = Fcar_safe (Fcdr_safe (elt)); if (XTYPE (s) != Lisp_String) /* Ignore the element if it has no prompt string. */ ; /* If we have room for the prompt string, add it to this line. If this is the first on the line, always add it. */ else if (XSTRING (s)->size + i < width || !notfirst) { int thiswidth; /* Punctuate between strings. */ if (notfirst) { strcpy (menu + i, ", "); i += 2; } notfirst = 1; /* 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; } 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 (rest)->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); obj = read_char (1, 0, 0, Qnil, 0); if (XTYPE (obj) != Lisp_Int) return obj; else ch = XINT (obj); if (! EQ (obj, menu_prompt_more_char) && (XTYPE (menu_prompt_more_char) != Lisp_Int || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))) return obj; } } /* 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. When KEY is not defined in any of the keymaps, if it is an upper case letter and there are bindings for the corresponding lower-case letter, return the bindings for the lower-case letter. If KEY has no bindings in any of the CURRENT maps, NEXT is left unmodified. NEXT may == CURRENT. */ static int follow_key (key, nmaps, current, defs, next) Lisp_Object key; Lisp_Object *current, *defs, *next; int nmaps; { int i, first_binding; /* If KEY is a meta ASCII character, treat it like meta-prefix-char followed by the corresponding non-meta character. */ if (XTYPE (key) == Lisp_Int && (XINT (key) & CHAR_META)) { for (i = 0; i < nmaps; i++) if (! NILP (current[i])) { next[i] = 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. */ next[i] = get_keymap_1 (next[i], 0, 1); } else next[i] = Qnil; current = next; XSET (key, Lisp_Int, XFASTINT (key) & ~CHAR_META); } first_binding = nmaps; for (i = nmaps - 1; i >= 0; i--) { if (! NILP (current[i])) { defs[i] = get_keyelt (access_keymap (current[i], key, 1, 0)); if (! NILP (defs[i])) first_binding = i; } else defs[i] = Qnil; } /* When KEY is not defined in any of the keymaps, if it is an upper case letter and there are bindings for the corresponding lower-case letter, return the bindings for the lower-case letter. */ if (first_binding == nmaps && XTYPE (key) == Lisp_Int && ((((XINT (key) & 0x3ffff) < XSTRING (current_buffer->downcase_table)->size) && UPPERCASEP (XINT (key) & 0x3ffff)) || (XINT (key) & shift_modifier))) { if (XINT (key) & shift_modifier) XSETINT (key, XINT (key) & ~shift_modifier); else XSETINT (key, (DOWNCASE (XINT (key) & 0x3ffff) | (XINT (key) & ~0x3ffff))); first_binding = nmaps; for (i = nmaps - 1; i >= 0; i--) { if (! NILP (current[i])) { defs[i] = get_keyelt (access_keymap (current[i], 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) Lisp_Object *keybuf; int bufsize; Lisp_Object prompt; { 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 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 struct buffer *starting_buffer; 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) /* 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 */ /* 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; /* 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; nmaps = current_minor_maps (0, &maps) + 2; if (nmaps > nmaps_allocated) { submaps = (Lisp_Object *) alloca (nmaps * sizeof (submaps[0])); defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0])); nmaps_allocated = nmaps; } bcopy (maps, submaps, (nmaps - 2) * sizeof (submaps[0])); #ifdef USE_TEXT_PROPERTIES submaps[nmaps-2] = get_local_map (PT, current_buffer); #else submaps[nmaps-2] = current_buffer->keymap; #endif submaps[nmaps-1] = 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) 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 /* mock input is never part of a function key's sequence. */ && mock_input <= keytran_start)) { 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) 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); echo_char (key); } /* If not, we should actually read a character. */ else { struct buffer *buf = current_buffer; 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 (XTYPE (key) == Lisp_Int && XINT (key) == -1) { t = 0; goto done; } /* 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 (EQ (key, quit_char) && current_buffer != starting_buffer) { keybuf[t++] = key; mock_input = t; Vquit_flag = Qnil; 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 = EVENT_HEAD_KIND (EVENT_HEAD (key)); if (EQ (kind, Qmouse_click)) { Lisp_Object window = POSN_WINDOW (EVENT_START (key)); Lisp_Object posn = POSN_BUFFER_POSN (EVENT_START (key)); if (XTYPE (posn) == Lisp_Cons) { /* 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 && XTYPE (window) == Lisp_Window && XTYPE (XWINDOW (window)->buffer) == Lisp_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)); goto replay_sequence; } else if (XTYPE (posn) == Lisp_Symbol) { /* Expand mode-line and scroll-bar events into two events: use posn as a fake prefix key. */ 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, go ahead and return this event. If we're in the midst of a key sequence, delay it until the end. */ if (t > 0) { delayed_switch_frame = key; goto replay_key; } } else { Lisp_Object 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"); /* 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); 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 (XTYPE (posn) == Lisp_Cons) { /* 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 = EVENT_HEAD (key); if (EQ (head, Vhelp_char)) { read_key_sequence_cmd = Vprefix_help_command; keybuf[t++] = key; last_nonmenu_event = key; goto done; } if (XTYPE (head) == Lisp_Symbol) { Lisp_Object breakdown = parse_modifiers (head); int 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 & (drag_modifier | double_modifier)) modifiers &= ~(drag_modifier | double_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; /* 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; /* Scan from fkey_end until we find a bound suffix. */ 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 (XTYPE (key) == Lisp_Int && XINT (key) & meta_modifier) { fkey_next = get_keymap_1 (get_keyelt (access_keymap (fkey_map, meta_prefix_char, 1, 0)), 0, 1); XFASTINT (key) = XFASTINT (key) & ~meta_modifier; } else fkey_next = fkey_map; fkey_next = get_keyelt (access_keymap (fkey_next, key, 1, 0)); /* 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"); } /* 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++) XFASTINT (keybuf[fkey_start + i]) = XSTRING (fkey_next)->data[i]; } mock_input = t; fkey_start = fkey_end = t; fkey_map = Vfunction_key_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; } } } /* 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 (XTYPE (key) == Lisp_Int && XINT (key) & meta_modifier) { keytran_next = get_keymap_1 (get_keyelt (access_keymap (keytran_map, meta_prefix_char, 1, 0)), 0, 1); XFASTINT (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 (keytran_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 function-key-map returns invalid key sequence"); } /* 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++) XFASTINT (keybuf[keytran_start + i]) = XSTRING (keytran_next)->data[i]; } mock_input = t; keytran_start = keytran_end = t; keytran_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; } } } } read_key_sequence_cmd = (first_binding < nmaps ? defs[first_binding] : Qnil); done: unread_switch_frame = delayed_switch_frame; unbind_to (count, Qnil); /* 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++) { 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, 2, 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\ 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\ If the user switches frames in the middle of a key sequence, the\n\ frame-switch event is 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) #endif DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 2, 0, 0) (prompt, continue_echo) Lisp_Object prompt, continue_echo; { 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); if (i == -1) { Vquit_flag = Qt; QUIT; } UNGCPRO; return make_event_array (i, keybuf); } DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 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.") (cmd, record) Lisp_Object cmd, record; { register Lisp_Object final; register Lisp_Object tem; Lisp_Object prefixarg; struct backtrace backtrace; extern int debug_on_next_call; prefixarg = Vprefix_arg, Vprefix_arg = Qnil; Vcurrent_prefix_arg = prefixarg; debug_on_next_call = 0; if (XTYPE (cmd) == Lisp_Symbol) { tem = Fget (cmd, Qdisabled); 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 (XTYPE (final) == Lisp_String || XTYPE (final) == Lisp_Vector) { /* 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) || XTYPE (final) == Lisp_Subr || XTYPE (final) == Lisp_Compiled) { 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); 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 = Fthis_command_keys (); 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) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int) sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car)); else if (XTYPE (prefixarg) == Lisp_Int) sprintf (buf, "%d ", XINT (prefixarg)); /* 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; int i; Lisp_Object tem; this_command_key_count = 0; str = XSTRING (saved_keys); for (i = 0; i < str->size; i++) { XFASTINT (tem) = str->data[i]; add_command_key (tem); } str = XSTRING (function); for (i = 0; i < str->size; i++) { XFASTINT (tem) = str->data[i]; add_command_key (tem); } XFASTINT (tem) = '\015'; add_command_key (tem); } UNGCPRO; function = Fintern (function, Qnil); Vprefix_arg = prefixarg; this_command = function; return Fcommand_execute (function, Qt); } 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 (unread_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 ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, "Return the current depth in recursive edits.") () { Lisp_Object temp; XFASTINT (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)) { 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.") () { defining_kbd_macro = 0; update_mode_lines++; unread_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\ On systems that don't have job 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, call the functions in `suspend-hook' with no args.\n\ If any of them returns nil, don't call the rest and don't suspend.\n\ Otherwise, suspend normally and after resumption run the normal hook\n\ `suspend-resume-hook' if that is bound and non-nil.\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); 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; { register unsigned char *p; /* stuff_char works only in BSD, versions 4.2 and up. */ #ifdef BSD #ifndef BSD4_1 if (XTYPE (stuffstring) == Lisp_String) { 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. */ while (kbd_fetch_ptr != kbd_store_ptr) { if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) kbd_fetch_ptr = kbd_buffer; if (kbd_fetch_ptr->kind == ascii_keystroke) stuff_char (XINT (kbd_fetch_ptr->code)); kbd_fetch_ptr->kind = no_event; (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr - kbd_buffer] = Qnil); kbd_fetch_ptr++; } 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 (); /* If alarm has gone off already, echo now. */ if (echo_flag) { echo (); echo_flag = 0; } } 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 () { char c; /* Must preserve main program's value of errno. */ int old_errno = errno; #ifdef USG /* 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 */ printf ("Auto-save? (y or n) "); fflush (stdout); if (((c = getchar ()) & ~040) == 'Y') { Fdo_auto_save (Qt, Qnil); printf ("Auto-save done\n"); } while (c != '\n') c = getchar (); #ifdef VMS printf ("Abort (and enter debugger)? (y or n) "); #else /* not VMS */ printf ("Abort (and dump core)? (y or n) "); #endif /* not VMS */ fflush (stdout); if (((c = getchar ()) & ~040) == 'Y') abort (); while (c != '\n') c = getchar (); printf ("Continuing...\n"); 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; unread_command_events = Qnil; unread_command_char = -1; #ifdef POLL_FOR_INPUT /* May be > 1 if in recursive minibuffer. */ if (poll_suppress_count == 0) abort (); #endif #ifdef MULTI_FRAME if (XFRAME (internal_last_event_frame) != selected_frame) Fhandle_switch_frame (make_lispy_switch_frame (internal_last_event_frame)); #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) && (XTYPE (quit) != Lisp_Int || XINT (quit) < 0 || XINT (quit) > 0400)) error ("set-input-mode: QUIT must be an ASCII character"); #ifdef POLL_FOR_INPUT stop_polling (); #endif reset_sys_modes (); #ifdef SIGIO /* Note SIGIO has been undef'd if FIONREAD is missing. */ #ifdef NO_SOCK_SIGIO if (read_socket_hook) interrupt_input = 0; /* No interrupts if reading from a socket. */ else #endif /* NO_SOCK_SIGIO */ 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); init_sys_modes (); #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; XFASTINT (val[3]) = quit_char; return Flist (sizeof (val) / sizeof (val[0]), val); } init_keyboard () { /* This is correct before outermost invocation of the editor loop */ command_loop_level = -1; immediate_quit = 0; quit_char = Ctl ('g'); unread_command_events = Qnil; unread_command_char = -1; total_keys = 0; recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; kbd_store_ptr = kbd_buffer; do_mouse_tracking = 0; 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 /* If we're running a dumped Emacs, we need to clear out kbd_buffer_frame_or_window, in case some events got into it before we dumped. If we're running an undumped Emacs, it hasn't been initialized by syms_of_keyboard yet. */ if (initialized) Ffillarray (kbd_buffer_frame_or_window, Qnil); if (!noninteractive) { 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 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, }; 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); 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); { 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); func_key_syms = Qnil; staticpro (&func_key_syms); mouse_syms = Qnil; staticpro (&mouse_syms); unread_switch_frame = Qnil; staticpro (&unread_switch_frame); defsubr (&Sread_key_sequence); defsubr (&Srecursive_edit); defsubr (&Strack_mouse); defsubr (&Sinput_pending_p); defsubr (&Scommand_execute); defsubr (&Srecent_keys); defsubr (&Sthis_command_keys); 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 ("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 ("last-input-event", &last_input_char, "Last input event."); DEFVAR_LISP ("unread-command-events", &unread_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."); XSET (meta_prefix_char, Lisp_Int, 033); DEFVAR_LISP ("last-command", &last_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."); last_command = Qnil; 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."); XFASTINT (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_INT ("num-input-keys", &num_input_keys, "*Number of complete keys read from the keyboard so far."); num_input_keys = 0; #ifdef MULTI_FRAME 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; #endif 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."); XSET (Vhelp_char, Lisp_Int, Ctl ('H')); 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, "String used as translate table for keyboard input, or nil.\n\ Each character is looked up in this string and the contents used instead.\n\ If string is of length N, character codes N and up are untranslated."); Vkeyboard_translate_table = 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; 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."); XSET (menu_prompt_more_char, Lisp_Int, ' '); 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 ("pre-command-hook", &Vpre_command_hook, "Normal hook run before each command is executed."); Vpre_command_hook = Qnil; DEFVAR_LISP ("post-command-hook", &Vpost_command_hook, "Normal hook run after each command is executed."); Vpost_command_hook = Qnil; 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; } 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"); } emacs-19.22/src/keymap.c100444 12120 1 177003 5473767337 13417 0ustar rmsdaemon/* Manipulation of keymaps 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. */ #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; 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; void describe_map_tree (); static Lisp_Object define_as_prefix (); static Lisp_Object describe_buffer_bindings (); static void describe_command (); static void describe_map (); static void describe_map_2 (); /* 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; XSET (v, Lisp_Vector, tomap); XFASTINT (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 a keymap 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. 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 && XTYPE (object) == Lisp_Symbol && 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, 0, 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 (XTYPE (idx) == Lisp_Symbol) 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. */ XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1)); { Lisp_Object tail; Lisp_Object t_binding = Qnil; for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object binding = XCONS (tail)->car; switch (XTYPE (binding)) { case Lisp_Symbol: /* 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; break; case Lisp_Cons: 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; break; case Lisp_Vector: if (XTYPE (idx) == Lisp_Int && XINT (idx) >= 0 && XINT (idx) < XVECTOR (binding)->size) { val = XVECTOR (binding)->contents[XINT (idx)]; if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; return val; } break; } 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. */ Lisp_Object get_keyelt (object) register Lisp_Object object; { while (1) { register Lisp_Object map, tem; /* If the contents are (KEYMAP . ELEMENT), go indirect. */ map = get_keymap_1 (Fcar_safe (object), 0, 0); 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 (XTYPE (object) == Lisp_Cons && XTYPE (XCONS (object)->car) == Lisp_String) { object = XCONS (object)->cdr; /* Also remove a menu help string, if any, following the menu item name. */ if (XTYPE (object) == Lisp_Cons && XTYPE (XCONS (object)->car) == Lisp_String) 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 (XTYPE (keymap) != Lisp_Cons || ! 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 (XTYPE (idx) == Lisp_Symbol) 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. */ XFASTINT (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 = keymap; for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object elt = XCONS (tail)->car; switch (XTYPE (elt)) { case Lisp_Vector: if (XTYPE (idx) == Lisp_Int && XINT (idx) >= 0 && XINT (idx) < XVECTOR (elt)->size) { XVECTOR (elt)->contents[XFASTINT (idx)] = def; return def; } insertion_point = tail; break; case Lisp_Cons: if (EQ (idx, XCONS (elt)->car)) { XCONS (elt)->cdr = def; return def; } break; case Lisp_Symbol: /* 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; break; } 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 = XCONS (tail)->car; if (XTYPE (elt) == Lisp_Vector) { int i; elt = Fcopy_sequence (elt); XCONS (tail)->car = elt; for (i = 0; i < XVECTOR (elt)->size; i++) if (XTYPE (XVECTOR (elt)->contents[i]) != Lisp_Symbol && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i]))) XVECTOR (elt)->contents[i] = Fcopy_keymap (XVECTOR (elt)->contents[i]); } else if (CONSP (elt) && XTYPE (XCONS (elt)->cdr) != Lisp_Symbol && ! NILP (Fkeymapp (XCONS (elt)->cdr))) XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr); } return copy; } /* Simple Keymap mutators and accessors. */ 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 (keymap); if (XTYPE (key) != Lisp_Vector && XTYPE (key) != Lisp_String) key = wrong_type_argument (Qarrayp, key); length = XFASTINT (Flength (key)); if (length == 0) return Qnil; GCPRO3 (keymap, key, def); if (XTYPE (key) == Lisp_Vector) meta_bit = meta_modifier; else meta_bit = 0x80; idx = 0; while (1) { c = Faref (key, make_number (idx)); if (XTYPE (c) == Lisp_Int && (XINT (c) & meta_bit) && !metized) { c = meta_prefix_char; metized = 1; } else { if (XTYPE (c) == Lisp_Int) XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } if (idx == length) RETURN_UNGCPRO (store_in_keymap (keymap, c, def)); cmd = get_keyelt (access_keymap (keymap, c, 0, 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. */ Lisp_Object description = Fkey_description (key); error ("Key sequence %s uses invalid prefix characters", XSTRING (description)->data); } } } /* Value is number if KEY is too long; NIL if valid but has no definition. */ 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; keymap = get_keymap (keymap); if (XTYPE (key) != Lisp_Vector && XTYPE (key) != Lisp_String) key = wrong_type_argument (Qarrayp, key); length = XFASTINT (Flength (key)); if (length == 0) return keymap; if (XTYPE (key) == Lisp_Vector) meta_bit = meta_modifier; else meta_bit = 0x80; idx = 0; while (1) { c = Faref (key, make_number (idx)); if (XTYPE (c) == Lisp_Int && (XINT (c) & meta_bit) && !metized) { c = meta_prefix_char; metized = 1; } else { if (XTYPE (c) == Lisp_Int) XSETINT (c, XINT (c) & ~meta_bit); metized = 0; idx++; } cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0)); if (idx == length) return cmd; keymap = get_keymap_1 (cmd, 0, 0); if (NILP (keymap)) return 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; /* 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 (CONSP (assoc = XCONS (alist)->car) && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol && ! EQ ((val = find_symbol_value (var)), Qunbound) && ! NILP (val)) { if (i >= cmm_size) { Lisp_Object *newmodes, *newmaps; if (cmm_maps) { BLOCK_INPUT; newmodes = (Lisp_Object *) realloc (cmm_modes, cmm_size *= 2); newmaps = (Lisp_Object *) realloc (cmm_maps, cmm_size); UNBLOCK_INPUT; } else { BLOCK_INPUT; newmodes = (Lisp_Object *) malloc (cmm_size = 30); newmaps = (Lisp_Object *) malloc (cmm_size); UNBLOCK_INPUT; } if (newmaps && newmodes) { cmm_modes = newmodes; cmm_maps = newmaps; } else break; } cmm_modes[i] = var; cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr); i++; } if (modeptr) *modeptr = cmm_modes; if (mapptr) *mapptr = cmm_maps; return i; } 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; { Lisp_Object *maps, value; int nmaps, i; nmaps = current_minor_maps (0, &maps); for (i = 0; i < nmaps; i++) if (! NILP (maps[i])) { value = Flookup_key (maps[i], key, accept_default); if (! NILP (value) && XTYPE (value) != Lisp_Int) return value; } if (! NILP (current_buffer->keymap)) { value = Flookup_key (current_buffer->keymap, key, accept_default); if (! NILP (value) && XTYPE (value) != Lisp_Int) return value; } value = Flookup_key (current_global_map, key, accept_default); if (! NILP (value) && XTYPE (value) != Lisp_Int) return value; return Qnil; } 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); } 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); } 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; nmaps = current_minor_maps (&modes, &maps); for (i = j = 0; i < nmaps; i++) if (! NILP (maps[i]) && ! NILP (binding = Flookup_key (maps[i], key, accept_default)) && XTYPE (binding) != Lisp_Int) { if (! NILP (get_keymap (binding))) maps[j++] = Fcons (modes[i], binding); else if (j == 0) return Fcons (Fcons (modes[i], binding), Qnil); } return Flist (j, maps); } DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2, "kSet key globally: \nCSet key %s to command: ", "Give KEY a global binding as COMMAND.\n\ COMMAND is a symbol naming an interactively-callable function.\n\ KEY is a key sequence (a string or vector of characters or event types).\n\ Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ can be included if you use a vector.\n\ Note that if KEY has a local binding in the current buffer\n\ that local binding will continue to shadow any global binding.") (keys, function) Lisp_Object keys, function; { if (XTYPE (keys) != Lisp_Vector && XTYPE (keys) != Lisp_String) keys = wrong_type_argument (Qarrayp, keys); Fdefine_key (current_global_map, keys, function); return Qnil; } DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2, "kSet key locally: \nCSet key %s locally to command: ", "Give KEY a local binding as COMMAND.\n\ COMMAND is a symbol naming an interactively-callable function.\n\ KEY is a key sequence (a string or vector of characters or event types).\n\ Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\ can be included if you use a vector.\n\ The binding goes in the current buffer's local map,\n\ which is shared with other buffers in the same major mode.") (keys, function) Lisp_Object keys, function; { register Lisp_Object map; map = current_buffer->keymap; if (NILP (map)) { map = Fmake_sparse_keymap (Qnil); current_buffer->keymap = map; } if (XTYPE (keys) != Lisp_Vector && XTYPE (keys) != Lisp_String) keys = wrong_type_argument (Qarrayp, keys); Fdefine_key (map, keys, function); return Qnil; } DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key, 1, 1, "kUnset key globally: ", "Remove global binding of KEY.\n\ KEY is a string representing a sequence of keystrokes.") (keys) Lisp_Object keys; { return Fglobal_set_key (keys, Qnil); } DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1, "kUnset key locally: ", "Remove local binding of KEY.\n\ KEY is a string representing a sequence of keystrokes.") (keys) Lisp_Object keys; { if (!NILP (current_buffer->keymap)) Flocal_set_key (keys, Qnil); return Qnil; } 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; 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; 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. */ 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; if (!NILP (prefix)) prefixlen = XINT (Flength (prefix)); 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 = Fcar (Fcar (tail)); register Lisp_Object thismap = Fcdr (Fcar (tail)); Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1); /* Does the current sequence end in the meta-prefix-char? */ int is_metized = (XINT (last) >= 0 && EQ (Faref (thisseq, last), meta_prefix_char)); for (; CONSP (thismap); thismap = XCONS (thismap)->cdr) { Lisp_Object elt = XCONS (thismap)->car; QUIT; if (XTYPE (elt) == Lisp_Vector) { 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]); 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 = get_keyelt (XCONS (elt)->cdr); register Lisp_Object tem, filter; /* 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 && XTYPE (elt) == Lisp_Int) { 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; XFASTINT (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; 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; { if (XTYPE (keys) == Lisp_String) { Lisp_Object vector; int i; vector = Fmake_vector (Flength (keys), Qnil); for (i = 0; i < XSTRING (keys)->size; i++) { if (XSTRING (keys)->data[i] & 0x80) XFASTINT (XVECTOR (vector)->contents[i]) = meta_modifier | (XSTRING (keys)->data[i] & ~0x80); else XFASTINT (XVECTOR (vector)->contents[i]) = XSTRING (keys)->data[i]; } keys = vector; } return Fmapconcat (Qsingle_key_description, keys, build_string (" ")); } 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; } 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); switch (XTYPE (key)) { case Lisp_Int: /* Normal character */ *push_key_description (XUINT (key), tem) = 0; return build_string (tem); case Lisp_Symbol: /* Function key or event-symbol */ return Fsymbol_name (key); default: error ("KEY must be an integer, cons, or symbol."); } } 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; } 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; { Lisp_Object i; int len = XINT (Flength (seq)); for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++) { Lisp_Object elt = Faref (seq, i); if (XTYPE (elt) != Lisp_Int || (XUINT (elt) & ~CHAR_META) >= 0x80) return 0; } return 1; } /* where-is - finding a command in a set of keymaps. */ DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0, "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\ If KEYMAP is nil, search only KEYMAP1.\n\ If KEYMAP1 is nil, use the current global map.\n\ \n\ If optional 4th arg FIRSTONLY is non-nil, return a string representing\n\ the first key sequence found, rather than a list of all possible key\n\ sequences. If FIRSTONLY is t, avoid key sequences which use non-ASCII\n\ keys and therefore may not be usable on ASCII terminals. If FIRSTONLY\n\ is the symbol `non-ascii', return the first binding found, no matter\n\ what its components.\n\ \n\ If optional 5th 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, local_keymap, global_keymap, firstonly, noindirect) Lisp_Object definition, local_keymap, global_keymap; Lisp_Object firstonly, noindirect; { register Lisp_Object maps; Lisp_Object found; if (NILP (global_keymap)) global_keymap = current_global_map; if (!NILP (local_keymap)) maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap), Qnil), Faccessible_keymaps (get_keymap (global_keymap), Qnil)); else maps = Faccessible_keymaps (get_keymap (global_keymap), Qnil); found = Qnil; for (; !NILP (maps); maps = Fcdr (maps)) { /* Key sequence to reach map */ register Lisp_Object this = Fcar (Fcar (maps)); /* The map that it reaches */ register Lisp_Object map = Fcdr (Fcar (maps)); /* 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 = make_number (XINT (Flength (this)) - 1); int 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 = XCONS (map)->car; Lisp_Object key, binding, sequence; QUIT; /* Set key and binding to the current key and binding, and advance map and i to the next binding. */ if (XTYPE (elt) == Lisp_Vector) { /* In a vector, look at each element. */ binding = XVECTOR (elt)->contents[i]; XFASTINT (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)) binding = get_keyelt (binding); /* End this iteration if this element does not match the target. */ if (XTYPE (definition) == Lisp_Cons) { 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 (XTYPE (key) == Lisp_Int && 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 (!NILP (local_keymap)) { binding = Flookup_key (local_keymap, sequence, Qnil); if (!NILP (binding) && XTYPE (binding) != Lisp_Int) { if (XTYPE (definition) == Lisp_Cons) { Lisp_Object tem; tem = Fequal (binding, definition); if (NILP (tem)) continue; } else if (!EQ (binding, definition)) continue; } } /* It is a true unshadowed match. Record it. */ 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 sequence; else if (! NILP (firstonly) && ascii_sequence_p (sequence)) return sequence; } } 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; } /* Return a string listing the keys and buttons that run DEFINITION. */ static Lisp_Object where_is_string (definition) Lisp_Object definition; { register Lisp_Object keys, keys1; keys = Fwhere_is_internal (definition, current_buffer->keymap, Qnil, Qnil, Qnil); keys1 = Fmapconcat (Qkey_description, keys, build_string (", ")); return keys1; } DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ", "Print message listing key sequences that invoke specified command.\n\ Argument is a command definition, usually a symbol with a function definition.") (definition) Lisp_Object definition; { register Lisp_Object string; CHECK_SYMBOL (definition, 0); string = where_is_string (definition); if (XSTRING (string)->size) message ("%s is on %s", XSYMBOL (definition)->name->data, XSTRING (string)->data); else message ("%s is not on any key", XSYMBOL (definition)->name->data); return Qnil; } /* 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; XSET (thisbuf, Lisp_Buffer, 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, start2; 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; Fset_buffer (Vstandard_output); /* Report on alternates for keys. */ if (XTYPE (Vkeyboard_translate_table) == Lisp_String) { 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); } { 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); nmaps = current_minor_maps (&modes, &maps); Fset_buffer (Vstandard_output); /* Print the minor mode maps. */ for (i = 0; i < nmaps; i++) { /* Tht 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 = (char *) alloca (40 + XSYMBOL (modes[i])->name->size); char *p = title; if (XTYPE (modes[i]) == Lisp_Symbol) { *p++ = '`'; bcopy (XSYMBOL (modes[i])->name->data, p, XSYMBOL (modes[i])->name->size); p += XSYMBOL (modes[i])->name->size; *p++ = '\''; } else { bcopy ("Strangely Named", p, sizeof ("Strangely Named")); p += sizeof ("Strangely Named"); } bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings")); p += sizeof (" Minor Mode Bindings"); *p = 0; describe_map_tree (maps[i], 0, shadow, prefix, title); shadow = Fcons (maps[i], shadow); } } /* Print the (major mode) local map. */ start1 = XBUFFER (descbuf)->keymap; if (!NILP (start1)) { describe_map_tree (start1, 0, shadow, prefix, "Major Mode Bindings"); shadow = Fcons (start1, shadow); } describe_map_tree (current_global_map, 0, shadow, prefix, "Global Bindings"); Fset_buffer (descbuf); 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. */ void describe_map_tree (startmap, partial, shadow, prefix, title) Lisp_Object startmap, shadow, prefix; int partial; char *title; { Lisp_Object maps; struct gcpro gcpro1; int something = 0; char *key_heading = "\ key binding\n\ --- -------\n"; maps = Faccessible_keymaps (startmap, prefix); GCPRO1 (maps); if (!NILP (maps)) { 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, sub_shadows, 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 ((XTYPE (prefix) == Lisp_String && XSTRING (prefix)->size == 0) || (XTYPE (prefix) == Lisp_Vector && 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 (shadow, Fcar (elt), Qt); if (XTYPE (shmap) == Lisp_Int) 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), partial, sub_shadows); 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 (XTYPE (definition) == Lisp_Symbol) { XSET (tem1, Lisp_String, XSYMBOL (definition)->name); insert1 (tem1); insert_string ("\n"); } else { tem1 = Fkeymapp (definition); if (!NILP (tem1)) insert_string ("Prefix Command\n"); else insert_string ("??\n"); } } /* 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 is as in `describe_map_tree' above. */ static void describe_map (map, keys, partial, shadow) Lisp_Object map, keys; int partial; Lisp_Object shadow; { register Lisp_Object keysdesc; if (!NILP (keys) && XFASTINT (Flength (keys)) > 0) { Lisp_Object tem; /* Call Fkey_description first, to avoid GC bug for the other string. */ tem = Fkey_description (keys); keysdesc = concat2 (tem, build_string (" ")); } else keysdesc = Qnil; describe_map_2 (map, keysdesc, describe_command, partial, shadow); } /* 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; } /* Insert a description of KEYMAP into the current buffer. */ static void describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow) register Lisp_Object keymap; Lisp_Object elt_prefix; int (*elt_describer) (); int partial; Lisp_Object shadow; { Lisp_Object tail, definition, event; Lisp_Object tem; Lisp_Object suppress; Lisp_Object kludge; int first = 1; struct gcpro gcpro1, gcpro2, gcpro3; 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 = XCONS (keymap)->cdr; CONSP (tail); tail = Fcdr (tail)) { QUIT; if (XTYPE (XCONS (tail)->car) == Lisp_Vector) describe_vector (XCONS (tail)->car, elt_prefix, elt_describer, partial, shadow); else { event = Fcar_safe (Fcar (tail)); definition = get_keyelt (Fcdr_safe (Fcar (tail))); /* Don't show undefined commands or suppressed commands. */ if (NILP (definition)) continue; if (XTYPE (definition) == Lisp_Symbol && 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 (keymap, 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); } } 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 (vector, 0); describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil); return unbind_to (count, Qnil); } describe_vector (vector, elt_prefix, elt_describer, partial, shadow) register Lisp_Object vector; Lisp_Object elt_prefix; int (*elt_describer) (); int partial; Lisp_Object shadow; { Lisp_Object this; Lisp_Object dummy; Lisp_Object tem1, tem2; register int i; Lisp_Object suppress; Lisp_Object kludge; int first = 1; struct gcpro gcpro1, gcpro2, gcpro3; tem1 = 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); GCPRO3 (elt_prefix, tem1, kludge); if (partial) suppress = intern ("suppress-keymap"); for (i = 0; i < XVECTOR (vector)->size; i++) { QUIT; tem1 = get_keyelt (XVECTOR (vector)->contents[i]); if (NILP (tem1)) continue; /* Don't mention suppressed commands. */ if (XTYPE (tem1) == Lisp_Symbol && partial) { this = Fget (tem1, suppress); if (!NILP (this)) continue; } /* If this command in this map 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; } if (first) { insert ("\n", 1); first = 0; } /* 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. */ XFASTINT (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]), EQ (tem2, tem1))) i++; /* If we have a range of more than one character, print where the range reaches to. */ if (i != XINT (dummy)) { insert (" .. ", 4); if (!NILP (elt_prefix)) insert1 (elt_prefix); XFASTINT (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) (tem1); } 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 ("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 subsequences bound by\n\ function-key-map with their bindings. When the current local and global\n\ keymaps have no binding for the current key sequence but\n\ function-key-map binds a suffix of the sequence to a vector or string,\n\ read-key-sequence replaces the matching suffix with its binding, and\n\ continues with the new sequence.\n\ \n\ For example, suppose function-key-map binds `ESC O P' to [f1].\n\ Typing `ESC O P' to read-key-sequence would return [f1]. Typing\n\ `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\ key, typing `ESC O P x' would return [f1 x]."); Vfunction_key_map = Fmake_sparse_keymap (Qnil); 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 (&Sglobal_set_key); defsubr (&Slocal_set_key); defsubr (&Sdefine_key); defsubr (&Slookup_key); defsubr (&Sglobal_unset_key); defsubr (&Slocal_unset_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 (&Swhere_is); 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.22/src/lastfile.c100444 12241 12 2670 5444474574 14231 0ustar rolandstaff/* 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 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. */ /* 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 = 0; emacs-19.22/src/lread.c100444 12120 1 141171 5475240705 13200 0ustar rmsdaemon/* Lisp parsing and input streams. Copyright (C) 1985, 1986, 1987, 1988, 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. */ #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 #include #endif /* LISP_FLOAT_TYPE */ 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; extern Lisp_Object Qevent_symbol_element_mask; /* non-zero if inside `load' */ int load_in_progress; /* 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 useud to build the load history. */ Lisp_Object Vcurrent_load_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; /* 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 (XTYPE (readcharfun) == Lisp_Buffer) { 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 (XTYPE (readcharfun) == Lisp_Marker) { 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)) return getc (instream); if (XTYPE (readcharfun) == Lisp_String) { 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 (XTYPE (readcharfun) == Lisp_Buffer) { if (XBUFFER (readcharfun) == current_buffer) SET_PT (point - 1); else SET_BUF_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1); } else if (XTYPE (readcharfun) == Lisp_Marker) XMARKER (readcharfun)->bufpos--; else if (XTYPE (readcharfun) == Lisp_String) 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; register Lisp_Object delayed_switch_frame = Qnil; /* Read until we get an acceptable event. */ retry: val = read_char (0, 0, 0, Qnil, 0); /* 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 (XTYPE (val) == Lisp_Symbol) { 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)) XFASTINT (val) = XINT (tem1) | XINT (Fcar (Fcdr (tem))); } } /* If we don't have a character now, deal with it appropriately. */ if (XTYPE (val) != Lisp_Int) { if (error_nonascii) { unread_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; XSET (val, Lisp_Int, getc (instream)); return val; } static void readevalloop (); static Lisp_Object load_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.") (str, noerror, nomessage, nosuffix) Lisp_Object str, noerror, nomessage, nosuffix; { register FILE *stream; register int fd = -1; register Lisp_Object lispstream; register FILE **ptr; 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; CHECK_STRING (str, 0); str = Fsubstitute_in_file_name (str); /* If file name is magic, call the handler. */ handler = Ffind_file_name_handler (str); if (!NILP (handler)) return call5 (handler, Qload, str, noerror, nomessage, nosuffix); /* Avoid weird lossage with null string as arg, since it would try to load a directory as a Lisp file */ if (XSTRING (str)->size > 0) { fd = openp (Vload_path, str, !NILP (nosuffix) ? "" : ".elc:.el:", &found, 0); } if (fd < 0) { if (NILP (noerror)) while (1) Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"), Fcons (str, Qnil))); else return Qnil; } if (!bcmp (&(XSTRING (found)->data[XSTRING (found)->size - 4]), ".elc", 4)) { struct stat s1, s2; int result; stat (XSTRING (found)->data, &s1); XSTRING (found)->data[XSTRING (found)->size - 1] = 0; result = stat (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'; } stream = fdopen (fd, "r"); if (stream == 0) { close (fd); error ("Failure to create stdio stream for %s", XSTRING (str)->data); } if (NILP (nomessage) && !nomessage1) message ("Loading %s...", XSTRING (str)->data); GCPRO1 (str); /* We may not be able to store STREAM itself as a Lisp_Object pointer since that is guaranteed to work only for data that has been malloc'd. So malloc a full-size pointer, and record the address of that pointer. */ ptr = (FILE **) xmalloc (sizeof (FILE *)); *ptr = stream; XSET (lispstream, Lisp_Internal_Stream, (int) ptr); record_unwind_protect (load_unwind, lispstream); load_in_progress++; readevalloop (Qget_file_char, stream, str, Feval, 0); unbind_to (count, Qnil); /* Run any load-hooks for this file. */ temp = Fassoc (str, Vafter_load_alist); if (!NILP (temp)) Fprogn (Fcdr (temp)); UNGCPRO; if (!noninteractive && NILP (nomessage)) message ("Loading %s...done", XSTRING (str)->data); return Qt; } static Lisp_Object load_unwind (stream) /* used as unwind-protect function in load */ Lisp_Object stream; { fclose (*(FILE **) XSTRING (stream)); xfree (XPNTR (stream)); if (--load_in_progress < 0) load_in_progress = 0; return Qnil; } static int complete_filename_p (pathname) Lisp_Object pathname; { register unsigned char *s = XSTRING (pathname)->data; return (*s == '/' #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; 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, 0, 0); if (fd >= 0) { /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = build_string (fn); return fd; } } /* Advance to next suffix. */ if (esuffix == 0) break; nsuffix += lsuffix + 1; } if (absolute) return -1; } 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; if (c == ' ' || c == '\t' || c == '\n' || c == '\f') continue; if (!NILP (Vpurify_flag) && c == '(') { record_unwind_protect (unreadpure, Qnil); val = read_list (-1, readcharfun); unbind_to (count + 1, Qnil); } else { UNREAD (c); val = read0 (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).") (readcharfun) Lisp_Object readcharfun; { extern Lisp_Object Fread_minibuffer (); if (NILP (readcharfun)) readcharfun = Vstandard_input; if (EQ (readcharfun, Qt)) readcharfun = Qread_char; #ifndef standalone if (EQ (readcharfun, Qread_char)) return Fread_minibuffer (build_string ("Lisp expression: "), Qnil); #endif if (XTYPE (readcharfun) == Lisp_String) return Fcar (Fread_from_string (readcharfun, Qnil, Qnil)); return read0 (readcharfun); } 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; 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); if (XTYPE (val) == Lisp_Internal) { c = XINT (val); return 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; } } static Lisp_Object read1 (readcharfun) register Lisp_Object readcharfun; { register int c; 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 ']': { register Lisp_Object val; XSET (val, Lisp_Internal, c); return val; } case '#': c = READCHAR; 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; /* Read the string itself. */ tmp = read1 (readcharfun); if (XTYPE (tmp) != Lisp_String) 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); if (XTYPE (beg) == Lisp_Internal) { if (XINT (beg) == ')') break; Fsignal (Qinvalid_read_syntax, Fcons (make_string ("invalid string property list", 28), Qnil)); } end = read1 (readcharfun); if (XTYPE (end) == Lisp_Internal) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("invalid string property list", 28), Qnil)); plist = read1 (readcharfun); if (XTYPE (plist) == Lisp_Internal) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("invalid string property list", 28), Qnil)); Fset_text_properties (beg, end, plist, tmp); } UNGCPRO; return tmp; } #endif 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 '?': { register Lisp_Object val; c = READCHAR; if (c < 0) return Fsignal (Qend_of_file, Qnil); if (c == '\\') XSET (val, Lisp_Int, read_escape (readcharfun)); else XSET (val, Lisp_Int, 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 if (c & CHAR_META) /* Move the meta bit to the right place for a string. */ *p++ = (c & ~CHAR_META) | 0x80; else *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 (! isdigit (next_char)) #endif { register Lisp_Object val; XSET (val, Lisp_Internal, c); return val; } /* 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: 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 XSET (val, Lisp_Int, atoi (read_buffer)); 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 (isdigit(*cp)) { state |= LEAD_INT; while (isdigit (*cp)) cp ++; } if (*cp == '.') { state |= DOT_CHAR; cp++; } if (isdigit(*cp)) { state |= TRAIL_INT; while (isdigit (*cp)) cp++; } if (*cp == 'e') { state |= E_CHAR; cp++; } if ((*cp == '+') || (*cp == '-')) cp++; if (isdigit (*cp)) { state |= EXP_INT; while (isdigit (*cp)) cp++; } return (*cp == 0 && (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; val = Qnil; tail = Qnil; while (1) { GCPRO2 (val, tail); elt = read1 (readcharfun); UNGCPRO; if (XTYPE (elt) == Lisp_Internal) { if (flag > 0) { if (XINT (elt) == ']') return val; return Fsignal (Qinvalid_read_syntax, Fcons (make_string (") or . in a vector", 18), Qnil)); } if (XINT (elt) == ')') return val; if (XINT (elt) == '.') { GCPRO2 (val, tail); if (!NILP (tail)) XCONS (tail)->cdr = read0 (readcharfun); else val = read0 (readcharfun); elt = read1 (readcharfun); UNGCPRO; if (XTYPE (elt) == Lisp_Internal && XINT (elt) == ')') 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; Lisp_Object check_obarray (obarray) Lisp_Object obarray; { while (XTYPE (obarray) != Lisp_Vector || 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; } static int hash_string (); Lisp_Object oblookup (); Lisp_Object intern (str) char *str; { Lisp_Object tem; int len = strlen (str); Lisp_Object obarray = Vobarray; if (XTYPE (obarray) != Lisp_Vector || XVECTOR (obarray)->size == 0) obarray = check_obarray (obarray); tem = oblookup (obarray, str, len); if (XTYPE (tem) == Lisp_Symbol) 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 (XTYPE (tem) != Lisp_Int) return tem; if (!NILP (Vpurify_flag)) str = Fpurecopy (str); sym = Fmake_symbol (str); ptr = &XVECTOR (obarray)->contents[XINT (tem)]; if (XTYPE (*ptr) == Lisp_Symbol) 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 (XTYPE (tem) != Lisp_Int) return tem; return Qnil; } Lisp_Object oblookup (obarray, ptr, size) Lisp_Object obarray; register char *ptr; register int size; { int hash, obsize; register Lisp_Object tail; Lisp_Object bucket, tem; if (XTYPE (obarray) != Lisp_Vector || (obsize = XVECTOR (obarray)->size) == 0) { obarray = check_obarray (obarray); obsize = XVECTOR (obarray)->size; } /* Combining next two lines breaks VMS C 2.3. */ hash = hash_string (ptr, size); hash %= obsize; bucket = XVECTOR (obarray)->contents[hash]; if (XFASTINT (bucket) == 0) ; else if (XTYPE (bucket) != Lisp_Symbol) error ("Bad data in guts of obarray"); /* Like CADR error message */ else for (tail = bucket; ; XSET (tail, Lisp_Symbol, 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; } XSET (tem, Lisp_Int, 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; XSET (tail, Lisp_Symbol, 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; XFASTINT (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); XSET (XSYMBOL (sym)->function, Lisp_Subr, 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); XSET (XSYMBOL (sym)->function, Lisp_Subr, sname); } #endif /* NOTDEF */ /* New replacement for DefIntVar; it ignores the doc string argument on the assumption that make-docfile will handle that. */ /* Define an "integer variable"; a symbol whose value is forwarded to a C variable of type int. Sample call: */ /* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */ void defvar_int (namestring, address, doc) char *namestring; int *address; char *doc; { Lisp_Object sym; sym = intern (namestring); XSET (XSYMBOL (sym)->value, Lisp_Intfwd, address); } /* Similar but define a variable whose value is T if address contains 1, NIL if address contains 0 */ void defvar_bool (namestring, address, doc) char *namestring; int *address; char *doc; { Lisp_Object sym; sym = intern (namestring); XSET (XSYMBOL (sym)->value, Lisp_Boolfwd, address); } /* Similar but define a variable whose value is the Lisp Object stored at address. */ void defvar_lisp (namestring, address, doc) char *namestring; Lisp_Object *address; char *doc; { Lisp_Object sym; sym = intern (namestring); XSET (XSYMBOL (sym)->value, Lisp_Objfwd, address); staticpro (address); } /* Similar but don't request gc-marking of the C variable. 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, doc) char *namestring; Lisp_Object *address; char *doc; { Lisp_Object sym; sym = intern (namestring); XSET (XSYMBOL (sym)->value, Lisp_Objfwd, 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; int offset; extern struct buffer buffer_local_symbols; sym = intern (namestring); offset = (char *)address - (char *)current_buffer; XSET (XSYMBOL (sym)->value, Lisp_Buffer_Objfwd, (Lisp_Object *) offset); *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym; *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type; if (*(int *)(offset + (char *)&buffer_local_flags) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding slot of buffer_local_flags */ abort (); } #endif /* standalone */ init_lread () { char *normal; /* 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); if (! NILP (Fequal (dump_path, Vload_path))) { Vload_path = decode_env_path (0, normal); if (!NILP (Vinvocation_directory)) { /* Add to the path the ../lisp dir of the Emacs executable, if that dir exists. */ Lisp_Object tem, tem1; tem = Fexpand_file_name (build_string ("../lisp"), Vinvocation_directory); tem1 = Ffile_exists_p (tem); if (!NILP (tem1) && NILP (Fmember (tem, Vload_path))) Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); } } } else Vload_path = decode_env_path (0, normal); #endif /* Warn if dirs in the *standard* path don't exist. */ { 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 (XTYPE (dirfile) == Lisp_String) { dirfile = Fdirectory_file_name (dirfile); if (access (XSTRING (dirfile)->data, 0) < 0) printf ("Warning: lisp library (%s) does not exist.\n", XSTRING (Fcar (path_tail))->data); } } } /* If the EMACSLOADPATH environment variable is set, use its value. This doesn't apply if we're dumping. */ if (NILP (Vpurify_flag) && egetenv ("EMACSLOADPATH")) Vload_path = decode_env_path ("EMACSLOADPATH", normal); Vvalues = Qnil; load_in_progress = 0; } void syms_of_lread () { defsubr (&Sread); defsubr (&Sread_from_string); defsubr (&Sintern); defsubr (&Sintern_soft); 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 ("current-load-list", &Vcurrent_load_list, "Used for internal purposes by `load'."); Vcurrent_load_list = Qnil; 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); Qascii_character = intern ("ascii-character"); staticpro (&Qascii_character); Qload = intern ("load"); staticpro (&Qload); } emacs-19.22/src/macros.c100444 12241 12 17074 5444474576 13740 0ustar rolandstaff/* 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" Lisp_Object Qexecute_kbd_macro; int defining_kbd_macro; /* The start of storage for the current keyboard macro, and its size. */ Lisp_Object *kbd_macro_buffer; int kbd_macro_bufsize; /* 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_pointer, because we advance this to kbd_macro_pointer 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; Lisp_Object Vlast_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 (defining_kbd_macro) error ("Already defining kbd macro"); update_mode_lines++; if (NILP (append)) { kbd_macro_ptr = kbd_macro_buffer; kbd_macro_end = kbd_macro_buffer; message("Defining kbd macro..."); } else { message("Appending to kbd macro..."); kbd_macro_ptr = kbd_macro_end; Fexecute_kbd_macro (Vlast_kbd_macro, make_number (1)); } defining_kbd_macro++; 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 (!defining_kbd_macro) error ("Not defining kbd macro."); if (NILP (arg)) XFASTINT (arg) = 1; else CHECK_NUMBER (arg, 0); if (defining_kbd_macro) { defining_kbd_macro = 0; update_mode_lines++; Vlast_kbd_macro = make_event_array (kbd_macro_end - kbd_macro_buffer, kbd_macro_buffer); message("Keyboard macro defined"); } if (XFASTINT (arg) == 0) Fexecute_kbd_macro (Vlast_kbd_macro, arg); else { XSETINT (arg, XINT (arg)-1); if (XINT (arg) > 0) Fexecute_kbd_macro (Vlast_kbd_macro, arg); } return Qnil; } /* Store character c into kbd macro being defined */ store_kbd_macro_char (c) Lisp_Object c; { if (defining_kbd_macro) { if (kbd_macro_ptr - kbd_macro_buffer == kbd_macro_bufsize) { register Lisp_Object *new = (Lisp_Object *) xrealloc (kbd_macro_buffer, ((kbd_macro_bufsize *= 2) * sizeof (Lisp_Object))); kbd_macro_ptr += new - kbd_macro_buffer; kbd_macro_end += new - kbd_macro_buffer; kbd_macro_buffer = new; } *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 () { kbd_macro_end = kbd_macro_ptr; } 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 (defining_kbd_macro) error ("Can't execute anonymous macro while defining one"); else if (NILP (Vlast_kbd_macro)) error ("No kbd macro has been defined"); else Fexecute_kbd_macro (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 (XTYPE (final) != Lisp_String && XTYPE (final) != Lisp_Vector) error ("Keyboard macros must be strings or vectors."); XFASTINT (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; command_loop_1 (); QUIT; } while (--repeat && (XTYPE (Vexecuting_macro) == Lisp_String || XTYPE (Vexecuting_macro) == Lisp_Vector)); UNGCPRO; return unbind_to (count, Qnil); } init_macros () { Vlast_kbd_macro = Qnil; defining_kbd_macro = 0; Vexecuting_macro = Qnil; } syms_of_macros () { kbd_macro_bufsize = 100; kbd_macro_buffer = (Lisp_Object *) malloc (kbd_macro_bufsize * sizeof (Lisp_Object)); 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); DEFVAR_BOOL ("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 (a string); nil if none executing."); DEFVAR_LISP_NOPRO ("executing-kbd-macro", &Vexecuting_macro, "Currently executing keyboard macro (a string); nil if none executing."); DEFVAR_LISP ("last-kbd-macro", &Vlast_kbd_macro, "Last kbd macro defined, as a string; 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.22/src/marker.c100444 12241 12 15622 5444474577 13733 0ustar rolandstaff/* 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 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. */ #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) { XSET (buf, Lisp_Buffer, 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 (); XFASTINT (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) || (XTYPE (pos) == Lisp_Marker && !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->chain = b->markers; b->markers = marker; m->buffer = b; } 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) || (XTYPE (pos) == Lisp_Marker && !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->chain = b->markers; b->markers = marker; m->buffer = b; } 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 int omark; register struct buffer *b; b = XMARKER (marker)->buffer; if (b == 0) return; if (EQ (b->name, Qnil)) abort (); tail = b->markers; prev = Qnil; while (XSYMBOL (tail) != XSYMBOL (Qnil)) { next = XMARKER (tail)->chain; XUNMARK (next); if (XMARKER (marker) == XMARKER (tail)) { if (NILP (prev)) { b->markers = next; /* Deleting first marker from the buffer's chain. Crash if new first marker in chain does not say it belongs to this buffer. */ if (!EQ (next, Qnil) && b != XMARKER (next)->buffer) 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; } 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, 1, 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.") (marker) register Lisp_Object marker; { register Lisp_Object new; while (1) { if (XTYPE (marker) == Lisp_Int || XTYPE (marker) == Lisp_Marker) { new = Fmake_marker (); Fset_marker (new, marker, ((XTYPE (marker) == Lisp_Marker) ? Fmarker_buffer (marker) : Qnil)); return new; } else marker = wrong_type_argument (Qinteger_or_marker_p, marker); } } syms_of_marker () { defsubr (&Smarker_position); defsubr (&Smarker_buffer); defsubr (&Sset_marker); defsubr (&Scopy_marker); } emacs-19.22/src/minibuf.c100444 12120 1 137670 5473202451 13545 0ustar rmsdaemon/* Minibuffer input and completion. 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 "commands.h" #include "buffer.h" #include "dispextern.h" #include "frame.h" #include "window.h" #include "syntax.h" #define min(a, b) ((a) < (b) ? (a) : (b)) /* 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 deeped minibuffer recursions are encountered. */ Lisp_Object Vminibuffer_list; struct minibuf_save_data { char *prompt; int prompt_width; Lisp_Object help_form; Lisp_Object current_prefix_arg; Lisp_Object history_position; Lisp_Object history_variable; }; int minibuf_save_vector_size; struct minibuf_save_data *minibuf_save_vector; /* 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 hook for entry to minibuffer. */ Lisp_Object Qminibuffer_setup_hook, Vminibuffer_setup_hook; /* Nonzero means completion ignores case. */ int completion_ignore_case; /* 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; /* 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 non-nil, 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, or as the object that resulted iff EXPFLAG is non-nil. */ 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; { register Lisp_Object val; int count = specpdl_ptr - specpdl; Lisp_Object mini_frame; struct gcpro gcpro1, gcpro2; if (XTYPE (prompt) != Lisp_String) prompt = build_string (""); /* Emacs in -batch mode calls minibuffer: print the prompt. */ if (noninteractive && XTYPE (prompt) == Lisp_String) printf ("%s", XSTRING (prompt)->data); if (!enable_recursive_minibuffers && minibuf_level > 0 && (EQ (selected_window, minibuf_window))) #if 0 || selected_frame != XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))) #endif error ("Command attempted to use minibuffer while in minibuffer"); if (minibuf_level == minibuf_save_vector_size) minibuf_save_vector = (struct minibuf_save_data *) xrealloc (minibuf_save_vector, (minibuf_save_vector_size *= 2) * sizeof (struct minibuf_save_data)); minibuf_save_vector[minibuf_level].prompt = minibuf_prompt; minibuf_save_vector[minibuf_level].prompt_width = minibuf_prompt_width; minibuf_prompt_width = 0; /* >> Why is this done this way rather than binding these variables? */ minibuf_save_vector[minibuf_level].help_form = Vhelp_form; minibuf_save_vector[minibuf_level].current_prefix_arg = Vcurrent_prefix_arg; minibuf_save_vector[minibuf_level].history_position = Vminibuffer_history_position; minibuf_save_vector[minibuf_level].history_variable = Vminibuffer_history_variable; GCPRO2 (minibuf_save_vector[minibuf_level].help_form, minibuf_save_vector[minibuf_level].current_prefix_arg); 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 XSET (mini_frame, Lisp_Frame, WINDOW_FRAME (XWINDOW (minibuf_window))); if (XFRAME (mini_frame) != selected_frame) record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (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 (XTYPE (val) == Lisp_String) 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 = XCONS (XCONS (buf_list)->car)->cdr; if (XTYPE (XBUFFER (other_buf)->directory) == Lisp_String) { current_buffer->directory = XBUFFER (other_buf)->directory; break; } } } #ifdef MULTI_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); XFASTINT (XWINDOW (minibuf_window)->hscroll) = 0; Ferase_buffer (); minibuf_level++; if (!NILP (initial)) { Finsert (1, &initial); if (!NILP (backup_n) && XTYPE (backup_n) == Lisp_Int) Fforward_char (backup_n); } minibuf_prompt = (char *) alloca (XSTRING (prompt)->size + 1); bcopy (XSTRING (prompt)->data, minibuf_prompt, XSTRING (prompt)->size + 1); echo_area_glyphs = 0; Vhelp_form = Vminibuffer_help_form; current_buffer->keymap = map; Vminibuffer_history_position = histpos; Vminibuffer_history_variable = histvar; /* 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)) 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. */ if (XTYPE (Vminibuffer_history_variable) == Lisp_Symbol && ! 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) val = Fread (val); unbind_to (count, Qnil); /* The appropriate frame will get selected in set-window-configuration. */ UNGCPRO; return 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[14]; extern Lisp_Object nconc2 (); XFASTINT (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 reset_buffer (XBUFFER (buf)); 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; { /* 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; Ferase_buffer (); /* 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++; XFASTINT (XWINDOW (minibuf_window)->last_modified) = 0; /* Restore prompt from outer minibuffer */ minibuf_prompt = minibuf_save_vector[minibuf_level].prompt; minibuf_prompt_width = minibuf_save_vector[minibuf_level].prompt_width; Vhelp_form = minibuf_save_vector[minibuf_level].help_form; Vcurrent_prefix_arg = minibuf_save_vector[minibuf_level].current_prefix_arg; Vminibuffer_history_position = minibuf_save_vector[minibuf_level].history_position; Vminibuffer_history_variable = minibuf_save_vector[minibuf_level].history_variable; } /* 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_input, keymap, read, hist) Lisp_Object prompt, initial_input, keymap, read, hist; { int pos = 0; Lisp_Object histvar, histpos, position; position = Qnil; CHECK_STRING (prompt, 0); if (!NILP (initial_input)) { if (XTYPE (initial_input) == Lisp_Cons) { position = Fcdr (initial_input); initial_input = Fcar (initial_input); } CHECK_STRING (initial_input, 1); if (!NILP (position)) { CHECK_NUMBER (position, 0); /* Convert to distance from end of input. */ pos = XINT (position) - 1 - XSTRING (initial_input)->size; } } if (NILP (keymap)) keymap = Vminibuffer_local_map; else keymap = get_keymap (keymap,2); if (XTYPE (hist) == Lisp_Symbol) { histvar = hist; histpos = Qnil; } else { histvar = Fcar_safe (hist); histpos = Fcdr_safe (hist); } if (NILP (histvar)) histvar = Qminibuffer_history; if (NILP (histpos)) XFASTINT (histpos) = 0; return read_minibuf (keymap, initial_input, 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, 2, 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.") (prompt, initial_input) Lisp_Object prompt, initial_input; { return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, Qnil); } 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 (XTYPE (def) == Lisp_Buffer) 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 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 && XTYPE (alist) != Lisp_Vector) 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 XFASTINT (bucket) = 0; } else if (++index >= obsize) break; else { bucket = XVECTOR (alist)->contents[index]; continue; } } /* Is this element a possible completion? */ if (XTYPE (eltstring) == Lisp_String && XSTRING (string)->size <= XSTRING (eltstring)->size && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data, XSTRING (string)->size)) { /* Yes. */ /* 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; XFASTINT (zero) = 0; /* Else extract the part in which */ XFASTINT (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. */ scmp (s1, s2, len) register 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, 3, 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\ 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 or the symbol from the obarray.") (string, alist, pred) Lisp_Object string, alist, pred; { 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 && XTYPE (alist) != Lisp_Vector) { 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 XFASTINT (bucket) = 0; } else if (++index >= obsize) break; else { bucket = XVECTOR (alist)->contents[index]; continue; } } /* Is this element a possible completion? */ if (XTYPE (eltstring) == Lisp_String && XSTRING (string)->size <= XSTRING (eltstring)->size && XSTRING (eltstring)->data[0] != ' ' && 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data, XSTRING (string)->size)) { /* Yes. */ /* 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' for more details on completion, TABLE, and PREDICATE.\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.\n\ If it is also not t, Return does not exit if it does non-null completion.\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 (XTYPE (init) == Lisp_Cons) { 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 (XTYPE (hist) == Lisp_Symbol) { histvar = hist; histpos = Qnil; } else { histvar = Fcar_safe (hist); histpos = Fcdr_safe (hist); } if (NILP (histvar)) histvar = Qminibuffer_history; if (NILP (histpos)) XFASTINT (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; 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 (osize); Vinhibit_quit = Qt; Fsit_for (make_number (2), Qnil, Qnil); del_range (point, ZV); if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; unread_command_events = Fcons (make_number (Ctl ('g')), Qnil); } Vinhibit_quit = oinhibit; } Lisp_Object Fminibuffer_completion_help (); Lisp_Object assoc_for_completion (); /* 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; completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table, Vminibuffer_completion_predicate); last = last_exact_completion; last_exact_completion = Qnil; if (NILP (completion)) { bitch_at_user (); temp_echo_area_glyphs (" [No match]"); return 0; } if (EQ (completion, Qt)) /* exact and unique match */ 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? */ if (CONSP (Vminibuffer_completion_table) || NILP (Vminibuffer_completion_table)) tem = assoc_for_completion (Fbuffer_string (), Vminibuffer_completion_table); else if (XTYPE (Vminibuffer_completion_table) == Lisp_Vector) { /* the primitive used by Fintern_soft */ extern Lisp_Object oblookup (); tem = Fbuffer_string (); /* Bypass intern-soft as that loses for nil */ tem = oblookup (Vminibuffer_completion_table, XSTRING (tem)->data, XSTRING (tem)->size); if (XTYPE (tem) != Lisp_Symbol) tem = Qnil; else if (!NILP (Vminibuffer_completion_predicate)) tem = call1 (Vminibuffer_completion_predicate, tem); else tem = Qt; } else tem = call3 (Vminibuffer_completion_table, Fbuffer_string (), Vminibuffer_completion_predicate, Qlambda); if (NILP (tem)) { /* not an exact match */ 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) 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 (); } 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 (XTYPE (thiscar) != Lisp_String) 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.") () { register int 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; } DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit, Sminibuffer_complete_and_exit, 0, 0, "", "Complete the minibuffer contents, and maybe exit.\n\ Exit if the name is valid with no completion needed.\n\ If name was completed to a valid match,\n\ a repetition of this command will exit.") () { register int i; /* Allow user to specify null string */ if (BEGV == ZV) goto exit; i = do_completion (); 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.") () { Lisp_Object completion, tem; register int i; register unsigned char *completion_string; struct gcpro gcpro1; /* 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 (); /* 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); } } #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 (XTYPE (tem) == Lisp_String) completion = tem; else { GCPRO1 (completion); tem = Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")), Vminibuffer_completion_table, Vminibuffer_completion_predicate); UNGCPRO; if (XTYPE (tem) == Lisp_String) 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.") (completions) Lisp_Object completions; { register Lisp_Object tail, elt; register int i; int column = 0; /* No GCPRO needed, since (when it matters) every variable points to a non-string that is pointed to by COMPLETIONS. */ struct buffer *old = current_buffer; if (XTYPE (Vstandard_output) == Lisp_Buffer) 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++) { /* this needs fixing for the case of long completions and/or narrow windows */ /* Sadly, the window it will appear in is not known until after the text has been made. */ if (i & 1) { if (XTYPE (Vstandard_output) == Lisp_Buffer) Findent_to (make_number (35), make_number (1)); else { do { write_string (" ", -1); column++; } while (column < 35); } } else { Fterpri (Qnil); column = 0; } elt = Fcar (tail); if (CONSP (elt)) { if (XTYPE (Vstandard_output) != Lisp_Buffer) { Lisp_Object tem; tem = Flength (Fcar (elt)); column += XINT (tem); tem = Flength (Fcar (Fcdr (elt))); column += XINT (tem); } Fprinc (Fcar (elt), Qnil); Fprinc (Fcar (Fcdr (elt)), Qnil); } else { if (XTYPE (Vstandard_output) != Lisp_Buffer) { Lisp_Object tem; tem = Flength (elt); column += XINT (tem); } Fprinc (elt, Qnil); } } } if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, intern ("completion-setup-hook")); if (XTYPE (Vstandard_output) == Lisp_Buffer) set_buffer_internal (old); 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); 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 (XTYPE (last_command_char) == Lisp_Int) 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); } init_minibuf_once () { Vminibuffer_list = Qnil; staticpro (&Vminibuffer_list); } syms_of_minibuf () { minibuf_level = 0; minibuf_prompt = 0; minibuf_save_vector_size = 5; minibuf_save_vector = (struct minibuf_save_data *) malloc (5 * sizeof (struct minibuf_save_data)); 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_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); DEFVAR_LISP ("minibuffer-setup-hook", &Vminibuffer_setup_hook, "Normal hook run just after entry to minibuffer."); Vminibuffer_setup_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 minibuffer output is added with\n\ (set minibuffer-history-variable\n\ (cons STRING (symbol-value minibuffer-history-variable)))"); XFASTINT (Vminibuffer_history_variable) = 0; DEFVAR_LISP ("minibuffer-history-position", &Vminibuffer_history_position, "Current position of redoing in the history list."); Vminibuffer_history_position = 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 (&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.22/src/mocklisp.c100444 12241 12 13663 5444474601 14262 0ustar rolandstaff/* Mocklisp compatibility functions for GNU Emacs Lisp interpreter. Copyright (C) 1985, 1986 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* 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 (XTYPE (tem) == Lisp_Int) tem = Fnumber_to_string (tem); if (XTYPE (tem) == Lisp_String) 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.22/src/pre-crt0.c100444 12241 12 616 5444474606 14034 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.22/src/prefix-args.c100666 13437 1 3104 5405345171 14427 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.22/src/print.c100444 12241 12 65574 5444474606 13612 0ustar rolandstaff/* Lisp object printing and output streams. Copyright (C) 1985, 1986, 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. */ #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" #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 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 (XTYPE (printcharfun) == Lisp_Buffer) \ { if (XBUFFER (printcharfun) != current_buffer) \ Fset_buffer (printcharfun); \ printcharfun = Qnil;} \ if (XTYPE (printcharfun) == Lisp_Marker) \ { 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 (XTYPE (original) == Lisp_Marker) \ 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(selected_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)) { if (noninteractive) { putchar (ch); noninteractive_need_newline = 1; return; } if (echo_area_glyphs != FRAME_MESSAGE_BUF (selected_frame) || !message_buf_print) { echo_area_glyphs = FRAME_MESSAGE_BUF (selected_frame); printbufidx = 0; message_buf_print = 1; } if (printbufidx < FRAME_WIDTH (selected_frame) - 1) FRAME_MESSAGE_BUF (selected_frame)[printbufidx++] = ch; FRAME_MESSAGE_BUF (selected_frame)[printbufidx] = 0; return; } #endif /* not standalone */ XFASTINT (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)) { 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 (selected_frame) || !message_buf_print) { echo_area_glyphs = FRAME_MESSAGE_BUF (selected_frame); printbufidx = 0; message_buf_print = 1; } if (i > FRAME_WIDTH (selected_frame) - printbufidx - 1) i = FRAME_WIDTH (selected_frame) - printbufidx - 1; bcopy (ptr, &FRAME_MESSAGE_BUF (selected_frame) [printbufidx], i); printbufidx += i; FRAME_MESSAGE_BUF (selected_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, because printing one char can relocate. */ print_string (string, printcharfun) Lisp_Object string; Lisp_Object printcharfun; { if (EQ (printcharfun, Qnil) || EQ (printcharfun, Qt)) /* In predictable cases, strout is safe: output to buffer or frame. */ strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun); 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 STREAM.\n\ STREAM 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->read_only = Qnil; Ferase_buffer (); XSET (buf, Lisp_Buffer, 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; record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); temp_output_buffer_setup (bufname); buf = Vstandard_output; val = (*function) (args); temp_output_buffer_show (buf); 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.\n\ If STREAM 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 STREAM, 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 STREAM, 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 STREAM, 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; } #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) || XTYPE (Vfloat_output_format) != Lisp_String) 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') for (width = 0; (*cp >= '0' && *cp <= '9'); cp++) width = (width * 10) + (*cp - '0'); if (*cp != 'e' && *cp != 'f' && *cp != 'g') goto lose; /* A precision of zero is valid for %f; everything else requires at least one. Width may be omitted anywhere. */ if (width != -1 && (width < (*cp != 'f') || width > DBL_DIG)) goto lose; 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 (XTYPE (obj) == Lisp_Cons || XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_Compiled) { 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 */ #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (obj)) #else switch (XTYPE (obj)) #endif { default: /* We're in trouble if this happens! Probably should just abort () */ strout ("#", -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 /* LISP_FLOAT_TYPE */ case Lisp_Int: sprintf (buf, "%d", XINT (obj)); strout (buf, -1, printcharfun); break; 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 == '\"' || 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 (XTYPE (Vprint_level) == Lisp_Int && print_depth > XINT (Vprint_level)) { strout ("...", -1, printcharfun); break; } PRINTCHAR ('('); { register int i = 0; register int max = 0; if (XTYPE (Vprint_length) == Lisp_Int) 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_Compiled: strout ("#", -1, printcharfun); case Lisp_Vector: PRINTCHAR ('['); { register int i; register Lisp_Object tem; for (i = 0; i < XVECTOR (obj)->size; i++) { if (i) PRINTCHAR (' '); tem = XVECTOR (obj)->contents[i]; print (tem, printcharfun, escapeflag); } } PRINTCHAR (']'); break; #ifndef standalone case Lisp_Buffer: if (NILP (XBUFFER (obj)->name)) strout ("#", -1, printcharfun); else if (escapeflag) { strout ("#name, printcharfun); PRINTCHAR ('>'); } else print_string (XBUFFER (obj)->name, printcharfun); break; case Lisp_Process: if (escapeflag) { strout ("#name, printcharfun); PRINTCHAR ('>'); } else print_string (XPROCESS (obj)->name, printcharfun); break; case Lisp_Window: 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 ('>'); break; case Lisp_Window_Configuration: strout ("#", -1, printcharfun); break; #ifdef MULTI_FRAME case Lisp_Frame: strout ((FRAME_LIVE_P (XFRAME (obj)) ? "#name, printcharfun); sprintf (buf, " 0x%x", (unsigned int) (XFRAME (obj))); strout (buf, -1, printcharfun); strout (">", -1, printcharfun); break; #endif /* MULTI_FRAME */ case Lisp_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_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; #endif /* standalone */ case Lisp_Subr: strout ("#symbol_name, -1, printcharfun); PRINTCHAR ('>'); break; } 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."); 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.22/src/process.c100644 12120 1 261063 5475527772 13610 0ustar rmsdaemon/* Asynchronous subprocess control for GNU Emacs. 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. */ #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_SOCKETS /* TCP connection support, if kernel can do it */ #include #include #include #include #endif /* HAVE_SOCKETS */ /* TERM is a poor-man's SLIP, used on Linux. */ #ifdef TERM #include #endif /* DGUX inet_addr returns a 'struct in_addr'. */ #ifdef DGUX #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 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; /* 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) (XGCTYPE (XPROCESS (p)->childp) == Lisp_String) #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 errno; extern sys_nerr; extern char *sys_errlist[]; #ifndef VMS #ifndef BSD4_1 #ifndef LINUX extern char *sys_siglist[]; #endif #else 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 #endif /* VMS */ /* 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 */ /* Number of events of change of status of a process. */ static int process_tick; /* Number of events for which the user or sentinel has been notified. */ static int update_tick; #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 */ /* Mask of bits indicating the descriptors that we wait for input on */ static SELECT_TYPE input_wait_mask; /* Descriptor to use for keyboard input. */ static int keyboard_descriptor; /* 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 */ static Lisp_Object chan_process[MAXDESC]; /* Alist of elements (NAME . PROCESS) */ static 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. */ static int proc_buffered_char[MAXDESC]; static Lisp_Object get_process (); /* 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 (XTYPE (l) == Lisp_Symbol) { *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)) { #ifndef VMS string = build_string (code < NSIG ? sys_siglist[code] : "unknown"); #else string = build_string (code < NSIG ? sys_errlist[code] : "unknown"); #endif 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. */ char pty_name[24]; 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; { register Lisp_Object val, tem, name1; register struct Lisp_Process *p; char suffix[10]; register int i; /* size of process structure includes the vector header, so deduct for that. But struct Lisp_Vector includes the first element, thus deducts too much, so add it back. */ val = Fmake_vector (make_number ((sizeof (struct Lisp_Process) - sizeof (struct Lisp_Vector) + sizeof (Lisp_Object)) / sizeof (Lisp_Object)), Qnil); XSETTYPE (val, Lisp_Process); p = XPROCESS (val); XSET (p->infd, Lisp_Int, -1); XSET (p->outfd, Lisp_Int, -1); XFASTINT (p->pid) = 0; XFASTINT (p->tick) = 0; XFASTINT (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; 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 XTYPE (obj) == Lisp_Process ? 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 (XTYPE (name) == Lisp_Process) 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 (XTYPE (proc) == Lisp_Process && 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; if (NILP (name)) proc = Fget_buffer_process (Fcurrent_buffer ()); else { proc = Fget_process (name); if (NILP (proc)) proc = Fget_buffer_process (Fget_buffer (name)); } if (!NILP (proc)) return proc; if (NILP (name)) error ("Current buffer has no process"); else error ("Process %s does not exist", XSTRING (name)->data); /* NOTREACHED */ } 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; proc = Fget_process (proc); if (NILP (proc)) return proc; p = XPROCESS (proc); if (!NILP (p->raw_status_low)) update_status (p); status = p->status; if (XTYPE (status) == Lisp_Cons) 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 (XTYPE (XPROCESS (proc)->status) == Lisp_Cons) 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 ("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); else if (EQ (XPROCESS (proc)->filter, Qt)) FD_SET (XINT (XPROCESS (proc)->infd), &input_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 ("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-nill 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]; XFASTINT (minspace) = 1; set_buffer_internal (XBUFFER (Vstandard_output)); Fbuffer_disable_undo (Vstandard_output); current_buffer->truncate_lines = Qt; write_string ("\ Proc Status Buffer 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 (XTYPE (p->status) == Lisp_Cons) 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", 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 (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 *)); 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; new_argv[0] = XSTRING (program)->data; /* If program file name is not absolute, search our path for it */ if (new_argv[0][0] != '/') { tem = Qnil; openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1); if (NILP (tem)) report_file_error ("Searching for program", Fcons (program, Qnil)); new_argv[0] = XSTRING (tem)->data; } #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); 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 (XTYPE (proc) != Lisp_Process) 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, forkin, forkout; int sv[2]; #ifdef SIGCHLD SIGTYPE (*sigchld)(); #endif int pty_flag = 0; extern char **environ; inchannel = outchannel = -1; #ifdef HAVE_PTYS if (EQ (Vprocess_connection_type, Qt)) 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 */ { pipe (sv); inchannel = sv[0]; forkout = sv[1]; pipe (sv); outchannel = sv[1]; forkin = sv[0]; } #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; XSET (XPROCESS (process)->infd, Lisp_Int, inchannel); XSET (XPROCESS (process)->outfd, Lisp_Int, outchannel); /* Record the tty descriptor used in the subprocess. */ if (forkin < 0) XPROCESS (process)->subtty = Qnil; else XFASTINT (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 */ /* 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; pid = vfork (); if (pid == 0) { 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 setsid (); #ifdef TIOCSCTTY /* Make the pty's terminal the controlling terminal. */ if (pty_flag) /* 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 */ #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. */ setpgrp (0, 0); #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) { /* 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) abort (); } #endif /* not UNIPLUS and not RTU */ #ifdef SETUP_SLAVE_PTY 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 */ child_setup_tty (xforkout); child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); } environ = save_environ; } if (pid < 0) report_file_error ("Doing vfork", Qnil); XFASTINT (XPROCESS (process)->pid) = pid; FD_SET (inchannel, &input_wait_mask); /* 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); #ifdef SYSV4_PTYS /* OK to close only if it's not a pty. Otherwise we need to leave it open for ioctl to get pgrp when signals are sent, or to send the interrupt characters through if that's how we're signalling subprocesses. Alternately if you are concerned about running out of file descriptors, you could just save the tty name and open just to do the ioctl. */ if (NILP (XFASTINT (XPROCESS (process)->pty_flag))) #endif { XPROCESS (process)->subtty = Qnil; if (forkin >= 0) close (forkin); } alarm (0); start_polling (); if (forkin != forkout && forkout >= 0) close (forkout); #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; GCPRO4 (name, buffer, host, service); CHECK_STRING (name, 0); CHECK_STRING (host, 0); if (XTYPE(service) == Lisp_Int) 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 host_info_ptr = gethostbyname (XSTRING (host)->data); 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)); loop: if (connect (s, (struct sockaddr *) &address, sizeof address) == -1) { int xerrno = errno; if (errno == EINTR) goto loop; close (s); errno = xerrno; report_file_error ("connection failed", Fcons (host, Fcons (name, Qnil))); } #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; XSET (XPROCESS (proc)->infd, Lisp_Int, s); XSET (XPROCESS (proc)->outfd, Lisp_Int, outch); XPROCESS (proc)->status = Qrun; FD_SET (inch, &input_wait_mask); 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); #ifdef SYSV4_PTYS if (!NILP (p->subtty)) close (XINT (p->subtty)); #endif #endif XSET (p->infd, Lisp_Int, -1); XSET (p->outfd, Lisp_Int, -1); chan_process[inchannel] = Qnil; FD_CLR (inchannel, &input_wait_mask); } } /* 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 () { 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); } } } 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 (XTYPE (timeout) != Lisp_Int) XSET (timeout, Lisp_Int, 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)) XFASTINT (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 */ 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 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 (XTYPE (read_kbd) == Lisp_Process) { wait_proc = XPROCESS (read_kbd); wait_channel = XINT (wait_proc->infd); XFASTINT (read_kbd) = 0; } /* If waiting for non-nil in a cell, record where. */ if (XTYPE (read_kbd) == Lisp_Cons) { wait_for_cell = &XCONS (read_kbd)->car; XFASTINT (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, 0, 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 */ Available = input_wait_mask; /* We used to have && wait_for_cell == 0 but that led to lossage handling selection_request events: within one, we would start to handle another. */ if (! XINT (read_kbd)) FD_CLR (keyboard_descriptor, &Available); /* 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) redisplay_preserve_echo_area (); if (XINT (read_kbd) && detect_input_pending ()) { nfds = 0; FD_ZERO (&Available); } else nfds = select (MAXDESC, &Available, 0, 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", sys_errlist[xerrno]); } #if defined(sun) && !defined(USG5_4) else if (nfds > 0 && FD_ISSET (keyboard_descriptor, &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 his if wait_for_cell, but that caused infinite recursion in selection request events. */ if ((XINT (read_kbd)) && 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 && (FD_ISSET (keyboard_descriptor, &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 = keyboard_descriptor == 0 ? FIRST_PROC_DESC : 0; channel < MAXDESC; channel++) { if (FD_ISSET (channel, &Available)) { 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 */ /* 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; } /* 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) nchars = read (channel, chars, sizeof chars); else { chars[0] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; nchars = read (channel, chars + 1, sizeof chars - 1); 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; odeactivate = Vdeactivate_mark; specbind (Qinhibit_quit, Qt); call2 (outstream, proc, make_string (chars, nchars)); /* Handling the process output should not deactivate the mark. */ Vdeactivate_mark = odeactivate; #ifdef VMS start_vms_process_read (vs); #endif unbind_to (count); 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; XFASTINT (old_begv) = BEGV; XFASTINT (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 (marker_position (p->mark)); 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)) XFASTINT (old_begv) += nchars; if (point <= XFASTINT (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_process (proc, buf, len) Lisp_Object proc; char *buf; int len; { /* Don't use register vars; longjmp can lose them. */ int rv; 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 (!setjmp (send_process_frame)) while (len > 0) { int this = len; SIGTYPE (*old_sigpipe)(); /* Don't send more than 500 bytes at a time. */ if (this > 500) this = 500; 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 ) { /* It would be nice to accept process output here, but that is difficult. For example, it could garbage what we are sending if that is from a buffer. */ immediate_quit = 1; QUIT; sleep (1); immediate_quit = 0; continue; } report_file_error ("writing to process", Fcons (proc, Qnil)); } buf += rv; len -= rv; /* Allow input from processes between bursts of sending. Otherwise things may get stopped up. */ if (len > 0) { Lisp_Object zero; XFASTINT (zero) = 0; wait_reading_process_input (-1, 0, zero, 0); } } #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)); 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); 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 pipe. 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); return; case SIGQUIT: tcgetattr (XINT (p->infd), &t); send_process (proc, &t.c_cc[VQUIT], 1); return; case SIGTSTP: tcgetattr (XINT (p->infd), &t); #if defined (VSWTCH) && !defined (IRIX5) send_process (proc, &t.c_cc[VSWTCH], 1); #else send_process (proc, &t.c_cc[VSUSP], 1); #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); return; case SIGQUIT: ioctl (XINT (p->infd), TIOCGETC, &c); send_process (proc, &c.t_quitc, 1); return; #ifdef SIGTSTP case SIGTSTP: ioctl (XINT (p->infd), TIOCGLTC, &lc); send_process (proc, &lc.t_suspc, 1); 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); return; case SIGQUIT: ioctl (XINT (p->infd), TCGETA, &t); send_process (proc, &t.c_cc[VQUIT], 1); return; #ifdef SIGTSTP case SIGTSTP: ioctl (XINT (p->infd), TCGETA, &t); send_process (proc, &t.c_cc[VSWTCH], 1); 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); /* ^C */ goto whoosh; #endif case SIGQUIT: #ifdef VMS send_process (proc, "\031", 1); /* ^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 number PID the signal with code CODE.\n\ Both PID and CODE are integers.") (pid, sig) Lisp_Object pid, sig; { CHECK_NUMBER (pid, 0); CHECK_NUMBER (sig, 1); return make_number (kill (XINT (pid), XINT (sig))); } 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.") (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); /* Sending a zero-length record is supposed to mean eof when TIOCREMOTE is turned on. */ #ifdef DID_REMOTE { char buf[1]; write (XINT (XPROCESS (proc)->outfd), buf, 0); } #else /* did not do TOICREMOTE */ #ifdef VMS send_process (proc, "\032", 1); /* ^z */ #else if (!NILP (XPROCESS (proc)->pty_flag)) send_process (proc, "\004", 1); else { close (XINT (XPROCESS (proc)->outfd)); XSET (XPROCESS (proc)->outfd, Lisp_Int, open (NULL_DEVICE, O_WRONLY)); } #endif /* VMS */ #endif /* did not do TOICREMOTE */ 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; XGCTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { proc = XCONS (XCONS (tail)->car)->cdr; if (XGCTYPE (proc) == Lisp_Process && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) { if (NETCONN_P (proc)) deactivate_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 (XTYPE (p->pid) == Lisp_Int && 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; XSETINT (p->tick, ++process_tick); u.wt = w; XFASTINT (p->raw_status_low) = u.i & 0xffff; XFASTINT (p->raw_status_high) = u.i >> 16; /* If process has terminated, stop waiting for its output. */ if (WIFSIGNALED (w) || WIFEXITED (w)) if (XINT (p->infd) >= 0) FD_CLR (XINT (p->infd), &input_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)) #ifndef VMS synch_process_death = (char *) sys_siglist[WTERMSIG (w)]; #else synch_process_death = sys_errlist[WTERMSIG (w)]; #endif /* 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)) #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 void exec_sentinel (proc, reason) Lisp_Object proc, reason; { Lisp_Object sentinel; register struct Lisp_Process *p = XPROCESS (proc); int count = specpdl_ptr - specpdl; 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); call2 (sentinel, proc, reason); unbind_to (count); } /* 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 = Qnil; Lisp_Object msg = Qnil; struct gcpro gcpro1, gcpro2; /* 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); 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 (XTYPE (p->status) == Lisp_Cons) 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 = XBUFFER (buffer)->read_only; Lisp_Object tem; struct buffer *old = current_buffer; int opoint; /* 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 (); update_tick = process_tick; UNGCPRO; } init_process () { register int i; #ifdef SIGCHLD #ifndef CANNOT_DUMP if (! noninteractive || initialized) #endif signal (SIGCHLD, sigchld_handler); #endif FD_ZERO (&input_wait_mask); keyboard_descriptor = 0; FD_SET (keyboard_descriptor, &input_wait_mask); Vprocess_alist = Qnil; for (i = 0; i < MAXDESC; i++) { chan_process[i] = Qnil; proc_buffered_char[i] = -1; } } /* From now on, assume keyboard input comes from descriptor DESC. */ void change_keyboard_wait_descriptor (desc) int desc; { FD_CLR (keyboard_descriptor, &input_wait_mask); keyboard_descriptor = desc; FD_SET (keyboard_descriptor, &input_wait_mask); } 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); 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, and t or 'pty for a pty. Note that if\n\ pty's are not available, this variable will be ignored. The value takes\n\ 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_command); defsubr (&Sset_process_buffer); defsubr (&Sprocess_buffer); defsubr (&Sprocess_mark); defsubr (&Sset_process_filter); defsubr (&Sprocess_filter); defsubr (&Sset_process_sentinel); 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" 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. This version of the function ignores it. 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) redisplay_preserve_echo_area (); if (XINT (read_kbd) && detect_input_pending ()) nfds = 0; else nfds = select (1, &waitchannels, 0, 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 confused 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.22/src/ralloc.c100444 12120 1 32620 5472637427 13353 0ustar rmsdaemon/* Block-relocating memory allocator. 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 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. */ /* 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 (); #include "getpagesize.h" #else /* Not emacs. */ #include typedef size_t SIZE; typedef void *POINTER; #include #include #include #define safe_bcopy(x, y, z) memmove (y, x, z) #endif /* emacs. */ #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 break value, viewed by the relocatable blocs. */ static POINTER break_value; /* The REAL (i.e., page aligned) break value of the process. */ static POINTER page_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))) /* Functions to get and return memory from the system. */ /* Obtain SIZE bytes of space. If enough space is not presently available in our process reserve, (i.e., (page_break_value - break_value)), this means getting more page-aligned space from the system. Return non-zero if all went well, or zero if we couldn't allocate the memory. */ static int obtain (size) SIZE size; { SIZE already_available = page_break_value - break_value; if (already_available < size) { SIZE get = ROUNDUP (size - already_available); /* Get some extra, so we can come here less often. */ get += extra_bytes; if ((*real_morecore) (get) == 0) return 0; page_break_value += get; } break_value += size; return 1; } /* Obtain SIZE bytes of space and return a pointer to the new area. If we could not allocate the space, return zero. */ static POINTER get_more_space (size) SIZE size; { POINTER ptr = break_value; if (obtain (size)) return ptr; else return 0; } /* Note that SIZE bytes of space have been relinquished by the process. If SIZE is more than a page, return the space to the system. */ static void relinquish (size) SIZE size; { POINTER new_page_break; int excess; break_value -= size; new_page_break = (POINTER) ROUNDUP (break_value); excess = (char *) page_break_value - (char *) new_page_break; if (excess > extra_bytes * 2) { /* Keep extra_bytes worth of empty space. And don't free anything unless we can free at least extra_bytes. */ if ((*real_morecore) (extra_bytes - excess) == 0) abort (); page_break_value += extra_bytes - excess; } /* Zero the space from the end of the "official" break to the actual break, so that bugs show up faster. */ bzero (break_value, ((char *) page_break_value - (char *) break_value)); } /* The meat - allocating, freeing, and relocating blocs. */ /* 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. */ typedef struct bp { struct bp *next; struct bp *prev; POINTER *variable; POINTER data; SIZE size; } *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; /* 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; if (! (new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE)) || ! (new_bloc->data = get_more_space (size))) { if (new_bloc) free (new_bloc); return 0; } new_bloc->size = size; new_bloc->next = NIL_BLOC; new_bloc->variable = (POINTER *) NIL; 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; } /* Relocate all blocs from BLOC on upward in the list to the zone indicated by ADDRESS. Direction of relocation is determined by the position of ADDRESS relative to BLOC->data. If BLOC is NIL_BLOC, nothing is done. Note that ordering of blocs is not affected by this function. */ static void relocate_some_blocs (bloc, address) bloc_ptr bloc; POINTER address; { if (bloc != NIL_BLOC) { register SIZE offset = address - bloc->data; register SIZE data_size = 0; register bloc_ptr b; for (b = bloc; b != NIL_BLOC; b = b->next) { data_size += b->size; b->data += offset; *b->variable = b->data; } safe_bcopy (address - offset, address, data_size); } } /* Free BLOC from the chain of blocs, relocating any blocs above it and returning BLOC->size bytes to the free area. */ static void free_bloc (bloc) bloc_ptr bloc; { 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; } relocate_some_blocs (bloc->next, bloc->data); relinquish (bloc->size); free (bloc); } /* Interface routines. */ static int use_relocatable_buffers; /* 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; { /* This is the first address not currently available for the heap. */ POINTER top; /* Amount of empty space below that. */ /* It is not correct to use SIZE here, because that is usually unsigned. ptrdiff_t would be okay, but is not always available. `long' will work in all cases, in practice. */ long already_available; POINTER ptr; if (! use_relocatable_buffers) return (*real_morecore) (size); top = first_bloc ? first_bloc->data : page_break_value; already_available = (char *) top - (char *) virtual_break_value; /* Do we not have enough gap already? */ if (size > 0 && already_available < size) { /* Get what we need, plus some extra so we can come here less often. */ SIZE get = size - already_available + extra_bytes; if (! obtain (get)) return 0; if (first_bloc) relocate_some_blocs (first_bloc, first_bloc->data + get); /* Zero out the space we just allocated, to help catch bugs quickly. */ bzero (virtual_break_value, get); } /* Can we keep extra_bytes of gap while freeing at least extra_bytes? */ else if (size < 0 && already_available - size > 2 * extra_bytes) { /* Ok, do so. This is how many to free. */ SIZE give_back = already_available - size - extra_bytes; if (first_bloc) relocate_some_blocs (first_bloc, first_bloc->data - give_back); relinquish (give_back); } ptr = virtual_break_value; virtual_break_value += size; return ptr; } /* 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. 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 (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; dead_bloc = find_bloc (ptr); if (dead_bloc == NIL_BLOC) abort (); free_bloc (dead_bloc); *ptr = 0; } /* 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. 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; bloc = find_bloc (ptr); if (bloc == NIL_BLOC) abort (); if (size <= bloc->size) /* Wouldn't it be useful to actually resize the bloc here? */ return *ptr; if (! obtain (size - bloc->size)) return 0; relocate_some_blocs (bloc->next, bloc->data + size); /* Zero out the new space in the bloc, to help catch bugs faster. */ bzero (bloc->data + bloc->size, size - bloc->size); /* Indicate that this block has a new size. */ bloc->size = size; return *ptr; } /* 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; virtual_break_value = break_value = (*real_morecore) (0); if (break_value == NIL) abort (); page_size = PAGE; extra_bytes = ROUNDUP (50000); page_break_value = (POINTER) ROUNDUP (break_value); /* 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) (page_break_value - break_value); /* 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 (break_value, (page_break_value - break_value)); virtual_break_value = break_value = page_break_value; use_relocatable_buffers = 1; } emacs-19.22/src/regex.c100666 12120 1 510365 5475061065 13236 0ustar rmsdaemon/* Extended regular expression matching and search library, version 0.12. (Implements POSIX draft P10003.2/D11.2, except for internationalization features.) Copyright (C) 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. */ /* AIX requires this to be the first thing in the file. */ #if defined (_AIX) && !defined (REGEX_MALLOC) #pragma alloca #endif #define _GNU_SOURCE /* We need this for `regex.h', and perhaps for the Emacs include files. */ #include #ifdef HAVE_CONFIG_H #include #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" /* Emacs uses `NULL' as a predicate. */ #undef NULL #else /* not emacs */ /* We used to test for `BSTRING' here, but only GCC and Emacs define `BSTRING', as far as I know, and neither of them use this code. */ #if HAVE_STRING_H || STDC_HEADERS #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 #ifdef STDC_HEADERS #include #else char *malloc (); char *realloc (); #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 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 (isascii) || defined (STDC_HEADERS) #undef isascii #define isascii(c) 1 #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 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) #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 */ #ifndef _AIX /* Already did AIX, up at the top. */ char *alloca (); #endif /* not _AIX */ #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) #endif /* not REGEX_MALLOC */ /* 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 /* 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. The value of `exactn' is needed in search.c (search_buffer) in Emacs. So regex.h defines a symbol `RE_EXACTN_VALUE' to be 1; the value of `exactn' we use here must also be 1. */ typedef enum { no_op = 0, /* Followed by one byte giving n, then by n literal bytes. */ exactn = 1, /* 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) extern void printchar (); /* 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; printchar (i - 1); while (i < (1 << BYTEWIDTH) && fastmap[i]) { was_a_range = 1; i++; } if (was_a_range) { printf ("-"); printchar (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 ('/'); printchar (*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) { printchar (last); in_range = 0; } if (! in_range) printchar (c); last = c; } if (in_range) printchar (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++) printchar (string1[this_char]); where = string2; } for (this_char = where - string2; this_char < size2; this_char++) printchar (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. */ reg_syntax_t re_syntax_options = RE_SYNTAX_EMACS; /* 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. */ static const char *re_error_msg[] = { NULL, /* REG_NOERROR */ "No match", /* REG_NOMATCH */ "Invalid regular expression", /* REG_BADPAT */ "Invalid collation character", /* REG_ECOLLATE */ "Invalid character class name", /* REG_ECTYPE */ "Trailing backslash", /* REG_EESCAPE */ "Invalid back reference", /* REG_ESUBREG */ "Unmatched [ or [^", /* REG_EBRACK */ "Unmatched ( or \\(", /* REG_EPAREN */ "Unmatched \\{", /* REG_EBRACE */ "Invalid content of \\{\\}", /* REG_BADBR */ "Invalid range end", /* REG_ERANGE */ "Memory exhausted", /* REG_ESPACE */ "Invalid preceding regular expression", /* REG_BADRPT */ "Premature end of regular expression", /* REG_EEND */ "Regular expression too big", /* REG_ESIZE */ "Unmatched ) or \\)", /* REG_ERPAREN */ }; /* Avoiding alloca during matching, to placate r_alloc. */ /* Define MATCH_MAY_ALLOCATE if 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. */ /* Normally, this is fine. */ #define MATCH_MAY_ALLOCATE /* But under some circumstances, it's not. */ #if defined (REL_ALLOC) && defined (C_ALLOCA) #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. */ /* 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. */ int re_max_failures = 2000; typedef const unsigned char *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 FAIL_STACK_TOP() (fail_stack.stack[fail_stack.avail]) /* Initialize `fail_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 (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) #else #define INIT_FAIL_STACK() \ do { \ fail_stack.avail = 0; \ } while (0) #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 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 ((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 PATTERN_OP 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(pattern_op, fail_stack) \ ((FAIL_STACK_FULL () \ && !DOUBLE_FAIL_STACK (fail_stack)) \ ? 0 \ : ((fail_stack).stack[(fail_stack).avail++] = pattern_op, \ 1)) /* This pushes an item onto the failure stack. Must be a four-byte value. Assumes the variable `fail_stack'. Probably should only be called from within `PUSH_FAILURE_POINT'. */ #define PUSH_FAILURE_ITEM(item) \ fail_stack.stack[fail_stack.avail++] = (fail_stack_elt_t) item /* The complement operation. Assumes `fail_stack' is nonempty. */ #define POP_FAILURE_ITEM() 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_ITEM #define DEBUG_POP(item_addr) *(item_addr) = POP_FAILURE_ITEM () #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"); \ \ 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_ITEM (regstart[this_reg]); \ \ DEBUG_PRINT2 (" end: 0x%x\n", regend[this_reg]); \ PUSH_FAILURE_ITEM (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_ITEM (reg_info[this_reg].word); \ } \ \ DEBUG_PRINT2 (" Pushing low active reg: %d\n", lowest_active_reg);\ PUSH_FAILURE_ITEM (lowest_active_reg); \ \ DEBUG_PRINT2 (" Pushing high active reg: %d\n", highest_active_reg);\ PUSH_FAILURE_ITEM (highest_active_reg); \ \ DEBUG_PRINT2 (" Pushing pattern 0x%x: ", pattern_place); \ DEBUG_PRINT_COMPILED_PATTERN (bufp, pattern_place, pend); \ PUSH_FAILURE_ITEM (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_ITEM (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 \ ((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_ITEM (); \ 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_ITEM (); \ DEBUG_PRINT2 (" Popping pattern 0x%x: ", pat); \ DEBUG_PRINT_COMPILED_PATTERN (bufp, pat, pend); \ \ /* Restore register info. */ \ high_reg = (unsigned) POP_FAILURE_ITEM (); \ DEBUG_PRINT2 (" Popping high active reg: %d\n", high_reg); \ \ low_reg = (unsigned) POP_FAILURE_ITEM (); \ DEBUG_PRINT2 (" Popping low active reg: %d\n", low_reg); \ \ 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_ITEM (); \ DEBUG_PRINT2 (" info: 0x%x\n", reg_info[this_reg]); \ \ regend[this_reg] = (const char *) POP_FAILURE_ITEM (); \ DEBUG_PRINT2 (" end: 0x%x\n", regend[this_reg]); \ \ regstart[this_reg] = (const char *) POP_FAILURE_ITEM (); \ DEBUG_PRINT2 (" start: 0x%x\n", regstart[this_reg]); \ } \ \ DEBUG_STATEMENT (nfailure_points_popped++); \ } /* POP_FAILURE_POINT */ /* Structure for per-register (a.k.a. per-group) information. This must not be longer than one word, because we push this value onto the failure stack. 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 \ { \ unsigned r; \ 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. */ #define REG_UNSET_VALUE ((char *) -1) #define REG_UNSET(e) ((e) == REG_UNSET_VALUE) /* How do we implement a missing MATCH_MAY_ALLOCATE? We make the fail stack a global thing, and then grow it to re_max_failures when we compile. */ #ifndef MATCH_MAY_ALLOCATE static fail_stack_type fail_stack; 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; #endif /* 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'). */ #define PATFETCH(c) \ do {if (p == pend) return REG_EEND; \ c = (unsigned char) *p++; \ if (translate) c = translate[c]; \ } while (0) /* 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. */ #define TRANSLATE(d) (translate ? translate[(unsigned char) (d)] : (d)) /* 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")) /* `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. */ 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. */ char *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++) printchar (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) 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) 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) 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) 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) return REG_EBRACK; PATFETCH (c); /* \ might escape characters inside [...] and [^...]. */ if ((syntax & RE_BACKSLASH_ESCAPE_IN_LISTS) && c == '\\') { if (p == pend) 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 != ']') 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) 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) 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) 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)) return REG_ECTYPE; /* Throw away the ] at the end of the character class. */ PATFETCH (c); if (p == pend) return REG_EBRACK; for (ch = 0; ch < 1 << BYTEWIDTH; ch++) { if ( (is_alnum && ISALNUM (ch)) || (is_alpha && ISALPHA (ch)) || (is_blank && ISBLANK (ch)) || (is_cntrl && ISCNTRL (ch)) || (is_digit && ISDIGIT (ch)) || (is_graph && ISGRAPH (ch)) || (is_lower && ISLOWER (ch)) || (is_print && ISPRINT (ch)) || (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) 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 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 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 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 return REG_BADBR; } if (!(syntax & RE_NO_BK_BRACES)) { if (c != '\\') return REG_EBRACE; PATFETCH (c); } if (c != '}') { if (syntax & RE_NO_BK_BRACES) goto unfetch_interval; else 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) 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) 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) return REG_EPAREN; 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. */ fail_stack.size = (2 * re_max_failures * MAX_FAILURE_ITEMS); if (fail_stack.stack) fail_stack.stack = (fail_stack_elt_t *) realloc (fail_stack.stack, (fail_stack.size * sizeof (fail_stack_elt_t))); else fail_stack.stack = (fail_stack_elt_t *) malloc (fail_stack.size * sizeof (fail_stack_elt_t)); /* Initialize some other variables the matcher uses. */ 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); } #endif 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 : NULL; 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; char *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. */ range_start = ((unsigned char *) p)[-2]; range_end = ((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; const unsigned char *p = pattern; register unsigned char *pend = pattern + size; /* 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 (p != pend || !FAIL_STACK_EMPTY ()) { if (p == pend) { bufp->can_be_null |= path_can_be_null; /* Reset for next path. */ path_can_be_null = true; p = fail_stack.stack[--fail_stack.avail]; } /* We should never be about to go beyond the end of the pattern. */ assert (p < pend); #ifdef SWITCH_ENUM_BUG switch ((int) ((re_opcode_t) *p++)) #else switch ((re_opcode_t) *p++) #endif { /* 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; return 0; /* 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: /* `.' matches anything ... */ for (j = 0; j < (1 << BYTEWIDTH); j++) fastmap[j] = 1; /* ... except perhaps newline. */ if (!(bufp->syntax & RE_DOT_NEWLINE)) fastmap['\n'] = 0; /* 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) return 0; /* 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 /* not 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] == 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)) 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; 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 char *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. */ if (endpos < -1) range = -1 - 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; } /* 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 (bufp, string1, size1, string2, size2, startpos, regs, stop); 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) ? (ptr) - string1 : (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 #ifdef REGEX_MALLOC #define FREE_VAR(var) if (var) free (var); var = NULL #define FREE_VARIABLES() \ do { \ FREE_VAR (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 /* not REGEX_MALLOC */ /* Some MIPS systems (at least) want this to free alloca'd storage. */ #define FREE_VARIABLES() alloca (0) #endif /* not REGEX_MALLOC */ #else #define FREE_VARIABLES() /* Do nothing! */ #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; { return re_match_2 (bufp, NULL, 0, string, size, pos, regs, size); } #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; { /* 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; /* We use this to map every character in the string. */ char *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 /* 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; /* 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; } } #if defined (REGEX_MALLOC) 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 /* REGEX_MALLOC */ #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) { DEBUG_PRINT1 ("backtracking.\n"); if (!FAIL_STACK_EMPTY ()) { /* More failure points to try. */ boolean same_str_p = (FIRST_STRING_P (match_end) == MATCHING_IN_FIRST_STRING); /* If exceeds best match so far, save it. */ if (!best_regs_set || (same_str_p && d > match_end) || (!same_str_p && !MATCHING_IN_FIRST_STRING)) { 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. */ else if (best_regs_set) { 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 */ 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) 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) 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 ? d - string1 : 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] = POINTER_TO_OFFSET (regstart[mcnt]); regs->end[mcnt] = 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 */ FREE_VARIABLES (); 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); return mcnt; } /* Otherwise match next pattern command. */ #ifdef SWITCH_ENUM_BUG switch ((int) ((re_opcode_t) *p++)) #else switch ((re_opcode_t) *p++) #endif { /* 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; /* 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 (translate[(unsigned char) *d++] != (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; /* 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; 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; /* 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]) || (re_opcode_t) p[-3] == start_memory) && (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 ((int) old_regend[r] >= (int) 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; } } 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 \(\(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) { register unsigned char c = *p2 == (unsigned char) endline ? '\n' : p2[2]; if ((re_opcode_t) p1[3] == exactn && ! (p2[1] * BYTEWIDTH > 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 < p2[1]; idx++) if (! (p2[2 + idx] == 0 || (idx < 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 < p2[1] && idx < 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 #ifdef emacs19 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; #else /* not emacs19 */ case at_dot: DEBUG_PRINT1 ("EXECUTING at_dot.\n"); if (PTR_CHAR_POS ((unsigned char *) d) + 1 != point) goto fail; break; #endif /* not emacs19 */ 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 (); if (SYNTAX (*d++) != (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 (); if (SYNTAX (*d++) == (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; char *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); return re_error_msg[(int) ret]; } /* Entry points compatible with 4.2 BSD regex library. We don't define them if this is an Emacs or POSIX compilation. */ #if !defined (emacs) && !defined (_POSIX_SOURCE) /* 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 "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 "Memory exhausted"; re_comp_buf.allocated = 200; re_comp_buf.fastmap = (char *) malloc (1 << BYTEWIDTH); if (re_comp_buf.fastmap == NULL) return "Memory exhausted"; } /* 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); /* Yes, we're discarding `const' here. */ return (char *) re_error_msg[(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 /* not emacs and not _POSIX_SOURCE */ /* 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 = (char *) malloc (CHAR_SET_SIZE); 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_msg) / sizeof (re_error_msg[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 = re_error_msg[errcode]; /* POSIX doesn't require that we do anything in this case, but why not be nice. */ if (! msg) msg = "Success"; 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.22/src/scroll.c100444 12241 12 44733 5444474613 13744 0ustar rolandstaff/* Calculate what line insertion or deletion to do, and do it, Copyright (C) 1985, 1986, 1990, 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 "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 15000 characters. */ #define INFINITY 15000 struct matrix_elt { /* Cost of outputting through this line if no insert/delete is done just above it. */ short writecost; /* Cost of outputting through this line if an insert is done just above it. */ short insertcost; /* Cost of outputting through this line if a delete is done just above it. */ short deletecost; /* Number of inserts so far in this run of inserts, for the cost in insertcost. */ char insertcount; /* Number of deletes so far in this run of deletes, for the cost in deletecost. */ char deletecount; }; /* Determine, in matrix[i,j], the cost of updating the first j old lines into the first i new lines. 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 (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 (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 according to the costs in the matrix. Updates the contents of the frame to record what was done. */ 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->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_X_WINDOWS if (FRAME_X_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->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++]; } } if (window) set_terminal_window (0); } void scrolling_1 (frame, window_size, unchanged_at_top, unchanged_at_bottom, 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_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)); 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_DELETEN_COST (frame)[offset + to] + (amount - 1) * FRAME_DELETE_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_DELETEN_COST (frame), FRAME_DELETE_COST (frame), coefficient); } emacs-19.22/src/search.c100444 12120 1 131273 5470243067 13357 0ustar rmsdaemon/* String search routines for GNU Emacs. 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 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. */ #include #include "lisp.h" #include "syntax.h" #include "buffer.h" #include "commands.h" #include "blockinput.h" #include #include "regex.h" #define max(a, b) ((a) > (b) ? (a) : (b)) #define min(a, b) ((a) < (b) ? (a) : (b)) /* We compile regexps into this buffer and then use it for searching. */ struct re_pattern_buffer searchbuf; char search_fastmap[0400]; /* Last regexp we compiled */ Lisp_Object last_regexp; /* 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 searchbuf. 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 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. */ compile_pattern (pattern, bufp, regp, translate) Lisp_Object pattern; struct re_pattern_buffer *bufp; struct re_registers *regp; char *translate; { CONST char *val; Lisp_Object dummy; if (EQ (pattern, last_regexp) && translate == bufp->translate) return; last_regexp = Qnil; bufp->translate = translate; BLOCK_INPUT; val = (CONST char *) re_compile_pattern ((char *) XSTRING (pattern)->data, XSTRING (pattern)->size, bufp); UNBLOCK_INPUT; if (val) { dummy = build_string (val); while (1) Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil)); } last_regexp = pattern; /* Advise the searching functions about the space we have allocated for register data. */ BLOCK_INPUT; if (regp) re_set_registers (bufp, regp, regp->num_regs, regp->start, regp->end); UNBLOCK_INPUT; return; } /* 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; } DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, "Return t if text after point matches regular expression PAT.\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.") (string) Lisp_Object string; { Lisp_Object val; unsigned char *p1, *p2; int s1, s2; register int i; CHECK_STRING (string, 0); compile_pattern (string, &searchbuf, &search_regs, !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0); 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 (&searchbuf, (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; } XSET (last_thing_searched, Lisp_Buffer, current_buffer); immediate_quit = 0; return 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; { int val; int s; 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); } compile_pattern (regexp, &searchbuf, &search_regs, !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0); immediate_quit = 1; val = re_search (&searchbuf, (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); } /* 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; compile_pattern (regexp, &searchbuf, 0, 0); immediate_quit = 1; val = re_search (&searchbuf, (char *) XSTRING (string)->data, XSTRING (string)->size, 0, XSTRING (string)->size, 0); immediate_quit = 0; return val; } /* Search for COUNT instances of the character TARGET, starting 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 TARGETs left unfound, and return the end of the buffer we bumped up against. */ scan_buffer (target, start, count, shortage) int *shortage, start; register int count, target; { 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 (shortage != 0) *shortage = 0; immediate_quit = 1; 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 != target && ++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 != target) ; if (cursor != ceiling_addr) { if (++count == 0) { immediate_quit = 0; return (start + cursor - base + 1); } } else break; } start += cursor - base; } } immediate_quit = 0; if (shortage != 0) *shortage = count * direction; return (start + ((direction == 1 ? 0 : 1))); } int find_next_newline (from, cnt) register int from, cnt; { return (scan_buffer ('\n', from, cnt, (int *) 0)); } 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)) XSET (lim, Lisp_Int, 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) XFASTINT (lim) = ZV; if (XINT (lim) < BEGV) XFASTINT (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 ^ 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) Lisp_Object string, bound, noerror, count; int direction; int RE; { 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) ? XSTRING (current_buffer->case_canon_table)->data : 0), (!NILP (current_buffer->case_fold_search) ? XSTRING (current_buffer->case_eqv_table)->data : 0)); 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); } /* search for the n'th occurrence of STRING in the current buffer, starting at position POS and stopping at position LIM, treating PAT 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). */ search_buffer (string, pos, lim, n, RE, trt, inverse_trt) Lisp_Object string; int pos; int lim; int n; int RE; register unsigned char *trt; register unsigned char *inverse_trt; { 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; /* Null string is found at starting position. */ if (len == 0) return pos; /* Searching 0 times means don't move. */ if (n == 0) return pos; if (RE) compile_pattern (string, &searchbuf, &search_regs, (char *) trt); if (RE /* Here we detect whether the */ /* generality of an RE search is */ /* really needed. */ /* first item is "exact match" */ && *(searchbuf.buffer) == (char) RE_EXACTN_VALUE && searchbuf.buffer[1] + 2 == searchbuf.used) /*first is ONLY item */ { RE = 0; /* can do straight (non RE) search */ pat = (base_pat = (unsigned char *) searchbuf.buffer + 2); /* trt already applied */ len = searchbuf.used - 2; } else if (!RE) { pat = (unsigned char *) alloca (len); for (i = len; i--;) /* Copy the pattern; apply trt */ *pat++ = (((int) trt) ? trt [*base_pat++] : *base_pat++); pat -= len; base_pat = pat; } if (RE) { 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 (&searchbuf, (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; } XSET (last_thing_searched, Lisp_Buffer, 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 (&searchbuf, (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; } XSET (last_thing_searched, Lisp_Buffer, 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 /* 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 ((int) trt) { 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 = 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) { if ((lim - pos - (direction > 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 ((int) (p_limit + infinity) > (int) p_limit) while ((int) cursor <= (int) p_limit) cursor += BM_tab[*cursor]; else while ((unsigned int) cursor <= (unsigned int) p_limit) cursor += BM_tab[*cursor]; } else { if ((int) (p_limit + infinity) < (int) p_limit) while ((int) cursor >= (int) p_limit) cursor += BM_tab[*cursor]; else while ((unsigned int) cursor >= (unsigned 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 ((int) trt) { 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; /* Make sure we have registers in which to store the match position. */ if (search_regs.num_regs == 0) { regoff_t *starts, *ends; starts = (regoff_t *) xmalloc (2 * sizeof (regoff_t)); ends = (regoff_t *) xmalloc (2 * sizeof (regoff_t)); BLOCK_INPUT; re_set_registers (&searchbuf, &search_regs, 2, starts, ends); UNBLOCK_INPUT; } search_regs.start[0] = pos + cursor - p2 + ((direction > 0) ? 1 - len : 0); search_regs.end[0] = len + search_regs.start[0]; XSET (last_thing_searched, Lisp_Buffer, current_buffer); 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] != (((int) trt) ? 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; /* Make sure we have registers in which to store the match position. */ if (search_regs.num_regs == 0) { regoff_t *starts, *ends; starts = (regoff_t *) xmalloc (2 * sizeof (regoff_t)); ends = (regoff_t *) xmalloc (2 * sizeof (regoff_t)); BLOCK_INPUT; re_set_registers (&searchbuf, &search_regs, 2, starts, ends); UNBLOCK_INPUT; } search_regs.start[0] = pos + ((direction > 0) ? 1 - len : 0); search_regs.end[0] = len + search_regs.start[0]; XSET (last_thing_searched, Lisp_Buffer, current_buffer); 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; } } /* 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); } 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); } 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); } 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); } 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 place 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'.") (string, bound, noerror, count) Lisp_Object string, bound, noerror, count; { return search_command (string, bound, noerror, count, -1, 1); } 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'.") (string, bound, noerror, count) Lisp_Object string, bound, noerror, count; { return search_command (string, bound, noerror, count, 1, 1); } DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 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 convert to all caps or cap initials, like replaced text.\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.") (newtext, fixedcase, literal) Lisp_Object newtext, fixedcase, literal; { enum { nochange, all_caps, cap_initial } case_action; register int pos, last; int some_multiletter_word; int some_lowercase; int some_uppercase_initial; register int c, prevc; int inslen; CHECK_STRING (newtext, 0); 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 (search_regs.start[0] < BEGV || search_regs.start[0] > search_regs.end[0] || search_regs.end[0] > ZV) args_out_of_range (make_number (search_regs.start[0]), make_number (search_regs.end[0])); if (NILP (fixedcase)) { /* Decide how to casify by examining the matched text. */ last = search_regs.end[0]; 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_uppercase_initial = 0; for (pos = search_regs.start[0]; pos < last; pos++) { c = FETCH_CHAR (pos); if (LOWERCASEP (c)) { /* Cannot be all caps if any original char is lower case */ some_lowercase = 1; if (SYNTAX (prevc) != Sword) ; else some_multiletter_word = 1; } else if (!NOCASEP (c)) { if (SYNTAX (prevc) != Sword) some_uppercase_initial = 1; else some_multiletter_word = 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 a capitalized word. */ else if (some_uppercase_initial) case_action = cap_initial; else case_action = nochange; } /* 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[0]); 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[0]; c = XSTRING (newtext)->data[pos]; if (c == '\\') { c = XSTRING (newtext)->data[++pos]; if (c == '&') Finsert_buffer_substring (Fcurrent_buffer (), make_number (search_regs.start[0] + offset), make_number (search_regs.end[0] + offset)); else if (c >= '1' && 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[0]); del_range (search_regs.start[0] + inslen, search_regs.end[0] + inslen); if (case_action == all_caps) Fupcase_region (make_number (point - inslen), make_number (point)); else if (case_action == cap_initial) upcase_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)) { XFASTINT (data[2 * i]) = start; XFASTINT (data[2 * i + 1]) = search_regs.end[i]; } else if (XTYPE (last_thing_searched) == Lisp_Buffer) { 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 (!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)); } BLOCK_INPUT; re_set_registers (&searchbuf, &search_regs, length, search_regs.start, search_regs.end); UNBLOCK_INPUT; } } 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 (XTYPE (marker) == Lisp_Marker) { if (XMARKER (marker)->buffer == 0) XFASTINT (marker) = 0; else XSET (last_thing_searched, Lisp_Buffer, XMARKER (marker)->buffer); } CHECK_NUMBER_COERCE_MARKER (marker, 0); search_regs.start[i] = XINT (marker); list = Fcdr (list); marker = Fcar (list); if (XTYPE (marker) == Lisp_Marker && XMARKER (marker)->buffer == 0) XFASTINT (marker) = 0; CHECK_NUMBER_COERCE_MARKER (marker, 0); search_regs.end[i] = XINT (marker); } list = Fcdr (list); } return Qnil; } /* 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; searchbuf.allocated = 100; searchbuf.buffer = (unsigned char *) malloc (searchbuf.allocated); searchbuf.fastmap = search_fastmap; 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_regexp = Qnil; staticpro (&last_regexp); last_thing_searched = Qnil; staticpro (&last_thing_searched); defsubr (&Sstring_match); defsubr (&Slooking_at); 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 (&Sreplace_match); defsubr (&Smatch_beginning); defsubr (&Smatch_end); defsubr (&Smatch_data); defsubr (&Sstore_match_data); defsubr (&Sregexp_quote); } emacs-19.22/src/sunfns.c100444 12241 12 34123 5444474616 13755 0ustar rolandstaff/* 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 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. */ /* 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(XTYPE(Value) == Lisp_Symbol) Value = XSYMBOL(Value)->value; if(XTYPE(Value) == Lisp_Vector) { 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.22/src/syntax.c100444 12120 1 135115 5470242225 13432 0ustar rmsdaemon/* GNU Emacs routines to deal with syntax tables; also word and list parsing. Copyright (C) 1985, 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. */ #include #include #include "lisp.h" #include "commands.h" #include "buffer.h" #include "syntax.h" Lisp_Object Qsyntax_table_p; static void scan_sexps_forward (); static int char_quoted (); int words_include_escapes; /* 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, -1, &shortage); 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, -2, &shortage); } /* 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\ Any vector of 256 elements will do.") (obj) Lisp_Object obj; { if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400) return Qt; return Qnil; } Lisp_Object check_syntax_table (obj) Lisp_Object obj; { register Lisp_Object tem; while (tem = Fsyntax_table_p (obj), NILP (tem)) obj = wrong_type_argument (Qsyntax_table_p, obj); return 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 size, val; XFASTINT (size) = 0400; XFASTINT (val) = 0; val = Fmake_vector (size, val); if (!NILP (table)) table = check_syntax_table (table); else if (NILP (Vstandard_syntax_table)) /* Can only be null during initialization */ return val; else table = Vstandard_syntax_table; bcopy (XVECTOR (table)->contents, XVECTOR (val)->contents, 0400 * sizeof (Lisp_Object)); return val; } 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; { 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, 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, (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[13] = { ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>' }; 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; { CHECK_NUMBER (ch, 0); return make_number (syntax_code_spec[(int) SYNTAX (0xFF & XINT (ch))]); } /* 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.\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 of a\n\ comment-start, or the first character of a comment-end sequence) by 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, match; register enum syntaxcode code; Lisp_Object val; CHECK_NUMBER (c, 0); CHECK_STRING (newentry, 1); if (NILP (syntax_table)) syntax_table = current_buffer->syntax_table; else syntax_table = 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); match = *p; if (match) p++; if (match == ' ') match = 0; XFASTINT (val) = (match << 8) + (int) code; while (*p) switch (*p++) { case '1': XFASTINT (val) |= 1 << 16; break; case '2': XFASTINT (val) |= 1 << 17; break; case '3': XFASTINT (val) |= 1 << 18; break; case '4': XFASTINT (val) |= 1 << 19; break; case 'p': XFASTINT (val) |= 1 << 20; break; case 'b': XFASTINT (val) |= 1 << 21; break; } XVECTOR (syntax_table)->contents[0xFF & XINT (c)] = val; 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]; Findent_to (make_number (16), make_number (1)); if (XTYPE (value) != Lisp_Int) { insert_string ("invalid"); return; } code = (enum syntaxcode) (XINT (value) & 0377); match = (XINT (value) >> 8) & 0377; start1 = (XINT (value) >> 16) & 1; start2 = (XINT (value) >> 17) & 1; end1 = (XINT (value) >> 18) & 1; end2 = (XINT (value) >> 19) & 1; prefix = (XINT (value) >> 20) & 1; comstyle = (XINT (value) >> 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] = match ? match : ' '; 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: "); #ifdef SWITCH_ENUM_BUG switch ((int) code) #else switch (code) #endif { 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 (match) { insert_string (", matches "); insert_char (match); } 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); 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; immediate_quit = 1; QUIT; while (count > 0) { while (1) { if (from == end) { immediate_quit = 0; return 0; } code = SYNTAX (FETCH_CHAR (from)); if (words_include_escapes && (code == Sescape || code == Scharquote)) break; if (code == Sword) break; from++; } while (1) { if (from == end) break; code = SYNTAX (FETCH_CHAR (from)); 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; } code = SYNTAX (FETCH_CHAR (from - 1)); if (words_include_escapes && (code == Sescape || code == Scharquote)) break; if (code == Sword) break; from--; } while (1) { if (from == beg) break; code = SYNTAX (FETCH_CHAR (from - 1)); 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; 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; while (from < stop) { c = FETCH_CHAR (from); code = SYNTAX (c); from++; comstyle = 0; if (from < stop && SYNTAX_COMSTART_FIRST (c) && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from))) { /* 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 (code == Scomment) { while (1) { if (from == stop) { immediate_quit = 0; SET_PT (from); return Qnil; } 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; } } /* We have skipped one comment. */ break; } else if (code != Swhitespace && code != Sendcomment) { immediate_quit = 0; SET_PT (from - 1); return Qnil; } } /* End of comment reached */ 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) && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1)) && !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 (FETCH_CHAR (from - 1)); 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 (SYNTAX (c = FETCH_CHAR (from)) == Scomment && SYNTAX_COMMENT_STYLE (c) == comstyle) break; if (from == stop) { immediate_quit = 0; SET_PT (from); return Qnil; } 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; /* 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--; } else if (from > stop && SYNTAX_COMSTART_SECOND (c) && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1)) && comstyle == SYNTAX_COMMENT_STYLE (c)) { code = Scomment; from--; } /* 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; 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; #ifdef SWITCH_ENUM_BUG switch ((int) code) #else switch (code) #endif { 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) { #ifdef SWITCH_ENUM_BUG switch ((int) SYNTAX (FETCH_CHAR (from))) #else switch (SYNTAX (FETCH_CHAR (from))) #endif { 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) goto done; 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; #ifdef SWITCH_ENUM_BUG switch ((int) SYNTAX (FETCH_CHAR (from))) #else switch (SYNTAX (FETCH_CHAR (from))) #endif { 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; #ifdef SWITCH_ENUM_BUG switch ((int) (quoted ? Sword : code)) #else switch (quoted ? Sword : code) #endif { 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) goto done; 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; /* 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--; } else if (from > stop && SYNTAX_COMSTART_SECOND (c) && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1)) && comstyle == SYNTAX_COMMENT_STYLE (c)) { code = Scomment; from--; } /* 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; XFASTINT (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; #ifdef SWITCH_ENUM_BUG switch ((int) code) #else switch (code) #endif { 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) { #ifdef SWITCH_ENUM_BUG switch ((int) SYNTAX (FETCH_CHAR (from))) #else switch (SYNTAX (FETCH_CHAR (from))) #endif { 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; case Scomment: state.incomment = 1; startincomment: 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++; 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) goto done; break; case Sclose: depth--; if (depth < mindepth) mindepth = depth; if (curlevel != levelstart) curlevel--; curlevel->prev = curlevel->last; if (!++targetdepth) 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; #ifdef SWITCH_ENUM_BUG switch ((int) SYNTAX (FETCH_CHAR (from))) #else switch (SYNTAX (FETCH_CHAR (from))) #endif { 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; register struct Lisp_Vector *v; /* Set this now, so first buffer creation can refer to it. */ /* Make it nil before calling copy-syntax-table so that copy-syntax-table will know not to try to copy from garbage */ Vstandard_syntax_table = Qnil; Vstandard_syntax_table = Fcopy_syntax_table (Qnil); v = XVECTOR (Vstandard_syntax_table); for (i = 'a'; i <= 'z'; i++) XFASTINT (v->contents[i]) = (int) Sword; for (i = 'A'; i <= 'Z'; i++) XFASTINT (v->contents[i]) = (int) Sword; for (i = '0'; i <= '9'; i++) XFASTINT (v->contents[i]) = (int) Sword; XFASTINT (v->contents['$']) = (int) Sword; XFASTINT (v->contents['%']) = (int) Sword; XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8); XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8); XFASTINT (v->contents['[']) = (int) Sopen + (']' << 8); XFASTINT (v->contents[']']) = (int) Sclose + ('[' << 8); XFASTINT (v->contents['{']) = (int) Sopen + ('}' << 8); XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8); XFASTINT (v->contents['"']) = (int) Sstring; XFASTINT (v->contents['\\']) = (int) Sescape; for (i = 0; i < 10; i++) XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol; for (i = 0; i < 12; i++) XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct; } 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 (&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.22/src/sysdep.c100444 12120 1 332046 5475356316 13431 0ustar rmsdaemon/* Interfaces to system-dependent kernel and library entries. 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 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. */ #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 #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 #include #include #include #include extern int errno; #ifndef VMS extern char *sys_errlist[]; #endif #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 */ #ifdef BROKEN_FASYNC /* On some systems (DGUX comes to mind real fast) FASYNC causes background writes to the terminal to stop all processes in the process group when invoked under the csh (and probably any shell with job control). This stops Emacs dead in its tracks when coming up under X11. */ #undef FASYNC #endif #include #include "systty.h" #include "syswait.h" #ifdef BROKEN_TIOCGWINSZ #undef TIOCGWINSZ #endif #ifdef USG #include #include #ifndef MEMORY_IN_STRING_H #include #endif #ifdef TIOCGWINSZ #ifdef NEED_SIOCTL #include #endif #ifdef NEED_PTEM_H #include #include #endif #endif /* TIOCGWINSZ */ #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 NONSYSTEM_DIR_LIBRARY #include "ndir.h" #endif /* NONSYSTEM_DIR_LIBRARY */ #include "syssignal.h" #include "systime.h" /* 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 normaly zero except when using X; under VMS, we place the input channel number here. This allows us to write more code that works for both VMS and Unix. */ static 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 () { 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 */ EMACS_GET_TTY (input_fd, &buf); EMACS_SET_TTY (input_fd, &buf, 0); #endif /* not Apollo */ #endif /* not VMS */ } #ifdef SIGTSTP /* Arrange for character C to be read as the next input from the terminal. */ stuff_char (c) char c; { /* 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 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); #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 */ } 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 */ 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 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; { 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 */ s.main.c_oflag &= ~(NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY); /* No output delays */ s.main.c_lflag &= ~ECHO; /* Disable echo */ s.main.c_lflag |= ISIG; /* Enable signals */ s.main.c_iflag &= ~IUCLC; /* Disable map of upper case to lower on input */ s.main.c_oflag &= ~OLCUC; /* Disable map of lower case to upper on output */ 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] = 0377; /* disable erase processing */ s.main.c_cc[VKILL] = 0377; /* 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 VMS */ #endif /* subprocesses */ /*ARGSUSED*/ setpgrp_of_tty (pid) int pid; { EMACS_SET_TTY_PGRP (input_fd, &pid); } /* 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 #ifdef SIGTSTP { 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. */ int pid = fork (); struct save_signal saved_handlers[5]; 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 if (pid == -1) error ("Can't spawn subshell"); if (pid == 0) { char *sh; sh = (char *) egetenv ("SHELL"); if (sh == 0) sh = "sh"; /* Use our buffer's default directory for the subshell. */ { Lisp_Object dir; unsigned char *str; int len; /* mentioning current_buffer->buffer would mean including buffer.h, which somehow wedges the hp compiler. So instead... */ dir = intern ("default-directory"); /* Can't use NULL */ if (XFASTINT (Fboundp (dir)) == XFASTINT (Qnil)) goto xyzzy; dir = Fsymbol_value (dir); if (XTYPE (dir) != Lisp_String) goto xyzzy; 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; chdir (str); } xyzzy: #ifdef subprocesses close_process_descs (); /* Close Emacs's pipes/ptys */ #endif #ifdef PRIO_PROCESS { extern int emacs_priority; if (emacs_priority) nice (-emacs_priority); } #endif execlp (sh, sh, 0); write (1, "Can't execute subshell", 22); _exit (1); } save_signal_handlers (saved_handlers); synch_process_alive = 1; wait_for_termination (pid); restore_signal_handlers (saved_handlers); #endif /* no USG_JOBCTRL */ #endif /* no SIGTSTP */ #endif /* not 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 () { #ifdef FASYNC old_fcntl_flags = fcntl (input_fd, F_GETFL, 0) & ~FASYNC; #endif request_sigio (); } reset_sigio () { unrequest_sigio (); } #ifdef FASYNC /* F_SETFL does not imply existence of FASYNC */ request_sigio () { #ifdef SIGWINCH sigunblock (sigmask (SIGWINCH)); #endif fcntl (input_fd, F_SETFL, old_fcntl_flags | FASYNC); interrupts_deferred = 0; } unrequest_sigio () { #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; ioctl (input_fd, FIOASYNC, &on); interrupts_deferred = 0; } unrequest_sigio () { int off = 0; ioctl (input_fd, FIOASYNC, &off); interrupts_deferred = 1; } #else /* not FASYNC, not STRIDE */ request_sigio () { croak ("request_sigio"); } unrequest_sigio () { croak ("unrequest_sigio"); } #endif /* STRIDE */ #endif /* FASYNC */ #endif /* F_SETFL */ /* Saving and restoring the process group of Emacs's terminal. */ #ifdef BSD /* 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 /* 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 /* I give up - I hope you have the BSD ioctls. */ if (ioctl (fd, TIOCGETP, &settings->main) < 0) return -1; #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 WAITP is non-zero, we wait for all queued output to be written before making the change; otherwise, we forget any queued input and make the change immediately. Return 0 if all went well, and -1 if anything failed. */ int emacs_set_tty (fd, settings, waitp) int fd; struct emacs_tty *settings; int waitp; { /* 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, waitp ? 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, waitp ? TCSETAW : TCSETAF, &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 /* I give up - I hope you have the BSD ioctls. */ if (ioctl (fd, (waitp) ? TIOCSETP : TIOCSETN, &settings->main) < 0) return -1; #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; int term_initted; /* 1 if outer tty status has been recorded */ #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 if (! read_socket_hook && EQ (Vwindow_system, Qnil)) narrow_foreground_group (); #endif EMACS_GET_TTY (input_fd, &old_tty); if (!read_socket_hook && EQ (Vwindow_system, Qnil)) { tty = old_tty; #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) 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_iflag &= ~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 */ #endif /* mips or HAVE_TCATTR */ #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) */ 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 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 */ 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 #ifdef AIX 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 #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) { old_fcntl_owner = fcntl (input_fd, F_GETOWN, 0); fcntl (input_fd, F_SETOWN, getpid ()); init_sigio (); } #endif /* F_GETOWN */ #endif /* F_SETOWN_BUG */ #endif /* F_SETFL */ #ifdef BSD4_1 if (interrupt_input) init_sigio (); #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 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. If zero or a negative number is stored, the value is not valid. */ 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 /* system doesn't know size */ *widthp = 0; *heightp = 0; #endif /* not VMS */ #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; if (read_socket_hook || !EQ (Vwindow_system, Qnil)) return; 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); #ifdef IBMR2AIX { /* 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 */ #endif /* F_SETFL */ #ifdef BSD4_1 if (interrupt_input) reset_sigio (); #endif /* BSD4_1 */ while (EMACS_SET_TTY (input_fd, &old_tty, 0) < 0 && errno == EINTR) ; #ifdef AIX hft_reset (); #endif #ifdef BSD 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; XSET (e.code, Lisp_Int, c); #ifdef MULTI_FRAME XSET(e.frame_or_window, Lisp_Frame, selected_frame); #else e.frame_or_window = Qnil; #endif 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++; 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 () { 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 CANNOT_UNEXEC 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 CANNOT_UNEXEC */ /* * 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 */ /* Get_system_name returns as its value a string for the Lisp function system-name to return. */ #ifdef BSD4_1 #include #endif /* Can't have this within the function since `static' is #defined to nothing for some USG systems. */ #ifdef USG #ifdef HAVE_GETHOSTNAME static char get_system_name_name[256]; #else /* not HAVE_GETHOSTNAME */ static struct utsname get_system_name_name; #endif /* not HAVE_GETHOSTNAME */ #endif /* USG */ #ifndef BSD4_1 #ifndef USG #ifndef VMS #ifdef HAVE_SOCKETS #include #include #endif /* HAVE_SOCKETS */ #endif /* not VMS */ #endif /* not USG */ #endif /* not BSD4_1 */ char * get_system_name () { #ifdef USG #ifdef HAVE_GETHOSTNAME gethostname (get_system_name_name, sizeof (get_system_name_name)); return get_system_name_name; #else /* not HAVE_GETHOSTNAME */ uname (&get_system_name_name); return (get_system_name_name.nodename); #endif /* not HAVE_GETHOSTNAME */ #else /* Not USG */ #ifdef BSD4_1 return sysname; #else /* not USG, not 4.1 */ static char system_name_saved[32]; #ifdef VMS char *sp; if ((sp = egetenv ("SYS$NODE")) == 0) sp = "vax-vms"; else { char *end; if ((end = index (sp, ':')) != 0) *end = '\0'; } strcpy (system_name_saved, sp); #else /* not VMS */ gethostname (system_name_saved, sizeof (system_name_saved)); #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; hp = gethostbyname (system_name_saved); if (hp && strlen (hp->h_name) < sizeof(system_name_saved)) strcpy (system_name_saved, hp->h_name); } #endif /* HAVE_SOCKETS */ #endif /* not VMS */ return system_name_saved; #endif /* not USG, not 4.1 */ #endif /* not USG */ } #ifdef VMS #ifndef HAVE_GETHOSTNAME void gethostname(buf, len) char *buf; int len; { char *s; s = getenv ("SYS$NODE"); if (s == NULL) buf[0] = '\0'; else { strncpy (buf, s, len - 2); buf[len - 1] = '\0'; } /* else */ } /* static void gethostname */ #endif /* ! HAVE_GETHOSTNAME */ #endif /* VMS */ #ifndef VMS #ifndef HAVE_SELECT #ifdef HAVE_X_WINDOWS /* 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); } /* Only rfds are checked. */ int select (nfds, rfds, wfds, efds, timeout) int nfds; int *rfds, *wfds, *efds, *timeout; { int ravail = 0, orfds = 0, old_alarm; int timeoutval = timeout ? *timeout : 100000; int *local_timeout = &timeoutval; 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 (rfds) { orfds = *rfds; *rfds = 0; } if (wfds) *wfds = 0; if (efds) *efds = 0; /* If we are looking only for the terminal, with no timeout, just read it and wait -- that's more efficient. */ if (orfds == 1 && *local_timeout == 100000 && process_tick == update_tick) { if (! detect_input_pending ()) read_input_waiting (); *rfds = 1; return 1; } /* 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, bit, fd; if (rfds) { for (to_check = nfds, bit = 1, fd = 0; --to_check >= 0; bit <<= 1, fd++) { if (orfds & bit) { int avail = 0, status = 0; if (bit == 1) 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) { (*rfds) |= bit; 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 (orfds & 1) { 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; } /* Read keyboard input into the standard buffer, waiting for at least one character. */ /* Make all keyboard buffers much bigger when using X windows. */ #ifdef HAVE_X_WINDOWS #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 && XINT(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; 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; } XSET (e.code, Lisp_Int, 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 */ #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 () { if (noninteractive) return; lmode = LINTRUP | lmode; ioctl (0, 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; new_action.sa_flags = 0; 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 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 */ #ifndef 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 /* no bcopy */ #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 */ #ifndef HAVE_RANDOM #ifdef USG /* * The BSD random returns numbers in the range of * 0 to 2e31 - 1. The USG rand returns numbers in the * range of 0 to 2e15 - 1. This is probably not significant * in this usage. */ long random () { /* Arrange to return a range centered on zero. */ return (rand () << 15) + rand () - (1 << 29); } srandom (arg) int arg; { srand (arg); } #endif /* USG */ #ifdef BSD4_1 long random () { /* Arrange to return a range centered on zero. */ return (rand () << 15) + rand () - (1 << 29); } srandom (arg) int arg; { srand (arg); } #endif /* BSD4_1 */ #endif #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 */ #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; { register int rtnval; while ((rtnval = close (fd)) == -1 && (errno == EINTR)); 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 (-1); } buf += rtnval; nbyte -= rtnval; bytes_written += rtnval; } return (bytes_written); } #endif /* INTERRUPTIBLE_IO */ #ifndef HAVE_VFORK /* * Substitute fork for vfork on USG flavors. */ vfork () { return (fork ()); } #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 */ "HFT grant", /* 28 SIGGRANT */ "HFT retract", /* 29 SIGRETRACT */ "HFT sound done", /* 30 SIGSOUND */ "HFT input ready", /* 31 SIGMSG */ #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 */ #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 MISSING_UTIMES /* HPUX (among others) sets HAVE_TIMEVAL but does not implement utimes. */ utimes () { } #endif #ifdef IRIS_UTIME /* The IRIS (3.5) has timevals, but uses sys V utime, and doesn't have the utimbuf structure defined anywhere but in the man page. */ struct utimbuf { long actime; long modtime; }; utimes (name, tvp) char *name; struct timeval tvp[]; { struct utimbuf utb; utb.actime = tvp[0].tv_sec; utb.modtime = tvp[1].tv_sec; utime (name, &utb); } #endif /* IRIS_UTIME */ #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, sys_errlist[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 */ /* 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. */ int mkdir (dpath, dmode) char *dpath; int dmode; { 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/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/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 AIX /* 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 /* AIX */ emacs-19.22/src/term.c100444 12241 12 133734 5444474624 13437 0ustar rolandstaff/* terminal control module for terminals described by TERMCAP 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. */ #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" #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 memory_below_frame; /* Terminal remembers lines scrolled off bottom */ int fast_clear_end_of_line; /* Terminal has a `ce' string */ 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. */ 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) (); /* 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, 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 */ /* Number of chars of space used for standout marker at beginning of line, or'd with 0100. Zero if no standout marker at all. 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; char *tparam (); 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; } 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) && 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; } 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); } } } } /* 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); } } 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. */ 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); } #ifdef HAVE_X_WINDOWS extern int x_screen_planes; #endif 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; if (dont_calculate_costs) return; #ifdef HAVE_X_WINDOWS if (FRAME_X_P (frame)) { do_line_insertion_deletion_costs (frame, 0, ".5*", 0, ".5*", 0, 0, x_screen_planes); 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. */ if (chars_wasted != 0) chars_wasted = (char *) xrealloc (chars_wasted, FRAME_HEIGHT (frame)); else chars_wasted = (char *) xmalloc (FRAME_HEIGHT (frame)); if (copybuf != 0) copybuf = (char *) xrealloc (copybuf, FRAME_HEIGHT (frame)); else copybuf = (char *) xmalloc (FRAME_HEIGHT (frame)); if (char_ins_del_vector != 0) char_ins_del_vector = (int *) xrealloc (char_ins_del_vector, (sizeof (int) + 2 * FRAME_WIDTH (frame) * sizeof (int))); else char_ins_del_vector = (int *) xmalloc (sizeof (int) + 2 * FRAME_WIDTH (frame) * sizeof (int)); bzero (chars_wasted, FRAME_HEIGHT (frame)); bzero (copybuf, FRAME_HEIGHT (frame)); bzero (char_ins_del_vector, (sizeof (int) + 2 * FRAME_WIDTH (frame) * 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", }; /* These subroutines are used to call Fdefine_key inside of a condition-case. */ static Lisp_Object term_get_fkeys_data; extern Lisp_Object cmd_error (); static Lisp_Object term_get_fkeys_define_1 () { Fdefine_key (Vfunction_key_map, Fcar (term_get_fkeys_data), Fcdr (term_get_fkeys_data)); return Qnil; } /* Define KEY as DEFINITION in function-key-map, catching errors. */ static void term_get_fkeys_define (key, definition) Lisp_Object key, definition; { term_get_fkeys_data = Fcons (key, definition); internal_condition_case (term_get_fkeys_define_1, Qerror, cmd_error); } /* 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; { extern char *tgetstr (); int i; /* 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) term_get_fkeys_define (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) { term_get_fkeys_define (build_string (k_semi), Fmake_vector (make_number (1), intern ("f10"))); k0_name = "f0"; } if (k0) term_get_fkeys_define (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 - 11; else fcap[1] = 'a' + i - 11; { char *sequence = tgetstr (fcap, address); if (sequence) { sprintf (fkey, "f%d", i); term_get_fkeys_define (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) \ term_get_fkeys_define (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"); #undef CONDITIONAL_REASSIGN } } term_init (terminal_type) char *terminal_type; { char *area; char **address = &area; char buffer[2044]; register char *p; int status; extern char *tgetstr (); Wcm_clear (); dont_calculate_costs = 0; status = tgetent (buffer, terminal_type); if (status < 0) fatal ("Cannot open termcap database file.\n"); if (status == 0) 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); #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); AutoWrap = 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"); MagicWrap = tgetflag ("xn"); 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"); 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 (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 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 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); } emacs-19.22/src/termcap.c100666 12241 1 35613 5444001767 14216 0ustar rolanddaemon/* Work-alike for termcap, plus extra features. Copyright (C) 1985, 1986, 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; 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 #else /* not HAVE_CONFIG_H */ #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 *getenv (); char *malloc (); char *realloc (); #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef _POSIX_VERSION #include #endif #endif /* not HAVE_CONFIG_H */ #ifndef NULL #define NULL (char *) 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 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++ & 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 short 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, -384 #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; #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. */ padcount *= speeds[ospeed]; padcount += 500; padcount /= 1000; if (speeds[ospeed] < 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 */ #define valid_filename_p(fn) (*(fn) == '/') #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; termcap_name = getenv ("TERMCAP"); if (termcap_name && *termcap_name == '\0') termcap_name = NULL; 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) #ifdef VMS termcap_name = "emacs_library:[etc]termcap.dat"; #else termcap_name = "/etc/termcap"; #endif /* Here we know we must search a file and termcap_name has its name. */ fd = open (termcap_name, 0, 0); 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; if (malloc_size) return (int) 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.22/src/terminfo.c100444 12241 12 3265 5444474625 14247 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.22/src/textprop.c100444 12120 1 110314 5474213454 13771 0ustar rmsdaemon/* Interface code for dealing with text properties. 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. */ #include #include "lisp.h" #include "intervals.h" #include "buffer.h" /* 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, Qhidden; /* 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) && CONSP ((o2) = XCONS (o1)->cdr)) Lisp_Object Vinhibit_point_motion_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 (*begin == *end && begin != end) return NULL_INTERVAL; if (XINT (*begin) > XINT (*end)) { Lisp_Object n; n = *begin; *begin = *end; *end = n; } if (XTYPE (object) == Lisp_Buffer) { 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 = b->intervals; /* 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. */ XFASTINT (*begin) += 1; if (begin != 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 int property_value (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; { register Lisp_Object tail1, tail2, sym1, val1; register int changed = 0; register int found; /* 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))) { register Lisp_Object 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 (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); record_property_change (i->position, LENGTH (i), sym1, Fcar (this_cdr), object); } /* 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 (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); record_property_change (i->position, LENGTH (i), sym1, Qnil, object); } i->plist = Fcons (sym1, Fcons (val1, i->plist)); changed++; } } 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; register Lisp_Object current_plist = i->plist; register int changed = 0; /* 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 (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); record_property_change (i->position, LENGTH (i), sym, Fcar (Fcdr (current_plist)), object); } 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 = Fcdr (Fcdr (tail2)); if (EQ (sym, Fcar (this))) { if (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); record_property_change (i->position, LENGTH (i), sym, Fcar (Fcdr (this)), object); } 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)) XSET (object, Lisp_Buffer, 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; register Lisp_Object prop; { register INTERVAL i; register Lisp_Object tail; if (NILP (object)) XSET (object, Lisp_Buffer, 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 textget (i->plist, prop); } 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)) XSET (object, Lisp_Buffer, current_buffer); i = validate_interval_range (object, &pos, &pos, soft); 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; return next->position - (XTYPE (object) == Lisp_String); } /* 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; XSET (object, Lisp_Buffer, current_buffer); XFASTINT (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; fail 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)) XSET (object, Lisp_Buffer, current_buffer); 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; return next->position - (XTYPE (object) == Lisp_String); } 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; fail if nothing is found before LIMIT.") (pos, object, limit) Lisp_Object pos, object, limit; { register INTERVAL i, previous; if (NILP (object)) XSET (object, Lisp_Buffer, current_buffer); i = validate_interval_range (object, &pos, &pos, soft); if (NULL_INTERVAL_P (i)) return limit; 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; return (previous->position + LENGTH (previous) - (XTYPE (object) == Lisp_String)); } 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; fail if nothing is found before LIMIT.") (pos, prop, object, limit) Lisp_Object pos, prop, object, limit; { register INTERVAL i, previous; register Lisp_Object here_val; if (NILP (object)) XSET (object, Lisp_Buffer, current_buffer); i = validate_interval_range (object, &pos, &pos, soft); 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; return (previous->position + LENGTH (previous) - (XTYPE (object) == Lisp_String)); } 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; properties = validate_plist (properties); if (NILP (properties)) return Qnil; if (NILP (object)) XSET (object, Lisp_Buffer, current_buffer); i = validate_interval_range (object, &start, &end, hard); if (NULL_INTERVAL_P (i)) return Qnil; s = XINT (start); len = XINT (end) - s; /* 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) { 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); } } 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; props = validate_plist (props); if (NILP (object)) XSET (object, Lisp_Buffer, current_buffer); i = validate_interval_range (object, &start, &end, hard); 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); if (NULL_INTERVAL_P (prev_changed)) set_properties (props, i, object); else merge_interval_left (i); return Qt; } len -= LENGTH (i); if (NULL_INTERVAL_P (prev_changed)) { set_properties (props, i, object); 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)) XSET (object, Lisp_Buffer, 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)) XSET (object, Lisp_Buffer, current_buffer); i = validate_interval_range (object, &start, &end, soft); e = XINT (end); while (! NULL_INTERVAL_P (i)) { if (i->position >= e) break; if (EQ (textget (i->plist, prop), value)) { pos = i->position; if (pos < XINT (start)) pos = XINT (start); return make_number (pos - (XTYPE (object) == Lisp_String)); } i = next_interval (i); } return Qnil; } DEFUN ("text-property-not-all", Ftext_property_not_all, Stext_property_not_all, 4, 5, 0, "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\ If so, return the position of the first character whose PROP is not\n\ `eq' to VALUE. Otherwise, return nil.\n\ The optional fifth argument, OBJECT, is the string or buffer\n\ containing the text.") (start, end, prop, value, object) Lisp_Object start, end, prop, value, object; { register INTERVAL i; register int s, e; if (NILP (object)) XSET (object, Lisp_Buffer, current_buffer); i = validate_interval_range (object, &start, &end, soft); if (NULL_INTERVAL_P (i)) return (NILP (value) || EQ (start, end)) ? 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 - (XTYPE (object) == Lisp_String)); } 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)) XSET (object, Lisp_Buffer, 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. */ /* DEFUN ("copy-text-properties", Fcopy_text_properties, Scopy_text_properties, 5, 6, 0, "Add properties from SRC-START to SRC-END of SRC at DEST-POS of DEST.\n\ SRC and DEST may each refer to strings or buffers.\n\ Optional sixth argument PROP causes only that property to be copied.\n\ Properties are copied to DEST as if by `add-text-properties'.\n\ Return t if any property value actually changed, nil otherwise.") */ 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; 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; XFASTINT (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; } 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); } return modified ? Qt : Qnil; } void syms_of_textprop () { DEFVAR_INT ("interval-balance-threshold", &interval_balance_threshold, "Threshold for rebalancing interval trees, expressed as the\n\ percentage by which the left interval tree should not differ from the right."); interval_balance_threshold = 8; DEFVAR_LISP ("inhibit-point-motion-hooks", &Vinhibit_point_motion_hooks, "If nonnil, don't call the text property values of\n\ `point-left' and `point-entered'."); Vinhibit_point_motion_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 (&Qhidden); Qhidden = intern ("hidden"); 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 (&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.22/src/tparam.c100666 12241 1 16675 5444002071 14043 0ustar rolanddaemon/* Merge parameters into a termcap entry string. Copyright (C) 1985, 1987, 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; 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 #else /* not HAVE_CONFIG_H */ #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 HAVE_CONFIG_H */ #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; { #ifdef NO_ARG_ARRAY int arg[4]; arg[0] = arg0; arg[1] = arg1; arg[2] = arg2; arg[3] = arg3; return tparam1 (string, outstring, len, NULL, NULL, arg); #else return tparam1 (string, outstring, len, NULL, NULL, &arg0); #endif } 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.22/src/undo.c100444 12241 12 27467 5444474630 13417 0ustar rolandstaff/* undo handling for GNU Emacs. Copyright (C) 1990, 1993 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" /* Last buffer for which undo information was recorded. */ Lisp_Object last_undo_buffer; Lisp_Object Qinhibit_read_only; /* 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) Lisp_Object beg, length; { Lisp_Object lbeg, lend; if (EQ (current_buffer->undo_list, Qt)) return; if (current_buffer != XBUFFER (last_undo_buffer)) Fundo_boundary (); XSET (last_undo_buffer, Lisp_Buffer, current_buffer); if (MODIFF <= current_buffer->save_modified) record_first_change (); /* If this is following another insertion and consecutive with it in the buffer, combine the two. */ if (XTYPE (current_buffer->undo_list) == Lisp_Cons) { Lisp_Object elt; elt = XCONS (current_buffer->undo_list)->car; if (XTYPE (elt) == Lisp_Cons && XTYPE (XCONS (elt)->car) == Lisp_Int && XTYPE (XCONS (elt)->cdr) == Lisp_Int && XINT (XCONS (elt)->cdr) == XINT (beg)) { XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length)); return; } } lbeg = beg; XSET (lend, Lisp_Int, XINT (beg) + XINT (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; if (EQ (current_buffer->undo_list, Qt)) return; if (current_buffer != XBUFFER (last_undo_buffer)) Fundo_boundary (); XSET (last_undo_buffer, Lisp_Buffer, current_buffer); if (MODIFF <= current_buffer->save_modified) record_first_change (); if (point == beg + length) XSET (sbeg, Lisp_Int, -beg); else XFASTINT (sbeg) = beg; XFASTINT (lbeg) = beg; XFASTINT (lend) = beg + length; /* If point isn't at start of deleted range, record where it is. */ if (PT != XFASTINT (sbeg)) current_buffer->undo_list = Fcons (make_number (PT), 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; XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff; XFASTINT (low) = current_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 (current_buffer->undo_list, Qt)) return; 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 <= current_buffer->save_modified) record_first_change (); XSET (lbeg, Lisp_Int, beg); XSET (lend, Lisp_Int, 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)) 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 (XTYPE (next) == Lisp_Cons && 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 (XTYPE (next) == Lisp_Cons && ! 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 (XTYPE (elt) == Lisp_Cons) { size_so_far += sizeof (struct Lisp_Cons); if (XTYPE (XCONS (elt)->car) == Lisp_String) size_so_far += (sizeof (struct Lisp_String) - 1 + XSTRING (XCONS (elt)->car)->size); } /* Advance to next element. */ prev = next; next = XCONS (next)->cdr; } if (XTYPE (next) == Lisp_Cons) last_boundary = prev; while (XTYPE (next) == Lisp_Cons) { 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 (XTYPE (elt) == Lisp_Cons) { size_so_far += sizeof (struct Lisp_Cons); if (XTYPE (XCONS (elt)->car) == Lisp_String) 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; { int count = specpdl_ptr - specpdl; register int arg = XINT (n); #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 /* 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) { Lisp_Object next; 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 (XTYPE (next) == Lisp_Int) SET_PT (clip_to_bounds (BEGV, XINT (next), ZV)); else if (XTYPE (next) == Lisp_Cons) { 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; high = Fcar (cdr); low = Fcdr (cdr); mod_time = (XFASTINT (high) << 16) + XFASTINT (low); /* If this records an obsolete save (not matching the actual disk file) then don't mark unmodified. */ if (mod_time != current_buffer->modtime) break; #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 (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int) { /* 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 (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int) { /* 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--; } return unbind_to (count, list); } syms_of_undo () { Qinhibit_read_only = intern ("inhibit-read-only"); staticpro (&Qinhibit_read_only); defsubr (&Sprimitive_undo); defsubr (&Sundo_boundary); } emacs-19.22/src/unexaix.c100444 12241 12 55321 5444474630 14121 0ustar rolandstaff/* 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 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. 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 #ifndef CANNOT_DUMP /* all rest of file! */ #ifndef CANNOT_UNEXEC /* most of rest of file */ #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 static report_error (file, fd) char *file; int fd; { if (fd) close (fd); error ("Failure operating on %s", file); } #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: %x flags where %x expected in %s section.\n", \ 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%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", 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 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); if (symentry.n_numaux) { 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; lseek (a_out, orig_data_scnptr + ldrel->l_vaddr, 0); if (read (a_out, (void *) &orig_int, sizeof (orig_int)) != sizeof (orig_int)) { PERROR (a_name); } switch (ldrel->l_symndx) { case SYMNDX_TEXT: p = (int *) (d_start + ldrel->l_vaddr); orig_int = * p - (t_start - f_ohdr.text_start); break; case SYMNDX_DATA: case SYMNDX_BSS: p = (int *) (d_start + ldrel->l_vaddr); orig_int = * p - (d_start - f_ohdr.data_start); break; } lseek (new, data_scnptr + ldrel->l_vaddr, 0); if (write (new, (void *) &orig_int, sizeof (orig_int)) != sizeof (orig_int)) { PERROR (new_name); } } } } #endif /* XCOFF */ #endif /* not CANNOT_UNEXEC */ #endif /* not CANNOT_DUMP */ emacs-19.22/src/unexconvex.c100444 12241 12 41115 5444474631 14637 0ustar rolandstaff/* 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 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. */ /* 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.22/src/unexec.c100444 12241 1 71073 5470305016 14035 0ustar rolanddaemon/* Copyright (C) 1985, 1986, 1987, 1988, 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. */ /* * 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.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. */ #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! */ #ifndef CANNOT_UNEXEC /* most of rest of file */ #ifdef COFF_ENCAPSULATE int need_coff_header = 1; #include /* The location might be a poor assumption */ #else #include #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 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 static report_error (file, fd) char *file; int fd; { if (fd) close (fd); error ("Failure operating on %s\n", file); } #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, 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, 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 */ 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. */ lseek (a_out, sizeof (f_hdr) + sizeof (f_ohdr), 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 bzero (&hdr, sizeof hdr); #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); } #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 */ ptr = (char *) unexec_text_start; end = ptr + hdr.a_text; write_segment (new, ptr, end); 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; 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%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", 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; #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; 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); 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); } } } close (new); } #endif /* COFF_BSD_SYMBOLS */ #endif /* COFF */ #endif /* not CANNOT_UNEXEC */ #endif /* not CANNOT_DUMP */ emacs-19.22/src/unexelf.c100444 12241 12 71024 5444474632 14106 0ustar rolandstaff/* 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 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 ((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; { 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; 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, ".bss")) 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) 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_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); 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); /* 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; } /* 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_data2_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; /* 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 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); } } } /* 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.22/src/unexelfsgi.c100444 12241 12 70777 5444474633 14630 0ustar rolandstaff/* 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 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; } /* **************************************************************** * 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; 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 < 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); 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_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(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 + 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); 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); /* 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; /* 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_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_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 < 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_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; } /* 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_data2_offset) NEW_SECTION_H(nn).sh_offset += new_data2_size; /* 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 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); } } } /* 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.22/src/unexencap.c100444 12241 12 6176 5444474634 14416 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.22/src/unexenix.c100444 12241 12 17054 5444474634 14310 0ustar rolandstaff/* 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 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can 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. */ /* 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 int sys_nerr; extern char *sys_errlist[]; #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 if (errno < sys_nerr) fprintf (stderr, "unexec: %s, ", sys_errlist[errno]); else fprintf (stderr, "unexec: error code %d, ", errno); va_start (ap); _doprnt (s, ap, stderr); fputs (".\n", stderr); exit (1); } emacs-19.22/src/unexfx2800.c100444 12241 12 667 5444474635 14237 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.22/src/unexhp9k800.c100444 12241 12 21645 5444474635 14452 0ustar rolandstaff/* 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 #define NBPG 2048 #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); /* 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 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.22/src/unexmips.c100444 12241 12 22416 5444474636 14315 0ustar rolandstaff/* 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 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can 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. */ #include #include #include #include #include #include #include #include #include #include #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 int sys_nerr; extern char *sys_errlist[]; #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 (); brk = (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, TEXT_START, hdr.aout.tsize, "writing text section to %s", new_name); WRITE (new, DATA_START, hdr.aout.dsize, "writing text 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); #define symhdr ((pHDRR)buffer) newsyms = hdr.aout.tsize + hdr.aout.dsize; symrel = newsyms - hdr.fhdr.f_symptr; hdr.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; #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 if (errno < sys_nerr) fprintf (stderr, "unexec: %s, ", sys_errlist[errno]); else fprintf (stderr, "unexec: error code %d, ", errno); va_start (ap); _doprnt (s, ap, stderr); fputs (".\n", stderr); exit (1); } emacs-19.22/src/unexnext.c100444 12241 12 21663 5444474636 14326 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.22/src/unexsunos4.c100444 12241 12 16523 5444474637 14603 0ustar rolandstaff/* 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! * */ #ifdef emacs #include #endif #include #include #include #include #include #include #include /* * 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; 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; { char buf[PAGSIZ]; int fd, new; char *old; struct exec ohdr; /* Allocate on the stack, not needed in the next life */ struct stat stat; #ifdef emacs fprintf (stderr, "Used %d bytes of Pure Storage\n", pureptr); #endif 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_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); Brk = sbrk (0); /* Save the break, it is reset to &_end (by ld.so?) */ /* * 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, but the caller is *supposed* to know * what she is doing. */ nhdr.a_data = (bss_start ? bss_start : Brk) - N_DATADDR (nhdr); nhdr.a_bss = bss_start ? Brk - 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)); 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 (Brk); /* 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 (path) char *path; { int fd; long paths_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 (path, 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, &paths_cookie, sizeof (paths_cookie)); if (paths_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 (data_start, rd_only_len, PROT_READ | PROT_EXEC, MAP_SHARED | MAP_FIXED, fd, N_DATOFF (hdr) + data_start - N_DATADDR (hdr)); close (fd); return 1; } } close (fd); } return 0; } emacs-19.22/src/vm-limit.c100444 12241 12 6477 5444474640 14167 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.22/src/vms-pp.c100444 12241 12 15711 5444474640 13662 0ustar rolandstaff/* 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 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. * * 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.22/src/vmsfns.c100444 12241 12 63663 5444474641 13766 0ustar rolandstaff/* 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 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. */ /* 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) || XTYPE (pid) == Lisp_String && XSTRING (pid)->size == 0 || XTYPE (pid) == Lisp_Int && 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 (XTYPE (pid) == Lisp_Int) 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.22/src/vmsgmalloc.c100444 12241 12 161020 5444474642 14621 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.22/src/vmsmap.c100444 12241 12 13575 5444474644 13755 0ustar rolandstaff/* 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 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. */ /* 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.22/src/xdisp.c100444 12120 1 251667 5473351130 13245 0ustar rmsdaemon/* Display generation from window structure and buffer text. 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. */ #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" extern int interrupt_input; extern int command_loop_level; /* Nonzero means print newline before next minibuffer message. */ int noninteractive_need_newline; #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) /* 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; /* Set by try_window_id to the vpos of first of any lines scrolled on to the bottom of the frame. These lines should not be included in any general scroll computation. */ static int scroll_bottom_vpos; /* 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; 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; /* Values of those variables at last redisplay. */ static Lisp_Object last_arrow_position, last_arrow_string; /* Nonzero if overlay arrow has been displayed once in this window. */ static int overlay_arrow_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. */ 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. 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; int debug_end_pos; /* Nonzero means display mode line highlighted */ int mode_line_inverse_video; static void echo_area_display (); void mark_window_display_accurate (); static void redisplay_windows (); static void redisplay_window (); 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 *fmodetrunc (); 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 */ char *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; /* 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 head_clip or tail_clip of current buffer has changed since last redisplay that finished */ int clip_changed; /* 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. */ int line_number_display_limit; /* Specify m, a string, as a message in the minibuf. If m is 0, clear out any existing message, and let the minibuffer text show through. */ void message1 (m) char *m; { if (noninteractive) { if (noninteractive_need_newline) putc ('\n', stderr); noninteractive_need_newline = 0; if (cursor_in_echo_area != 0) fprintf (stderr, "%s", m); else fprintf (stderr, "%s\n", m); 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)) { #ifdef MULTI_FRAME Lisp_Object minibuf_frame; choose_minibuf_frame (); minibuf_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); FRAME_SAMPLE_VISIBILITY (XFRAME (minibuf_frame)); if (FRAME_VISIBLE_P (selected_frame) && ! FRAME_VISIBLE_P (XFRAME (minibuf_frame))) Fmake_frame_visible (WINDOW_FRAME (XWINDOW (minibuf_window))); #endif if (m) echo_area_glyphs = m; else echo_area_glyphs = previous_echo_glyphs = 0; do_pending_window_change (); echo_area_display (); update_frame (XFRAME (XWINDOW (minibuf_window)->frame), 1, 1); do_pending_window_change (); } } /* 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; { 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. */ FRAME_PTR echo_frame; #ifdef MULTI_FRAME choose_minibuf_frame (); echo_frame = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); #else echo_frame = selected_frame; #endif /* 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 (echo_frame)) { if (m) { { #ifdef NO_ARG_ARRAY int a[3]; a[0] = a1; a[1] = a2; a[2] = a3; doprnt (FRAME_MESSAGE_BUF (echo_frame), FRAME_WIDTH (echo_frame), m, 0, 3, a); #else doprnt (FRAME_MESSAGE_BUF (echo_frame), FRAME_WIDTH (echo_frame), m, 0, 3, &a1); #endif /* NO_ARG_ARRAY */ } message1 (FRAME_MESSAGE_BUF (echo_frame)); } else message1 (0); /* Print should start at the beginning of the message buffer next time. */ message_buf_print = 0; } } } static void echo_area_display () { register int vpos; FRAME_PTR f; #ifdef MULTI_FRAME choose_minibuf_frame (); #endif f = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); if (! FRAME_VISIBLE_P (f)) return; if (frame_garbaged) { redraw_garbaged_frames (); frame_garbaged = 0; } if (echo_area_glyphs || minibuf_level == 0) { vpos = XFASTINT (XWINDOW (minibuf_window)->top); get_display_line (f, vpos, 0); display_string (XWINDOW (minibuf_window), vpos, echo_area_glyphs ? echo_area_glyphs : "", 0, 0, 0, FRAME_WIDTH (f)); /* If desired cursor location is on this line, put it at end of text */ if (FRAME_CURSOR_Y (f) == vpos) FRAME_CURSOR_X (f) = FRAME_DESIRED_GLYPHS (f)->used[vpos]; /* Fill the rest of the minibuffer window with blank lines. */ { int i; for (i = vpos + 1; i < vpos + XFASTINT (XWINDOW (minibuf_window)->height); i++) { get_display_line (f, i, 0); display_string (XWINDOW (minibuf_window), vpos, "", 0, 0, 0, FRAME_WIDTH (f)); } } } else if (!EQ (minibuf_window, selected_window)) windows_or_buffers_changed++; if (EQ (minibuf_window, selected_window)) this_line_bufpos = 0; previous_echo_glyphs = echo_area_glyphs; } /* 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. Everyone would like to have a hook here to call eval, but that cannot be done safely without a lot of changes elsewhere. This can be called from signal handlers; with alarms set up; or with synchronous processes running. See the function `echo' in keyboard.c. See Fcall_process; if you called it from here, it could be entered recursively. */ 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; extern int input_pending; if (noninteractive) return; /* 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)); } /* Notice any pending interrupt request to change frame size. */ do_pending_window_change (); if (frame_garbaged) { redraw_garbaged_frames (); frame_garbaged = 0; } /* 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 (clip_changed || 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) <= current_buffer->save_modified) { w->update_mode_line = Qt; if (buffer_shared > 1) update_mode_lines++; } 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, clip_changed = 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) && 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 */ && point >= tlbufpos && point <= 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. */ && ((XTYPE (current_buffer->selective_display) == Lisp_Int && 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; 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 (XFASTINT (w->width) != FRAME_WIDTH (XFRAME (WINDOW_FRAME (w)))) preserve_other_columns (w); goto update; } else goto cancel; } else if (point == XFASTINT (w->last_point)) { if (!must_finish) { do_pending_window_change (); return; } goto update; } /* If highlighting the region, we can't just move the cursor. */ else if (! (!NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active)) && NILP (w->region_showing)) { pos = *compute_motion (tlbufpos, 0, XINT (w->hscroll) ? 1 - XINT (w->hscroll) : 0, point, 2, - (1 << (SHORTBITS - 1)), window_internal_width (w) - 1, XINT (w->hscroll), pos_tab_offset (w, tlbufpos)); if (pos.vpos < 1) { FRAME_CURSOR_X (selected_frame) = XFASTINT (w->left) + max (pos.hpos, 0); 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; if (all_windows) { Lisp_Object tail, frame; #ifdef HAVE_X_WINDOWS /* Since we're doing a thorough redisplay, we might as well recompute all our display faces. */ clear_face_vector (); #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); /* 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 (XTYPE (XCONS (tail)->car) != Lisp_Frame) continue; f = XFRAME (XCONS (tail)->car); if (FRAME_VISIBLE_P (f)) { pause |= update_frame (f, 0, 0); if (!pause) mark_window_display_accurate (f->root_window, 1); } } } else #endif /* MULTI_FRAME */ { if (FRAME_VISIBLE_P (selected_frame)) pause = update_frame (selected_frame, 0, 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. */ { FRAME_PTR mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window))); if (mini_frame != selected_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; clip_changed = 0; unchanged_modified = BUF_MODIFF (b); beg_unchanged = BUF_GPT (b) - BUF_BEG (b); end_unchanged = BUF_Z (b) - BUF_GPT (b); XFASTINT (w->last_point) = BUF_PT (b); XFASTINT (w->last_point_x) = FRAME_CURSOR_X (selected_frame); XFASTINT (w->last_point_y) = FRAME_CURSOR_Y (selected_frame); if (all_windows) mark_window_display_accurate (FRAME_ROOT_WINDOW (selected_frame), 1); else { w->update_mode_line = Qnil; XFASTINT (w->last_modified) = BUF_MODIFF (b); w->window_end_valid = Qt; last_arrow_position = Voverlay_arrow_position; last_arrow_string = Voverlay_arrow_string; } 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 (); } /* 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 (XTYPE (window) != Lisp_Window) abort (); w = XWINDOW (window); if (!NILP (w->buffer)) { XFASTINT (w->last_modified) = !flag ? 0 : XBUFFER (w->buffer) == current_buffer ? MODIFF : 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 = Qt; w->update_mode_line = Qnil; 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; } } int do_id = 1; static void redisplay_windows (window) Lisp_Object window; { for (; !NILP (window); window = XWINDOW (window)->next) redisplay_window (window, 0); } 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 = point; 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 = point; int tem; int window_needs_modeline; 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); if (MINI_WINDOW_P (w)) { if (w == XWINDOW (minibuf_window)) { if (echo_area_glyphs) /* We've already displayed the echo area glyphs, if any. */ goto finish_scroll_bars; } else { /* This is a minibuffer, but it's not the currently active one, so clear it. */ int vpos = XFASTINT (XWINDOW (FRAME_MINIBUF_WINDOW (f))->top); int i; for (i = 0; i < height; i++) { get_display_line (f, vpos + i, 0); display_string (w, vpos + i, "", 0, 0, 0, width); } goto finish_scroll_bars; } } if (update_mode_lines) w->update_mode_line = Qt; /* Otherwise set up data on this window; select its buffer and point value */ current_buffer = XBUFFER (w->buffer); opoint = point; /* Count number of windows showing the selected buffer. */ if (!just_this_one && current_buffer == XBUFFER (XWINDOW (selected_window)->buffer)) buffer_shared++; /* POINT refers normally to the selected window. For any other window, set up appropriate value. */ if (!EQ (window, selected_window)) { SET_PT (marker_position (w->pointm)); if (point < BEGV) { SET_PT (BEGV); Fset_marker (w->pointm, make_number (point), Qnil); } else if (point > (ZV - 1)) { SET_PT (ZV); Fset_marker (w->pointm, make_number (point), Qnil); } } /* 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; w->update_mode_line = Qt; w->force_start = Qnil; XFASTINT (w->last_modified) = 0; if (startp < BEGV) startp = BEGV; if (startp > ZV) startp = ZV; try_window (window, startp); if (cursor_vpos < 0) { /* ??? What should happen here if highlighting a region? */ /* If point does not appear, move point so it does appear */ pos = *compute_motion (startp, 0, ((EQ (window, minibuf_window) && startp == 1) ? minibuf_prompt_width : 0) + (hscroll ? 1 - hscroll : 0), ZV, height / 2, - (1 << (SHORTBITS - 1)), width, hscroll, pos_tab_offset (w, startp)); SET_PT (pos.bufpos); if (w != XWINDOW (FRAME_SELECTED_WINDOW (f))) Fset_marker (w->pointm, make_number (point), Qnil); else { lpoint = point; FRAME_CURSOR_X (f) = max (0, pos.hpos) + XFASTINT (w->left); FRAME_CURSOR_Y (f) = pos.vpos + XFASTINT (w->top); } } 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 && point >= startp && !clip_changed && (just_this_one || XFASTINT (w->width) == FRAME_WIDTH (f)) /* Can't use this case if highlighting a region. */ && !(!NILP (Vtransient_mark_mode) && !NILP (current_buffer->mark_active)) && NILP (w->region_showing) && !EQ (window, minibuf_window)) { pos = *compute_motion (startp, 0, (hscroll ? 1 - hscroll : 0), point, height + 1, 10000, width, hscroll, pos_tab_offset (w, startp)); 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) = max (0, pos.hpos) + XFASTINT (w->left); 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) && point >= 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 && !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)) && 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 || 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); } XFASTINT (w->last_modified) = 0; w->update_mode_line = Qt; /* Try to scroll by specified few lines */ if (scroll_step && !clip_changed) { if (point > startp) { pos = *vmotion (Z - XFASTINT (w->window_end_pos), scroll_step, width, hscroll, window); if (pos.vpos >= height) goto scroll_fail; } pos = *vmotion (startp, point < startp ? - scroll_step : scroll_step, width, hscroll, window); if (point >= pos.bufpos) { try_window (window, pos.bufpos); if (cursor_vpos >= 0) { if (!just_this_one || 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 (point, - height / 2, width, hscroll, window); 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 ((!NILP (w->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)) && 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 (!NILP (w->update_mode_line) && 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 = startp - 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); } SET_PT (opoint); current_buffer = old; SET_PT (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; 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; if (val.vpos) tab_offset = 0; vpos++; 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' || ! NILP (Fget_text_property (val.bufpos-1, Qinvisible, Fcurrent_buffer ())))); 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. */ XFASTINT (w->window_end_pos) = Z - pos; XFASTINT (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; register int vpos; register int i, tem; int last_text_vpos = 0; int stop_vpos; struct position val, bp, ep, xp, pp; int scroll_amount = 0; int delta; int tab_offset, epto; if (GPT - BEG < beg_unchanged) beg_unchanged = GPT - BEG; if (Z - GPT < end_unchanged) end_unchanged = Z - GPT; if (beg_unchanged + 1 < 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, beg_unchanged + 1, height + 1, 0, width, hscroll, pos_tab_offset (w, start)); if (bp.vpos >= height) { if (point < bp.bufpos && !bp.contin) { /* All changes are below the frame, and point is on the frame. We don't need to change the frame at all. But we need to update window_end_pos to account for any change in buffer size. */ bp = *compute_motion (start, 0, lmargin, Z, height, 0, width, hscroll, pos_tab_offset (w, start)); XFASTINT (w->window_end_vpos) = height; XFASTINT (w->window_end_pos) = Z - bp.bufpos; return 1; } return 0; } vpos = bp.vpos; /* Find beginning of that frame line. Must display from there. */ bp = *vmotion (bp.bufpos, 0, width, hscroll, window); pos = bp.bufpos; val.hpos = lmargin; if (pos < start) return -1; /* 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. */ (XTYPE (current_buffer->selective_display) == Lisp_Int && XINT (current_buffer->selective_display) > 0 && bp.bufpos - 1 == beg_unchanged && vpos > 0)) { bp = *vmotion (bp.bufpos, -1, width, hscroll, window); --vpos; pos = bp.bufpos; } if (bp.contin && bp.hpos != lmargin) { val.hpos = bp.prevhpos - width + lmargin; 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 (XTYPE (current_buffer->selective_display) == Lisp_Int && XINT (current_buffer->selective_display) > 0) while (tem < ZV - 1 && (position_indentation (tem) >= XINT (current_buffer->selective_display))) tem = find_next_newline (tem, 1); /* Compute the cursor position after that newline. */ ep = *compute_motion (pos, vpos, val.hpos, tem, height, - (1 << (SHORTBITS - 1)), width, hscroll, pos_tab_offset (w, bp.bufpos)); /* 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; /* 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, Z - XFASTINT (w->window_end_pos), 10000, 0, width, hscroll, epto); 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; XFASTINT (w->window_end_vpos) += scroll_amount; /* Before doing any scrolling, verify that point will be on frame. */ if (point > ep.bufpos && !(point <= xp.bufpos && xp.bufpos < height)) { if (point <= xp.bufpos) { pp = *compute_motion (ep.bufpos, ep.vpos, ep.hpos, point, height, - (1 << (SHORTBITS - 1)), width, hscroll, epto); } else { pp = *compute_motion (xp.bufpos, xp.vpos, xp.hpos, point, height, - (1 << (SHORTBITS - 1)), width, hscroll, pos_tab_offset (w, xp.bufpos)); } if (pp.bufpos < point || pp.vpos == height) return 0; cursor_vpos = pp.vpos + top; cursor_hpos = pp.hpos + XFASTINT (w->left); } 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) {} 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); if (!tem) stop_vpos = height; } 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); 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; while (vpos < stop_vpos) { val = *display_text_line (w, pos, top + vpos++, val.hpos, tab_offset); 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++; XFASTINT (w->window_end_vpos) = last_text_vpos; XFASTINT (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 == point) 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, width, hscroll, window); XFASTINT (w->window_end_pos) = Z - val.bufpos; 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) { val = *compute_motion (start, 0, lmargin, point, 10000, 10000, width, hscroll, pos_tab_offset (w, start)); /* 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 = val.hpos + XFASTINT (w->left); } FRAME_CURSOR_X (f) = max (0, cursor_hpos); FRAME_CURSOR_Y (f) = cursor_vpos; if (debug_end_pos) { val = *compute_motion (start, 0, lmargin, ZV, height, - (1 << (SHORTBITS - 1)), width, hscroll, pos_tab_offset (w, start)); 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 (buf != current_buffer) 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_modified) buf->save_modified++; if (BUF_MODIFF (buf) == buf->auto_save_modified) buf->auto_save_modified++; BUF_MODIFF (buf) ++; } /* Copy glyphs from the vector FROM to the rope T. But don't actually copy the parts that would come in before S. Value is T, advanced past the copied data. */ GLYPH * copy_rope (t, s, from, face) register GLYPH *t; /* Copy to here. */ register GLYPH *s; /* Starting point. */ Lisp_Object from; /* Data to copy; known to be a vector. */ int face; /* Face to apply to glyphs which don't specify one. */ { register int n = XVECTOR (from)->size; register Lisp_Object *f = XVECTOR (from)->contents; while (n--) { int glyph = XFASTINT (*f); if (t >= s) *t = MAKE_GLYPH (GLYPH_CHAR (glyph), (GLYPH_FACE (glyph) ? GLYPH_FACE (glyph) : face)); ++t; ++f; } return t; } /* Copy exactly LEN glyphs from FROM into data at T. But don't alter words before S. */ GLYPH * copy_part_of_rope (t, s, from, len, face) register GLYPH *t; /* 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 *f = from; while (n--) { int glyph = XFASTINT (*f); if (t >= s) *t = MAKE_GLYPH (GLYPH_CHAR (glyph), (GLYPH_FACE (glyph) ? GLYPH_FACE (glyph) : face)); ++t; ++f; } return t; } /* Display one line of window w, starting at position START in W's buffer. Display starting at horizontal position HPOS, which is normally zero or negative. A negative value causes output up to hpos = 0 to be discarded. This is done for negative hscroll, or when this is a continuation line and the continuation occurred in the middle of a multi-column character. TABOFFSET is an offset for ostensible hpos, used in tab stop calculations. Display on position VPOS on the frame. (origin 0). 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; int end; register int pause; register unsigned char *p; GLYPH *endp; register GLYPH *startp; register GLYPH *p1prev = 0; 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 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 = XTYPE (current_buffer->selective_display) == Lisp_Int ? 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_Vector *dp = window_display_table (w); Lisp_Object default_invis_vector[3]; /* Nonzero means display something where there are invisible lines. The precise value is the number of glyphs to display. */ int selective_rlen = (selective && dp && XTYPE (DISP_INVIS_VECTOR (dp)) == Lisp_Vector ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : selective && !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 && XTYPE (DISP_INVIS_VECTOR (dp)) == Lisp_Vector ? XVECTOR (DISP_INVIS_VECTOR (dp))->contents : default_invis_vector); GLYPH truncator = (dp == 0 || XTYPE (DISP_TRUNC_GLYPH (dp)) != Lisp_Int ? '$' : XINT (DISP_TRUNC_GLYPH (dp))); GLYPH continuer = (dp == 0 || XTYPE (DISP_CONTINUE_GLYPH (dp)) != Lisp_Int ? '\\' : 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; #ifdef USE_TEXT_PROPERTIES /* The next location where the `invisible' property changes */ int next_invisible; #endif /* The face we're currently using. */ int current_face = 0; XFASTINT (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 == 1 && vpos == XFASTINT (w->top)) { if (minibuf_prompt) hpos = display_string (w, vpos, minibuf_prompt, hpos, (!truncate ? continuer : truncator), -1, -1); minibuf_prompt_width = hpos; } desired_glyphs->bufp[vpos] = pos; p1 = desired_glyphs->glyphs[vpos] + hpos; end = ZV; startp = desired_glyphs->glyphs[vpos] + XFASTINT (w->left); endp = startp + 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; #ifdef USE_TEXT_PROPERTIES next_invisible = pos; #endif while (p1 < endp) { p1prev = p1; if (pos >= pause) { /* Did we hit the end of the visible region of the buffer? Stop here. */ if (pos >= end) break; /* Did we reach point? Record the cursor location. */ if (pos == point && cursor_vpos < 0) { cursor_vpos = vpos; cursor_hpos = p1 - startp; } #ifdef USE_TEXT_PROPERTIES /* if the `invisible' property is set to t, we can skip to the next property change */ while (pos == next_invisible && pos < end) { Lisp_Object position, limit, endpos, prop; XFASTINT (position) = pos; prop = Fget_text_property (position, Qinvisible, Fcurrent_buffer ()); /* This is just an estimate to give reasonable performance; nothing should go wrong if it is too small. */ XFASTINT (limit) = pos + 50; endpos = Fnext_single_property_change (position, Qinvisible, Fcurrent_buffer (), limit); if (INTEGERP (endpos)) next_invisible = XINT (endpos); else next_invisible = end; if (! NILP (prop)) { if (pos < point && next_invisible >= point) { cursor_vpos = vpos; cursor_hpos = p1 - startp; } pos = next_invisible; } } if (pos >= end) break; #endif #ifdef HAVE_X_WINDOWS /* 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_X_P (f)) current_face = compute_char_face (f, w, pos, region_beg, region_end, &next_face_change, pos + 50); #endif pause = end; #ifdef USE_TEXT_PROPERTIES if (pos < next_invisible && next_invisible < pause) pause = next_invisible; #endif if (pos < next_face_change && next_face_change < pause) pause = next_face_change; /* Wouldn't you hate to read the next line to someone over the phone? */ if (pos < point && point < pause) pause = point; if (pos < GPT && GPT < pause) pause = GPT; p = &FETCH_CHAR (pos); } c = *p++; if (c >= 040 && c < 0177 && (dp == 0 || XTYPE (DISP_CHAR_VECTOR (dp, c)) != Lisp_Vector)) { if (p1 >= startp) *p1 = MAKE_GLYPH (c, current_face); p1++; } else if (c == '\n') { invis = 0; while (pos < end && selective > 0 && position_indentation (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 >= startp) { p1 += selective_rlen; if (p1 - startp > width) p1 = endp; copy_part_of_rope (p1prev, p1prev, invis_vector_contents, (p1 - p1prev), current_face); } #if 1 /* Draw the face of the newline character as extending all the way to the end of the frame line. */ if (current_face) while (p1 < endp) *p1++ = MAKE_GLYPH (' ', current_face); #endif break; } else if (c == '\t') { do { if (p1 >= startp && p1 < endp) *p1 = MAKE_GLYPH (' ', current_face); p1++; } while ((p1 - startp + 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 - startp > width) p1 = endp; copy_part_of_rope (p1prev, p1prev, invis_vector_contents, (p1 - p1prev), current_face); } #if 1 /* Draw the face of the newline character as extending all the way to the end of the frame line. */ if (current_face) while (p1 < endp) *p1++ = MAKE_GLYPH (' ', current_face); #endif break; } else if (dp != 0 && XTYPE (DISP_CHAR_VECTOR (dp, c)) == Lisp_Vector) { p1 = copy_rope (p1, startp, DISP_CHAR_VECTOR (dp, c), current_face); } else if (c < 0200 && ctl_arrow) { if (p1 >= startp) *p1 = MAKE_GLYPH ((dp && XTYPE (DISP_CTRL_GLYPH (dp)) == Lisp_Int ? XINT (DISP_CTRL_GLYPH (dp)) : '^'), current_face); p1++; if (p1 >= startp && p1 < endp) *p1 = MAKE_GLYPH (c ^ 0100, current_face); p1++; } else { if (p1 >= startp) *p1 = MAKE_GLYPH ((dp && XTYPE (DISP_ESCAPE_GLYPH (dp)) == Lisp_Int ? XINT (DISP_ESCAPE_GLYPH (dp)) : '\\'), current_face); p1++; if (p1 >= startp && p1 < endp) *p1 = MAKE_GLYPH ((c >> 6) + '0', current_face); p1++; if (p1 >= startp && p1 < endp) *p1 = MAKE_GLYPH ((7 & (c >> 3)) + '0', current_face); p1++; if (p1 >= startp && p1 < endp) *p1 = MAKE_GLYPH ((7 & c) + '0', current_face); p1++; } pos++; } val.hpos = - XINT (w->hscroll); if (val.hpos) val.hpos++; val.vpos = 1; lastpos = pos; /* 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++; else /* Stopped due to right margin of window */ { if (truncate) { *p1++ = truncator; /* 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 */ pos = find_next_newline (pos, 1); val.hpos = XINT (w->hscroll) ? 1 - XINT (w->hscroll) : 0; lastpos = pos - (FETCH_CHAR (pos - 1) == '\n'); } else { *p1++ = continuer; val.vpos = 0; lastpos--; } } } /* If point is at eol or in invisible text at eol, record its frame location now. */ if (start <= point && point <= lastpos && cursor_vpos < 0) { cursor_vpos = vpos; cursor_hpos = p1 - startp; } 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))) { 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) { *startp = truncator; if (p1 <= startp) p1 = startp + 1; } if (XFASTINT (w->width) + XFASTINT (w->left) != FRAME_WIDTH (f)) { endp++; if (p1 < startp) p1 = startp; 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. */ *p1++ = (FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? ' ' : '|'); } 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 (XTYPE (Voverlay_arrow_position) == Lisp_Marker && current_buffer == XMARKER (Voverlay_arrow_position)->buffer && start == marker_position (Voverlay_arrow_position) && XTYPE (Voverlay_arrow_string) == Lisp_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; for (i = 0; i < len; i++) startp[i] = p[i]; /* Bug in SunOS 4.1.1 compiler requires this intermediate variable. */ arrow_end = (startp - 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; if (FRAME_MENU_BAR_LINES (f) <= 0) return; get_display_line (f, vpos, 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 || update_mode_lines || (XFASTINT (w->last_modified) < MODIFF && (XFASTINT (w->last_modified) <= XBUFFER (w->buffer)->save_modified))) { struct buffer *prev = current_buffer; current_buffer = XBUFFER (w->buffer); FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (); current_buffer = prev; } for (tail = FRAME_MENU_BAR_ITEMS (f); CONSP (tail); tail = XCONS (tail)->cdr) { Lisp_Object string; string = XCONS (XCONS (XCONS (tail)->car)->cdr)->car; /* Record in each item its hpos. */ XFASTINT (XCONS (XCONS (XCONS (tail)->car)->cdr)->cdr) = hpos; if (hpos < maxendcol) hpos = display_string (XWINDOW (FRAME_ROOT_WINDOW (f)), vpos, XSTRING (string)->data, hpos, 0, hpos, maxendcol); /* Put a gap of 3 spaces between items. */ if (hpos < maxendcol) { int hpos1 = hpos + 3; hpos = display_string (w, vpos, "", hpos, 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, "", hpos, 0, maxendcol, -1); /* 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; get_display_line (f, vpos, left); display_mode_element (w, vpos, left, 0, right, right, current_buffer->mode_line_format); 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_X_WINDOWS /* I'm trying this out because I saw Unimpress use it, but it's possible that this may mess adversely with some window managers. -jla Wouldn't it be nice to use something like mode-line-format to describe frame titles? -JimB */ /* Change the title of the frame to the name of the buffer displayed in the currently selected window. Don't do this for minibuffer frames, and don't do it when there's only one non-minibuffer frame. */ if (FRAME_X_P (f) && ! FRAME_MINIBUF_ONLY_P (f) && w == XWINDOW (f->selected_window)) x_implicitly_set_name (f, (EQ (Fnext_frame (WINDOW_FRAME (w), Qnil), WINDOW_FRAME (w)) ? Qnil : XBUFFER (w->buffer)->name), Qnil); #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++; #ifdef SWITCH_ENUM_BUG switch ((int) XTYPE (elt)) #else switch (XTYPE (elt)) #endif { 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; hpos = display_string (w, vpos, last, hpos, 0, hpos, min (lim, maxendcol)); } else /* c == '%' */ { 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'); } spec_width += hpos; if (spec_width > maxendcol) spec_width = maxendcol; if (c == 'M') hpos = display_mode_element (w, vpos, hpos, depth, spec_width, maxendcol, Vglobal_mode_string); else if (c != 0) hpos = display_string (w, vpos, decode_mode_spec (w, c, maxendcol - hpos), hpos, 0, spec_width, 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 (XTYPE (tem) == Lisp_String) hpos = display_string (w, vpos, XSTRING (tem)->data, hpos, 0, 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 (XTYPE (car) == Lisp_Symbol) { tem = Fboundp (car); elt = XCONS (elt)->cdr; if (XTYPE (elt) != Lisp_Cons) 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 (XTYPE (elt) != Lisp_Cons) goto invalid; elt = XCONS (elt)->car; goto tail_recurse; } else if (XTYPE (car) == Lisp_Int) { 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 (XTYPE (car) == Lisp_String || XTYPE (car) == Lisp_Cons) { register int limit = 50; /* LIMIT is to protect against circular lists. */ while (XTYPE (elt) == Lisp_Cons && --limit > 0 && hpos < maxendcol) { hpos = display_mode_element (w, vpos, hpos, depth, hpos, maxendcol, XCONS (elt)->car); elt = XCONS (elt)->cdr; } } } break; default: invalid: return (display_string (w, vpos, "*invalid*", hpos, 0, minendcol, maxendcol)); } end: if (minendcol > hpos) hpos = display_string (w, vpos, "", hpos, 0, minendcol, -1); return hpos; } /* Return a string for the output of a mode line %-spec for window W, generated by character C and width MAXWIDTH. */ static char lots_of_dashes[] = "--------------------------------------------------------------------------------------------------------------------------------------------"; static char * decode_mode_spec (w, c, maxwidth) struct window *w; register char c; register int maxwidth; { Lisp_Object obj = Qnil; FRAME_PTR f = XFRAME (WINDOW_FRAME (w)); char *decode_mode_spec_buf = (char *) FRAME_TEMP_GLYPHS (f)->total_contents; if (maxwidth > FRAME_WIDTH (f)) maxwidth = FRAME_WIDTH (f); switch (c) { case 'b': obj = current_buffer->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 'f': obj = current_buffer->filename; #if 0 if (NILP (obj)) return "[none]"; else if (XTYPE (obj) == Lisp_String && 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)) return "??"; /* If the buffer is very big, don't waste time. */ if (ZV - BEGV > line_number_display_limit) { w->base_line_pos = Qnil; w->base_line_number = Qnil; return "??"; } 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 = BEGV; } /* 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 == BEGV) { XFASTINT (w->base_line_number) = topline; XFASTINT (w->base_line_pos) = BEGV; } else if (nlines < height + 25 || nlines > height * 3 + 50 || linepos == BEGV) { int limit = BEGV; 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; return "??"; } XFASTINT (w->base_line_number) = topline - nlines; XFASTINT (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. */ sprintf (decode_mode_spec_buf, "%d", topline + nlines); return decode_mode_spec_buf; } break; case 'm': obj = current_buffer->mode_name; break; case 'n': if (BEGV > BEG || ZV < Z) return " Narrow"; break; case '*': if (!NILP (current_buffer->read_only)) return "%"; if (MODIFF > current_buffer->save_modified) return "*"; return "-"; case 's': /* status of process */ obj = Fget_buffer_process (Fcurrent_buffer ()); if (NILP (obj)) return "no process"; obj = Fsymbol_name (Fprocess_status (obj)); break; case 'p': { int pos = marker_position (w->start); int total = ZV - BEGV; if (XFASTINT (w->window_end_pos) <= Z - ZV) { if (pos <= BEGV) return "All"; else return "Bottom"; } else if (pos <= BEGV) return "Top"; else { total = ((pos - BEGV) * 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; } } 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; } } if (XTYPE (obj) == Lisp_String) return (char *) XSTRING (obj)->data; else return ""; } /* 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 = scan_buffer ('\n', 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. 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. Returns ending hpos */ static int display_string (w, vpos, string, hpos, truncate, mincol, maxcol) struct window *w; unsigned char *string; int vpos, hpos; GLYPH truncate; int mincol, maxcol; { register int c; 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_Vector *dp = 0; if (XTYPE (Vstandard_display_table) == Lisp_Vector && XVECTOR (Vstandard_display_table)->size == DISP_TABLE_SIZE) dp = XVECTOR (Vstandard_display_table); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; p1 = p1start; start = desired_glyphs->glyphs[vpos] + XFASTINT (w->left); 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 < VERTICAL_SCROLL_BAR_WIDTH; i++) *end-- = ' '; } else *end-- = '|'; } if (maxcol >= 0 && end - desired_glyphs->glyphs[vpos] > maxcol) end = desired_glyphs->glyphs[vpos] + maxcol; if (maxcol >= 0 && mincol > maxcol) mincol = maxcol; while (p1 < end) { c = *string++; if (!c) break; if (c >= 040 && c < 0177 && (dp == 0 || XTYPE (DISP_CHAR_VECTOR (dp, c)) != Lisp_Vector)) { 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 (dp != 0 && XTYPE (DISP_CHAR_VECTOR (dp, c)) == Lisp_Vector) p1 = copy_rope (p1, start, DISP_CHAR_VECTOR (dp, c), 0); else if (c < 0200 && ! NILP (buffer_defaults.ctl_arrow)) { if (p1 >= start) *p1 = (dp && XTYPE (DISP_CTRL_GLYPH (dp)) == Lisp_Int ? XINT (DISP_CTRL_GLYPH (dp)) : '^'); p1++; if (p1 >= start && p1 < end) *p1 = c ^ 0100; p1++; } else { if (p1 >= start) *p1 = (dp && XTYPE (DISP_ESCAPE_GLYPH (dp)) == Lisp_Int ? XINT (DISP_ESCAPE_GLYPH (dp)) : '\\'); 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 (c) { p1 = end; if (truncate) *p1++ = truncate; } 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; } } void syms_of_xdisp () { 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; } /* 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))); XFASTINT (XWINDOW (root_window)->top) = 0; set_window_height (root_window, FRAME_HEIGHT (f) - 1, 0); XFASTINT (mini_w->top) = FRAME_HEIGHT (f) - 1; set_window_height (minibuf_window, 1, 0); XFASTINT (XWINDOW (root_window)->width) = FRAME_WIDTH (f); XFASTINT (mini_w->width) = FRAME_WIDTH (f); } } emacs-19.22/src/vmsproc.c100444 12241 12 42334 5444474645 14137 0ustar rolandstaff/* Interfaces to subprocesses on VMS. 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 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. */ /* 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 "vmsproc.h" #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 (XTYPE (current_buffer->directory) == Lisp_String) 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 (XTYPE (buffer) == Lisp_Int) { 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 (XTYPE (buffer) != Lisp_Int) { 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 (XTYPE (buffer) == Lisp_Int) { #ifndef subprocesses wait_without_blocking (); #endif subprocesses return Qnil; } record_unwind_protect (call_process_cleanup, Fcons (make_number (fd[0]), make_number (pid))); if (XTYPE (buffer) == Lisp_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; XFASTINT (XPROCESS (process)->infd) = inchannel; XFASTINT (XPROCESS (process)->outfd) = outchannel; XFASTINT (XPROCESS (process)->flags) = RUNNING; /* 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)); XFASTINT (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; child_changed++; XFASTINT (p->flags) = EXITED | CHANGED; /* Truncate the exit status to 24 bits so that it fits in a FASTINT */ XFASTINT (p->reason) = (vs->exitStatus) & 0xffffff; } 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.22/src/vmstime.c100444 12241 12 22373 5444474646 14134 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.22/src/window.c100444 12120 1 261466 5473763710 13436 0ustar rmsdaemon/* Window creation, deletion and examination for GNU Emacs. Does not include redisplay. 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. */ #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; /* 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 XTYPE (obj) == Lisp_Window ? 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 ((XTYPE (obj) == Lisp_Window && ! NILP (XWINDOW (obj)->buffer)) ? Qt : Qnil); } Lisp_Object make_window () { register Lisp_Object val; register struct window *p; /* Add sizeof (Lisp_Object) here because sizeof (struct Lisp_Vector) includes the first element. */ val = Fmake_vector ( make_number ((sizeof (struct window) - sizeof (struct Lisp_Vector) + sizeof (Lisp_Object)) / sizeof (Lisp_Object)), Qnil); XSETTYPE (val, Lisp_Window); p = XWINDOW (val); XFASTINT (p->sequence_number) = ++sequence_number; XFASTINT (p->left) = XFASTINT (p->top) = XFASTINT (p->height) = XFASTINT (p->width) = XFASTINT (p->hscroll) = 0; XFASTINT (p->last_point_x) = XFASTINT (p->last_point_y) = 0; p->start = Fmake_marker (); p->pointm = Fmake_marker (); XFASTINT (p->use_time) = 0; p->frame = Qnil; p->display_table = Qnil; p->dedicated = Qnil; 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)) XSET (frame, Lisp_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; if (NILP (pos)) posint = point; else { CHECK_NUMBER_COERCE_MARKER (pos, 0); posint = XINT (pos); } w = decode_window (window); top = marker_position (w->start); 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_Z (buf)) return Qnil; /* If that info is not correct, calculate afresh */ posval = *compute_motion (top, 0, 0, posint, height, 0, window_internal_width (w) - 1, XINT (w->hscroll), 0); 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 columns in WINDOW.") (window) Lisp_Object window; { register struct window *w = decode_window (window); register int width = XFASTINT (w->width); return make_number (window_internal_width (w)); } 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) XFASTINT (ncol) = 0; if (XFASTINT (ncol) >= (1 << (SHORTBITS - 1))) args_out_of_range (ncol, Qnil); w = decode_window (window); if (XINT (w->hscroll) != XINT (ncol)) clip_changed = 1; /* Prevent redisplay shortcuts */ w->hscroll = ncol; return ncol; } 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)) XSET (frame, Lisp_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.") (window) Lisp_Object window; { return Fmarker_position (decode_window (window)->start); } DEFUN ("window-end", Fwindow_end, Swindow_end, 0, 1, 0, "Return position at which display currently ends in WINDOW.") (window) Lisp_Object window; { Lisp_Object value; struct window *w = decode_window (window); Lisp_Object buf; buf = w->buffer; CHECK_BUFFER (buf, 0); XSET (value, Lisp_Int, 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; XFASTINT (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_Vector * window_display_table (w) struct window *w; { Lisp_Object tem; tem = w->display_table; if (XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == DISP_TABLE_SIZE) return XVECTOR (tem); tem = XBUFFER (w->buffer)->display_table; if (XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == DISP_TABLE_SIZE) return XVECTOR (tem); tem = Vstandard_display_table; if (XTYPE (tem) == Lisp_Vector && XVECTOR (tem)->size == DISP_TABLE_SIZE) return XVECTOR (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 = w->buffer; if (XBUFFER (buf) != XMARKER (w->pointm)->buffer) abort (); 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. */ 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++; /* 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 = 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. This means that next-window may 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. If neither nil nor t, 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 ? Qt : Qlambda); /* all_frames == nil doesn't specify which frames to include. Decide which frames it includes. */ if (NILP (all_frames)) all_frames = (EQ (minibuf, Qt) ? (FRAME_MINIBUF_WINDOW (XFRAME (WINDOW_FRAME (XWINDOW (window))))) : Qnil); else if (! EQ (all_frames, Qt)) all_frames = Qnil; /* Now all_frames is t meaning search all frames, nil meaning search just current frame, or a window, meaning search the frame that window belongs to. */ /* 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)) tem = next_frame (tem, all_frames); #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 minibuffer windows, 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 (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. This means that previous-window may 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\n\ 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. If neither nil nor t, 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 ? Qt : Qlambda); /* all_frames == nil doesn't specify which frames to include. Decide which frames it includes. */ if (NILP (all_frames)) all_frames = (EQ (minibuf, Qt) ? (FRAME_MINIBUF_WINDOW (XFRAME (WINDOW_FRAME (XWINDOW (window))))) : Qnil); else if (! EQ (all_frames, Qt)) all_frames = Qnil; /* Now all_frames is t meaning search all frames, nil meaning search just current frame, or a window, meaning search the frame that window belongs to. */ /* 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. */ tem = prev_frame (tem, all_frames); #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 acceptable? Exit the loop and accept this window if this isn't a minibuffer window, or we're accepting minibuffer windows, 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 (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; 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; #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; #else frame = 0; #endif /* Pick a window to start with. */ if (XTYPE (obj) == Lisp_Window) 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. */ #ifdef MULTI_FRAME if (frame) last_window = Fprevious_window (w, (mini ? Qt : Qnil), Qlambda); else #endif /* MULTI_FRAME */ /* We know frame is 0, so we're looping through all frames. Or we know this isn't a MULTI_FRAME Emacs, so who cares? */ last_window = Fprevious_window (w, mini ? Qt : Qnil, Qt); 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. */ #ifdef MULTI_FRAME if (frame) next_window = Fnext_window (w, (mini ? Qt : Qnil), Qlambda); else #endif /* MULTI_FRAME */ /* We know frame is 0, so we're looping through all frames. Or we know this isn't a MULTI_FRAME Emacs, so who cares? */ next_window = Fnext_window (w, mini ? Qt : Qnil, Qt); if (! MINI_WINDOW_P (XWINDOW (w)) || (mini && minibuf_level > 0)) switch (type) { case GET_BUFFER_WINDOW: /* Ignore invisible and iconified frames. */ if (! FRAME_VISIBLE_P (w_frame) || FRAME_ICONIFIED_P (w_frame)) break; 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; #if 0 /* Ignore invisible and iconified frames. */ if (! FRAME_VISIBLE_P (XFRAME (WINDOW_FRAME (XWINDOW (w)))) || FRAME_ICONIFIED_P (XFRAME (WINDOW_FRAME (XWINDOW (w))))) break; #endif /* 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)) { /* 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 = 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: #if 0 /* Ignore invisible and iconified frames. */ if (! FRAME_VISIBLE_P (XFRAME (WINDOW_FRAME (XWINDOW (w)))) || FRAME_ICONIFIED_P (XFRAME (WINDOW_FRAME (XWINDOW (w))))) break; #endif /* 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 = Fother_buffer (obj, Qnil); if (NILP (another_buffer)) another_buffer = Fget_buffer_create (build_string ("*scratch*")); 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 FRAMES is t, search all frames. If FRAME is a\n\ frame, search only that frame.\n") (frames) Lisp_Object frames; { register Lisp_Object w; /* First try for a window that is full-width */ w = window_loop (GET_LRU_WINDOW, Qt, 0, frames); if (!NILP (w) && !EQ (w, selected_window)) return w; /* If none of them, try the rest */ return window_loop (GET_LRU_WINDOW, Qnil, 0, frames); } DEFUN ("get-largest-window", Fget_largest_window, Sget_largest_window, 0, 1, 0, "Return the largest window in area.\n\ If optional argument FRAMES is t, search all frames. If FRAME is a\n\ frame, search only that frame.\n") (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 t, search all visible frames.\n\ If FRAME is nil, search only the selected frame.\n\ If FRAME is a frame, search only that frame.\n") (buffer, frame) Lisp_Object buffer, frame; { buffer = Fget_buffer (buffer); if (XTYPE (buffer) == Lisp_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; struct buffer *obuf = current_buffer; int opoint; int top; if (NILP (window)) window = selected_window; else CHECK_LIVE_WINDOW (window, 0); w = XWINDOW (window); top = XFASTINT (w->top); window_loop (DELETE_OTHER_WINDOWS, window, 0, WINDOW_FRAME (w)); Fset_buffer (w->buffer); opoint = point; SET_PT (marker_position (w->start)); Frecenter (make_number (top - FRAME_MENU_BAR_LINES (XFRAME (WINDOW_FRAME (w))))); SET_PT (opoint); 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 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; } XFASTINT (w->last_modified) = 0; windows_or_buffers_changed++; XFASTINT (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); XFASTINT (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) { Fdelete_window (window); return; } XFASTINT (w->last_modified) = 0; windows_or_buffers_changed++; XFASTINT (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); XFASTINT (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\n", tem); unshow_buffer (w); } w->buffer = buffer; w->window_end_pos = 0; w->window_end_valid = Qnil; 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; XFASTINT (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"); XFASTINT (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; Fhandle_switch_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); if (new_point > ZV) SET_PT (ZV); else SET_PT (new_point); } windows_or_buffers_changed++; 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\ Returns the window displaying BUFFER.") (buffer, not_this_window) register Lisp_Object buffer, not_this_window; { register Lisp_Object window; 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 selected_window; window = Fget_buffer_window (buffer, Qnil); if (!NILP (window) && (NILP (not_this_window) || !EQ (window, selected_window))) return window; #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); #if 0 Fhandle_switch_frame (XWINDOW (window)->frame, Qnil); #endif return window; } #endif /* MULTI_FRAME */ if (pop_up_windows #ifdef MULTI_FRAME || FRAME_MINIBUF_ONLY_P (selected_frame) #endif ) { Lisp_Object frames = Qnil; #ifdef MULTI_FRAME if (FRAME_MINIBUF_ONLY_P (selected_frame)) XSET (frames, Lisp_Frame, 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; window = Fget_largest_window (frames); if (!NILP (window) && window_height (window) >= split_height_threshold && (XFASTINT (XWINDOW (window)->width) == FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (window)))))) window = Fsplit_window (window, Qnil, Qnil); else { window = Fget_lru_window (frames); if ((EQ (window, selected_window) || EQ (XWINDOW (window)->parent, Qnil)) && window_height (window) >= window_min_height << 1) window = Fsplit_window (window, Qnil, Qnil); } } else window = Fget_lru_window (Qnil); Fset_window_buffer (window, buffer); return 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); XBUFFER (buf)->save_modified = MODIFF; BEGV = BEG; ZV = Z; SET_PT (BEG); 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); XFASTINT (w->hscroll) = 0; set_marker_restricted (w->start, make_number (1), buf); set_marker_restricted (w->pointm, make_number (1), buf); } } static make_dummy_parent (window) Lisp_Object window; { register Lisp_Object old, new; register struct window *o, *p; old = window; XSETTYPE (old, Lisp_Vector); new = Fcopy_sequence (old); XSETTYPE (new, Lisp_Window); o = XWINDOW (old); p = XWINDOW (new); XFASTINT (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 || size + window_min_height > XFASTINT (o->height)) args_out_of_range_3 (window, chsize, horflag); 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 || size + window_min_width > XFASTINT (o->width)) args_out_of_range_3 (window, chsize, horflag); 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++; 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; XFASTINT (p->width) = XFASTINT (o->width) - size; XFASTINT (o->width) = size; XFASTINT (p->left) = XFASTINT (o->left) + size; } else { p->left = o->left; p->width = o->width; XFASTINT (p->height) = XFASTINT (o->height) - size; XFASTINT (o->height) = size; XFASTINT (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); if (*sizep + delta < MINSIZE (window)) { Fdelete_window (window); return; } { 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 (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); } XFASTINT (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 - VERTICAL_SCROLL_BAR_WIDTH; /* 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 = point; register int pos; register int ht = window_internal_height (w); register Lisp_Object tem; int lose; Lisp_Object bolp, nmoved; XFASTINT (tem) = point; tem = Fpos_visible_in_window_p (tem, window); if (NILP (tem)) { Fvertical_motion (make_number (- ht / 2)); XFASTINT (tem) = point; Fset_marker (w->start, tem, w->buffer); w->force_start = Qt; } SET_PT (marker_position (w->start)); lose = n < 0 && point == BEGV; Fvertical_motion (make_number (n)); pos = point; 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; XFASTINT (w->last_modified) = 0; if (pos > opoint) SET_PT (pos); if (n < 0) { SET_PT (pos); tem = Fvertical_motion (make_number (ht)); if (point > opoint || XFASTINT (tem) < ht) SET_PT (opoint); else Fvertical_motion (make_number (-1)); } } 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\ 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\ When calling from a program, supply a number as argument or nil.") (n) Lisp_Object n; { scroll_command (n, -1); return Qnil; } 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.\n\ When calling from a program, supply a number as argument or nil.\n\ \n\ If in the minibuffer, `minibuf-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 ht; register struct window *w; register int count = specpdl_ptr - specpdl; 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"); w = XWINDOW (window); ht = window_internal_height (w); /* 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, ht - next_screen_context_lines, 1); else if (EQ (n, Qminus)) window_scroll (window, next_screen_context_lines - ht, 1); else { if (XTYPE (n) == Lisp_Cons) n = Fcar (n); CHECK_NUMBER (n, 0); window_scroll (window, XINT (n), 1); } Fset_marker (w->pointm, make_number (point), 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)) XFASTINT (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)) XFASTINT (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); register int opoint = point; if (NILP (n)) { extern int frame_garbaged; SET_FRAME_GARBAGED (XFRAME (WINDOW_FRAME (w))); XFASTINT (n) = ht / 2; } else if (XTYPE (n) == Lisp_Cons) /* Just C-u. */ { XFASTINT (n) = ht / 2; } else { n = Fprefix_numeric_value (n); CHECK_NUMBER (n, 0); } if (XINT (n) < 0) XSETINT (n, XINT (n) + ht); XSETINT (n, - XINT (n)); Fvertical_motion (n); Fset_marker (w->start, make_number (point), w->buffer); w->start_at_line_beg = Fbolp (); SET_PT (opoint); 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 text 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; if (NILP (arg)) XFASTINT (arg) = height / 2; else { arg = Fprefix_numeric_value (arg); if (XINT (arg) < 0) XSETINT (arg, XINT (arg) + height); } start = marker_position (w->start); if (start < BEGV || start > ZV) { Fvertical_motion (make_number (- height / 2)); Fset_marker (w->start, make_number (point), w->buffer); w->start_at_line_beg = Fbolp (); w->force_start = Qt; } else SET_PT (start); return Fvertical_motion (arg); } struct save_window_data { int size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; Lisp_Object frame_width, frame_height; 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; /* A vector, interpreted as a struct saved_window */ Lisp_Object saved_windows; }; /* Arg to Fmake_vector */ #define SAVE_WINDOW_DATA_SIZE \ ((sizeof (struct save_window_data) \ - (sizeof (struct Lisp_Vector) \ /* Don't count the contents member of the struct Lisp_Vector */ \ - sizeof (Lisp_Object))) \ / sizeof (Lisp_Object)) /* 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 (XTYPE (obj) == Lisp_Window_Configuration) 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 (XTYPE (configuration) != Lisp_Window_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); 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); windows_or_buffers_changed++; /* 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 (XTYPE (w->height) == Lisp_Buffer) 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; XFASTINT (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) || (XTYPE (data->focus_frame) == Lisp_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)) Fhandle_switch_frame (WINDOW_FRAME (XWINDOW (data->root_window)), Qnil); #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 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))) Fhandle_switch_frame (data->selected_frame, Qnil); #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); XFASTINT (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); p->start = Fcopy_marker (w->start); p->start_at_line_beg = w->start_at_line_beg; tem = XBUFFER (w->buffer)->mark; p->mark = Fcopy_marker (tem); } 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 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))); data = (struct save_window_data *) XVECTOR (Fmake_vector (make_number (SAVE_WINDOW_DATA_SIZE), Qnil)); XFASTINT (data->frame_width) = FRAME_WIDTH (f); XFASTINT (data->frame_height) = FRAME_HEIGHT (f); #ifdef MULTI_FRAME XSET (data->selected_frame, Lisp_Frame, selected_frame); #endif data->current_window = FRAME_SELECTED_WINDOW (f); XSET (data->current_buffer, Lisp_Buffer, current_buffer); data->minibuf_scroll_window = Vminibuf_scroll_window; data->root_window = FRAME_ROOT_WINDOW (f); data->focus_frame = FRAME_FOCUS_FRAME (f); 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); XSET (tem, Lisp_Window_Configuration, data); return (tem); } DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion, 0, UNEVALLED, 0, "Execute body, preserving window sizes and contents.\n\ Restores which buffer appears in which window, where display starts,\n\ as well as 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 (); 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 (); 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 */ XFASTINT (XWINDOW (FRAME_ROOT_WINDOW (selected_frame))->width) = 10; XFASTINT (XWINDOW (minibuf_window)->width) = 10; XFASTINT (XWINDOW (FRAME_ROOT_WINDOW (selected_frame))->height) = 9; XFASTINT (XWINDOW (minibuf_window)->top) = 9; XFASTINT (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. */ XFASTINT (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); #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\ Used by `with-output-to-temp-buffer'."); 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, "*If non-nil, 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_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_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 (&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.22/src/xfaces.c100444 12120 1 75213 5473335327 13350 0ustar rmsdaemon/* "Face" primitives. 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. */ /* This is derived from work by Lucid (some parts very loosely so). */ #include #include #include #include "lisp.h" #ifdef HAVE_X_WINDOWS #include "xterm.h" #include "buffer.h" #include "dispextern.h" #include "frame.h" #include "blockinput.h" #include "window.h" /* 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 /* 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. Elements 0 and 1 of computed_faces have GC's; all the other faces in computed_faces do not. The global array face_vector contains faces with their GC's set. Given a computed_face, the function intern_face finds (or adds) an element of face_vector with equivalent parameters, and returns a pointer to that face, whose GC can then be used for display. 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. Since face_vector is just a cache --- there are no pointers into it from the rest of the code, and everyone accesses it through intern_face --- we could just free its GC's and throw the whole thing away without breaking anything. This gives us a simple way to garbage-collect old GC's nobody's using any more - we can just purge face_vector, and then let subsequent calls to intern_face refill it as needed. The function clear_face_vector performs this purge. We're often applying intern_face to faces in computed_faces - for example, we do this while sending GLYPHs from a struct frame_glyphs to X during redisplay. It would be nice to avoid searching all of face_vector every time we intern a frame's face. So, when intern_face finds a match for FACE in face_vector, it stores the index of the match in FACE's cached_index member, and checks there first next time. */ /* Definitions and declarations. */ /* A table of display faces. */ static struct face **face_vector; /* The length in use of the table. */ static int nfaces; /* The allocated length of the table. */ static int nfaces_allocated; /* The number of face-id's in use (same for all frames). */ int next_face_id; /* The number of the face to use to indicate the region. */ 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, Qwindow, Qpriority; static void build_face ( /* FRAME_PTR, struct face * */ ); 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; 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); } /* Interning faces in the `face_vector' cache, and clearing that cache. */ /* Return the unique display face corresponding to the user-level face FACE. If there isn't one, make one, and find a slot in the face_vector to put it in. */ static struct face * get_cached_face (f, face) struct frame *f; struct face *face; { int i, empty = -1; struct face *result; /* Perhaps FACE->cached_index is valid; this could happen if FACE is in a frame's face list. */ if (face->cached_index >= 0 && face->cached_index < nfaces && face_eql (face_vector[face->cached_index], face)) return face_vector[face->cached_index]; /* Look for an existing display face that does the job. Also find an empty slot if any. */ for (i = 0; i < nfaces; i++) { if (face_eql (face_vector[i], face)) return face_vector[i]; if (face_vector[i] == 0) empty = i; } /* If no empty slots, make one. */ if (empty < 0 && nfaces == nfaces_allocated) { int newsize = nfaces + 20; face_vector = (struct face **) xrealloc (face_vector, newsize * sizeof (struct face *)); nfaces_allocated = newsize; } if (empty < 0) empty = nfaces++; /* Put a new display face in the empty slot. */ result = copy_face (face); face_vector[empty] = result; /* Make a graphics context for it. */ build_face (f, result); return result; } /* Given a computed face, return an equivalent display face (one which has a graphics context). */ struct face * intern_face (f, face) struct frame *f; struct face *face; { /* If it's equivalent to the default face, use that. */ if (face_eql (face, FRAME_DEFAULT_FACE (f))) { if (!FRAME_DEFAULT_FACE (f)->gc) build_face (f, FRAME_DEFAULT_FACE (f)); return FRAME_DEFAULT_FACE (f); } /* If it's equivalent to the mode line face, use that. */ if (face_eql (face, FRAME_MODE_LINE_FACE (f))) { if (!FRAME_MODE_LINE_FACE (f)->gc) build_face (f, FRAME_MODE_LINE_FACE (f)); return FRAME_MODE_LINE_FACE (f); } /* If it's not one of the frame's default faces, it shouldn't have a GC. */ if (face->gc) abort (); /* Get a specialized display face. */ return get_cached_face (f, face); } /* Clear out face_vector and start anew. This should be done from time to time just to avoid keeping too many graphics contexts in face_vector that are no longer needed. */ void clear_face_vector () { Lisp_Object rest; Display *dpy = x_current_display; int i; BLOCK_INPUT; /* Free the display faces in the face_vector. */ for (i = 0; i < nfaces; i++) { struct face *face = face_vector[i]; if (face->gc) XFreeGC (dpy, face->gc); xfree (face); } nfaces = 0; UNBLOCK_INPUT; } /* Allocating and freeing X resources for display faces. */ /* Make a graphics context for face FACE, which is on frame F, if that can be done. */ static void build_face (f, face) struct frame *f; struct face *face; { GC gc; XGCValues xgcv; unsigned long mask; BLOCK_INPUT; if (face->foreground != FACE_DEFAULT) xgcv.foreground = face->foreground; else xgcv.foreground = f->display.x->foreground_pixel; if (face->background != FACE_DEFAULT) xgcv.background = face->background; else xgcv.background = f->display.x->background_pixel; if (face->font && (int) face->font != FACE_DEFAULT) xgcv.font = face->font->fid; else xgcv.font = f->display.x->font->fid; xgcv.graphics_exposures = 0; mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures; gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f), mask, &xgcv); #if 0 if (face->stipple && face->stipple != FACE_DEFAULT) XSetStipple (x_current_display, gc, face->stipple); #endif face->gc = gc; UNBLOCK_INPUT; } /* Allocating, freeing, and duplicating fonts, colors, and pixmaps. */ 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 (x_current_display, (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; XFreeFont (x_current_display, font); UNBLOCK_INPUT; } static unsigned long load_color (f, name) struct frame *f; Lisp_Object name; { Display *dpy = x_current_display; Colormap cmap; XColor color; int result; if (NILP (name)) return FACE_DEFAULT; cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display)); CHECK_STRING (name, 0); BLOCK_INPUT; result = XParseColor (dpy, cmap, (char *) XSTRING (name)->data, &color); UNBLOCK_INPUT; if (! result) Fsignal (Qerror, Fcons (build_string ("undefined color"), Fcons (name, Qnil))); BLOCK_INPUT; result = XAllocColor (dpy, cmap, &color); UNBLOCK_INPUT; if (! result) Fsignal (Qerror, Fcons (build_string ("X server cannot allocate color"), Fcons (name, Qnil))); return (unsigned long) color.pixel; } static void unload_color (f, pixel) struct frame *f; unsigned long pixel; { /* Since faces get built by copying parameters from other faces, the allocation counts for the colors get all screwed up. I don't see any solution that will take less than 10 minutes, and it's better to have a color leak than a crash, so I'm just dyking this out. This isn't really a color leak, anyway - if we ask for it again, we'll get the same pixel. */ #if 0 Colormap cmap; Display *dpy = x_current_display; if (pixel == FACE_DEFAULT || pixel == BLACK_PIX_DEFAULT || pixel == WHITE_PIX_DEFAULT) return; cmap = DefaultColormapOfScreen (DefaultScreenOfDisplay (x_current_display)); BLOCK_INPUT; XFreeColors (dpy, cmap, &pixel, 1, 0); UNBLOCK_INPUT; #endif } /* Managing parameter face arrays for frames. */ void init_frame_faces (f) FRAME_PTR f; { ensure_face_ready (f, 0); ensure_face_ready (f, 1); new_computed_face (f, FRAME_PARAM_FACES (f)[0]); new_computed_face (f, FRAME_PARAM_FACES (f)[1]); recompute_basic_faces (f); /* 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); } } } /* Called from Fdelete_frame. */ void free_frame_faces (f) struct frame *f; { Display *dpy = x_current_display; int i; BLOCK_INPUT; for (i = 0; i < FRAME_N_PARAM_FACES (f); i++) { struct face *face = FRAME_PARAM_FACES (f) [i]; if (face) { if (face->gc) XFreeGC (dpy, face->gc); unload_font (f, face->font); unload_color (f, face->foreground); unload_color (f, face->background); #if 0 unload_pixmap (f, face->stipple); #endif 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. */ 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 (); } /* Computing faces appropriate for a given piece of text in a buffer. */ /* Return non-zero if FONT1 and FONT2 have the same size bounding box. 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); /* Checking the following caused bad results in some cases when fonts that should be the same size actually have very slightly different size. It is possible that this reintroduces the bug whereby line positions were not right. However, the right way to fix that is to change xterm.c so that the vertical positions of lines depend only on the height of the frame's font. && bounds1->ascent == bounds2->ascent && bounds1->descent == bounds2->descent); */ } /* 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 size as the base font. */ 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; 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; { struct x_display *d = f->display.x; face->gc = 0; face->foreground = d->foreground_pixel; face->background = d->background_pixel; face->font = d->font; face->stipple = 0; face->underline = 0; /* Avoid a face comparison by making this invalid. */ face->cached_index = -1; } struct sortvec { Lisp_Object overlay; int beg, end; int priority; }; static int sort_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; } /* 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. */ int compute_char_face (f, w, pos, region_beg, region_end, endptr, limit) struct frame *f; struct window *w; int pos; int region_beg, region_end; int *endptr; int limit; { struct face face; Lisp_Object prop, position; int i, j, noverlays; int facecode; Lisp_Object *overlay_vec; struct sortvec *sortvec; Lisp_Object frame; int endpos; /* 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 (); XSET (frame, Lisp_Frame, f); endpos = ZV; if (pos < region_beg && region_beg < endpos) endpos = region_beg; XFASTINT (position) = pos; prop = Fget_text_property (position, Qface, w->buffer); { Lisp_Object limit1, end; XFASTINT (limit1) = (limit < endpos ? limit : endpos); end = Fnext_single_property_change (position, Qface, 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); /* 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); } 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 (!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); } /* Put the valid and relevant overlays into sortvec. */ sortvec = (struct sortvec *) alloca (noverlays * sizeof (struct sortvec)); for (i = 0, j = 0; i < noverlays; i++) { Lisp_Object overlay = overlay_vec[i]; if (OVERLAY_VALID (overlay) && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0 && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0) { Lisp_Object window; window = Foverlay_get (overlay, Qwindow); /* Also ignore overlays limited to one window if it's not the window we are using. */ if (XTYPE (window) != Lisp_Window || XWINDOW (window) == w) { Lisp_Object tem; /* This overlay is good and counts: put it in 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), sort_overlays); /* Now merge the overlay data in that order. */ for (i = 0; i < noverlays; i++) { prop = Foverlay_get (sortvec[i].overlay, Qface); 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 (sortvec[i].overlay); 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); } /* 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. */ int compute_glyph_face (f, face_code) struct frame *f; int face_code; { struct face face; compute_base_face (f, &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); } /* 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 (x_current_display, FRAME_DEFAULT_FACE (f)->gc); if (FRAME_MODE_LINE_FACE (f)->gc) XFreeGC (x_current_display, 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)); build_face (f, FRAME_DEFAULT_FACE (f)); build_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; int id = XINT (face_id); CHECK_NUMBER (face_id, 0); if (id < 0 || id >= next_face_id) error ("Face id out of range"); for (rest = Vframe_list; !NILP (rest); rest = XCONS (rest)->cdr) { struct frame *f = XFRAME (XCONS (rest)->car); if (FRAME_X_P (f)) ensure_face_ready (f, 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; 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; 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->display.x->font) unload_font (f, face->font); face->font = font; } 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; } 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; } #if 0 else if (EQ (attr_name, intern ("background-pixmap"))) { unsigned int w, h, d; unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h, &d, 0); unload_pixmap (f, face->stipple); if (NILP (attr_value)) new_pixmap = 0; face->stipple = new_pixmap; face->pixmap_w = w; face->pixmap_h = h; /* face->pixmap_depth = d; */ } #endif /* 0 */ 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); /* If we're modifying either of the frame's display faces, that means that we're changing the parameters of a fixed face code; since the color/font/whatever is changed but the face ID hasn't, redisplay won't know to redraw the affected sections. Give it a kick. */ if (id == 0 || id == 1) SET_FRAME_GARBAGED (f); else /* Otherwise, it's enough to tell it to redisplay the text. */ windows_or_buffers_changed = 1; 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 () { Qwindow = intern ("window"); staticpro (&Qwindow); Qface = intern ("face"); staticpro (&Qface); Qpriority = intern ("priority"); staticpro (&Qpriority); 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 (&Sframe_face_alist); defsubr (&Sset_frame_face_alist); defsubr (&Smake_face_internal); defsubr (&Sset_face_attribute_internal); defsubr (&Sinternal_next_face_id); } #endif /* HAVE_X_WINDOWS */ emacs-19.22/src/xfns.c100444 12120 1 320271 5475473263 13076 0ustar rmsdaemon/* Functions for the X window system. Copyright (C) 1989, 1992, 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. */ /* Completely rewritten by Richard Stallman. */ /* Rewritten for X11 by Joseph Arceneaux */ #if 0 #include #endif #include #include #include "lisp.h" #include "xterm.h" #include "frame.h" #include "window.h" #include "buffer.h" #include "dispextern.h" #include "keyboard.h" #include "blockinput.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 #define min(a,b) ((a) < (b) ? (a) : (b)) #define max(a,b) ((a) > (b) ? (a) : (b)) #ifdef HAVE_X11 /* X Resource data base */ static XrmDatabase xrdb; /* The class of this X application. */ #define EMACS_CLASS "Emacs" #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; /* Title name and application name for X stuff. */ extern char *x_id_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; /* Color of chars displayed in cursor box. */ Lisp_Object Vx_cursor_fore_pixel; /* The screen being used. */ static Screen *x_screen; /* The X Visual we are using for X windows (the default) */ Visual *screen_visual; /* Height of this X screen in pixels. */ int x_screen_height; /* Width of this X screen in pixels. */ int x_screen_width; /* Number of planes for this screen. */ int x_screen_planes; /* Non nil if no window manager is in use. */ Lisp_Object Vx_no_window_manager; /* `t' if a mouse button is depressed. */ Lisp_Object Vmouse_depressed; extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed; /* Atom for indicating window state to the window manager. */ extern Atom Xatom_wm_change_state; /* Communication with window managers. */ extern Atom Xatom_wm_protocols; /* Kinds of protocol things we may receive. */ extern Atom Xatom_wm_take_focus; extern Atom Xatom_wm_save_yourself; extern Atom Xatom_wm_delete_window; /* Other WM communication */ extern Atom Xatom_wm_configure_denied; /* When our config request is denied */ extern Atom Xatom_wm_window_moved; /* When the WM moves us. */ #else /* X10 */ /* Default size of an Emacs window. */ static char *default_window = "=80x24+0+0"; #define MAXICID 80 char iconidentity[MAXICID]; #define ICONTAG "emacs@" char minibuffer_iconidentity[MAXICID]; #define MINIBUFFER_ICONTAG "minibuffer@" #endif /* X10 */ /* The last 23 bits of the timestamp of the last mouse button event. */ Time mouse_timestamp; /* 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; */ Lisp_Object Qicon_left; Lisp_Object Qicon_top; Lisp_Object Qicon_type; Lisp_Object Qinternal_border_width; Lisp_Object Qleft; Lisp_Object Qmouse_color; Lisp_Object Qnone; Lisp_Object Qparent_id; 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; /* 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; /* Error if we are not connected to X. */ static void check_x () { if (x_current_display == 0) error ("X windows are not in use or not initialized"); } /* 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 XGCTYPE. */ struct frame * x_window_to_frame (wdesc) int wdesc; { Lisp_Object tail, frame; struct frame *f; for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) { frame = XCONS (tail)->car; if (XGCTYPE (frame) != Lisp_Frame) continue; f = XFRAME (frame); if (FRAME_X_WINDOW (f) == wdesc || f->display.x->icon_desc == wdesc) return f; } return 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_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 (); 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, "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, }; /* 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; /* Record in these vectors all the parms specified. */ Lisp_Object *parms; Lisp_Object *values; int i; 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; /* 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 { register Lisp_Object param_index = Fget (prop, Qx_frame_parameter); register Lisp_Object old_value = get_frame_param (f, prop); store_frame_param (f, prop, val); if (XTYPE (param_index) == Lisp_Int && XINT (param_index) >= 0 && (XINT (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)) XSET (left, Lisp_Int, f->display.x->left_pos); if (EQ (top, Qunbound)) XSET (top, Lisp_Int, f->display.x->top_pos); /* Don't die if just one of these was set. */ if (EQ (width, Qunbound)) XSET (width, Lisp_Int, FRAME_WIDTH (f)); if (EQ (height, Qunbound)) XSET (height, Lisp_Int, FRAME_HEIGHT (f)); /* Don't set these parameters these unless they've been explicitly specified. The window might be mapped or resized while we're in this function, and we don't want to override that unless the lisp code has asked for it. Don't set these parameters unless they actually differ from the window's current parameters; the window may not actually exist yet. */ { Lisp_Object frame; check_frame_size (f, &height, &width); XSET (frame, Lisp_Frame, f); if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f)) || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f))) Fset_frame_size (frame, width, height); if ((NUMBERP (left) && XINT (left) != f->display.x->left_pos) || (NUMBERP (top) && XINT (top) != f->display.x->top_pos)) Fset_frame_position (frame, left, top); } } /* 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]; store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos)); store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos)); store_in_alist (alistptr, Qborder_width, make_number (f->display.x->border_width)); store_in_alist (alistptr, Qinternal_border_width, make_number (f->display.x->internal_border_width)); sprintf (buf, "%d", FRAME_X_WINDOW (f)); store_in_alist (alistptr, Qwindow_id, build_string (buf)); store_in_alist (alistptr, Qvisibility, (FRAME_VISIBLE_P (f) ? Qt : FRAME_ICONIFIED_P (f) ? Qicon : Qnil)); } /* Decide if color named COLOR is valid for the display associated with the selected frame. */ int defined_color (color, color_def) char *color; Color *color_def; { register int foo; Colormap screen_colormap; BLOCK_INPUT; #ifdef HAVE_X11 screen_colormap = DefaultColormap (x_current_display, XDefaultScreen (x_current_display)); foo = XParseColor (x_current_display, screen_colormap, color, color_def) && XAllocColor (x_current_display, screen_colormap, color_def); #else foo = XParseColor (color, color_def) && XGetHardwareColor (color_def); #endif /* not HAVE_X11 */ UNBLOCK_INPUT; if (foo) 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 (arg, def) Lisp_Object arg; int def; { Color cdef; CHECK_STRING (arg, 0); if (strcmp (XSTRING (arg)->data, "black") == 0) return BLACK_PIX_DEFAULT; else if (strcmp (XSTRING (arg)->data, "white") == 0) return WHITE_PIX_DEFAULT; #ifdef HAVE_X11 if (x_screen_planes == 1) return def; #else if (DISPLAY_CELLS == 1) return def; #endif if (defined_color (XSTRING (arg)->data, &cdef)) return cdef.pixel; else Fsignal (Qundefined_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->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT); if (FRAME_X_WINDOW (f) != 0) { #ifdef HAVE_X11 BLOCK_INPUT; XSetForeground (x_current_display, f->display.x->normal_gc, f->display.x->foreground_pixel); XSetBackground (x_current_display, f->display.x->reverse_gc, f->display.x->foreground_pixel); UNBLOCK_INPUT; #endif /* HAVE_X11 */ 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->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT); if (FRAME_X_WINDOW (f) != 0) { BLOCK_INPUT; #ifdef HAVE_X11 /* The main frame area. */ XSetBackground (x_current_display, f->display.x->normal_gc, f->display.x->background_pixel); XSetForeground (x_current_display, f->display.x->reverse_gc, f->display.x->background_pixel); XSetForeground (x_current_display, f->display.x->cursor_gc, f->display.x->background_pixel); XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f), f->display.x->background_pixel); #else temp = XMakeTile (f->display.x->background_pixel); XChangeBackground (FRAME_X_WINDOW (f), temp); XFreePixmap (temp); #endif /* not HAVE_X11 */ 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; int mask_color; if (!EQ (Qnil, arg)) f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT); mask_color = f->display.x->background_pixel; /* No invisible pointers. */ if (mask_color == f->display.x->mouse_pixel && mask_color == f->display.x->background_pixel) f->display.x->mouse_pixel = f->display.x->foreground_pixel; BLOCK_INPUT; #ifdef HAVE_X11 /* It's not okay to crash if the user selects a screwy cursor. */ x_catch_errors (); if (!EQ (Qnil, Vx_pointer_shape)) { CHECK_NUMBER (Vx_pointer_shape, 0); cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape)); } else cursor = XCreateFontCursor (x_current_display, XC_xterm); x_check_errors ("bad text pointer cursor: %s"); if (!EQ (Qnil, Vx_nontext_pointer_shape)) { CHECK_NUMBER (Vx_nontext_pointer_shape, 0); nontext_cursor = XCreateFontCursor (x_current_display, XINT (Vx_nontext_pointer_shape)); } else nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr); x_check_errors ("bad nontext pointer cursor: %s"); if (!EQ (Qnil, Vx_mode_pointer_shape)) { CHECK_NUMBER (Vx_mode_pointer_shape, 0); mode_cursor = XCreateFontCursor (x_current_display, XINT (Vx_mode_pointer_shape)); } else mode_cursor = XCreateFontCursor (x_current_display, XC_xterm); /* Check and report errors with the above calls. */ x_check_errors ("can't set cursor shape: %s"); x_uncatch_errors (); { XColor fore_color, back_color; fore_color.pixel = f->display.x->mouse_pixel; back_color.pixel = mask_color; XQueryColor (x_current_display, DefaultColormap (x_current_display, DefaultScreen (x_current_display)), &fore_color); XQueryColor (x_current_display, DefaultColormap (x_current_display, DefaultScreen (x_current_display)), &back_color); XRecolorCursor (x_current_display, cursor, &fore_color, &back_color); XRecolorCursor (x_current_display, nontext_cursor, &fore_color, &back_color); XRecolorCursor (x_current_display, mode_cursor, &fore_color, &back_color); } #else /* X10 */ cursor = XCreateCursor (16, 16, MouseCursor, MouseMask, 0, 0, f->display.x->mouse_pixel, f->display.x->background_pixel, GXcopy); #endif /* X10 */ if (FRAME_X_WINDOW (f) != 0) { XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor); } if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0) XFreeCursor (XDISPLAY f->display.x->text_cursor); f->display.x->text_cursor = cursor; #ifdef HAVE_X11 if (nontext_cursor != f->display.x->nontext_cursor && f->display.x->nontext_cursor != 0) XFreeCursor (XDISPLAY f->display.x->nontext_cursor); f->display.x->nontext_cursor = nontext_cursor; if (mode_cursor != f->display.x->modeline_cursor && f->display.x->modeline_cursor != 0) XFreeCursor (XDISPLAY f->display.x->modeline_cursor); f->display.x->modeline_cursor = mode_cursor; #endif /* HAVE_X11 */ XFlushQueue (); 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 (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT); else fore_pixel = f->display.x->background_pixel; f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT); /* Make sure that the cursor color differs from the background color. */ if (f->display.x->cursor_pixel == f->display.x->background_pixel) { f->display.x->cursor_pixel == f->display.x->mouse_pixel; if (f->display.x->cursor_pixel == fore_pixel) fore_pixel = f->display.x->background_pixel; } f->display.x->cursor_foreground_pixel = fore_pixel; if (FRAME_X_WINDOW (f) != 0) { #ifdef HAVE_X11 BLOCK_INPUT; XSetBackground (x_current_display, f->display.x->cursor_gc, f->display.x->cursor_pixel); XSetForeground (x_current_display, f->display.x->cursor_gc, fore_pixel); UNBLOCK_INPUT; #endif /* HAVE_X11 */ 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; #ifndef HAVE_X11 if (!strcmp (str, "grey") || !strcmp (str, "Grey") || !strcmp (str, "gray") || !strcmp (str, "Gray")) pix = -1; else #endif /* X10 */ pix = x_decode_color (arg, BLACK_PIX_DEFAULT); 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->display.x->border_pixel = pix; if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0) { Pixmap temp; int mask; BLOCK_INPUT; #ifdef HAVE_X11 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f), pix); #else if (pix < 0) temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height, gray_bits), BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT); else temp = XMakeTile (pix); XChangeBorder (FRAME_X_WINDOW (f), temp); XFreePixmap (XDISPLAY temp); #endif /* not HAVE_X11 */ 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; else #if 0 if (EQ (arg, Qbox)) #endif FRAME_DESIRED_CURSOR (f) = filled_box_cursor; /* Error messages commented out because people have trouble fixing .Xdefaults with Emacs, when it has something bad in it. */ #if 0 else error ("the `cursor-type' frame parameter should be either `bar' or `box'"); #endif /* 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 (EQ (oldval, Qnil) == EQ (arg, Qnil)) return; BLOCK_INPUT; if (NILP (arg)) result = x_text_icon (f, 0); else result = x_bitmap_icon (f); 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)) XMapWindow (XDISPLAY FRAME_X_WINDOW (f)); XFlushQueue (); 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->display.x->border_width) return; if (FRAME_X_WINDOW (f) != 0) error ("Cannot change the border width of a window"); f->display.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->display.x->internal_border_width; CHECK_NUMBER (arg, 0); f->display.x->internal_border_width = XINT (arg); if (f->display.x->internal_border_width < 0) f->display.x->internal_border_width = 0; if (f->display.x->internal_border_width == old) return; if (FRAME_X_WINDOW (f) != 0) { BLOCK_INPUT; x_set_window_size (f, f->width, f->height); #if 0 x_set_resize_hint (f); #endif XFlushQueue (); UNBLOCK_INPUT; SET_FRAME_GARBAGED (f); } } void x_set_visibility (f, value, oldval) struct frame *f; Lisp_Object value, oldval; { Lisp_Object frame; XSET (frame, Lisp_Frame, f); if (NILP (value)) Fmake_frame_invisible (frame); 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); XFASTINT (w->top) += n; 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 (XTYPE (value) == Lisp_Int) nlines = XINT (value); else nlines = 0; FRAME_MENU_BAR_LINES (f) = nlines; x_set_menu_bar_lines_1 (f->root_window, nlines - olines); } /* 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)) name = build_string (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; text.value = XSTRING (name)->data; text.encoding = XA_STRING; text.format = 8; text.nitems = XSTRING (name)->size; XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text); XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text); } #else XSetIconName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (name)->data); XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (name)->data); #endif 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_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, FRAME_WIDTH (f), FRAME_HEIGHT (f)); } } /* Subroutines of creating an X frame. */ #ifdef HAVE_X11 /* Make sure that Vx_resource_name is set to a reasonable value. */ static void validate_x_resource_name () { if (! STRINGP (Vx_resource_name)) Vx_resource_name = make_string ("emacs", 5); } extern char *x_get_string_resource (); extern XrmDatabase x_load_resources (); DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0, "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\ This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\ class, where INSTANCE is the name under which Emacs was invoked, or\n\ the name specified by the `-name' or `-rn' command-line arguments.\n\ \n\ The optional arguments COMPONENT and SUBCLASS add to the key and the\n\ class, respectively. You must specify both of them or neither.\n\ If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\ and the class is `Emacs.CLASS.SUBCLASS'.") (attribute, class, component, subclass) 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 (); if (NILP (component)) { /* Allocate space for the components, the dots which separate them, and the final '\0'. */ name_key = (char *) alloca (XSTRING (Vx_resource_name)->size + XSTRING (attribute)->size + 2); class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1) + XSTRING (class)->size + 2); sprintf (name_key, "%s.%s", XSTRING (Vx_resource_name)->data, XSTRING (attribute)->data); sprintf (class_key, "%s.%s", EMACS_CLASS, XSTRING (class)->data); } else { name_key = (char *) alloca (XSTRING (Vx_resource_name)->size + XSTRING (component)->size + XSTRING (attribute)->size + 3); class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1) + XSTRING (class)->size + XSTRING (subclass)->size + 3); sprintf (name_key, "%s.%s.%s", XSTRING (Vx_resource_name)->data, XSTRING (component)->data, XSTRING (attribute)->data); sprintf (class_key, "%s.%s.%s", EMACS_CLASS, XSTRING (class)->data, XSTRING (subclass)->data); } value = x_get_string_resource (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 (xrdb, name_key, class_key); } #else /* X10 */ DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0, "Get X default ATTRIBUTE from the system, or nil if no default.\n\ Value is a string (when not nil) and ATTRIBUTE is also a string.\n\ The defaults are specified in the file `~/.Xdefaults'.") (arg) Lisp_Object arg; { register unsigned char *value; CHECK_STRING (arg, 1); value = (unsigned char *) XGetDefault (XDISPLAY XSTRING (Vinvocation_name)->data, XSTRING (arg)->data); if (value == 0) /* Try reversing last two args, in case this is the buggy version of X. */ value = (unsigned char *) XGetDefault (XDISPLAY XSTRING (arg)->data, XSTRING (Vinvocation_name)->data); if (value != 0) return build_string (value); else return (Qnil); } #define Fx_get_resource(attribute, class, component, subclass) \ Fx_get_default(attribute) #endif /* X10 */ /* 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 = Fdowncase (tem); if (!strcmp (XSTRING (tem)->data, "on") || !strcmp (XSTRING (tem)->data, "true")) return Qt; else if (!strcmp (XSTRING (tem)->data, "off") || !strcmp (XSTRING (tem)->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) ... ).") (string) Lisp_Object string; { int geometry, x, y; unsigned int width, height; Lisp_Object values[4]; CHECK_STRING (string, 0); geometry = XParseGeometry ((char *) XSTRING (string)->data, &x, &y, &width, &height); switch (geometry & 0xf) /* Mask out {X,Y}Negative */ { case (XValue | YValue): /* What's one pixel among friends? Perhaps fix this some day by returning symbol `extreme-top'... */ if (x == 0 && (geometry & XNegative)) x = -1; if (y == 0 && (geometry & YNegative)) y = -1; values[0] = Fcons (Qleft, make_number (x)); values[1] = Fcons (Qtop, make_number (y)); return Flist (2, values); break; case (WidthValue | HeightValue): values[0] = Fcons (Qwidth, make_number (width)); values[1] = Fcons (Qheight, make_number (height)); return Flist (2, values); break; case (XValue | YValue | WidthValue | HeightValue): if (x == 0 && (geometry & XNegative)) x = -1; if (y == 0 && (geometry & YNegative)) y = -1; values[0] = Fcons (Qwidth, make_number (width)); values[1] = Fcons (Qheight, make_number (height)); values[2] = Fcons (Qleft, make_number (x)); values[3] = Fcons (Qtop, make_number (y)); return Flist (4, values); break; case 0: return Qnil; default: error ("Must specify x and y value, and/or width and height"); } } #ifdef HAVE_X11 /* Calculate the desired size and position of this window, or set rubber-band prompting if none. */ #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; 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->display.x->top_pos = 0; f->display.x->left_pos = 0; tem0 = x_get_arg (parms, Qheight, 0, 0, number); tem1 = x_get_arg (parms, Qwidth, 0, 0, number); if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound)) { CHECK_NUMBER (tem0, 0); CHECK_NUMBER (tem1, 0); f->height = XINT (tem0); f->width = XINT (tem1); window_prompting |= USSize; } else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) error ("Must specify *both* height and width"); f->display.x->vertical_scroll_bar_extra = (FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f) : 0); f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width); f->display.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); if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound)) { CHECK_NUMBER (tem0, 0); CHECK_NUMBER (tem1, 0); f->display.x->top_pos = XINT (tem0); f->display.x->left_pos = XINT (tem1); x_calc_absolute_position (f); window_prompting |= USPosition; } else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) error ("Must specify *both* top and left corners"); #if 0 /* PPosition and PSize mean "specified explicitly, by the program rather than by the user". So it is wrong to set them if nothing was specified. */ switch (window_prompting) { case USSize | USPosition: return window_prompting; break; case USSize: /* Got the size, need the position. */ window_prompting |= PPosition; return window_prompting; break; case USPosition: /* Got the position, need the size. */ window_prompting |= PSize; return window_prompting; break; case 0: /* Got nothing, take both from geometry. */ window_prompting |= PPosition | PSize; return window_prompting; break; default: /* Somehow a bit got set in window_prompting that we didn't put there. */ abort (); } #endif return window_prompting; } static void x_window (f) struct frame *f; { XSetWindowAttributes attributes; unsigned long attribute_mask; XClassHint class_hints; attributes.background_pixel = f->display.x->background_pixel; attributes.border_pixel = f->display.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 (x_current_display, ROOT_WINDOW, f->display.x->left_pos, f->display.x->top_pos, PIXEL_WIDTH (f), PIXEL_HEIGHT (f), f->display.x->border_width, CopyFromParent, /* depth */ InputOutput, /* class */ screen_visual, /* set in Fx_open_connection */ attribute_mask, &attributes); validate_x_resource_name (); class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data; class_hints.res_class = EMACS_CLASS; XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints); /* 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 (x_current_display, IronMaiden, &TheRack); */ f->display.x->wm_hints.input = True; f->display.x->wm_hints.flags |= InputHint; XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints); XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f), &Xatom_wm_delete_window, 1); /* 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 = f->name; int explicit = f->explicit_name; f->name = Qnil; f->explicit_name = 0; x_set_name (f, name, explicit); } XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), f->display.x->text_cursor); UNBLOCK_INPUT; if (FRAME_X_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 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)); 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->display.x->font->fid; gc_values.foreground = f->display.x->foreground_pixel; gc_values.background = f->display.x->background_pixel; gc_values.line_width = 0; /* Means 1 using fast algorithm. */ f->display.x->normal_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f), GCLineWidth | GCFont | GCForeground | GCBackground, &gc_values); /* Reverse video style. */ gc_values.foreground = f->display.x->background_pixel; gc_values.background = f->display.x->foreground_pixel; f->display.x->reverse_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f), GCFont | GCForeground | GCBackground | GCLineWidth, &gc_values); /* Cursor has cursor-color background, background-color foreground. */ gc_values.foreground = f->display.x->background_pixel; gc_values.background = f->display.x->cursor_pixel; gc_values.fill_style = FillOpaqueStippled; gc_values.stipple = XCreateBitmapFromData (x_current_display, ROOT_WINDOW, cursor_bits, 16, 16); f->display.x->cursor_gc = XCreateGC (x_current_display, 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->display.x->border_tile = (XCreatePixmapFromBitmapData (x_current_display, ROOT_WINDOW, gray_bits, gray_width, gray_height, f->display.x->foreground_pixel, f->display.x->background_pixel, DefaultDepth (x_current_display, XDefaultScreen (x_current_display)))); UNBLOCK_INPUT; } #endif /* HAVE_X11 */ 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\ Return an Emacs frame object representing the X window.\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.") (parms) Lisp_Object parms; { #ifdef HAVE_X11 struct frame *f; Lisp_Object frame, tem, tem0, tem1; Lisp_Object name; int minibuffer_only = 0; long window_prompting = 0; int width, height; check_x (); name = x_get_arg (parms, Qname, "title", "Title", string); if (XTYPE (name) != Lisp_String && ! EQ (name, Qunbound) && ! NILP (name)) error ("x-create-frame: name parameter must be a string"); tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol); if (EQ (tem, Qnone) || NILP (tem)) f = make_frame_without_minibuffer (Qnil); else if (EQ (tem, Qonly)) { f = make_minibuffer_frame (); minibuffer_only = 1; } else if (XTYPE (tem) == Lisp_Window) f = make_frame_without_minibuffer (tem); else f = make_frame (1); /* Note that X Windows does support scroll bars. */ FRAME_CAN_HAVE_SCROLL_BARS (f) = 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 (x_id_name); f->explicit_name = 0; } else { f->name = name; f->explicit_name = 1; } XSET (frame, Lisp_Frame, f); f->output_method = output_x_window; f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display)); bzero (f->display.x, sizeof (struct x_display)); /* Note that the frame has no physical cursor right now. */ f->phys_cursor_x = -1; /* 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-*-*-120-*-*-c-*-iso8859-1"); if (! STRINGP (font)) font = x_new_font (f, "-*-*-medium-r-normal-*-*-120-*-*-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-*-*-*-*-*-120-*-*-c-*-iso8859-1"); UNBLOCK_INPUT; if (! STRINGP (font)) font = build_string ("fixed"); 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 (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); f->display.x->parent_desc = ROOT_WINDOW; window_prompting = x_figure_window_size (f, parms); x_window (f); 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); x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0), "menuBarLines", "MenuBarLines", number); tem0 = x_get_arg (parms, Qtop, 0, 0, number); tem1 = x_get_arg (parms, Qleft, 0, 0, number); BLOCK_INPUT; x_wm_set_size_hint (f, window_prompting, XINT (tem0), XINT (tem1)); UNBLOCK_INPUT; tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean); f->no_split = minibuffer_only || EQ (tem, Qt); /* Make the window appear on the frame and enable display, unless the caller says not to. */ { Lisp_Object 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 frame; #else /* X10 */ struct frame *f; Lisp_Object frame, tem; Lisp_Object name; int pixelwidth, pixelheight; Cursor cursor; int height, width; Window parent; Pixmap temp; int minibuffer_only = 0; Lisp_Object vscroll, hscroll; if (x_current_display == 0) error ("X windows are not in use or not initialized"); name = Fassq (Qname, parms); tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol); if (EQ (tem, Qnone)) f = make_frame_without_minibuffer (Qnil); else if (EQ (tem, Qonly)) { f = make_minibuffer_frame (); minibuffer_only = 1; } else if (EQ (tem, Qnil) || EQ (tem, Qunbound)) f = make_frame (1); else f = make_frame_without_minibuffer (tem); parent = ROOT_WINDOW; XSET (frame, Lisp_Frame, f); f->output_method = output_x_window; f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display)); bzero (f->display.x, sizeof (struct x_display)); /* Some temporary default values for height and width. */ width = 80; height = 40; f->display.x->left_pos = -1; f->display.x->top_pos = -1; /* Give the frame a default name (which may be overridden with PARMS). */ strncpy (iconidentity, ICONTAG, MAXICID); if (gethostname (&iconidentity[sizeof (ICONTAG) - 1], (MAXICID - 1) - sizeof (ICONTAG))) iconidentity[sizeof (ICONTAG) - 2] = '\0'; f->name = build_string (iconidentity); /* Extract some window parameters from the supplied values. These are the parameters that affect window geometry. */ tem = x_get_arg (parms, Qfont, "BodyFont", 0, string); if (EQ (tem, Qunbound)) tem = build_string ("9x15"); x_set_font (f, tem, Qnil); x_default_parameter (f, parms, Qborder_color, build_string ("black"), "Border", 0, string); x_default_parameter (f, parms, Qbackground_color, build_string ("white"), "Background", 0, string); x_default_parameter (f, parms, Qforeground_color, build_string ("black"), "Foreground", 0, string); x_default_parameter (f, parms, Qmouse_color, build_string ("black"), "Mouse", 0, string); x_default_parameter (f, parms, Qcursor_color, build_string ("black"), "Cursor", 0, string); x_default_parameter (f, parms, Qborder_width, make_number (2), "BorderWidth", 0, number); x_default_parameter (f, parms, Qinternal_border_width, make_number (4), "InternalBorderWidth", 0, number); x_default_parameter (f, parms, Qauto_raise, Qnil, "AutoRaise", 0, boolean); hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt); vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt); if (f->display.x->internal_border_width < 0) f->display.x->internal_border_width = 0; tem = x_get_arg (parms, Qwindow_id, 0, 0, number); if (!EQ (tem, Qunbound)) { WINDOWINFO_TYPE wininfo; int nchildren; Window *children, root; CHECK_NUMBER (tem, 0); FRAME_X_WINDOW (f) = (Window) XINT (tem); BLOCK_INPUT; XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo); XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children); xfree (children); UNBLOCK_INPUT; height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height); width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width); f->display.x->left_pos = wininfo.x; f->display.x->top_pos = wininfo.y; FRAME_SET_VISIBILITY (f, wininfo.mapped != 0); f->display.x->border_width = wininfo.bdrwidth; f->display.x->parent_desc = parent; } else { tem = x_get_arg (parms, Qparent_id, 0, 0, number); if (!EQ (tem, Qunbound)) { CHECK_NUMBER (tem, 0); parent = (Window) XINT (tem); } f->display.x->parent_desc = parent; tem = x_get_arg (parms, Qheight, 0, 0, number); if (EQ (tem, Qunbound)) { tem = x_get_arg (parms, Qwidth, 0, 0, number); if (EQ (tem, Qunbound)) { tem = x_get_arg (parms, Qtop, 0, 0, number); if (EQ (tem, Qunbound)) tem = x_get_arg (parms, Qleft, 0, 0, number); } } /* Now TEM is Qunbound if no edge or size was specified. In that case, we must do rubber-banding. */ if (EQ (tem, Qunbound)) { tem = x_get_arg (parms, Qgeometry, 0, 0, number); x_rubber_band (f, &f->display.x->left_pos, &f->display.x->top_pos, &width, &height, (XTYPE (tem) == Lisp_String ? (char *) XSTRING (tem)->data : ""), XSTRING (f->name)->data, !NILP (hscroll), !NILP (vscroll)); } else { /* Here if at least one edge or size was specified. Demand that they all were specified, and use them. */ tem = x_get_arg (parms, Qheight, 0, 0, number); if (EQ (tem, Qunbound)) error ("Height not specified"); CHECK_NUMBER (tem, 0); height = XINT (tem); tem = x_get_arg (parms, Qwidth, 0, 0, number); if (EQ (tem, Qunbound)) error ("Width not specified"); CHECK_NUMBER (tem, 0); width = XINT (tem); tem = x_get_arg (parms, Qtop, 0, 0, number); if (EQ (tem, Qunbound)) error ("Top position not specified"); CHECK_NUMBER (tem, 0); f->display.x->left_pos = XINT (tem); tem = x_get_arg (parms, Qleft, 0, 0, number); if (EQ (tem, Qunbound)) error ("Left position not specified"); CHECK_NUMBER (tem, 0); f->display.x->top_pos = XINT (tem); } pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width); pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height); BLOCK_INPUT; FRAME_X_WINDOW (f) = XCreateWindow (parent, f->display.x->left_pos, /* Absolute horizontal offset */ f->display.x->top_pos, /* Absolute Vertical offset */ pixelwidth, pixelheight, f->display.x->border_width, BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT); UNBLOCK_INPUT; if (FRAME_X_WINDOW (f) == 0) error ("Unable to create window."); } /* Install the now determined height and width in the windows and in phys_lines and desired_lines. */ change_frame_size (f, height, width, 1, 0); XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy | EnterWindow | LeaveWindow | UnmapWindow ); x_set_resize_hint (f); /* Tell the server the window's default name. */ XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data); /* Now override the defaults with all the rest of the specified parms. */ tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean); f->no_split = minibuffer_only || EQ (tem, Qt); /* Do not create an icon window if the caller says not to */ if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt) || f->display.x->parent_desc != ROOT_WINDOW) { x_text_icon (f, iconidentity); x_default_parameter (f, parms, Qicon_type, Qnil, "BitmapIcon", 0, symbol); } /* Tell the X server the previously set values of the background, border and mouse colors; also create the mouse cursor. */ BLOCK_INPUT; temp = XMakeTile (f->display.x->background_pixel); XChangeBackground (FRAME_X_WINDOW (f), temp); XFreePixmap (temp); UNBLOCK_INPUT; x_set_border_pixel (f, f->display.x->border_pixel); x_set_mouse_color (f, Qnil, Qnil); /* Now override the defaults with all the rest of the specified parms. */ Fmodify_frame_parameters (frame, parms); /* Make the window appear on the frame and enable display. */ { Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol); if (EQ (visibility, Qunbound)) visibility = Qt; if (! EQ (visibility, Qicon) && ! NILP (visibility)) x_make_window_visible (f); } SET_FRAME_GARBAGED (f); return frame; #endif /* X10 */ } 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_X_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 (x_focus_frame) { BLOCK_INPUT; x_unfocus_frame (x_focus_frame); UNBLOCK_INPUT; } return Qnil; } #ifndef HAVE_X11 /* Computes an X-window size and position either from geometry GEO or with the mouse. F is a frame. It specifies an X window which is used to determine which display to compute for. Its font, borders and colors control how the rectangle will be displayed. X and Y are where to store the positions chosen. WIDTH and HEIGHT are where to store the sizes chosen. GEO is the geometry that may specify some of the info. STR is a prompt to display. HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */ int x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll) struct frame *f; int *x, *y, *width, *height; char *geo; char *str; int hscroll, vscroll; { OpaqueFrame frame; Window tempwindow; WindowInfo wininfo; int border_color; int background_color; Lisp_Object tem; int mask; BLOCK_INPUT; background_color = f->display.x->background_pixel; border_color = f->display.x->border_pixel; frame.bdrwidth = f->display.x->border_width; frame.border = XMakeTile (border_color); frame.background = XMakeTile (background_color); tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5, (2 * f->display.x->internal_border_width + (vscroll ? VSCROLL_WIDTH : 0)), (2 * f->display.x->internal_border_width + (hscroll ? HSCROLL_HEIGHT : 0)), width, height, f->display.x->font, FONT_WIDTH (f->display.x->font), FONT_HEIGHT (f->display.x->font)); XFreePixmap (frame.border); XFreePixmap (frame.background); if (tempwindow != 0) { XQueryWindow (tempwindow, &wininfo); XDestroyWindow (tempwindow); *x = wininfo.x; *y = wininfo.y; } /* Coordinates we got are relative to the root window. Convert them to coordinates relative to desired parent window by scanning from there up to the root. */ tempwindow = f->display.x->parent_desc; while (tempwindow != ROOT_WINDOW) { int nchildren; Window *children; XQueryWindow (tempwindow, &wininfo); *x -= wininfo.x; *y -= wininfo.y; XQueryTree (tempwindow, &tempwindow, &nchildren, &children); xfree (children); } UNBLOCK_INPUT; return tempwindow != 0; } #endif /* not HAVE_X11 */ 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\ The list does not include fonts Emacs can't use (i.e. proportional\n\ fonts), 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 list; CHECK_STRING (pattern, 0); if (!NILP (face)) CHECK_SYMBOL (face, 1); if (!NILP (frame)) CHECK_LIVE_FRAME (frame, 2); if (NILP (face)) size_ref = 0; else { FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame); int 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->display.x->font; else { size_ref = FRAME_PARAM_FACES (f) [face_id]->font; if (size_ref == (XFontStruct *) (~0)) size_ref = f->display.x->font; } } BLOCK_INPUT; names = XListFontsWithInfo (x_current_display, XSTRING (pattern)->data, 2000, /* maxnames */ &num_fonts, /* count_return */ &info); /* info_return */ UNBLOCK_INPUT; list = Qnil; if (names) { Lisp_Object *tail; int i; tail = &list; for (i = 0; i < num_fonts; i++) if (! size_ref || same_size_fonts (&info[i], size_ref)) { *tail = Fcons (build_string (names[i]), Qnil); tail = &XCONS (*tail)->cdr; } XFreeFontInfo (names, info, num_fonts); } return list; } DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0, "Return t if the current X display supports the color named COLOR.") (color) Lisp_Object color; { Color foo; check_x (); CHECK_STRING (color, 0); if (defined_color (XSTRING (color)->data, &foo)) return Qt; else return Qnil; } DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0, "Return t if the X screen currently in use supports color.") () { check_x (); if (x_screen_planes <= 2) return Qnil; switch (screen_visual->class) { case StaticColor: case PseudoColor: case TrueColor: case DirectColor: 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 display FRAME is on.") (frame) Lisp_Object frame; { Display *dpy = x_current_display; check_x (); return make_number (DisplayWidth (dpy, DefaultScreen (dpy))); } DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, 0, 1, 0, "Returns the height in pixels of the display FRAME is on.") (frame) Lisp_Object frame; { Display *dpy = x_current_display; check_x (); return make_number (DisplayHeight (dpy, DefaultScreen (dpy))); } DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, 0, 1, 0, "Returns the number of bitplanes of the display FRAME is on.") (frame) Lisp_Object frame; { Display *dpy = x_current_display; check_x (); return make_number (DisplayPlanes (dpy, DefaultScreen (dpy))); } 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 FRAME is on.") (frame) Lisp_Object frame; { Display *dpy = x_current_display; check_x (); return make_number (DisplayCells (dpy, DefaultScreen (dpy))); } 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 FRAME is using.") (frame) Lisp_Object frame; { Display *dpy = x_current_display; check_x (); return make_number (MAXREQUEST (dpy)); } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, "Returns the vendor ID string of the X server FRAME is on.") (frame) Lisp_Object frame; { Display *dpy = x_current_display; char *vendor; check_x (); vendor = ServerVendor (dpy); 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 in use.\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 variable `x-server-vendor'.") (frame) Lisp_Object frame; { Display *dpy = x_current_display; check_x (); 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 FRAME is on.") (frame) Lisp_Object frame; { check_x (); return make_number (ScreenCount (x_current_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 screen FRAME is on.") (frame) Lisp_Object frame; { check_x (); return make_number (HeightMMOfScreen (x_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 screen FRAME is on.") (frame) Lisp_Object frame; { check_x (); return make_number (WidthMMOfScreen (x_screen)); } DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, 0, 1, 0, "Returns an indication of whether the X screen FRAME is on does backing store.\n\ The value may be `always', `when-mapped', or `not-useful'.") (frame) Lisp_Object frame; { check_x (); switch (DoesBackingStore (x_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 display `screen' is on.\n\ The value is one of the symbols `static-gray', `gray-scale',\n\ `static-color', `pseudo-color', `true-color', or `direct-color'.") (screen) Lisp_Object screen; { check_x (); switch (screen_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 screen FRAME is on supports the save-under feature.") (frame) Lisp_Object frame; { check_x (); if (DoesSaveUnders (x_screen) == True) return Qt; else return Qnil; } x_pixel_width (f) register struct frame *f; { return PIXEL_WIDTH (f); } x_pixel_height (f) register struct frame *f; { return PIXEL_HEIGHT (f); } x_char_width (f) register struct frame *f; { return FONT_WIDTH (f->display.x->font); } x_char_height (f) register struct frame *f; { return FONT_HEIGHT (f->display.x->font); } #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->display.x->font) + f->display.x->internal_border_width); int top = (top_char * FONT_HEIGHT (f->display.x->font) + f->display.x->internal_border_width); if (chars < 0) width = FONT_WIDTH (f->display.x->font) / 2; else width = FONT_WIDTH (f->display.x->font) * chars; if (lines < 0) height = FONT_HEIGHT (f->display.x->font) / 2; else height = FONT_HEIGHT (f->display.x->font) * lines; XDrawRectangle (x_current_display, 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)->display.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_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)->display.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->display.x->internal_border_width; register int font_w = FONT_WIDTH (f->display.x->font); register int font_h = FONT_HEIGHT (f->display.x->font); 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 (x_current_display, 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->display.x->cursor_gc, x0, y0, x1, y1); else if (y1 < y0) /* point above mouse */ outline_region (f, f->display.x->cursor_gc, x1, y1, x0, y0); else /* same line: draw horizontal rectangle */ { if (x1 > x0) x_rectangle (f, f->display.x->cursor_gc, x0, y0, (x1 - x0 + 1), 1); else if (x1 < x0) x_rectangle (f, f->display.x->cursor_gc, x1, y1, (x0 - x1 + 1), 1); } XFlush (x_current_display); 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->display.x->reverse_gc, x0, y0, x1, y1); else if (y1 < y0) /* point above mouse */ outline_region (f, f->display.x->reverse_gc, x1, y1, x0, y0); else /* same line: draw horizontal rectangle */ { if (x1 > x0) x_rectangle (f, f->display.x->reverse_gc, x0, y0, (x1 - x0 + 1), 1); else if (x1 < x0) x_rectangle (f, f->display.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->display.x->cursor_gc, point_x, point_y, x_contour_x, x_contour_y); } else { mouse_below_point = 0; outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y, point_x, point_y); } while (1) { obj = read_char (-1, 0, 0, Qnil, 0); if (XTYPE (obj) != Lisp_Cons) break; if (mouse_below_point) { if (x_mouse_y <= point_y) /* Flipped. */ { mouse_below_point = 0; outline_region (f, f->display.x->reverse_gc, point_x, point_y, x_contour_x, x_contour_y); outline_region (f, f->display.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->display.x->reverse_gc, x_contour_x, x_contour_y, point_x, point_y); outline_region (f, f->display.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->display.x->cursor_gc; register GC erase_gc = f->display.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) * FONT_HEIGHT (f->display.x->font) + f->display.x->internal_border_width; register int left = f->display.x->internal_border_width + (w->left * FONT_WIDTH (f->display.x->font)); register int right = left + (w->width * FONT_WIDTH (f->display.x->font)) - f->display.x->internal_border_width; #if 0 BLOCK_INPUT; gc_values.foreground = f->display.x->cursor_pixel; gc_values.background = f->display.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 (x_current_display, FRAME_X_WINDOW (f), GCLineStyle | GCJoinStyle | GCCapStyle | GCLineWidth | GCForeground | GCBackground, &gc_values); XSetDashes (x_current_display, line_gc, 0, dash_list, dashes); gc_values.foreground = f->display.x->background_pixel; gc_values.background = f->display.x->foreground_pixel; erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f), GCLineStyle | GCJoinStyle | GCCapStyle | GCLineWidth | GCForeground | GCBackground, &gc_values); XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes); #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) * FONT_HEIGHT (f->display.x->font) + f->display.x->internal_border_width; XDrawLine (x_current_display, FRAME_X_WINDOW (f), line_gc, left, line, right, line); } XFlushQueue (); UNBLOCK_INPUT; do { obj = read_char (-1, 0, 0, Qnil, 0); if ((XTYPE (obj) != Lisp_Cons) || (! EQ (Fcar (Fcdr (Fcdr (obj))), Qvertical_scroll_bar)) || x_mouse_grabbed) { BLOCK_INPUT; XDrawLine (x_current_display, FRAME_X_WINDOW (f), erase_gc, left, line, right, line); UNBLOCK_INPUT; unread_command_event = obj; #if 0 XFreeGC (x_current_display, line_gc); XFreeGC (x_current_display, erase_gc); #endif return Qnil; } } while (x_mouse_y == previous_y); BLOCK_INPUT; XDrawLine (x_current_display, FRAME_X_WINDOW (f), erase_gc, left, line, right, line); UNBLOCK_INPUT; } } #endif /* Offset in buffer of character under the pointer, or 0. */ int mouse_buffer_offset; #if 0 /* These keep track of the rectangle following the pointer. */ int mouse_track_top, mouse_track_left, mouse_track_width; 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->display.x->nontext_cursor)) { unsigned char c; struct buffer *buf; current_pointer_shape = f->display.x->nontext_cursor; XDefineCursor (x_current_display, 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->display.x->modeline_cursor)) { current_pointer_shape = f->display.x->modeline_cursor; XDefineCursor (x_current_display, FRAME_X_WINDOW (f), current_pointer_shape); } XFlushQueue (); 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->display.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 (x_current_display, FRAME_X_WINDOW (f), f->display.x->text_cursor); x_rectangle (f, f->display.x->cursor_gc, mouse_track_left, mouse_track_top, mouse_track_width, 1); } else if (in_mode_line) XDefineCursor (x_current_display, FRAME_X_WINDOW (f), f->display.x->modeline_cursor); else XDefineCursor (x_current_display, FRAME_X_WINDOW (f), f->display.x->nontext_cursor); } XFlush (x_current_display); UNBLOCK_INPUT; obj = read_char (-1, 0, 0, Qnil, 0); BLOCK_INPUT; } while (XTYPE (obj) == Lisp_Cons /* 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->display.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 (x_current_display, FRAME_X_WINDOW (f), f->display.x->nontext_cursor); XFlush (x_current_display); 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 (x_current_display, FRAME_X_WINDOW (f), image_data, width, height); XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f), f->display.x->normal_gc, 0, 0, width, height, x, y); } #endif #ifndef HAVE_X11 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer, 1, 1, "sStore text in cut buffer: ", "Store contents of STRING into the cut buffer of the X window system.") (string) register Lisp_Object string; { int mask; CHECK_STRING (string, 1); if (! FRAME_X_P (selected_frame)) error ("Selected frame does not understand X protocol."); BLOCK_INPUT; XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size); UNBLOCK_INPUT; return Qnil; } DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0, "Return contents of cut buffer of the X window system, as a string.") () { int len; register Lisp_Object string; int mask; register char *d; BLOCK_INPUT; d = XFetchBytes (&len); string = make_string (d, len); XFree (d); UNBLOCK_INPUT; return string; } #endif /* X10 */ #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 */ #ifdef HAVE_X11 #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 (screen, depth) 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 (x_current_display, 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; } #endif /* HAVE_X11 */ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 2, 0, "Open a connection to an X server.\n\ DISPLAY is the name of the display to connect to.\n\ Optional second arg XRM_STRING is a string of resources in xrdb format.") (display, xrm_string) Lisp_Object display, xrm_string; { unsigned int n_planes; unsigned char *xrm_option; CHECK_STRING (display, 0); if (x_current_display != 0) error ("X server connection is already initialized"); if (! NILP (xrm_string)) CHECK_STRING (xrm_string, 1); /* This is what opens the connection and sets x_current_display. This also initializes many symbols, such as those used for input. */ x_term_init (XSTRING (display)->data); #ifdef HAVE_X11 XFASTINT (Vwindow_system_version) = 11; if (! NILP (xrm_string)) xrm_option = (unsigned char *) XSTRING (xrm_string)->data; else xrm_option = (unsigned char *) 0; validate_x_resource_name (); BLOCK_INPUT; xrdb = x_load_resources (x_current_display, xrm_option, (char *) XSTRING (Vx_resource_name)->data, EMACS_CLASS); UNBLOCK_INPUT; #ifdef HAVE_XRMSETDATABASE XrmSetDatabase (x_current_display, xrdb); #else x_current_display->db = xrdb; #endif x_screen = DefaultScreenOfDisplay (x_current_display); screen_visual = select_visual (x_screen, &n_planes); x_screen_planes = n_planes; x_screen_height = HeightOfScreen (x_screen); x_screen_width = WidthOfScreen (x_screen); /* X Atoms used by emacs. */ Xatoms_of_xselect (); BLOCK_INPUT; Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS", False); Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS", False); Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF", False); Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW", False); Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE", False); Xatom_wm_configure_denied = XInternAtom (x_current_display, "WM_CONFIGURE_DENIED", False); Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED", False); UNBLOCK_INPUT; #else /* not HAVE_X11 */ XFASTINT (Vwindow_system_version) = 10; #endif /* not HAVE_X11 */ return Qnil; } DEFUN ("x-close-current-connection", Fx_close_current_connection, Sx_close_current_connection, 0, 0, 0, "Close the connection to the current X server.") () { #ifdef HAVE_X11 /* This is ONLY used when killing emacs; For switching displays we'll have to take care of setting CloseDownMode elsewhere. */ if (x_current_display) { BLOCK_INPUT; XSetCloseDownMode (x_current_display, DestroyAll); XCloseDisplay (x_current_display); x_current_display = 0; } else fatal ("No current X display connection to close\n"); #endif return Qnil; } DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 1, 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.") (on) Lisp_Object on; { check_x (); XSynchronize (x_current_display, !EQ (on, Qnil)); return Qnil; } syms_of_xfns () { /* This is zero if not using X windows. */ x_current_display = 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); 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); 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); /* 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_INT ("mouse-buffer-offset", &mouse_buffer_offset, "The buffer offset of the character under the pointer."); mouse_buffer_offset = 0; 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 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape, "The shape of the pointer when not over text."); #endif Vx_nontext_pointer_shape = Qnil; #if 0 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape, "The shape of the pointer when over the mode line."); #endif Vx_mode_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 ("mouse-grabbed", &Vmouse_depressed, "Non-nil if a mouse button is currently depressed."); Vmouse_depressed = Qnil; DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager, "t if no X window manager is in use."); #ifdef HAVE_X11 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_display_color_p); defsubr (&Sx_list_fonts); defsubr (&Sx_color_defined_p); 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 #else defsubr (&Sx_get_default); defsubr (&Sx_store_cut_buffer); defsubr (&Sx_get_cut_buffer); #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_current_connection); defsubr (&Sx_synchronize); } #endif /* HAVE_X_WINDOWS */ emacs-19.22/src/xmenu.c100444 12241 12 57515 5444474655 13612 0ustar rolandstaff/* X Communication module for terminals which understand the X protocol. Copyright (C) 1986, 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. */ /* X pop-up deck-of-cards menu facility for gnuemacs. * * Written by Jon Arnold and Roman Budzianowski * Mods and rewrite by Robert Krawitz * */ #ifdef XDEBUG #include #endif /* On 4.3 this loses if it comes after xterm.h. */ #include #include #include "lisp.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 "xterm.h" /* 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_X11 #include "../oldXMenu/XMenu.h" #else #include #endif #define min(x,y) (((x) < (y)) ? (x) : (y)) #define max(x,y) (((x) > (y)) ? (x) : (y)) #define NUL 0 #ifndef TRUE #define TRUE 1 #define FALSE 0 #endif /* TRUE */ #ifdef HAVE_X11 extern Display *x_current_display; #else #define ButtonReleaseMask ButtonReleased #endif /* not HAVE_X11 */ extern Lisp_Object Qmenu_enable; Lisp_Object xmenu_show (); extern int x_error_handler (); /*************************************************************/ #if 0 /* Ignoring the args is easiest. */ xmenu_quit () { error ("Unknown XMenu error"); } #endif DEFUN ("x-popup-menu",Fx_popup_menu, Sx_popup_menu, 1, 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 characters 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\ \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.") (position, menu) Lisp_Object position, menu; { int number_of_panes; Lisp_Object XMenu_return, keymap, tem; int XMenu_xpos, XMenu_ypos; char **menus; char ***names; int **enables; Lisp_Object **obj_list; Lisp_Object *prefixes; int *items; char *title; char *error_name; Lisp_Object ltitle, selection; int i, j; FRAME_PTR f; Lisp_Object x, y, window; /* Decode the first argument: find the window and the coordinates. */ tem = Fcar (position); if (XTYPE (tem) == Lisp_Cons) { 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); } CHECK_NUMBER (x, 0); CHECK_NUMBER (y, 0); if (XTYPE (window) == Lisp_Frame) { f = XFRAME (window); XMenu_xpos = 0; XMenu_ypos = 0; } else if (XTYPE (window) == Lisp_Window) { CHECK_LIVE_WINDOW (window, 0); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); XMenu_xpos = FONT_WIDTH (f->display.x->font) * XWINDOW (window)->left; XMenu_ypos = FONT_HEIGHT (f->display.x->font) * 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); #ifdef HAVE_X11 { 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->display.x->parent_desc != ROOT_WINDOW) { BLOCK_INPUT; XTranslateCoordinates (x_current_display, /* From-window, to-window. */ f->display.x->window_desc, f->display.x->parent_desc, /* From-position, to-position. */ 0, 0, &win_x, &win_y, /* Child of window. */ &child); UNBLOCK_INPUT; XMenu_xpos += win_x; XMenu_ypos += win_y; } } #endif XMenu_xpos += FONT_WIDTH (f->display.x->font) * XINT (x); XMenu_ypos += FONT_HEIGHT (f->display.x->font) * XINT (y); XMenu_xpos += f->display.x->left_pos; XMenu_ypos += f->display.x->top_pos; 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); /* Search for a string appearing directly as an element of the keymap. That string is the title of the menu. */ prompt = map_prompt (keymap); if (!NILP (prompt)) title = (char *) XSTRING (prompt)->data; /* Extract the detailed info to make one pane. */ number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, &items, &prefixes, &menu, 1); /* The menu title seems to be ignored, so put it in the pane title. */ if (menus[0] == 0) menus[0] = title; } else if (!NILP (tem)) { /* We were given a list of keymaps. */ Lisp_Object prompt; int nmaps = XFASTINT (Flength (menu)); Lisp_Object *maps = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); int i; title = 0; /* The first keymap that has a prompt string supplies the menu title. */ for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) { maps[i++] = keymap = get_keymap (Fcar (tem)); prompt = map_prompt (keymap); if (title == 0 && !NILP (prompt)) title = (char *) XSTRING (prompt)->data; } /* Extract the detailed info to make one pane. */ number_of_panes = keymap_panes (&obj_list, &menus, &names, &enables, &items, &prefixes, maps, nmaps); /* The menu title seems to be ignored, so put it in the pane title. */ if (menus[0] == 0) menus[0] = title; } else { /* We were given an old-fashioned menu. */ ltitle = Fcar (menu); CHECK_STRING (ltitle, 1); title = (char *) XSTRING (ltitle)->data; prefixes = 0; number_of_panes = list_of_panes (&obj_list, &menus, &names, &enables, &items, Fcdr (menu)); } #ifdef XDEBUG fprintf (stderr, "Panes = %d\n", number_of_panes); for (i = 0; i < number_of_panes; i++) { fprintf (stderr, "Pane %d has lines %d title %s\n", i, items[i], menus[i]); for (j = 0; j < items[i]; j++) fprintf (stderr, " Item %d %s\n", j, names[i][j]); } #endif BLOCK_INPUT; { Window root; int root_x, root_y; int dummy_int; unsigned int dummy_uint; Window dummy_window; /* Figure out which root window F is on. */ XGetGeometry (x_current_display, FRAME_X_WINDOW (f), &root, &dummy_int, &dummy_int, &dummy_uint, &dummy_uint, &dummy_uint, &dummy_uint); /* Translate the menu co-ordinates within f to menu co-ordinates on that root window. */ if (! XTranslateCoordinates (x_current_display, FRAME_X_WINDOW (f), root, XMenu_xpos, XMenu_ypos, &root_x, &root_y, &dummy_window)) /* But XGetGeometry said root was the root window of f's screen! */ abort (); selection = xmenu_show (root, XMenu_xpos, XMenu_ypos, names, enables, menus, prefixes, items, number_of_panes, obj_list, title, &error_name); } UNBLOCK_INPUT; /* fprintf (stderr, "selection = %x\n", selection); */ if (selection != NUL) { /* selected something */ XMenu_return = selection; } else { /* nothing selected */ XMenu_return = Qnil; } /* now free up the strings */ for (i = 0; i < number_of_panes; i++) { xfree (names[i]); xfree (enables[i]); xfree (obj_list[i]); } xfree (menus); xfree (obj_list); xfree (names); xfree (enables); xfree (items); /* free (title); */ if (error_name) error (error_name); return XMenu_return; } struct indices { int pane; int line; }; Lisp_Object xmenu_show (parent, startx, starty, line_list, enable_list, pane_list, prefixes, line_cnt, pane_cnt, item_list, title, error) Window parent; int startx, starty; /* upper left corner position BROKEN */ char **line_list[]; /* list of strings for items */ int *enable_list[]; /* list of strings for items */ char *pane_list[]; /* list of pane titles */ Lisp_Object *prefixes; /* Prefix key for each pane */ char *title; int pane_cnt; /* total number of panes */ Lisp_Object *item_list[]; /* All items */ int line_cnt[]; /* Lines in each pane */ char **error; /* Error returned */ { XMenu *GXMenu; int last, panes, selidx, lpane, status; int lines, sofar; Lisp_Object entry; /* struct indices *datap, *datap_save; */ char *datap; int ulx, uly, width, height; int dispwidth, dispheight; *error = 0; if (pane_cnt == 0) return 0; BLOCK_INPUT; *error = (char *) 0; /* Initialize error pointer to null */ GXMenu = XMenuCreate (XDISPLAY parent, "emacs"); if (GXMenu == NUL) { *error = "Can't create menu"; UNBLOCK_INPUT; return (0); } for (panes = 0, lines = 0; panes < pane_cnt; lines += line_cnt[panes], panes++) ; /* datap = (struct indices *) xmalloc (lines * sizeof (struct indices)); */ /* datap = (char *) xmalloc (lines * sizeof (char)); datap_save = datap;*/ for (panes = 0, sofar = 0; panes < pane_cnt; sofar += line_cnt[panes], panes++) { /* create all the necessary panes */ lpane = XMenuAddPane (XDISPLAY GXMenu, pane_list[panes], TRUE); if (lpane == XM_FAILURE) { XMenuDestroy (XDISPLAY GXMenu); *error = "Can't create pane"; UNBLOCK_INPUT; return (0); } for (selidx = 0; selidx < line_cnt[panes]; selidx++) { /* add the selection stuff to the menus */ /* datap[selidx+sofar].pane = panes; datap[selidx+sofar].line = selidx; */ if (XMenuAddSelection (XDISPLAY GXMenu, lpane, 0, line_list[panes][selidx], enable_list[panes][selidx]) == XM_FAILURE) { XMenuDestroy (XDISPLAY GXMenu); /* free (datap); */ *error = "Can't add selection to menu"; /* error ("Can't add selection to menu"); */ UNBLOCK_INPUT; return (0); } } } /* all set and ready to fly */ XMenuRecompute (XDISPLAY GXMenu); dispwidth = DisplayWidth (x_current_display, XDefaultScreen (x_current_display)); dispheight = DisplayHeight (x_current_display, XDefaultScreen (x_current_display)); startx = min (startx, dispwidth); starty = min (starty, dispheight); startx = max (startx, 1); starty = max (starty, 1); XMenuLocate (XDISPLAY GXMenu, 0, 0, startx, starty, &ulx, &uly, &width, &height); if (ulx+width > dispwidth) { startx -= (ulx + width) - dispwidth; ulx = dispwidth - width; } if (uly+height > dispheight) { starty -= (uly + height) - dispheight; uly = dispheight - height; } if (ulx < 0) startx -= ulx; if (uly < 0) starty -= uly; XMenuSetFreeze (GXMenu, TRUE); panes = selidx = 0; status = XMenuActivate (XDISPLAY GXMenu, &panes, &selidx, startx, starty, ButtonReleaseMask, &datap); switch (status) { case XM_SUCCESS: #ifdef XDEBUG fprintf (stderr, "pane= %d line = %d\n", panes, selidx); #endif entry = item_list[panes][selidx]; if (prefixes != 0) { entry = Fcons (entry, Qnil); if (!NILP (prefixes[panes])) entry = Fcons (prefixes[panes], entry); } break; case XM_FAILURE: /* free (datap_save); */ XMenuDestroy (XDISPLAY GXMenu); *error = "Can't activate menu"; /* error ("Can't activate menu"); */ case XM_IA_SELECT: case XM_NO_SELECT: entry = Qnil; break; } XMenuDestroy (XDISPLAY GXMenu); UNBLOCK_INPUT; /* free (datap_save);*/ return (entry); } syms_of_xmenu () { defsubr (&Sx_popup_menu); } /* Construct the vectors that describe a menu and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. Each of those four values is a vector indexed by pane number. Return the number of panes. KEYMAPS is a vector of keymaps. NMAPS gives the length of KEYMAPS. */ int keymap_panes (vector, panes, names, enables, items, prefixes, keymaps, nmaps) Lisp_Object ***vector; /* RETURN all menu objects */ char ***panes; /* RETURN pane names */ char ****names; /* RETURN all line names */ int ***enables; /* RETURN enable-flags of lines */ int **items; /* RETURN number of items per pane */ Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ Lisp_Object *keymaps; int nmaps; { /* Number of panes we have made. */ int p = 0; /* Number of panes we have space for. */ int npanes_allocated = nmaps; int mapno; if (npanes_allocated < 4) npanes_allocated = 4; /* Make space for an estimated number of panes. */ *vector = (Lisp_Object **) xmalloc (npanes_allocated * sizeof (Lisp_Object *)); *panes = (char **) xmalloc (npanes_allocated * sizeof (char *)); *items = (int *) xmalloc (npanes_allocated * sizeof (int)); *names = (char ***) xmalloc (npanes_allocated * sizeof (char **)); *enables = (int **) xmalloc (npanes_allocated * sizeof (int *)); *prefixes = (Lisp_Object *) xmalloc (npanes_allocated * sizeof (Lisp_Object)); /* 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], panes, vector, names, enables, items, prefixes, &p, &npanes_allocated, ""); /* Return the number of panes. */ return p; } /* This is a recursive subroutine of the previous function. It handles one keymap, KEYMAP. The other arguments are passed along or point to local variables of the previous function. */ single_keymap_panes (keymap, panes, vector, names, enables, items, prefixes, p_ptr, npanes_allocated_ptr, pane_name) Lisp_Object keymap; Lisp_Object ***vector; /* RETURN all menu objects */ char ***panes; /* RETURN pane names */ char ****names; /* RETURN all line names */ int ***enables; /* RETURN enable flags of lines */ int **items; /* RETURN number of items per pane */ Lisp_Object **prefixes; /* RETURN vector of prefix keys, per pane */ int *p_ptr; int *npanes_allocated_ptr; char *pane_name; { int i; Lisp_Object pending_maps; Lisp_Object tail, item, item1, item2, table; pending_maps = Qnil; /* Make sure we have room for another pane. */ if (*p_ptr == *npanes_allocated_ptr) { *npanes_allocated_ptr *= 2; *vector = (Lisp_Object **) xrealloc (*vector, *npanes_allocated_ptr * sizeof (Lisp_Object *)); *panes = (char **) xrealloc (*panes, *npanes_allocated_ptr * sizeof (char *)); *items = (int *) xrealloc (*items, *npanes_allocated_ptr * sizeof (int)); *prefixes = (Lisp_Object *) xrealloc (*prefixes, (*npanes_allocated_ptr * sizeof (Lisp_Object))); *names = (char ***) xrealloc (*names, *npanes_allocated_ptr * sizeof (char **)); *enables = (int **) xrealloc (*enables, *npanes_allocated_ptr * sizeof (int *)); } /* When a menu comes from keymaps, don't give names to the panes. */ (*panes)[*p_ptr] = pane_name; /* Normally put nil as pane's prefix key. Caller will override this if appropriate. */ (*prefixes)[*p_ptr] = Qnil; /* Get the length of the list level of the keymap. */ i = XFASTINT (Flength (keymap)); /* Add in lengths of any arrays. */ for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) if (XTYPE (XCONS (tail)->car) == Lisp_Vector) i += XVECTOR (XCONS (tail)->car)->size; /* Create vectors for the names and values of the items in the pane. I is an upper bound for the number of items. */ (*vector)[*p_ptr] = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); (*names)[*p_ptr] = (char **) xmalloc (i * sizeof (char *)); (*enables)[*p_ptr] = (int *) xmalloc (i * sizeof (int)); /* I is now the index of the next unused slots. */ i = 0; 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 (XTYPE (item1) == Lisp_Cons) { item2 = XCONS (item1)->car; if (XTYPE (item2) == Lisp_String) { Lisp_Object def, tem; Lisp_Object enabled; def = Fcdr (item1); enabled = Qt; 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)) enabled = Feval (tem); } tem = Fkeymapp (def); if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item2, XCONS (item)->car)), pending_maps); else { (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; /* The menu item "value" is the key bound here. */ (*vector)[*p_ptr][i] = XCONS (item)->car; (*enables)[*p_ptr][i] = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); i++; } } } } else if (XTYPE (item) == Lisp_Vector) { /* 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; XFASTINT (character) = c; item1 = XVECTOR (item)->contents[c]; if (XTYPE (item1) == Lisp_Cons) { item2 = XCONS (item1)->car; if (XTYPE (item2) == Lisp_String) { Lisp_Object tem; Lisp_Object def; Lisp_Object enabled; def = Fcdr (item1); enabled = Qt; if (XTYPE (def) == Lisp_Symbol) { tem = Fget (def, Qmenu_enable); /* No property, or nil, means enable. Otherwise, enable if value is not nil. */ if (!NILP (tem)) enabled = Feval (tem); } tem = Fkeymapp (def); if (XSTRING (item2)->data[0] == '@' && !NILP (tem)) pending_maps = Fcons (Fcons (def, Fcons (item2, character)), pending_maps); else { (*names)[*p_ptr][i] = (char *) XSTRING (item2)->data; /* The menu item "value" is the key bound here. */ (*vector)[*p_ptr][i] = character; (*enables)[*p_ptr][i] = (NILP (def) ? -1 : !NILP (enabled) ? 1 : 0); i++; } } } } } } /* Record the number of items in the pane. */ (*items)[*p_ptr] = i; /* If we just made an empty pane, get rid of it. */ if (i == 0) { xfree ((*vector)[*p_ptr]); xfree ((*names)[*p_ptr]); xfree ((*enables)[*p_ptr]); } /* Otherwise, advance past it. */ else (*p_ptr)++; /* Process now any submenus which want to be panes at this level. */ while (!NILP (pending_maps)) { Lisp_Object elt, eltcdr; int panenum = *p_ptr; elt = Fcar (pending_maps); eltcdr = XCONS (elt)->cdr; single_keymap_panes (Fcar (elt), panes, vector, names, enables, items, prefixes, p_ptr, npanes_allocated_ptr, /* Add 1 to discard the @. */ (char *) XSTRING (XCONS (eltcdr)->car)->data + 1); (*prefixes)[panenum] = XCONS (eltcdr)->cdr; pending_maps = Fcdr (pending_maps); } } /* Construct the vectors that describe a menu and store them in *VECTOR, *PANES, *NAMES, *ENABLES and *ITEMS. Each of those four values is a vector indexed by pane number. Return the number of panes. MENU is the argument that was given to Fx_popup_menu. */ int list_of_panes (vector, panes, names, enables, items, menu) Lisp_Object ***vector; /* RETURN all menu objects */ char ***panes; /* RETURN pane names */ char ****names; /* RETURN all line names */ int ***enables; /* RETURN enable flags of lines */ int **items; /* RETURN number of items per pane */ Lisp_Object menu; { Lisp_Object tail, item, item1; int i; if (XTYPE (menu) != Lisp_Cons) menu = wrong_type_argument (Qlistp, menu); i = XFASTINT (Flength (menu)); *vector = (Lisp_Object **) xmalloc (i * sizeof (Lisp_Object *)); *panes = (char **) xmalloc (i * sizeof (char *)); *items = (int *) xmalloc (i * sizeof (int)); *names = (char ***) xmalloc (i * sizeof (char **)); *enables = (int **) xmalloc (i * sizeof (int *)); for (i = 0, tail = menu; !NILP (tail); tail = Fcdr (tail), i++) { item = Fcdr (Fcar (tail)); if (XTYPE (item) != Lisp_Cons) (void) wrong_type_argument (Qlistp, item); #ifdef XDEBUG fprintf (stderr, "list_of_panes check tail, i=%d\n", i); #endif item1 = Fcar (Fcar (tail)); CHECK_STRING (item1, 1); #ifdef XDEBUG fprintf (stderr, "list_of_panes check pane, i=%d%s\n", i, XSTRING (item1)->data); #endif (*panes)[i] = (char *) XSTRING (item1)->data; (*items)[i] = list_of_items ((*vector)+i, (*names)+i, (*enables)+i, item); /* (*panes)[i] = (char *) xmalloc ((XSTRING (item1)->size)+1); bcopy (XSTRING (item1)->data, (*panes)[i], XSTRING (item1)->size + 1) ; */ } return i; } /* Construct the lists of values and names for a single pane, from the alist PANE. Put them in *VECTOR and *NAMES. Put the enable flags int *ENABLES. Return the number of items. */ int list_of_items (vector, names, enables, pane) Lisp_Object **vector; /* RETURN menu "objects" */ char ***names; /* RETURN line names */ int **enables; /* RETURN enable flags of lines */ Lisp_Object pane; { Lisp_Object tail, item, item1; int i; if (XTYPE (pane) != Lisp_Cons) pane = wrong_type_argument (Qlistp, pane); i = XFASTINT (Flength (pane)); *vector = (Lisp_Object *) xmalloc (i * sizeof (Lisp_Object)); *names = (char **) xmalloc (i * sizeof (char *)); *enables = (int *) xmalloc (i * sizeof (int)); for (i = 0, tail = pane; !NILP (tail); tail = Fcdr (tail), i++) { item = Fcar (tail); if (STRINGP (item)) { (*vector)[i] = Qnil; (*names)[i] = (char *) XSTRING (item)->data; (*enables)[i] = -1; } else { CHECK_CONS (item, 0); (*vector)[i] = Fcdr (item); item1 = Fcar (item); CHECK_STRING (item1, 1); (*names)[i] = (char *) XSTRING (item1)->data; (*enables)[i] = 1; } } return i; } emacs-19.22/src/xrdb.c100444 12120 1 40416 5474300762 13027 0ustar rmsdaemon/* Deal with the X Resource Manager. Copyright (C) 1990, 1993 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 #define SYSV #include #endif /* USG5 */ #endif /* 1 */ /* This should be included before the X include files; otherwise, we get warnings about redefining NULL under BSD 4.3. */ #include #include #include #if 0 #include #endif #include #include #include #ifdef VMS #include "vms-pwd.h" #else #include #endif #include #ifndef MAXPATHLEN #define MAXPATHLEN 256 #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 #if defined (__bsdi__) || defined (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 /* 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 () { int uid; struct passwd *pw; char *ptr; char *copy; if ((ptr = getenv ("HOME")) == NULL) { if ((ptr = getenv ("USER")) != NULL) pw = getpwnam (ptr); else { uid = getuid (); pw = getpwuid (uid); } if (pw) ptr = pw->pw_dir; } if (ptr == NULL) return "/"; copy = (char *) malloc (strlen (ptr) + 2); strcpy (copy, ptr); strcat (copy, "/"); return copy; } static int file_p (path) char *path; { struct stat status; return (access (path, 4) == 0 /* exists and is readable */ && stat (path, &status) == 0 /* get the status */ && (status.st_mode & S_IFDIR) == 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 == ':' && *(p + 1) == ':') { char *path; s = "%N%S"; path = magic_file_p (s, strlen (s), class, escaped_suffix, suffix); if (path) return path; /* Skip the first colon. */ p++; continue; } if (p > s) { char *path = magic_file_p (s, p - 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 = 0; if ((p = getenv ("XENVIRONMENT")) == NULL) { home = gethomedir (); { int host_size = 100; host = (char *) malloc (host_size); for (;;) { host[host_size - 1] = '\0'; gethostname (host, host_size - 1); if (strlen (host) < host_size - 1) break; host = (char *) realloc (host, host_size *= 2); } } path = (char *) malloc (strlen (home) + sizeof (".Xdefaults-") + strlen (host)); sprintf (path, "%s%s%s", home, ".Xdefaults-", host); p = path; } db = XrmGetFileDatabase (p); if (path) free (path); if (home) free (home); if (host) free (host); return db; } /* External interface. */ /* Types of values that we can find in a database */ #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); XrmInitialize (); 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.22/src/xselect.c100444 12120 1 171144 5474152513 13561 0ustar rmsdaemon/* X Selection processing for emacs 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. */ /* x_handle_selection_notify x_reply_selection_request */ /* Rewritten by jwz */ #include #include "lisp.h" #if 0 #include /* termhooks.h needs this */ #include "termhooks.h" #endif #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 static Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE, Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, Xatom_ATOM_PAIR; 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 Lisp_Object Vx_lost_selection_hooks; 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 ) 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.) 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. */ 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. */ 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.) */ 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 (display, sym) 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 Xatom_CLIPBOARD; if (EQ (sym, QTIMESTAMP)) return Xatom_TIMESTAMP; if (EQ (sym, QTEXT)) return Xatom_TEXT; if (EQ (sym, QDELETE)) return Xatom_DELETE; if (EQ (sym, QMULTIPLE)) return Xatom_MULTIPLE; if (EQ (sym, QINCR)) return Xatom_INCR; if (EQ (sym, QEMACS_TMP)) return Xatom_EMACS_TMP; if (EQ (sym, QTARGETS)) return Xatom_TARGETS; if (EQ (sym, QNULL)) return 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 (display, atom) 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 == Xatom_CLIPBOARD) return QCLIPBOARD; if (atom == Xatom_TIMESTAMP) return QTIMESTAMP; if (atom == Xatom_TEXT) return QTEXT; if (atom == Xatom_DELETE) return QDELETE; if (atom == Xatom_MULTIPLE) return QMULTIPLE; if (atom == Xatom_INCR) return QINCR; if (atom == Xatom_EMACS_TMP) return QEMACS_TMP; if (atom == Xatom_TARGETS) return QTARGETS; if (atom == 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; { Display *display = x_current_display; #ifdef X_TOOLKIT Window selecting_window = XtWindow (selected_screen->display.x->edit_widget); #else Window selecting_window = FRAME_X_WINDOW (selected_frame); #endif Time time = last_event_timestamp; Atom selection_atom; CHECK_SYMBOL (selection_name, 0); selection_atom = symbol_to_x_atom (display, selection_name); BLOCK_INPUT; XSetSelectionOwner (display, selection_atom, selecting_window, time); 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, 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 = XCONS (target_type)->cdr; int size = XVECTOR (pairs)->size; int i; /* 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 = 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; (void) XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply); 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; /* 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); 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! */ /* 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 BLOCK_INPUT; 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); XFlushQueue (); UNBLOCK_INPUT; } else { /* Send an INCR selection. */ struct prop_location *wait_object; BLOCK_INPUT; if (x_window_to_frame (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, Xatom_INCR, 32, PropModeReplace, (unsigned char *) &bytes_remaining, 1); XSelectInput (display, window, PropertyChangeMask); /* Tell 'em the INCR data is there... */ (void) XSendEvent (display, window, False, 0L, (XEvent *) &reply); XFlushQueue (); UNBLOCK_INPUT; /* First, wait for the requestor to ack by deleting the property. This can run random lisp code (process handlers) or signal. */ 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; XFlushQueue (); UNBLOCK_INPUT; /* 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); XFlushQueue (); 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 = Qnil; Lisp_Object selection_symbol; Lisp_Object target_symbol = Qnil; Lisp_Object converted_selection = Qnil; Time local_selection_time; Lisp_Object successful_p = Qnil; int count; GCPRO3 (local_selection_data, converted_selection, target_symbol); selection_symbol = x_atom_to_symbol (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 (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 = 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; selection_symbol = x_atom_to_symbol (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); redisplay_preserve_echo_area (); } } } /* 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 (XPNTR (identifierval)); } /* 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; XSET (tem, Lisp_Cons, location); /* 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; if (! location->arrived) { property_change_reply_object = location; 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 (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 (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; { Display *display = x_current_display; #ifdef X_TOOLKIT Window requestor_window = XtWindow (selected_screen->display.x->edit_widget); #else Window requestor_window = FRAME_X_WINDOW (selected_frame); #endif Time requestor_time = last_event_timestamp; Atom target_property = Xatom_EMACS_TMP; Atom selection_atom = symbol_to_x_atom (display, selection_symbol); Atom type_atom; int secs, usecs; if (CONSP (target_type)) type_atom = symbol_to_x_atom (display, XCONS (target_type)->car); else type_atom = symbol_to_x_atom (display, target_type); BLOCK_INPUT; XConvertSelection (display, selection_atom, type_atom, target_property, requestor_window, requestor_time); XFlushQueue (); /* 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; 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); 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, 0, 0, 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, offset/4, 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); } XFlushQueue (); 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); XFlushQueue (); 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); XFlushQueue (); 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; 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 (display, actual_type), Qnil)) : Fcons (target_type, Qnil)) : Fcons (build_string ("no selection"), Fcons (x_atom_to_symbol (display, selection_atom), Qnil))); } if (actual_type == 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); XFlushQueue (); 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; { if (type == 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 (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 (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; *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 (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 (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 (display, XVECTOR (pair)->contents [0]); (*(Atom **) data_ret) [(i * 2) + 1] = symbol_to_x_atom (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 (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_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_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; { Display *display = x_current_display; Time timestamp; Atom selection_atom; XSelectionClearEvent event; 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 (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_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 = x_current_display; 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 (dpy, selection); if (atom == 0) return Qnil; BLOCK_INPUT; owner = XGetSelectionOwner (dpy, atom); UNBLOCK_INPUT; return (owner ? Qt : Qnil); } #ifdef CUT_BUFFER_SUPPORT static int cut_buffers_initialized; /* Whether we're sure they all exist */ /* 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; cut_buffers_initialized = 1; } #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; { Display *display = x_current_display; Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ Atom buffer_atom; unsigned char *data; int bytes; Atom type; int format; unsigned long size; Lisp_Object ret; CHECK_CUT_BUFFER (buffer, 0); buffer_atom = symbol_to_x_atom (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 (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; { Display *display = x_current_display; Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ Atom buffer_atom; unsigned char *data; int bytes; int bytes_remaining; int 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 (display, buffer); data = (unsigned char *) XSTRING (string)->data; bytes = XSTRING (string)->size; bytes_remaining = bytes; if (! cut_buffers_initialized) initialize_cut_buffers (display, window); 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; { Display *display = x_current_display; Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ Atom props [8]; CHECK_NUMBER (n, 0); if (XINT (n) == 0) return n; if (! cut_buffers_initialized) initialize_cut_buffers (display, window); 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 Xatoms_of_xselect () { #define ATOM(x) XInternAtom (x_current_display, (x), False) BLOCK_INPUT; /* Non-predefined atoms that we might end up using a lot */ Xatom_CLIPBOARD = ATOM ("CLIPBOARD"); Xatom_TIMESTAMP = ATOM ("TIMESTAMP"); Xatom_TEXT = ATOM ("TEXT"); Xatom_DELETE = ATOM ("DELETE"); Xatom_MULTIPLE = ATOM ("MULTIPLE"); Xatom_INCR = ATOM ("INCR"); Xatom_EMACS_TMP = ATOM ("_EMACS_TMP_"); Xatom_TARGETS = ATOM ("TARGETS"); Xatom_NULL = ATOM ("NULL"); Xatom_ATOM_PAIR = ATOM ("ATOM_PAIR"); UNBLOCK_INPUT; } 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); cut_buffers_initialized = 0; #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.22/src/xterm.c100444 12120 1 410254 5474517313 13252 0ustar rmsdaemon/* X Communication module for terminals which understand the X protocol. 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. */ /* Serious problems: Kludge: dup2 is used to put the X-connection socket into desc # 0 so that wait_reading_process_input will wait for it in place of actual terminal input. */ #define NEW_SELECTIONS /* 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 #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 #include #else /* ! defined (BSD) */ #ifndef VMS #include #endif #endif /* ! defined (BSD) */ #include "systty.h" #include "systime.h" #include #include #include #include #include #include #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 "frame.h" #include "disptab.h" #include "buffer.h" #include "window.h" #ifdef HAVE_X11 #define XMapWindow XMapRaised /* Raise them when mapping. */ #else /* ! defined (HAVE_X11) */ #include /*#include */ #endif /* ! defined (HAVE_X11) */ #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 */ /* For sending Meta-characters. Do we need this? */ #define METABIT 0200 #define min(a,b) ((a)<(b) ? (a) : (b)) #define max(a,b) ((a)>(b) ? (a) : (b)) /* Nonzero means we must reprint all windows because 1) we received an ExposeWindow event or 2) we received too many ExposeRegion events to record. This is never needed under X11. */ static int expose_all_windows; /* Nonzero means we must reprint all icon windows. */ static int expose_all_icons; #ifndef HAVE_X11 /* ExposeRegion events, when received, are copied into this queue for later processing. */ static struct event_queue x_expose_queue; /* ButtonPressed and ButtonReleased events, when received, are copied into this queue for later processing. */ struct event_queue x_mouse_queue; #endif /* HAVE_X11 */ #if defined (SIGIO) && defined (FIONREAD) int BLOCK_INPUT_mask; #endif /* ! defined (SIGIO) && defined (FIONREAD) */ /* The id of a bitmap used for icon windows. One such map is shared by all Emacs icon windows. This is zero if we have not yet had a need to create the bitmap. */ static Bitmap icon_bitmap; /* Font used for text icons. */ static FONT_TYPE *icon_font_info; /* Stuff for dealing with the main icon title. */ extern Lisp_Object Vcommand_line_args; char *hostname, *x_id_name; /* This is the X connection that we are using. */ Display *x_current_display; /* The cursor to use for vertical scroll bars on x_current_display. */ static Cursor x_vertical_scroll_bar_cursor; /* 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; /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in frame.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. */ static struct frame *x_highlight_frame; /* From .Xdefaults, the value of "emacs.WarpMouse". If non-zero, mouse is moved to inside of frame when frame is de-iconified. */ static int warp_mouse_on_deiconify; /* 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; #ifdef HAVE_X11 /* `t' if a mouse button is depressed. */ extern Lisp_Object Vmouse_depressed; /* Tells if a window manager is present or not. */ extern Lisp_Object Vx_no_window_manager; /* Timestamp that we requested selection data was made. */ extern Time requestor_time; /* ID of the window requesting selection data. */ extern Window requestor_window; /* Nonzero enables some debugging for the X interface code. */ extern int _Xdebug; #else /* ! defined (HAVE_X11) */ /* Bit patterns for the mouse cursor. */ short MouseCursor[] = { 0x0000, 0x0008, 0x0018, 0x0038, 0x0078, 0x00f8, 0x01f8, 0x03f8, 0x07f8, 0x00f8, 0x00d8, 0x0188, 0x0180, 0x0300, 0x0300, 0x0000}; short MouseMask[] = { 0x000c, 0x001c, 0x003c, 0x007c, 0x00fc, 0x01fc, 0x03fc, 0x07fc, 0x0ffc, 0x0ffc, 0x01fc, 0x03dc, 0x03cc, 0x0780, 0x0780, 0x0300}; static short grey_bits[] = { 0x0005, 0x000a, 0x0005, 0x000a}; static Pixmap GreyPixmap = 0; #endif /* ! defined (HAVE_X11) */ /* From time to time we get info on an Emacs window, here. */ static WINDOWINFO_TYPE windowinfo; extern int errno; /* A mask of extra modifier bits to put into every keyboard char. */ extern int extra_keyboard_modifiers; extern Display *XOpenDisplay (); extern Window XCreateWindow (); extern Cursor XCreateCursor (); extern FONT_TYPE *XOpenFont (); static void flashback (); static void redraw_previous_char (); #ifndef HAVE_X11 static void dumpqueue (); #endif /* HAVE_X11 */ void dumpborder (); static int XTcursor_to (); static int XTclear_end_of_line (); /* 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. */ extern int mouse_track_top, mouse_track_left, mouse_track_width; static XTupdate_begin (f) struct frame *f; { int mask; if (f == 0) abort (); flexlines = f->height; highlight = 0; BLOCK_INPUT; #ifndef HAVE_X11 dumpqueue (); #endif /* HAVE_X11 */ UNBLOCK_INPUT; } #ifndef HAVE_X11 static void x_do_pending_expose (); #endif static XTupdate_end (f) struct frame *f; { int mask; if (updating_frame == 0 || updating_frame != f) abort (); BLOCK_INPUT; #ifndef HAVE_X11 dumpqueue (); x_do_pending_expose (); #endif /* HAVE_X11 */ x_display_cursor (f, 1); XFlushQueue (); 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); XFlushQueue (); 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. 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. */ #if 1 /* This is the multi-face code. */ static void dumpglyphs (f, left, top, gp, n, hl) struct frame *f; int left, top; register GLYPH *gp; /* Points to first GLYPH. */ register int n; /* Number of glyphs to display. */ int hl; { /* 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); while (n > 0) { /* Get the face-code of the next GLYPH. */ int cf, len; int g = *gp; GLYPH_FOLLOW_ALIASES (tbase, tlen, g); cf = 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 (GLYPH_FACE (g) != cf) break; *cp++ = 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); FONT_TYPE *font = FACE_FONT (face); GC gc = FACE_GC (face); int defaulted = 1; int gc_temporary = 0; /* First look at the face of the text itself. */ if (cf != 0) { /* The face codes on the glyphs must be valid indices into the frame's face table. */ if (cf < 0 || cf >= FRAME_N_COMPUTED_FACES (f) || FRAME_COMPUTED_FACES (f) [cf] == 0) abort (); 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); defaulted = 0; } /* 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); defaulted = 0; } #define FACE_DEFAULT (~0) /* Now override that if the cursor's on this character. */ if (hl == 2) { if (defaulted || !face->font || (int) face->font == FACE_DEFAULT) { gc = f->display.x->cursor_gc; } /* Cursor on non-default face: must merge. */ else { XGCValues xgcv; unsigned long mask; xgcv.background = f->display.x->cursor_pixel; xgcv.foreground = f->display.x->cursor_foreground_pixel; xgcv.font = face->font->fid; xgcv.graphics_exposures = 0; mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures; gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f), mask, &xgcv); #if 0 if (face->stipple && face->stipple != FACE_DEFAULT) XSetStipple (x_current_display, gc, face->stipple); #endif gc_temporary = 1; } } if ((int) font == FACE_DEFAULT) font = f->display.x->font; XDrawImageString (x_current_display, window, gc, left, top + FONT_BASE (font), buf, len); if (gc_temporary) XFreeGC (x_current_display, gc); /* 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 (x_current_display, 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; FONT_TYPE *font; { register int len; Window window = FRAME_X_WINDOW (f); GC drawing_gc = (hl == 2 ? f->display.x->cursor_gc : (hl ? f->display.x->reverse_gc : f->display.x->normal_gc)); if (sizeof (GLYPH) == sizeof (XChar2b)) XDrawImageString16 (x_current_display, window, drawing_gc, left, top + FONT_BASE (font), (XChar2b *) gp, n); else if (sizeof (GLYPH) == sizeof (unsigned char)) XDrawImageString (x_current_display, 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; 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); /* 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 int 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; /* 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; #ifdef HAVE_X11 XClearArea (x_current_display, FRAME_X_WINDOW (f), CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), FONT_WIDTH (f->display.x->font) * (first_unused - curs_x), FONT_HEIGHT (f->display.x->font), False); #if 0 redraw_previous_char (f, curs_x, curs_y); #endif #else /* ! defined (HAVE_X11) */ XPixSet (FRAME_X_WINDOW (f), CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), FONT_WIDTH (f->display.x->font) * (first_unused - curs_x), FONT_HEIGHT (f->display.x->font), f->display.x->background_pixel); #endif /* ! defined (HAVE_X11) */ UNBLOCK_INPUT; } /* 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. */ static void redraw_previous_char (f, x, y) FRAME_PTR f; int x, y; { /* 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 (x_current_display, FRAME_X_WINDOW (f), CHAR_TO_PIXEL_COL (f, x - 1), CHAR_TO_PIXEL_ROW (f, y), FONT_WIDTH (f->display.x->font), FONT_HEIGHT (f->display.x->font), 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); } } 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; XClear (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); #ifndef HAVE_X11 dumpborder (f, 0); #endif /* HAVE_X11 */ XFlushQueue (); UNBLOCK_INPUT; } /* 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->display.x->foreground_pixel ^ f->display.x->background_pixel); gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f), GCFunction | GCForeground, &values); } { int width = PIXEL_WIDTH (f); int height = PIXEL_HEIGHT (f); XFillRectangle (x_current_display, FRAME_X_WINDOW (f), gc, width/4, height/4, width/2, height/2); XFlush (x_current_display); { struct timeval wakeup, now; gettimeofday (&wakeup, (struct timezone *) 0); /* 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; gettimeofday (&timeout, (struct timezone *)0); /* 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, 0, 0, 0, &timeout); } } XFillRectangle (x_current_display, FRAME_X_WINDOW (f), gc, width/4, height/4, width/2, height/2); XFreeGC (x_current_display, gc); XFlush (x_current_display); } } UNBLOCK_INPUT; } #endif /* Make audible bell. */ #ifdef HAVE_X11 #define XRINGBELL XBell(x_current_display, 0) #else /* ! defined (HAVE_X11) */ #define XRINGBELL XFeep(0); #endif /* ! defined (HAVE_X11) */ XTring_bell () { if (x_current_display == 0) return; #if defined (HAVE_TIMEVAL) && defined (HAVE_SELECT) if (visible_bell) XTflash (selected_frame); else #endif { BLOCK_INPUT; XRINGBELL; XFlushQueue (); 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; } /* Perform an insert-lines operation. Insert N lines at a vertical position curs_y. */ static void stufflines (n) register int n; { register int topregion, bottomregion; register int length, newtop, mask; register struct frame *f = updating_frame; int intborder = f->display.x->internal_border_width; if (curs_y >= flexlines) return; topregion = curs_y; bottomregion = flexlines - (n + 1); newtop = topregion + n; length = (bottomregion - topregion) + 1; #ifndef HAVE_X11 dumpqueue (); #endif /* HAVE_X11 */ if ((length > 0) && (newtop <= flexlines)) { #ifdef HAVE_X11 XCopyArea (x_current_display, FRAME_X_WINDOW (f), FRAME_X_WINDOW (f), f->display.x->normal_gc, intborder, CHAR_TO_PIXEL_ROW (f, topregion), f->width * FONT_WIDTH (f->display.x->font), length * FONT_HEIGHT (f->display.x->font), intborder, CHAR_TO_PIXEL_ROW (f, newtop)); #else /* ! defined (HAVE_X11) */ XMoveArea (FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, topregion), intborder, CHAR_TO_PIXEL_ROW (f, newtop), f->width * FONT_WIDTH (f->display.x->font), length * FONT_HEIGHT (f->display.x->font)); /* Now we must process any ExposeRegion events that occur if the area being copied from is obscured. We can't let it wait because further i/d operations may want to copy this area to another area. */ x_read_exposes (); #endif /* ! defined (HAVE_X11) */ } newtop = min (newtop, (flexlines - 1)); length = newtop - topregion; if (length > 0) { #ifdef HAVE_X11 XClearArea (x_current_display, FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, topregion), f->width * FONT_WIDTH (f->display.x->font), n * FONT_HEIGHT (f->display.x->font), False); #else /* ! defined (HAVE_X11) */ XPixSet (FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, topregion), f->width * FONT_WIDTH (f->display.x->font), n * FONT_HEIGHT (f->display.x->font), f->display.x->background_pixel); #endif /* ! defined (HAVE_X11) */ } } /* Perform a delete-lines operation, deleting N lines at a vertical position curs_y. */ static void scraplines (n) register int n; { int mask; register struct frame *f = updating_frame; int intborder = f->display.x->internal_border_width; if (curs_y >= flexlines) return; #ifndef HAVE_X11 dumpqueue (); #endif /* HAVE_X11 */ if ((curs_y + n) >= flexlines) { if (flexlines >= (curs_y + 1)) { #ifdef HAVE_X11 XClearArea (x_current_display, FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, curs_y), f->width * FONT_WIDTH (f->display.x->font), (flexlines - curs_y) * FONT_HEIGHT (f->display.x->font), False); #else /* ! defined (HAVE_X11) */ XPixSet (FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, curs_y), f->width * FONT_WIDTH (f->display.x->font), (flexlines - curs_y) * FONT_HEIGHT (f->display.x->font), f->display.x->background_pixel); #endif /* ! defined (HAVE_X11) */ } } else { #ifdef HAVE_X11 XCopyArea (x_current_display, FRAME_X_WINDOW (f), FRAME_X_WINDOW (f), f->display.x->normal_gc, intborder, CHAR_TO_PIXEL_ROW (f, curs_y + n), f->width * FONT_WIDTH (f->display.x->font), (flexlines - (curs_y + n)) * FONT_HEIGHT (f->display.x->font), intborder, CHAR_TO_PIXEL_ROW (f, curs_y)); XClearArea (x_current_display, FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, flexlines - n), f->width * FONT_WIDTH (f->display.x->font), n * FONT_HEIGHT (f->display.x->font), False); #else /* ! defined (HAVE_X11) */ XMoveArea (FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, curs_y + n), intborder, CHAR_TO_PIXEL_ROW (f, curs_y), f->width * FONT_WIDTH (f->display.x->font), (flexlines - (curs_y + n)) * FONT_HEIGHT (f->display.x->font)); /* Now we must process any ExposeRegion events that occur if the area being copied from is obscured. We can't let it wait because further i/d operations may want to copy this area to another area. */ x_read_exposes (); XPixSet (FRAME_X_WINDOW (f), intborder, CHAR_TO_PIXEL_ROW (f, flexlines - n), f->width * FONT_WIDTH (f->display.x->font), n * FONT_HEIGHT (f->display.x->font), f->display.x->background_pixel); #endif /* ! defined (HAVE_X11) */ } } /* 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; { if (updating_frame == 0) abort (); /* Hide the cursor. */ x_display_cursor (updating_frame, 0); XTcursor_to (vpos, 0); BLOCK_INPUT; if (n >= 0) stufflines (n); else scraplines (-n); XFlushQueue (); UNBLOCK_INPUT; } /* 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. */ 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; #ifndef HAVE_X11 /* Window manger does this for X11. */ { int intborder = f->display.x->internal_border_width; /* If the rectangle includes any of the internal border area, redisplay the border emphasis. */ if (top < intborder || left < intborder || bottom > intborder + f->height * FONT_HEIGHT (f->display.x->font) || right > intborder + f->width * FONT_WIDTH (f->display.x->font)) dumpborder (f, 0); } #endif /* HAVE_X11 Window manger does this for X11. */ /* 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 += (FONT_HEIGHT (f->display.x->font) - 1); right += (FONT_WIDTH (f->display.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]); } /* Turn the cursor on if we turned it off. */ if (cursor_cleared) x_display_cursor (f, 1); } #ifndef HAVE_X11 /* Process all queued ExposeRegion events. */ static void dumpqueue () { register int i; XExposeRegionEvent r; while (dequeue_event (&r, &x_expose_queue)) { struct frame *f = x_window_to_frame (r.window); if (f->display.x->icon_desc == r.window) refreshicon (f); else dumprectangle (f, r.x, r.y, r.width, r.height); } XFlushQueue (); } #endif /* HAVE_X11 */ /* Process all expose events that are pending, for X10. Redraws the cursor if necessary on any frame that is not in the process of being updated with update_frame. */ #ifndef HAVE_X11 static void x_do_pending_expose () { int mask; struct frame *f; Lisp_Object tail, frame; if (expose_all_windows) { expose_all_windows = 0; for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr) { register int temp_width, temp_height; int intborder; frame = XCONS (tail)->car; if (XGCTYPE (frame) != Lisp_Frame) continue; f = XFRAME (frame); if (! FRAME_X_P (f)) continue; if (!f->async_visible) continue; if (!f->display.x->needs_exposure) continue; intborder = f->display.x->internal_border_width; clear_cursor (f); XGetWindowInfo (FRAME_X_WINDOW (f), &windowinfo); temp_width = ((windowinfo.width - 2 * intborder - f->display.x->v_scroll_bar_width) / FONT_WIDTH (f->display.x->font)); temp_height = ((windowinfo.height- 2 * intborder - f->display.x->h_scroll_bar_height) / FONT_HEIGHT (f->display.x->font)); if (temp_width != f->width || temp_height != f->height) { change_frame_size (f, max (1, temp_height), max (1, temp_width), 0, 1); x_resize_scroll_bars (f); } f->display.x->left_pos = windowinfo.x; f->display.x->top_pos = windowinfo.y; dumprectangle (f, 0, 0, PIXEL_WIDTH (f), PIXEL_HEIGHT (f)); #if 0 dumpborder (f, 0); #endif /* ! 0 */ f->display.x->needs_exposure = 0; if (updating_frame != f) x_display_cursor (f, 1); XFlushQueue (); } } else /* Handle any individual-rectangle expose events queued for various windows. */ #ifdef HAVE_X11 ; #else /* ! defined (HAVE_X11) */ dumpqueue (); #endif /* ! defined (HAVE_X11) */ } #endif #ifdef HAVE_X11 static void frame_highlight (frame) struct frame *frame; { /* 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 (x_current_display, FRAME_X_WINDOW (frame), frame->display.x->border_pixel); UNBLOCK_INPUT; x_display_cursor (frame, 1); } static void frame_unhighlight (frame) struct frame *frame; { /* 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 (x_current_display, FRAME_X_WINDOW (frame), frame->display.x->border_tile); UNBLOCK_INPUT; x_display_cursor (frame, 1); } #else /* ! defined (HAVE_X11) */ /* Dump the border-emphasis of frame F. If F is selected, this is a lining of the same color as the border, just within the border, occupying a portion of the internal border. If F is not selected, it is background in the same place. If ALWAYS is 0, don't bother explicitly drawing if it's background. ALWAYS = 1 is used when a frame becomes selected or deselected. In that case, we also turn the cursor off and on again so it will appear in the proper shape (solid if selected; else hollow.) */ static void dumpborder (f, always) struct frame *f; int always; { int thickness = f->display.x->internal_border_width / 2; int width = PIXEL_WIDTH (f); int height = PIXEL_HEIGHT (f); int pixel; if (f != selected_frame) { if (!always) return; pixel = f->display.x->background_pixel; } else { pixel = f->display.x->border_pixel; } XPixSet (FRAME_X_WINDOW (f), 0, 0, width, thickness, pixel); XPixSet (FRAME_X_WINDOW (f), 0, 0, thickness, height, pixel); XPixSet (FRAME_X_WINDOW (f), 0, height - thickness, width, thickness, pixel); XPixSet (FRAME_X_WINDOW (f), width - thickness, 0, thickness, height, pixel); if (always) x_display_cursor (f, 1); } #endif /* ! defined (HAVE_X11) */ static void XTframe_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 (frame) struct frame *frame; { struct frame *old_focus = x_focus_frame; int events_enqueued = 0; if (frame != x_focus_frame) { /* Set this before calling other routines, so that they see the correct value of x_focus_frame. */ x_focus_frame = frame; if (old_focus && old_focus->auto_lower) x_lower_frame (old_focus); #if 0 selected_frame = frame; XSET (XWINDOW (selected_frame->selected_window)->frame, Lisp_Frame, selected_frame); Fselect_window (selected_frame->selected_window); choose_minibuf_frame (); #endif /* ! 0 */ if (x_focus_frame && x_focus_frame->auto_raise) x_raise_frame (x_focus_frame); } XTframe_rehighlight (); } /* 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. */ static void XTframe_rehighlight () { struct frame *old_highlight = x_highlight_frame; if (x_focus_frame) { x_highlight_frame = ((XGCTYPE (FRAME_FOCUS_FRAME (x_focus_frame)) == Lisp_Frame) ? XFRAME (FRAME_FOCUS_FRAME (x_focus_frame)) : x_focus_frame); if (! FRAME_LIVE_P (x_highlight_frame)) { FRAME_FOCUS_FRAME (x_focus_frame) = Qnil; x_highlight_frame = x_focus_frame; } } else x_highlight_frame = 0; if (x_highlight_frame != old_highlight) { if (old_highlight) frame_unhighlight (old_highlight); if (x_highlight_frame) frame_highlight (x_highlight_frame); } } /* Keyboard processing - modifier keys, vendor-specific keysyms, etc. */ /* 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. x_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 & x_meta_mod_mask) != 0. x_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 & x_shift_lock_mask) != 0. */ static int x_meta_mod_mask, x_shift_lock_mask; /* These are like x_meta_mod_mask, but for different modifiers. */ static int x_alt_mod_mask, x_super_mod_mask, x_hyper_mod_mask; /* Initialize mode_switch_bit and modifier_meaning. */ static void x_find_modifier_meanings () { int min_code, max_code; KeySym *syms; int syms_per_code; XModifierKeymap *mods; x_meta_mod_mask = 0; x_shift_lock_mask = 0; x_alt_mod_mask = 0; x_super_mod_mask = 0; x_hyper_mod_mask = 0; #ifdef HAVE_X11R4 XDisplayKeycodes (x_current_display, &min_code, &max_code); #else min_code = x_current_display->min_keycode; max_code = x_current_display->max_keycode; #endif syms = XGetKeyboardMapping (x_current_display, min_code, max_code - min_code + 1, &syms_per_code); mods = XGetModifierMapping (x_current_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]; /* 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: x_meta_mod_mask |= (1 << row); break; case XK_Alt_L: case XK_Alt_R: x_alt_mod_mask |= (1 << row); break; case XK_Hyper_L: case XK_Hyper_R: x_hyper_mod_mask |= (1 << row); break; case XK_Super_L: case XK_Super_R: x_super_mod_mask |= (1 << row); break; case XK_Shift_Lock: /* Ignore this if it's not on the lock modifier. */ if ((1 << row) == LockMask) x_shift_lock_mask = LockMask; break; } } } } } /* If we couldn't find any meta keys, accept any alt keys as meta keys. */ if (! x_meta_mod_mask) { x_meta_mod_mask = x_alt_mod_mask; x_alt_mod_mask = 0; } /* If some keys are both alt and meta, make them just meta, not alt. */ if (x_alt_mod_mask & x_meta_mod_mask) { x_alt_mod_mask &= ~x_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 (state) unsigned int state; { return ( ((state & (ShiftMask | x_shift_lock_mask)) ? shift_modifier : 0) | ((state & ControlMask) ? ctrl_modifier : 0) | ((state & x_meta_mod_mask) ? meta_modifier : 0) | ((state & x_alt_mod_mask) ? alt_modifier : 0) | ((state & x_super_mod_mask) ? super_modifier : 0) | ((state & x_hyper_mod_mask) ? hyper_modifier : 0)); } static unsigned int x_emacs_to_x_modifiers (state) unsigned int state; { return ( ((state & alt_modifier) ? x_alt_mod_mask : 0) | ((state & super_modifier) ? x_super_mod_mask : 0) | ((state & hyper_modifier) ? x_hyper_mod_mask : 0) | ((state & shift_modifier) ? ShiftMask : 0) | ((state & ctrl_modifier) ? ControlMask : 0) | ((state & meta_modifier) ? x_meta_mod_mask : 0)); } /* Return true iff KEYSYM is a vendor-specific keysym that we should return as a function key. If you add a keysym to this, you should make sure that the tables make_lispy_event uses contain a suitable name for it. */ static int x_is_vendor_fkey (sym) KeySym sym; { return 0 #ifdef DXK_Remove || (sym == DXK_Remove) #endif ; } /* Mouse clicks and mouse movement. Rah. */ #ifdef HAVE_X11 /* 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. */ static void pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds) FRAME_PTR f; register unsigned int pix_x, pix_y; register int *x, *y; XRectangle *bounds; { 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->display.x->font); bounds->height = FONT_HEIGHT (f->display.x->font); bounds->x = CHAR_TO_PIXEL_COL (f, pix_x); bounds->y = CHAR_TO_PIXEL_ROW (f, pix_y); } 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; } /* Any buttons grabbed. */ unsigned int x_mouse_grabbed; /* 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; XSET (result->code, Lisp_Int, event->button - Button1); result->timestamp = event->time; result->modifiers = (x_x_to_emacs_modifiers (event->state) | (event->type == ButtonRelease ? up_modifier : down_modifier)); /* Notice if the mouse is still grabbed. */ if (event->type == ButtonPress) { if (! x_mouse_grabbed) Vmouse_depressed = Qt; x_mouse_grabbed |= (1 << event->button); } else if (event->type == ButtonRelease) { x_mouse_grabbed &= ~(1 << event->button); if (!x_mouse_grabbed) Vmouse_depressed = Qnil; } { int row, column; pixel_to_glyph_coords (f, event->x, event->y, &column, &row, NULL); XFASTINT (result->x) = column; XFASTINT (result->y) = row; XSET (result->frame_or_window, Lisp_Frame, f); } } /* Mouse movement. Rah. 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; /* 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; /* Has the mouse moved off the glyph it was on at the last sighting? */ 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) { mouse_moved = 1; last_mouse_scroll_bar = Qnil; } 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; XQueryPointer (event->display, event->window, (Window *) &dummy, (Window *) &dummy, &dummy, &dummy, &dummy, &dummy, (unsigned int *) &dummy); } } static struct scroll_bar *x_window_to_scroll_bar (); static void x_scroll_bar_report_motion (); /* Return the current position of the mouse. If the mouse movement started in a scroll bar, set *f, *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 *f 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 (f, bar_window, part, x, y, time) FRAME_PTR *f; 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 (f, bar_window, part, x, y, time); else { Window root; int root_x, root_y; Window dummy_window; int dummy; mouse_moved = 0; last_mouse_scroll_bar = Qnil; /* Figure out which root window we're on. */ XQueryPointer (x_current_display, DefaultRootWindow (x_current_display), /* 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; for (;;) { XTranslateCoordinates (x_current_display, /* 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) 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_window_to_frame (win); /* 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) { /* Ok, we found a frame. Convert from pixels to characters and store all the values. */ pixel_to_glyph_coords (f1, win_x, win_y, &win_x, &win_y, &last_mouse_glyph); *bar_window = Qnil; *part = 0; *f = f1; XSET (*x, Lisp_Int, win_x); XSET (*y, Lisp_Int, win_y); *time = last_mouse_movement_time; } } } UNBLOCK_INPUT; } #else /* ! defined (HAVE_X11) */ #define XEvent XKeyPressedEvent #endif /* ! defined (HAVE_X11) */ /* 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 = XCONS (tail)->car; Lisp_Object bar, condemned; /* All elements of Vframe_list should be frames. */ if (XGCTYPE (frame) != Lisp_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 frame = 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 = frame->display.x->background_pixel; a.event_mask = (ButtonPressMask | ButtonReleaseMask | ButtonMotionMask | PointerMotionHintMask | ExposureMask); a.cursor = x_vertical_scroll_bar_cursor; mask = (CWBackPixel | CWEventMask | CWCursor); SET_SCROLL_BAR_X_WINDOW (bar, XCreateWindow (x_current_display, FRAME_X_WINDOW (frame), /* Position and size of scroll bar. */ left, top, width, height, /* Border width, depth, class, and visual. */ 0, CopyFromParent, CopyFromParent, CopyFromParent, /* Attributes. */ mask, &a)); } XSET (bar->window, Lisp_Window, window); XSET (bar->top, Lisp_Int, top); XSET (bar->left, Lisp_Int, left); XSET (bar->width, Lisp_Int, width); XSET (bar->height, Lisp_Int, height); XSET (bar->start, Lisp_Int, 0); XSET (bar->end, Lisp_Int, 0); bar->dragging = Qnil; /* Add bar to its frame's list of scroll bars. */ bar->next = FRAME_SCROLL_BARS (frame); bar->prev = Qnil; XSET (FRAME_SCROLL_BARS (frame), Lisp_Vector, bar); if (! NILP (bar->next)) XSET (XSCROLL_BAR (bar->next)->prev, Lisp_Vector, bar); XMapWindow (x_current_display, 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); GC gc = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)))->display.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. */ XSET (bar->start, Lisp_Int, start); XSET (bar->end, Lisp_Int, 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 (x_current_display, 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 (x_current_display, 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 (x_current_display, 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; { 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 (x_current_display, SCROLL_BAR_X_WINDOW (bar), mask, &wc); } XSET (bar->left, Lisp_Int, left); XSET (bar->top, Lisp_Int, top); XSET (bar->width, Lisp_Int, width); XSET (bar->height, Lisp_Int, 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 (x_current_display, 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 = VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f); 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); } } XSET (window->vertical_scroll_bar, Lisp_Vector, 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; { /* 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 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; XSET (FRAME_SCROLL_BARS (f), Lisp_Vector, bar); if (! NILP (bar->next)) XSET (XSCROLL_BAR (bar->next)->prev, Lisp_Vector, 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); GC gc = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)))->display.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 (x_current_display, w, gc, /* x, y, width, height */ 0, 0, XINT (bar->width) - 1, XINT (bar->height) - 1); /* Draw another line to make the extra-thick border on the right. */ XFillRectangle (x_current_display, w, gc, /* x, y, width, height */ XINT (bar->width) - 2, 1, 1, XINT (bar->height) - 2); 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 (XGCTYPE (bar->window) != Lisp_Window) abort (); emacs_event->kind = scroll_bar_click; XSET (emacs_event->code, Lisp_Int, event->xbutton.button - Button1); emacs_event->modifiers = (x_x_to_emacs_modifiers (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) XSET (bar->dragging, Lisp_Int, 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 XSET (emacs_event->x, Lisp_Int, y); #else XSET (emacs_event->x, Lisp_Int, y); #endif XSET (emacs_event->y, Lisp_Int, 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; { last_mouse_movement_time = event->xmotion.time; mouse_moved = 1; XSET (last_mouse_scroll_bar, Lisp_Vector, 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; XQueryPointer (event->xmotion.display, event->xmotion.window, (Window *) &dummy, (Window *) &dummy, &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 (f, bar_window, part, x, y, time) FRAME_PTR *f; 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); 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 (x_current_display, SCROLL_BAR_X_WINDOW (bar), /* 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)) *f = 0; 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; *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); *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; XSET (*x, Lisp_Int, win_y); XSET (*y, Lisp_Int, top_range); 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); XTYPE (bar) == Lisp_Vector; bar = XSCROLL_BAR (bar)->next) XClearArea (x_current_display, SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)), 0, 0, 0, 0, True); } /* 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; /* 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; /* Other WM communication */ Atom Xatom_wm_configure_denied; /* When our config request is denied */ Atom Xatom_wm_window_moved; /* When the WM moves us. */ /* Window manager communication. */ Atom Xatom_wm_change_state; /* 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 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; if (interrupt_input_blocked) { interrupt_input_pending = 1; return -1; } interrupt_input_pending = 0; BLOCK_INPUT; if (numchars <= 0) abort (); /* Don't think this happens. */ #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 (fileno (stdin), F_SETFL, 0); #endif /* ! defined (FIOSNBIO) */ #ifndef SIGIO #ifndef HAVE_SELECT if (! (fcntl (fileno (stdin), F_GETFL, 0) & O_NDELAY)) { extern int read_alarm_should_throw; read_alarm_should_throw = 1; XPeekEvent (XDISPLAY &event); read_alarm_should_throw = 0; } #endif /* HAVE_SELECT */ #endif /* SIGIO */ while (XStuffPending () != 0) { XNextEvent (XDISPLAY &event); event_found = 1; switch (event.type) { #ifdef HAVE_X11 case ClientMessage: { if (event.xclient.message_type == Xatom_wm_protocols && event.xclient.format == 32) { if (event.xclient.data.l[0] == Xatom_wm_take_focus) { f = x_window_to_frame (event.xclient.window); if (f) x_focus_on_frame (f); /* Not certain about handling scroll bars here */ } else if (event.xclient.data.l[0] == 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) { } } else if (event.xclient.data.l[0] == Xatom_wm_delete_window) { struct frame *f = x_window_to_frame (event.xclient.window); if (f) { if (numchars == 0) abort (); bufp->kind = delete_window_event; XSET (bufp->frame_or_window, Lisp_Frame, f); bufp++; count += 1; numchars -= 1; } } } else if (event.xclient.message_type == Xatom_wm_configure_denied) { } else if (event.xclient.message_type == Xatom_wm_window_moved) { int new_x, new_y; struct frame *f = x_window_to_frame (event.xclient.window); new_x = event.xclient.data.s[0]; new_y = event.xclient.data.s[1]; if (f) { f->display.x->left_pos = new_x; f->display.x->top_pos = new_y; } } } break; #ifdef NEW_SELECTIONS case SelectionNotify: x_handle_selection_notify (&event); break; #endif case SelectionClear: /* Someone has grabbed ownership. */ #ifdef NEW_SELECTIONS { 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; } #else x_disown_selection (event.xselectionclear.window, event.xselectionclear.selection, event.xselectionclear.time); #endif break; case SelectionRequest: /* Someone wants our selection. */ #ifdef NEW_SELECTIONS { 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; } #else x_answer_selection_request (event); #endif break; case PropertyNotify: #ifdef NEW_SELECTIONS x_handle_property_notify (&event); #else /* If we're being told about a root window property, then it's a cut buffer change. */ if (event.xproperty.window == ROOT_WINDOW) x_invalidate_cut_buffer_cache (&event.xproperty); /* Otherwise, we're probably handling an incremental selection transmission. */ else { /* If we were to do this synchronously, there'd be no worry about re-selecting. */ x_send_incremental (event); } #endif break; case ReparentNotify: f = x_window_to_frame (event.xreparent.window); if (f) f->display.x->parent_desc = event.xreparent.parent; break; case Expose: f = x_window_to_frame (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 (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); } break; case GraphicsExpose: /* This occurs when an XCopyArea's source area was obscured or not available.*/ f = x_window_to_frame (event.xgraphicsexpose.drawable); if (f) { dumprectangle (f, event.xgraphicsexpose.x, event.xgraphicsexpose.y, event.xgraphicsexpose.width, event.xgraphicsexpose.height); } break; case NoExpose: /* This occurs when an XCopyArea's source area was completely available */ break; #else /* ! defined (HAVE_X11) */ case ExposeWindow: if (event.subwindow != 0) break; /* duplicate event */ f = x_window_to_frame (event.window); if (event.window == f->display.x->icon_desc) { refreshicon (f); f->async_iconified = 1; } if (event.window == FRAME_X_WINDOW (f)) { /* Say must check all windows' needs_exposure flags. */ expose_all_windows = 1; f->display.x->needs_exposure = 1; f->async_visible = 1; } break; case ExposeRegion: if (event.subwindow != 0) break; /* duplicate event */ f = x_window_to_frame (event.window); if (event.window == f->display.x->icon_desc) { refreshicon (f); break; } /* If window already needs full redraw, ignore this rectangle. */ if (expose_all_windows && f->display.x->needs_exposure) break; /* Put the event on the queue of rectangles to redraw. */ if (enqueue_event (&event, &x_expose_queue)) /* If it is full, we can't record the rectangle, so redraw this entire window. */ { /* Say must check all windows' needs_exposure flags. */ expose_all_windows = 1; f->display.x->needs_exposure = 1; } break; case ExposeCopy: /* This should happen only when we are expecting it, in x_read_exposes. */ abort (); #endif /* ! defined (HAVE_X11) */ #ifdef HAVE_X11 case UnmapNotify: f = x_window_to_frame (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; /* The window manager never makes a window invisible ("withdrawn"); all it does is switch between visible and iconified. Frames get into the invisible state only through x_make_frame_invisible. */ if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) f->async_iconified = 1; } break; case MapNotify: f = x_window_to_frame (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); } break; /* Turn off processing if we become fully obscured. */ case VisibilityNotify: break; #else /* ! defined (HAVE_X11) */ case UnmapWindow: f = x_window_to_frame (event.window); if (event.window == f->display.x->icon_desc) f->async_iconified = 0; if (event.window == FRAME_X_WINDOW (f)) f->async_visible = 0; break; #endif /* ! defined (HAVE_X11) */ #ifdef HAVE_X11 case KeyPress: f = x_window_to_frame (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 (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; nbytes = XLookupString (&event.xkey, copy_buffer, 80, &keysym, &compose_status); /* Strip off the vendor-specific keysym bit, and take a shot at recognizing the codes. HP servers have extra keysyms that fit into the MiscFunctionKey category. */ orig_keysym = keysym; keysym &= ~(1<<28); 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 || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ || x_is_vendor_fkey (orig_keysym)) && ! (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; XSET (bufp->code, Lisp_Int, (unsigned) keysym - 0xff00); XSET (bufp->frame_or_window, Lisp_Frame, f); bufp->modifiers = x_x_to_emacs_modifiers (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; XSET (bufp->code, Lisp_Int, copy_buffer[i]); XSET (bufp->frame_or_window, Lisp_Frame, f); bufp->modifiers = x_x_to_emacs_modifiers (modifiers); bufp->timestamp = event.xkey.time; bufp++; } count += nbytes; numchars -= nbytes; } else abort (); } else abort (); } break; #else /* ! defined (HAVE_X11) */ case KeyPressed: { register char *where_mapping; f = x_window_to_frame (event.window); /* Ignore keys typed on icon windows. */ if (f != 0 && event.window == f->display.x->icon_desc) break; where_mapping = XLookupMapping (&event, &nbytes); /* Nasty fix for arrow keys */ if (!nbytes && IsCursorKey (event.detail & 0xff)) { switch (event.detail & 0xff) { case KC_CURSOR_LEFT: where_mapping = "\002"; break; case KC_CURSOR_RIGHT: where_mapping = "\006"; break; case KC_CURSOR_UP: where_mapping = "\020"; break; case KC_CURSOR_DOWN: where_mapping = "\016"; break; } nbytes = 1; } if (numchars - nbytes > 0) { register int i; for (i = 0; i < nbytes; i++) { bufp->kind = ascii_keystroke; XSET (bufp->code, Lisp_Int, where_mapping[i]); XSET (bufp->time, Lisp_Int, event.xkey.time); XSET (bufp->frame_or_window, Lisp_Frame, f); bufp++; } count += nbytes; numchars -= nbytes; } } break; #endif /* ! defined (HAVE_X11) */ #ifdef HAVE_X11 /* 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_window_to_frame (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 (f); enter_timestamp = event.xcrossing.time; } } else if (f == x_focus_frame) x_new_focus_frame (0); break; case FocusIn: f = x_window_to_frame (event.xfocus.window); if (event.xfocus.detail != NotifyPointer) x_focus_event_frame = f; if (f) x_new_focus_frame (f); break; case LeaveNotify: f = x_window_to_frame (event.xcrossing.window); if (event.xcrossing.focus) { if (! x_focus_event_frame) x_new_focus_frame (0); else x_new_focus_frame (f); } else { if (f == x_focus_event_frame) x_focus_event_frame = 0; if (f == x_focus_frame) x_new_focus_frame (0); } break; case FocusOut: f = x_window_to_frame (event.xfocus.window); if (event.xfocus.detail != NotifyPointer && f == x_focus_event_frame) x_focus_event_frame = 0; if (f && f == x_focus_frame) x_new_focus_frame (0); break; #else /* ! defined (HAVE_X11) */ case EnterWindow: if ((event.detail & 0xFF) == 1) break; /* Coming from our own subwindow */ if (event.subwindow != 0) break; /* Entering our own subwindow. */ { f = x_window_to_frame (event.window); x_mouse_frame = f; x_new_focus_frame (f); } break; case LeaveWindow: if ((event.detail & 0xFF) == 1) break; /* Entering our own subwindow */ if (event.subwindow != 0) break; /* Leaving our own subwindow. */ x_mouse_frame = 0; if (x_focus_frame == 0 && x_input_frame != 0 && x_input_frame == x_window_to_frame (event.window) && event.window == FRAME_X_WINDOW (x_input_frame)) { f = x_input_frame; x_input_frame = 0; if (f) frame_unhighlight (f); } break; #endif /* ! defined (HAVE_X11) */ #ifdef HAVE_X11 case MotionNotify: { f = x_window_to_frame (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); } } break; case ConfigureNotify: f = x_window_to_frame (event.xconfigure.window); if (f) { 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->display.x->pixel_width || event.xconfigure.height != f->display.x->pixel_height) { change_frame_size (f, rows, columns, 0, 1); SET_FRAME_GARBAGED (f); } if (! event.xconfigure.send_event) { 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 (x_current_display, /* From-window, to-window. */ f->display.x->window_desc, 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->display.x->pixel_width = event.xconfigure.width; f->display.x->pixel_height = event.xconfigure.height; f->display.x->left_pos = event.xconfigure.x; f->display.x->top_pos = event.xconfigure.y; } break; 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; f = x_window_to_frame (event.xbutton.window); if (f) { if (!x_focus_frame || (f == 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 (numchars >= 1 && emacs_event.kind != no_event) { bcopy (&emacs_event, bufp, sizeof (struct input_event)); bufp++; count++; numchars--; } } break; #else /* ! defined (HAVE_X11) */ case ButtonPressed: case ButtonReleased: f = x_window_to_frame (event.window); if (f) { if (event.window == f->display.x->icon_desc) { x_make_frame_visible (f); if (warp_mouse_on_deiconify) XWarpMouse (FRAME_X_WINDOW (f), 10, 10); break; } if (event.window == FRAME_X_WINDOW (f)) { if (f->auto_raise) x_raise_frame (f); } } enqueue_event (&event, &x_mouse_queue); if (numchars >= 2) { bufp->kind = ascii_keystroke; bufp->code = (char) 'X' & 037; /* C-x */ XSET (bufp->frame_or_window, Lisp_Frame, f); XSET (bufp->time, Lisp_Int, event.xkey.time); bufp++; bufp->kind = ascii_keystroke; bufp->code = (char) 0; /* C-@ */ XSET (bufp->frame_or_window, Lisp_Frame, f); XSET (bufp->time, Lisp_Int, event.xkey.time); bufp++; count += 2; numchars -= 2; } break; #endif /* ! defined (HAVE_X11) */ #ifdef HAVE_X11 case CirculateNotify: break; case CirculateRequest: break; #endif /* ! defined (HAVE_X11) */ case MappingNotify: /* Someone has changed the keyboard mapping - update the local cache. */ switch (event.xmapping.request) { case MappingModifier: x_find_modifier_meanings (); /* This is meant to fall through. */ case MappingKeyboard: XRefreshKeyboardMapping (&event.xmapping); } break; default: break; } } #ifdef HAVE_SELECT if (expected && ! event_found) { /* AOJ 880406: if select returns true but XPending doesn't, it means that there is an EOF condition; in other words, that X has died. Act as if there had been a hangup. */ int fd = ConnectionNumber (x_current_display); SELECT_TYPE mask; EMACS_TIME timeout; FD_ZERO (&mask); FD_SET (fd, &mask); EMACS_SET_SECS_USECS (timeout, 0, 0); if (0 != select (fd + 1, &mask, (long *) 0, (long *) 0, &timeout) && !XStuffPending ()) kill (getpid (), SIGHUP); } #endif /* HAVE_SELECT */ #ifndef HAVE_X11 if (updating_frame == 0) x_do_pending_expose (); #endif UNBLOCK_INPUT; return count; } #ifndef HAVE_X11 /* Read and process only Expose events until we get an ExposeCopy event; then return. This is used in insert/delete line. We assume input is already blocked. */ static void x_read_exposes () { struct frame *f; XKeyPressedEvent event; while (1) { /* while there are more events*/ XMaskEvent (ExposeWindow | ExposeRegion | ExposeCopy, &event); switch (event.type) { case ExposeWindow: if (event.subwindow != 0) break; /* duplicate event */ f = x_window_to_frame (event.window); if (event.window == f->display.x->icon_desc) { refreshicon (f); break; } if (event.window == FRAME_X_WINDOW (f)) { expose_all_windows = 1; f->display.x->needs_exposure = 1; break; } break; case ExposeRegion: if (event.subwindow != 0) break; /* duplicate event */ f = x_window_to_frame (event.window); if (event.window == f->display.x->icon_desc) { refreshicon (f); break; } /* If window already needs full redraw, ignore this rectangle. */ if (expose_all_windows && f->display.x->needs_exposure) break; /* Put the event on the queue of rectangles to redraw. */ if (enqueue_event (&event, &x_expose_queue)) /* If it is full, we can't record the rectangle, so redraw this entire window. */ { /* Say must check all windows' needs_exposure flags. */ expose_all_windows = 1; f->display.x->needs_exposure = 1; } break; case ExposeCopy: return; } } } #endif /* HAVE_X11 */ /* 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; { int left = CHAR_TO_PIXEL_COL (f, f->cursor_x); int top = CHAR_TO_PIXEL_ROW (f, f->cursor_y); int width = FONT_WIDTH (f->display.x->font); int height = FONT_HEIGHT (f->display.x->font); #ifdef HAVE_X11 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f), f->display.x->cursor_gc, left, top, width - 1, height - 1); #else /* ! defined (HAVE_X11) */ XPixSet (FRAME_X_WINDOW (f), left, top, width, 1, f->display.x->cursor_pixel); XPixSet (FRAME_X_WINDOW (f), left, top, 1, height, f->display.x->cursor_pixel); XPixSet (FRAME_X_WINDOW (f), left+width-1, top, 1, height, f->display.x->cursor_pixel); XPixSet (FRAME_X_WINDOW (f), left, top+height-1, width, 1, f->display.x->cursor_pixel); #endif /* ! defined (HAVE_X11) */ } /* 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; #ifdef HAVE_X11 x_display_cursor (f, 0); #else /* ! defined (HAVE_X11) */ XPixSet (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->display.x->font), FONT_HEIGHT (f->display.x->font), f->display.x->background_pixel); #endif /* ! defined (HAVE_X11) */ 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); } 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->display.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->display.x->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); XFillRectangle (x_current_display, FRAME_X_WINDOW (f), f->display.x->cursor_gc, CHAR_TO_PIXEL_COL (f, curs_x), CHAR_TO_PIXEL_ROW (f, curs_y), 1, FONT_HEIGHT (f->display.x->font)); f->phys_cursor_x = curs_x; f->phys_cursor_y = curs_y; f->display.x->current_cursor = bar_cursor; } if (updating_frame != f) XFlushQueue (); } /* 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->display.x->current_cursor != hollow_box_cursor && (f != x_highlight_frame)))) { /* 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 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->display.x->current_cursor != filled_box_cursor && f == x_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 != x_highlight_frame) { x_draw_box (f); f->display.x->current_cursor = hollow_box_cursor; } else { x_draw_single_glyph (f, curs_y, curs_x, f->phys_cursor_glyph, 2); f->display.x->current_cursor = filled_box_cursor; } f->phys_cursor_x = curs_x; f->phys_cursor_y = curs_y; } if (updating_frame != f) XFlushQueue (); } x_display_cursor (f, on) struct frame *f; int on; { 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 (); } /* Icons. */ /* Refresh bitmap kitchen sink icon for frame F when we get an expose event for it. */ refreshicon (f) struct frame *f; { #ifdef HAVE_X11 /* Normally, the window manager handles this function. */ #else /* ! defined (HAVE_X11) */ int mask; if (f->display.x->icon_bitmap_flag) XBitmapBitsPut (f->display.x->icon_desc, 0, 0, sink_width, sink_height, sink_bits, BlackPixel, WHITE_PIX_DEFAULT, icon_bitmap, GXcopy, AllPlanes); else { extern struct frame *selected_frame; struct Lisp_String *str; unsigned char *string; string = XSTRING (XBUFFER (XWINDOW (f->selected_window)->buffer)->name)->data; if (f->display.x->icon_label != string) { f->display.x->icon_label = string; XChangeWindow (f->display.x->icon_desc, XQueryWidth (string, icon_font_info->id) + 10, icon_font_info->height + 10); } XText (f->display.x->icon_desc, 5, 5, string, str->size, icon_font_info->id, BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT); } XFlushQueue (); #endif /* ! defined (HAVE_X11) */ } /* Make the x-window of frame F use the gnu icon bitmap. */ int x_bitmap_icon (f) struct frame *f; { int mask; Window icon_window; if (FRAME_X_WINDOW (f) == 0) return 1; #ifdef HAVE_X11 if (! icon_bitmap) icon_bitmap = XCreateBitmapFromData (x_current_display, FRAME_X_WINDOW (f), gnu_bits, gnu_width, gnu_height); x_wm_set_icon_pixmap (f, icon_bitmap); f->display.x->icon_bitmap_flag = 1; #else /* ! defined (HAVE_X11) */ if (f->display.x->icon_desc) { XClearIconWindow (FRAME_X_WINDOW (f)); XDestroyWindow (f->display.x->icon_desc); } icon_window = XCreateWindow (f->display.x->parent_desc, 0, 0, sink_width, sink_height, 2, WhitePixmap, (Pixmap) NULL); if (icon_window == 0) return 1; XSetIconWindow (FRAME_X_WINDOW (f), icon_window); XSelectInput (icon_window, ExposeWindow | UnmapWindow); f->display.x->icon_desc = icon_window; f->display.x->icon_bitmap_flag = 1; if (icon_bitmap == 0) icon_bitmap = XStoreBitmap (sink_mask_width, sink_mask_height, sink_mask_bits); #endif /* ! defined (HAVE_X11) */ return 0; } /* Make the x-window of frame F use a rectangle with text. */ int x_text_icon (f, icon_name) struct frame *f; char *icon_name; { #ifndef HAVE_X11 int mask; int width; Window icon_window; char *X_DefaultValue; Bitmap b1; #ifndef WhitePixel #define WhitePixel 1 #endif /* WhitePixel */ #ifndef BlackPixel #define BlackPixel 0 #endif /* BlackPixel */ #endif /* HAVE_X11 */ if (FRAME_X_WINDOW (f) == 0) return 1; #ifdef HAVE_X11 if (icon_name) f->display.x->icon_label = icon_name; else if (! f->display.x->icon_label) f->display.x->icon_label = " *emacs* "; #if 0 XSetIconName (x_current_display, FRAME_X_WINDOW (f), (char *) f->display.x->icon_label); #endif f->display.x->icon_bitmap_flag = 0; x_wm_set_icon_pixmap (f, 0); #else /* ! defined (HAVE_X11) */ if (icon_font_info == 0) icon_font_info = XGetFont (XGetDefault (XDISPLAY (char *) XSTRING (Vinvocation_name)->data, "BodyFont")); if (f->display.x->icon_desc) { XClearIconWindow (XDISPLAY FRAME_X_WINDOW (f)); XDestroyWindow (XDISPLAY f->display.x->icon_desc); } if (icon_name) f->display.x->icon_label = (unsigned char *) icon_name; else if (! f->display.x->icon_label) f->display.x->icon_label = XSTRING (f->name)->data; width = XStringWidth (f->display.x->icon_label, icon_font_info, 0, 0); icon_window = XCreateWindow (f->display.x->parent_desc, f->display.x->left_pos, f->display.x->top_pos, width + 10, icon_font_info->height + 10, 2, BlackPixmap, WhitePixmap); if (icon_window == 0) return 1; XSetIconWindow (FRAME_X_WINDOW (f), icon_window); XSelectInput (icon_window, ExposeWindow | ExposeRegion | UnmapWindow | ButtonPressed); f->display.x->icon_desc = icon_window; f->display.x->icon_bitmap_flag = 0; f->display.x->icon_label = 0; #endif /* ! defined (HAVE_X11) */ return 0; } /* Handling X errors. */ /* Shut down Emacs in an orderly fashion, because of a SIGPIPE on the X server's connection, or an error reported via the X protocol. */ static SIGTYPE x_connection_closed () { if (_Xdebug) abort (); shut_down_emacs (0, 1, Qnil); exit (70); } /* An X error handler which prints an error message and then kills Emacs. This is what's normally installed as Xlib's handler for protocol errors. */ static int x_error_quitter (display, error) Display *display; XErrorEvent *error; { char buf[256]; /* 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)); fprintf (stderr, "X protocol error: %s on protocol request %d\n", buf, error->request_code); #if 0 /* While we're testing Emacs 19, we'll just dump core whenever we get an X error, so we can figure out why it happened. */ abort (); #endif x_connection_closed (); } /* A handler for X IO errors which prints an error message and then kills Emacs. This is what is always installed as Xlib's handler for I/O errors. */ static int x_io_error_quitter (display) Display *display; { fprintf (stderr, "Connection to X server %s lost.\n", XDisplayName (DisplayString (display))); #if 0 /* While we're testing Emacs 19, we'll just dump core whenever we get an X error, so we can figure out why it happened. */ abort (); #endif x_connection_closed (); } /* 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. 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 () { /* Make sure any errors from previous requests have been dealt with. */ XSync (x_current_display, 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. */ XHandleError (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 (format) char *format; { /* Make sure to catch any errors incurred so far. */ XSync (x_current_display, 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 (); error (buf); } } void x_uncatch_errors () { xfree (x_caught_error_message); x_caught_error_message = 0; XHandleError (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. */ /* Set the font of the x-window specified by frame F to the font named NEWNAME. This is safe to use even before F has an actual x-window. */ #ifdef HAVE_X11 struct font_info { XFontStruct *font; char *name; }; /* A table of all the fonts we have already loaded. */ static struct font_info *x_font_table; /* The current capacity of x_font_table. */ static int x_font_table_size; /* The number of fonts actually stored in x_font_table. x_font_table[n] is used and valid iff 0 <= n < n_fonts. 0 <= n_fonts <= x_font_table_size. */ static int n_fonts; 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 (x_current_display, 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 < n_fonts; i++) for (j = 0; j < n_matching_fonts; j++) if (!strcmp (x_font_table[i].name, font_names[j])) { already_loaded = i; fontname = font_names[j]; goto found_font; } } found_font: /* If we have, just return it from the table. */ if (already_loaded >= 0) f->display.x->font = x_font_table[already_loaded].font; /* Otherwise, load the font and add it to the table. */ else { int i; XFontStruct *font; /* 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 (x_current_display, 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 (x_font_table_size == 0) { x_font_table_size = 16; x_font_table = (struct font_info *) xmalloc (x_font_table_size * sizeof (x_font_table[0])); } /* Do we need to grow the table? */ else if (n_fonts >= x_font_table_size) { x_font_table_size *= 2; x_font_table = (struct font_info *) xrealloc (x_font_table, (x_font_table_size * sizeof (x_font_table[0]))); } x_font_table[n_fonts].name = (char *) xmalloc (strlen (fontname) + 1); bcopy (fontname, x_font_table[n_fonts].name, strlen (fontname) + 1); f->display.x->font = x_font_table[n_fonts++].font = font; } /* Now make the frame display the given font. */ if (FRAME_X_WINDOW (f) != 0) { XSetFont (x_current_display, f->display.x->normal_gc, f->display.x->font->fid); XSetFont (x_current_display, f->display.x->reverse_gc, f->display.x->font->fid); XSetFont (x_current_display, f->display.x->cursor_gc, f->display.x->font->fid); x_set_window_size (f, f->width, f->height); } { Lisp_Object lispy_name = build_string (fontname); /* Free the information from XListFonts. The data we actually retain comes from XLoadQueryFont. */ XFreeFontNames (font_names); return lispy_name; } } #else /* ! defined (HAVE_X11) */ x_new_font (f, newname) struct frame *f; register char *newname; { FONT_TYPE *temp; int mask; temp = XGetFont (newname); if (temp == (FONT_TYPE *) 0) return 1; if (f->display.x->font) XLoseFont (f->display.x->font); f->display.x->font = temp; if (FRAME_X_WINDOW (f) != 0) x_set_window_size (f, f->width, f->height); return 0; } #endif /* ! defined (HAVE_X11) */ /* X Window sizes and positions. */ x_calc_absolute_position (f) struct frame *f; { #ifdef HAVE_X11 Window win, 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->display.x->parent_desc != ROOT_WINDOW) { BLOCK_INPUT; XTranslateCoordinates (x_current_display, /* From-window, to-window. */ f->display.x->window_desc, f->display.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 (f->display.x->left_pos < 0) f->display.x->left_pos = (x_screen_width - f->display.x->border_width - win_x - PIXEL_WIDTH (f) + f->display.x->left_pos); if (f->display.x->top_pos < 0) f->display.x->top_pos = (x_screen_height - f->display.x->border_width - win_y - PIXEL_HEIGHT (f) + f->display.x->top_pos); #else /* ! defined (HAVE_X11) */ WINDOWINFO_TYPE parentinfo; XGetWindowInfo (FRAME_X_WINDOW (f), &parentinfo); if (f->display.x->left_pos < 0) f->display.x->left_pos = parentinfo.width + (f->display.x->left_pos + 1) - PIXEL_WIDTH (f) - 2 * f->display.x->internal_border_width; if (f->display.x->top_pos < 0) f->display.x->top_pos = parentinfo.height + (f->display.x->top_pos + 1) - PIXEL_HEIGHT (f) - 2 * f->display.x->internal_border_width; #endif /* ! defined (HAVE_X11) */ } x_set_offset (f, xoff, yoff) struct frame *f; register int xoff, yoff; { f->display.x->top_pos = yoff; f->display.x->left_pos = xoff; x_calc_absolute_position (f); BLOCK_INPUT; XMoveWindow (XDISPLAY FRAME_X_WINDOW (f), f->display.x->left_pos, f->display.x->top_pos); #ifdef HAVE_X11 x_wm_set_size_hint (f, 0, xoff, yoff); #endif /* ! defined (HAVE_X11) */ UNBLOCK_INPUT; } /* Call this to change the size of frame F's x-window. */ x_set_window_size (f, cols, rows) struct frame *f; int cols, rows; { int pixelwidth, pixelheight; int mask; BLOCK_INPUT; check_frame_size (f, &rows, &cols); f->display.x->vertical_scroll_bar_extra = (FRAME_HAS_VERTICAL_SCROLL_BARS (f) ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f) : 0); pixelwidth = CHAR_TO_PIXEL_WIDTH (f, cols); pixelheight = CHAR_TO_PIXEL_HEIGHT (f, rows); #ifdef HAVE_X11 x_wm_set_size_hint (f, 0, 0, 0); #endif /* ! defined (HAVE_X11) */ XChangeWindowSize (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; /* 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); XFlushQueue (); UNBLOCK_INPUT; } #ifndef HAVE_X11 x_set_resize_hint (f) struct frame *f; { XSetResizeHint (FRAME_X_WINDOW (f), 2 * f->display.x->internal_border_width, 2 * f->display.x->internal_border_width, FONT_WIDTH (f->display.x->font), FONT_HEIGHT (f->display.x->font)); } #endif /* HAVE_X11 */ /* Mouse warping, focus shifting, raising and lowering. */ x_set_mouse_position (f, x, y) struct frame *f; int x, y; { int pix_x, pix_y; x_raise_frame (f); pix_x = CHAR_TO_PIXEL_COL (f, x) + FONT_WIDTH (f->display.x->font) / 2; pix_y = CHAR_TO_PIXEL_ROW (f, y) + FONT_HEIGHT (f->display.x->font) / 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; XWarpMousePointer (FRAME_X_WINDOW (f), pix_x, pix_y); UNBLOCK_INPUT; } #ifdef HAVE_X11 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 (x_current_display, 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 (x_focus_frame == f) XSetInputFocus (x_current_display, PointerRoot, RevertToPointerRoot, CurrentTime); #endif /* ! 0 */ } #endif /* ! defined (HAVE_X11) */ /* Raise frame F. */ x_raise_frame (f) struct frame *f; { if (f->async_visible) { BLOCK_INPUT; XRaiseWindow (XDISPLAY FRAME_X_WINDOW (f)); XFlushQueue (); UNBLOCK_INPUT; } } /* Lower frame F. */ x_lower_frame (f) struct frame *f; { if (f->async_visible) { BLOCK_INPUT; XLowerWindow (XDISPLAY FRAME_X_WINDOW (f)); XFlushQueue (); 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 from withdrawn state to mapped state. */ x_make_frame_visible (f) struct frame *f; { int mask; BLOCK_INPUT; if (! FRAME_VISIBLE_P (f)) { #ifdef HAVE_X11 if (! EQ (Vx_no_window_manager, Qt)) x_wm_set_window_state (f, NormalState); XMapWindow (XDISPLAY FRAME_X_WINDOW (f)); if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) XMapSubwindows (x_current_display, FRAME_X_WINDOW (f)); #else /* ! defined (HAVE_X11) */ XMapWindow (XDISPLAY FRAME_X_WINDOW (f)); if (f->display.x->icon_desc != 0) XUnmapWindow (f->display.x->icon_desc); /* Handled by the MapNotify event for X11 */ f->async_visible = 1; f->async_iconified = 0; /* NOTE: this may cause problems for the first frame. */ XTcursor_to (0, 0); #endif /* ! defined (HAVE_X11) */ } XFlushQueue (); UNBLOCK_INPUT; } /* Change from mapped state to withdrawn state. */ x_make_frame_invisible (f) struct frame *f; { int mask; /* Don't keep the highlight on an invisible frame. */ if (x_highlight_frame == f) x_highlight_frame = 0; if (! f->async_visible && ! f->async_iconified) return; BLOCK_INPUT; #ifdef HAVE_X11R4 if (! XWithdrawWindow (x_current_display, FRAME_X_WINDOW (f), DefaultScreen (x_current_display))) { UNBLOCK_INPUT_RESIGNAL; error ("can't notify window manager of window withdrawal"); } #else /* ! defined (HAVE_X11R4) */ #ifdef HAVE_X11 /* 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 = FRAME_X_WINDOW (f); unmap.xunmap.event = DefaultRootWindow (x_current_display); unmap.xunmap.from_configure = False; if (! XSendEvent (x_current_display, DefaultRootWindow (x_current_display), False, SubstructureRedirectMask|SubstructureNotifyMask, &unmap)) { UNBLOCK_INPUT_RESIGNAL; error ("can't notify window manager of withdrawal"); } } /* Unmap the window ourselves. Cheeky! */ XUnmapWindow (x_current_display, FRAME_X_WINDOW (f)); #else /* ! defined (HAVE_X11) */ XUnmapWindow (FRAME_X_WINDOW (f)); f->async_visible = 0; /* Handled by the UnMap event for X11 */ if (f->display.x->icon_desc != 0) XUnmapWindow (f->display.x->icon_desc); #endif /* ! defined (HAVE_X11) */ #endif /* ! defined (HAVE_X11R4) */ XFlushQueue (); UNBLOCK_INPUT; } /* Change window state from mapped to iconified. */ x_iconify_frame (f) struct frame *f; { int mask; /* Don't keep the highlight on an invisible frame. */ if (x_highlight_frame == f) x_highlight_frame = 0; if (f->async_iconified) return; BLOCK_INPUT; #ifdef HAVE_X11 /* 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 = Xatom_wm_change_state; message.xclient.format = 32; message.xclient.data.l[0] = IconicState; if (! XSendEvent (x_current_display, DefaultRootWindow (x_current_display), 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. */ XMapWindow (XDISPLAY FRAME_X_WINDOW (f)); if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) XMapSubwindows (x_current_display, FRAME_X_WINDOW (f)); } f->async_iconified = 1; #else /* ! defined (HAVE_X11) */ XUnmapWindow (XDISPLAY FRAME_X_WINDOW (f)); f->async_visible = 0; /* Handled in the UnMap event for X11. */ if (f->display.x->icon_desc != 0) { XMapWindow (XDISPLAY f->display.x->icon_desc); refreshicon (f); } #endif /* ! defined (HAVE_X11) */ XFlushQueue (); UNBLOCK_INPUT; } /* Destroy the X window of frame F. */ x_destroy_window (f) struct frame *f; { BLOCK_INPUT; if (f->display.x->icon_desc != 0) XDestroyWindow (XDISPLAY f->display.x->icon_desc); XDestroyWindow (XDISPLAY f->display.x->window_desc); free_frame_faces (f); XFlushQueue (); xfree (f->display.x); f->display.x = 0; if (f == x_focus_frame) x_focus_frame = 0; if (f == x_highlight_frame) x_highlight_frame = 0; UNBLOCK_INPUT; } /* Manage event queues for X10. */ #ifndef HAVE_X11 /* Manage event queues. This code is only used by the X10 support. We cannot leave events in the X queue and get them when we are ready because X does not provide a subroutine to get only a certain kind of event but not block if there are no queued events of that kind. Therefore, we must examine events as they come in and copy events of certain kinds into our private queues. All ExposeRegion events are put in x_expose_queue. All ButtonPressed and ButtonReleased events are put in x_mouse_queue. */ /* Write the event *P_XREP into the event queue *QUEUE. If the queue is full, do nothing, but return nonzero. */ int enqueue_event (p_xrep, queue) register XEvent *p_xrep; register struct event_queue *queue; { int newindex = queue->windex + 1; if (newindex == EVENT_BUFFER_SIZE) newindex = 0; if (newindex == queue->rindex) return -1; queue->xrep[queue->windex] = *p_xrep; queue->windex = newindex; return 0; } /* Fetch the next event from queue *QUEUE and store it in *P_XREP. If *QUEUE is empty, do nothing and return 0. */ int dequeue_event (p_xrep, queue) register XEvent *p_xrep; register struct event_queue *queue; { if (queue->windex == queue->rindex) return 0; *p_xrep = queue->xrep[queue->rindex++]; if (queue->rindex == EVENT_BUFFER_SIZE) queue->rindex = 0; return 1; } /* Return the number of events buffered in *QUEUE. */ int queue_event_count (queue) register struct event_queue *queue; { int tem = queue->windex - queue->rindex; if (tem >= 0) return tem; return EVENT_BUFFER_SIZE + tem; } /* Return nonzero if mouse input is pending. */ int mouse_event_pending_p () { return queue_event_count (&x_mouse_queue); } #endif /* HAVE_X11 */ /* Setting window manager hints. */ #ifdef HAVE_X11 /* SPEC_X and SPEC_Y are the specified positions. We look only at their sign, to decide the gravity. */ x_wm_set_size_hint (f, prompting, spec_x, spec_y) struct frame *f; long prompting; int spec_x, spec_y; { XSizeHints size_hints; Window window = FRAME_X_WINDOW (f); size_hints.flags = PResizeInc | PMinSize /* | PMaxSize */; flexlines = f->height; size_hints.x = f->display.x->left_pos; size_hints.y = f->display.x->top_pos; size_hints.height = PIXEL_HEIGHT (f); size_hints.width = PIXEL_WIDTH (f); size_hints.width_inc = FONT_WIDTH (f->display.x->font); size_hints.height_inc = FONT_HEIGHT (f->display.x->font); #if 0 size_hints.max_width = x_screen_width - CHAR_TO_PIXEL_WIDTH (f, 0); size_hints.max_height = x_screen_height - CHAR_TO_PIXEL_HEIGHT (f, 0); #endif { int base_width, base_height; base_width = CHAR_TO_PIXEL_WIDTH (f, 0); base_height = CHAR_TO_PIXEL_HEIGHT (f, 0); { int min_rows = 0, min_cols = 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 (prompting) size_hints.flags |= prompting; else { XSizeHints hints; /* Sometimes I hate X Windows... */ if (XGetNormalHints (x_current_display, window, &hints) == 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; } #if defined (PWinGravity) switch (((spec_x < 0) << 1) + (spec_y < 0)) { case 0: size_hints.win_gravity = NorthWestGravity; break; case 1: size_hints.win_gravity = SouthWestGravity; break; case 2: size_hints.win_gravity = NorthEastGravity; break; case 3: size_hints.win_gravity = SouthEastGravity; break; } size_hints.flags |= PWinGravity; #endif /* PWinGravity */ #ifdef HAVE_X11R4 XSetWMNormalHints (x_current_display, window, &size_hints); #else XSetNormalHints (x_current_display, window, &size_hints); #endif } /* Used for IconicState or NormalState */ x_wm_set_window_state (f, state) struct frame *f; int state; { Window window = FRAME_X_WINDOW (f); f->display.x->wm_hints.flags |= StateHint; f->display.x->wm_hints.initial_state = state; XSetWMHints (x_current_display, window, &f->display.x->wm_hints); } x_wm_set_icon_pixmap (f, icon_pixmap) struct frame *f; Pixmap icon_pixmap; { Window window = FRAME_X_WINDOW (f); if (icon_pixmap) { f->display.x->wm_hints.icon_pixmap = icon_pixmap; f->display.x->wm_hints.flags |= IconPixmapHint; } else f->display.x->wm_hints.flags &= ~IconPixmapHint; XSetWMHints (x_current_display, window, &f->display.x->wm_hints); } x_wm_set_icon_position (f, icon_x, icon_y) struct frame *f; int icon_x, icon_y; { Window window = FRAME_X_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 (x_current_display, window, &f->display.x->wm_hints); } /* Initialization. */ void x_term_init (display_name) char *display_name; { Lisp_Object frame; char *defaultvalue; #ifndef F_SETOWN_BUG #ifdef F_SETOWN extern int old_fcntl_owner; #endif /* ! defined (F_SETOWN) */ #endif /* F_SETOWN_BUG */ x_focus_frame = x_highlight_frame = 0; x_current_display = XOpenDisplay (display_name); if (x_current_display == 0) fatal ("X server %s not responding.\n\ Check the DISPLAY environment variable or use \"-d\"\n", display_name); #ifdef HAVE_X11 { int hostname_size = 256; hostname = (char *) xmalloc (hostname_size); #if 0 XSetAfterFunction (x_current_display, x_trace_wire); #endif /* ! 0 */ /* 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 gethostname to store the '\0'? */ if (strlen (hostname) < hostname_size - 1) break; hostname_size <<= 1; hostname = (char *) xrealloc (hostname, hostname_size); } x_id_name = (char *) xmalloc (XSTRING (Vinvocation_name)->size + strlen (hostname) + 2); sprintf (x_id_name, "%s@%s", XSTRING (Vinvocation_name)->data, hostname); } /* Figure out which modifier bits mean what. */ x_find_modifier_meanings (); /* Get the scroll bar cursor. */ x_vertical_scroll_bar_cursor = XCreateFontCursor (x_current_display, XC_sb_v_double_arrow); #if 0 /* Watch for PropertyNotify events on the root window; we use them to figure out when to invalidate our cache of the cut buffers. */ x_watch_cut_buffer_cache (); #endif if (ConnectionNumber (x_current_display) != 0) change_keyboard_wait_descriptor (ConnectionNumber (x_current_display)); change_input_fd (ConnectionNumber (x_current_display)); #endif /* ! defined (HAVE_X11) */ #ifndef F_SETOWN_BUG #ifdef F_SETOWN old_fcntl_owner = fcntl (ConnectionNumber (x_current_display), F_GETOWN, 0); #ifdef F_SETOWN_SOCK_NEG /* stdin is a socket here */ fcntl (ConnectionNumber (x_current_display), F_SETOWN, -getpid ()); #else /* ! defined (F_SETOWN_SOCK_NEG) */ fcntl (ConnectionNumber (x_current_display), F_SETOWN, getpid ()); #endif /* ! defined (F_SETOWN_SOCK_NEG) */ #endif /* ! defined (F_SETOWN) */ #endif /* F_SETOWN_BUG */ #ifdef SIGIO init_sigio (); #endif /* ! defined (SIGIO) */ expose_all_windows = 0; 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; 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; /* Try to use interrupt input; if we can't, then start polling. */ Fset_input_mode (Qt, Qnil, Qt, Qnil); /* Note that there is no real way portable across R3/R4 to get the original error handler. */ XHandleError (x_error_quitter); XHandleIOError (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_closed); } void syms_of_xterm () { staticpro (&last_mouse_scroll_bar); last_mouse_scroll_bar = Qnil; } #endif /* ! defined (HAVE_X11) */ #endif /* ! defined (HAVE_X_WINDOWS) */ emacs-19.22/src/acldef.h100444 12241 12 2043 5444474534 13637 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.22/src/blockinput.h100444 12241 12 6302 5444474535 14576 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.22/src/buffer.h100444 12241 12 35351 5444474537 13725 0ustar rolandstaff/* Header file for the buffer manipulation primitives. 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. */ #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->text.pt = (position)) #define TEMP_SET_PT(position) (current_buffer->text.pt = (position)) #define BUF_SET_PT(buffer, position) (buffer->text.pt = (position)) #define BUF_TEMP_SET_PT(buffer, position) (buffer->text.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->text.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->text.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->text.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) /* 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->text.begv)) /* Address of point in buffer. */ #define PT_ADDR (&FETCH_CHAR (current_buffer->text.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->text.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)->text.begv) /* Character position of point in buffer. */ #define BUF_PT(buf) ((buf)->text.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)->text.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) /* 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)->text.zv = (value)) #define SET_BUF_PT(buf, value) ((buf)->text.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) struct buffer_text { unsigned char *beg; /* Actual address of buffer contents. */ int begv; /* Index of beginning of accessible range. */ int pt; /* Position of point in buffer. */ int gpt; /* Index of gap in buffer. */ int zv; /* Index of end of accessible range. */ 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. */ }; 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. */ /* This structure holds the coordinates of the buffer contents. */ struct buffer_text text; /* 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. */ struct buffer *next; /* Flags saying which DEFVAR_PER_BUFFER variables are local to this buffer. */ int local_var_flags; /* Value of text.modiff as of when visited file was read or written. */ int save_modified; /* 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; /* Position in buffer at which display started the last time this buffer was displayed */ int last_window_start; /* Properties of this buffer's text -- conditionally compiled. */ DECLARE_INTERVALS /* This is a special exception -- as this slot should not be marked by gc_sweep, and as it is not lisp-accessible as a local variable -- so we regard it as not really being of type Lisp_Object */ /* 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; /* Everything from here down must be a Lisp_Object */ /* the name of this buffer */ Lisp_Object name; /* Nuked: buffer number, assigned when buffer made Lisp_Object number;*/ /* the name of the file associated with this buffer */ Lisp_Object filename; /* Dir for expanding relative pathnames */ Lisp_Object directory; /* true iff this buffer has been been backed up (if you write to its associated 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. */ Lisp_Object save_length; /* file name used for auto-saving this buffer */ Lisp_Object auto_save_file_name; /* Non-nil if buffer read-only */ Lisp_Object read_only; /* "The mark"; no longer allowed to be nil */ 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; /* Format string for 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; /* String of length 256 mapping each char to its lower-case version. */ Lisp_Object downcase_table; /* String of length 256 mapping each char to its upper-case version. */ Lisp_Object upcase_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; /* Translate table for case-folding search. */ Lisp_Object case_canon_table; /* Inverse translate (equivalence class) table for case-folding search. */ Lisp_Object case_eqv_table; /* Changes in the buffer are recorded here for undo. t means don't record anything. */ Lisp_Object undo_list; /* t means the mark and region are currently active. */ Lisp_Object mark_active; /* 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; }; /* 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->text.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 Lisp_Object Fbuffer_name (); extern Lisp_Object Fget_file_buffer (); /* Functions to call before and after each text change. */ extern Lisp_Object Vbefore_change_function; extern Lisp_Object Vafter_change_function; extern Lisp_Object Vfirst_change_hook; extern Lisp_Object Qfirst_change_hook; extern Lisp_Object Vdeactivate_mark; extern Lisp_Object Vtransient_mark_mode; /* Overlays */ /* Overlays are ordinary Lisp objects, and users can alter their contents. Therefore, we cannot assume that they remain valid--we must check. */ /* 1 if the OV is a cons cell whose car is a cons cell. */ #define OVERLAY_VALID(OV) (OVERLAYP (OV)) /* Return the marker that stands for where OV starts in the buffer. */ #define OVERLAY_START(OV) (XCONS (XCONS ((OV))->car)->car) /* Return the marker that stands for where OV ends in the buffer. */ #define OVERLAY_END(OV) (XCONS (XCONS ((OV))->car)->cdr) /* Return the actual buffer position for the marker P, if it is a marker and points into the current buffer. Otherwise, zero. */ #define OVERLAY_POSITION(P) \ ((MARKERP ((P)) && XMARKER ((P))->buffer == current_buffer) \ ? marker_position ((P)) : 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.22/src/chpdef.h100444 12241 12 1565 5444474543 13662 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.22/src/cm.h100444 12241 12 12620 5444474544 13043 0ustar rolandstaff/* 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 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. */ /* 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 cmputc (); extern int cmcostinit (); extern int cmgoto (); extern int Wcm_clear (); extern int Wcm_init (); emacs-19.22/src/commands.h100444 12241 12 5336 5444474545 14234 0ustar rolandstaff/* Definitions needed by most editing commands. 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 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. */ #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 unread_command_events; /* 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. */ extern Lisp_Object unread_switch_frame; /* Previous command symbol found here for comparison */ extern Lisp_Object last_command; /* 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.22/src/COPYING100666 12120 24 43070 5475722562 12676 0ustar rmsother 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.22/src/dir.h100444 12241 12 5402 5444474547 13205 0ustar rolandstaff/* 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 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. */ /* * 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.22/src/dispextern.h100444 12241 12 10116 5444474550 14624 0ustar rolandstaff/* Interface definitions for display code. Copyright (C) 1985, 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. */ /* 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 struct face { /* If this is non-zero, it is a GC we can use without modification to represent this face. */ GC gc; /* If we have ever called get_cached_face on this face structure, here is the index in face_vector of the face it returned. It might not be valid any more, but it's a good place to start looking; get_cached_face tries to use this to avoid searching all of face_vector. */ int cached_index; /* Pixel value for foreground color. */ int foreground; /* Pixel value for background color. */ int 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 X */ 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 X */ /* 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. */ int *bufp; #ifdef HAVE_X_WINDOWS /* 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_X_WINDOWS */ }; extern void get_display_line (); extern Lisp_Object sit_for (); emacs-19.22/src/disptab.h100444 12241 12 6424 5444474552 14056 0ustar rolandstaff/* 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 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. */ /* Access the slots of a display-table, according to their purpose. */ #define DISP_TABLE_SIZE 261 #define DISP_TRUNC_GLYPH(dp) ((dp)->contents[256]) #define DISP_CONTINUE_GLYPH(dp) ((dp)->contents[257]) #define DISP_ESCAPE_GLYPH(dp) ((dp)->contents[258]) #define DISP_CTRL_GLYPH(dp) ((dp)->contents[259]) #define DISP_INVIS_VECTOR(dp) ((dp)->contents[260]) #define DISP_CHAR_VECTOR(dp, c) ((dp)->contents[c]) extern struct Lisp_Vector *window_display_table (); /* Display table to use for vectors that don't specify their own. */ extern Lisp_Object Vstandard_display_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 \ ((XTYPE (Vglyph_table) == Lisp_Vector) \ ? 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 \ ((XTYPE (Vglyph_table) == Lisp_Vector) \ ? 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) || XTYPE (base[g]) != Lisp_String) /* 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) && XTYPE (base[g]) == Lisp_Int) /* 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.22/src/frame.h100444 12241 12 42151 5444474563 13541 0ustar rolandstaff/* Define frame-object for GNU Emacs. 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. */ /* 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 }; struct frame { int size; struct Lisp_Vector *next; /* 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. */ int height; int width; /* New height and width for pending size change. 0 if no change pending. */ int new_height, new_width; /* Name of this frame: a Lisp string. See also `explicit_name'. */ Lisp_Object 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; /* 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_display is used for X window frames; it is defined in xterm.h. */ union display { struct x_display *x; int nothing; } display; /* Number of lines of menu bar. */ int menu_bar_lines; /* 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. This 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; /* 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; }; #ifdef MULTI_FRAME typedef struct frame *FRAME_PTR; #define XFRAME(p) ((struct frame *) XPNTR (p)) #define XSETFRAME(p, v) ((struct frame *) XSETPNTR (p, v)) #define WINDOW_FRAME(w) (w)->frame #define FRAME_LIVE_P(f) ((f)->display.nothing != 0) #define FRAME_TERMCAP_P(f) ((f)->output_method == output_termcap) #define FRAME_X_P(f) ((f)->output_method == output_x_window) #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 #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_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_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) /* 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. */ #define FRAME_PTR int /* 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; extern int selected_frame; extern int last_nonminibuf_frame; #define XFRAME(f) selected_frame #define WINDOW_FRAME(w) selected_frame #define FRAME_LIVE_P(f) 1 #define FRAME_TERMCAP_P(f) 1 #define FRAME_X_P(f) 0 #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_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_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) /* 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 = selected_frame, ! NILP (list_var); list_var = Qnil) #endif /* not MULTI_FRAME */ /* Device- and MULTI_FRAME-independent scroll bar stuff. */ /* The number of columns a vertical scroll bar occupies. */ #define VERTICAL_SCROLL_BAR_WIDTH (2) /* 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) - VERTICAL_SCROLL_BAR_WIDTH \ : 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.22/src/getpagesize.h100777 21570 1 1162 5426320432 14343 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 #endif /* NBPC */ #endif /* no NBPG */ #endif /* no EXEC_PAGESIZE */ #endif /* no _SC_PAGESIZE */ #endif /* not HAVE_GETPAGESIZE */ emacs-19.22/src/gnu.h100444 12241 12 4325 5444474563 13221 0ustar rolandstaff#define gnu_width 50 #define gnu_height 50 static 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.22/src/indent.h100444 12241 12 2033 5444474565 13705 0ustar rolandstaff/* 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 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. */ 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; emacs-19.22/src/intervals.h100444 12241 12 21113 5444474567 14455 0ustar rolandstaff/* Definitions and global variables for intervals. 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 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. */ #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 || \ XTYPE ((Lisp_Object)(i)) == Lisp_Buffer || \ XTYPE ((Lisp_Object)(i)) == Lisp_String) /* True if this interval has no right child. */ #define NULL_RIGHT_CHILD(i) (NULL_INTERVAL_P((i)->right)) /* True if this interval has no left child. */ #define NULL_LEFT_CHILD(i) (NULL_INTERVAL_P((i)->left)) /* 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 ehild 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 absolute index of the last character belonging to I. Note that the position cache i->position must be valid for this to work. */ #define INTERVAL_LAST_POS(i) ((i)->position + LENGTH ((i)) - 1) /* 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))) /* Declared in alloc.c */ extern INTERVAL make_interval (); /* Declared in intervals.c */ extern Lisp_Object interval_balance_threshold; 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 textget_direct (); 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, Qhidden, Qread_only; extern Lisp_Object Vinhibit_point_motion_hooks; /* Sticky properties */ extern Lisp_Object Qfront_sticky, Qrear_nonsticky; 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.22/src/ioctl.h100444 12241 12 44 5444474567 13500 0ustar rolandstaff/* Emacs ioctl emulation for VMS */ emacs-19.22/src/keyboard.h100444 12241 12 7630 5444474572 14232 0ustar rolandstaff/* 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. */ /* 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; /* 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) \ (XTYPE (event) == Lisp_Cons) /* 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; emacs-19.22/src/line.h100444 12241 12 506 5444474574 13336 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.22/src/lisp.h100444 12120 1 132634 5474357150 13073 0ustar rmsdaemon/* Fundamental definitions for GNU Emacs Lisp interpreter. 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. */ /* 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, /* Marker (buffer ptr). XMARKER(object) points to a struct Lisp_Marker. */ Lisp_Marker, /* 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. XVECTOR(object) points to a struct Lisp_Vector. The length of the vector, and its contents, are stored therein. */ Lisp_Vector, /* Cons. XCONS (object) points to a struct Lisp_Cons. */ Lisp_Cons, /* Byte-compiled function. A vector of 4 to 6 elements which are the arglist, bytecode-string, constant vector, stack size, (optional) doc string, and (optional) interactive spec. */ Lisp_Compiled, /* Editor buffer. XBUFFER(obj) points to a struct buffer. */ Lisp_Buffer, /* Built-in function. XSUBR(obj) points to a struct Lisp_Subr which describes how to call the function, and its documentation, as well as pointing to the code. */ Lisp_Subr, /* Internal value return by subroutines of read. The user never sees this data type. Its value is just a number. */ Lisp_Internal, /* 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. XINTPTR(obj) points to the int variable. */ Lisp_Intfwd, /* 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. XINTPTR(obj) points to the int variable. */ Lisp_Boolfwd, /* Object describing a connection to a subprocess. It points to storage of type struct Lisp_Process */ Lisp_Process, /* 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. XOBJFWD(obj) points to the Lisp_Object variable. */ Lisp_Objfwd, #ifdef MULTI_FRAME /* Pointer to a vector-like object describing a display frame on which Emacs can display a window hierarchy. We don't define this unless MULTI_FRAME is defined; this helps the compiler catch code that won't work on a non-MULTI_FRAME configuration. */ Lisp_Frame, #endif /* Used when a FILE * value needs to be passed in an argument of type Lisp_Object. You must do *(FILE **) XPNTR(obj) to get the value. The user will never see this data type. */ Lisp_Internal_Stream, /* Used in a symbol value cell when the symbol's value is per-buffer. The actual contents are a cons cell which starts a list like this: (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. 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_Buffer_Local_Value, /* Like Lisp_Buffer_Local_Value with one difference: 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. */ Lisp_Some_Buffer_Local_Value, /* Like Lisp_Objfwd except that value lives in a slot in the current buffer. Value is byte index of slot within buffer */ Lisp_Buffer_Objfwd, /* In symbol value cell, means var is unbound. In symbol function cell, means function name is undefined. */ Lisp_Void, /* Window used for Emacs display. Data inside looks like a Lisp_Vector. */ Lisp_Window, /* Used by save,set,restore-window-configuration */ Lisp_Window_Configuration, #ifdef LISP_FLOAT_TYPE Lisp_Float, #endif /* LISP_FLOAT_TYPE */ /* The overlay type. An overlay values is actually a retagged cons, the first in a list of the form ((START . END) nil . PLIST) where START and END are markers in the overlay's buffer, and PLIST is the overlay's property list. */ Lisp_Overlay }; #ifndef NO_UNION_TYPE #ifndef 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: 24; char type; } s; struct { unsigned int val: 24; char type; } u; struct { unsigned int val: 24; enum Lisp_Type type: 7; /* 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 BIG_ENDIAN */ typedef union Lisp_Object { /* Used for comparing two Lisp_Objects; also, positive integers can be accessed fast this way. */ int i; struct { char type; int val: 24; } s; struct { char type; unsigned int val: 24; } 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: 7; unsigned int val: 24; } gu; } Lisp_Object; #endif /* 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 int /* These values are overridden by the m- file on some machines. */ #ifndef VALBITS #define VALBITS 24 #endif #ifndef GCTYPEBITS #define GCTYPEBITS 7 #endif #ifndef VALMASK #define VALMASK ((1<> VALBITS)) #endif #ifndef XSETTYPE #define XSETTYPE(a, b) ((a) = XUINT (a) | ((int)(b) << VALBITS)) #endif /* Use XFASTINT for fast retrieval and storage of integers known to be positive. This takes advantage of the fact that Lisp_Int is 0. */ #define XFASTINT(a) (a) /* Extract the value of a Lisp_Object as a signed integer. */ #ifndef XINT /* Some machines need to do this differently. */ #define XINT(a) (((a) << (INTBITS-VALBITS)) >> (INTBITS-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 XSETINT #define XSETINT(a, b) ((a) = ((a) & ~VALMASK) | ((b) & VALMASK)) #endif #ifndef XSETUINT #define XSETUINT(a, b) XSETINT (a, b) #endif #ifndef XSETPNTR #define XSETPNTR(a, b) XSETINT (a, b) #endif #ifndef XSET #define XSET(var, type, ptr) \ ((var) = ((int)(type) << VALBITS) + ((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 == INTBITS - 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)) /* Use XFASTINT for fast retrieval and storage of integers known to be positive. This takes advantage of the fact that Lisp_Int is 0. */ #define XFASTINT(a) ((a).i) #ifdef EXPLICIT_SIGN_EXTEND /* Make sure we sign-extend; compilers have been known to fail to do so. */ #define XINT(a) (((a).i << 8) >> 8) #else #define XINT(a) ((a).s.val) #endif /* EXPLICIT_SIGN_EXTEND */ #define XUINT(a) ((a).u.val) #define XPNTR(a) ((a).u.val) #define XSETINT(a, b) ((a).s.val = (int) (b)) #define XSETUINT(a, b) ((a).s.val = (int) (b)) #define XSETPNTR(a, b) ((a).s.val = (int) (b)) #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 */ #define XCONS(a) ((struct Lisp_Cons *) XPNTR(a)) #define XBUFFER(a) ((struct buffer *) XPNTR(a)) #define XVECTOR(a) ((struct Lisp_Vector *) XPNTR(a)) #define XSUBR(a) ((struct Lisp_Subr *) XPNTR(a)) #define XSTRING(a) ((struct Lisp_String *) XPNTR(a)) #define XSYMBOL(a) ((struct Lisp_Symbol *) XPNTR(a)) #define XFUNCTION(a) ((Lisp_Object (*)()) XPNTR(a)) #define XMARKER(a) ((struct Lisp_Marker *) XPNTR(a)) #define XOBJFWD(a) ((Lisp_Object *) XPNTR(a)) #define XINTPTR(a) ((int *) XPNTR(a)) #define XWINDOW(a) ((struct window *) XPNTR(a)) #define XPROCESS(a) ((struct Lisp_Process *) XPNTR(a)) #define XFLOAT(a) ((struct Lisp_Float *) XPNTR(a)) #define XSETCONS(a, b) XSETPNTR(a, (int) (b)) #define XSETBUFFER(a, b) XSETPNTR(a, (int) (b)) #define XSETVECTOR(a, b) XSETPNTR(a, (int) (b)) #define XSETSUBR(a, b) XSETPNTR(a, (int) (b)) #define XSETSTRING(a, b) XSETPNTR(a, (int) (b)) #define XSETSYMBOL(a, b) XSETPNTR(a, (int) (b)) #define XSETFUNCTION(a, b) XSETPNTR(a, (int) (b)) #define XSETMARKER(a, b) XSETPNTR(a, (int) (b)) #define XSETOBJFWD(a, b) XSETPNTR(a, (int) (b)) #define XSETINTPTR(a, b) XSETPNTR(a, (int) (b)) #define XSETWINDOW(a, b) XSETPNTR(a, (int) (b)) #define XSETPROCESS(a, b) XSETPNTR(a, (int) (b)) #define XSETFLOAT(a, b) XSETPNTR(a, (int) (b)) #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 (XTYPE ((x)) != Lisp_String && XTYPE ((x)) != Lisp_Buffer) \ 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 { int size; DECLARE_INTERVALS /* `data' field must be last. */ unsigned char data[1]; }; struct Lisp_Vector { int size; struct Lisp_Vector *next; Lisp_Object contents[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 */ }; struct Lisp_Subr { Lisp_Object (*function) (); short min_args, max_args; char *symbol_name; char *prompt; char *doc; }; /* In a marker, the markbit of the chain field is used as the gc mark bit */ struct Lisp_Marker { struct buffer *buffer; Lisp_Object chain; int bufpos; int modified; }; #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 18 bits for the character value itself, so we probably shouldn't use any bits lower than 0x040000. */ #define CHAR_ALT (0x040000) #define CHAR_SUPER (0x080000) #define CHAR_HYPER (0x100000) #define CHAR_SHIFT (0x200000) #define CHAR_CTL (0x400000) #define CHAR_META (0x800000) /* 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 /* Given a character code and a face ID, return the appropriate glyph. */ #define MAKE_GLYPH(char, face) ((char) | ((face) << 8)) /* Return a glyph's character code. */ #define GLYPH_CHAR(glyph) ((glyph) & 0xff) /* Return a glyph's face ID. */ #define GLYPH_FACE(glyph) (((glyph) >> 8) & ((1 << 24) - 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) (XTYPE (x) == Lisp_Int || XTYPE (x) == Lisp_Float) #else #define NUMBERP(x) (XTYPE (x) == Lisp_Int) #endif #define INTEGERP(x) (XTYPE ((x)) == Lisp_Int) #define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) #define MARKERP(x) (XTYPE ((x)) == Lisp_Marker) #define STRINGP(x) (XTYPE ((x)) == Lisp_String) #define VECTORP(x) (XTYPE ((x)) == Lisp_Vector) #define CONSP(x) (XTYPE ((x)) == Lisp_Cons) #define COMPILEDP(x) (XTYPE ((x)) == Lisp_Compiled) #define BUFFERP(x) (XTYPE ((x)) == Lisp_Buffer) #define SUBRP(x) (XTYPE ((x)) == Lisp_Subr) #define PROCESSP(x) (XTYPE ((x)) == Lisp_Process) #define FRAMEP(x) (XTYPE ((x)) == Lisp_Frame) #define WINDOWP(x) (XTYPE ((x)) == Lisp_Window) #define WINDOW_CONFIGURATIONP(x) (XTYPE ((x)) == Lisp_Window_Configuration) #ifdef LISP_FLOAT_TYPE #define FLOATP(x) (XTYPE ((x)) == Lisp_Float) #else #define FLOATP(x) (0) #endif #define OVERLAYP(x) (XTYPE ((x)) == Lisp_Overlay) #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 ((XTYPE ((x)) != Lisp_Cons) && !NILP (x)) x = wrong_type_argument (Qlistp, (x)); } while (0) #define CHECK_STRING(x, i) \ do { if (XTYPE ((x)) != Lisp_String) x = wrong_type_argument (Qstringp, (x)); } while (0) #define CHECK_CONS(x, i) \ do { if (XTYPE ((x)) != Lisp_Cons) x = wrong_type_argument (Qconsp, (x)); } while (0) #define CHECK_SYMBOL(x, i) \ do { if (XTYPE ((x)) != Lisp_Symbol) x = wrong_type_argument (Qsymbolp, (x)); } while (0) #define CHECK_VECTOR(x, i) \ do { if (XTYPE ((x)) != Lisp_Vector) x = wrong_type_argument (Qvectorp, (x)); } while (0) #define CHECK_BUFFER(x, i) \ do { if (XTYPE ((x)) != Lisp_Buffer) x = wrong_type_argument (Qbufferp, (x)); } while (0) #define CHECK_WINDOW(x, i) \ do { if (XTYPE ((x)) != Lisp_Window) 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 (XTYPE ((x)) != Lisp_Window \ || NILP (XWINDOW ((x))->buffer)) \ x = wrong_type_argument (Qwindow_live_p, (x)); \ } while (0) #define CHECK_PROCESS(x, i) \ do { if (XTYPE ((x)) != Lisp_Process) x = wrong_type_argument (Qprocessp, (x)); } while (0) #define CHECK_NUMBER(x, i) \ do { if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qintegerp, (x)); } while (0) #define CHECK_NATNUM(x, i) \ do { if (XTYPE ((x)) != Lisp_Int || XINT ((x)) < 0) \ x = wrong_type_argument (Qnatnump, (x)); } while (0) #define CHECK_MARKER(x, i) \ do { if (XTYPE ((x)) != Lisp_Marker) x = wrong_type_argument (Qmarkerp, (x)); } while (0) #define CHECK_NUMBER_COERCE_MARKER(x, i) \ do { if (XTYPE ((x)) == Lisp_Marker) XFASTINT (x) = marker_position (x); \ else if (XTYPE ((x)) != Lisp_Int) 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 (XTYPE (x) != Lisp_Float) \ x = wrong_type_argument (Qfloatp, (x)); } while (0) #define CHECK_NUMBER_OR_FLOAT(x, i) \ do { if (XTYPE (x) != Lisp_Float && XTYPE (x) != Lisp_Int) \ x = wrong_type_argument (Qnumberp, (x)); } while (0) #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x, i) \ do { if (XTYPE (x) == Lisp_Marker) XFASTINT (x) = marker_position (x); \ else if (XTYPE (x) != Lisp_Int && XTYPE (x) != Lisp_Float) \ 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 (XTYPE ((x)) != Lisp_Overlay) 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. This can be zero or a C string. Zero means that interactive calls are not allowed. A string is interpreted in a hairy way: it should contain one line for each argument to be read, terminated by \n. The first character of the line controls the type of parsing: s -- read a string. S -- read a symbol. k -- read a key sequence and return it as a string. a -- read a function name (symbol) with completion. C -- read a command name (symbol) with completion. v -- read a variable name (symbol) with completion. b -- read a buffer name (a string) with completion. B -- buffer name, may be existing buffer or may not be. f -- read a file name, file must exist. F -- read a file name, file need not exist. n -- read a number. c -- read a character and return it as a number. p -- use the numeric value of the prefix argument. P -- use raw value of prefix - can be nil, -, (NUMBER) or NUMBER. x -- read a Lisp object from the minibuffer. X -- read a Lisp form from the minibuffer and use its value. A null string means call interactively with no arguments. `doc' is documentation for the user. */ #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \ Lisp_Object fnname (); \ struct Lisp_Subr sname = {fnname, minargs, maxargs, lname, prompt, 0}; \ Lisp_Object fnname /* 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 (); /* 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) /* 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; /* 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; /* 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) \ (XSTRING (current_buffer->downcase_table)->data[CH] != (CH)) /* 1 if CH is lower case. */ #define LOWERCASEP(CH) \ (!UPPERCASEP (CH) \ && XSTRING (current_buffer->upcase_table)->data[CH] != (CH)) /* 1 if CH is neither upper nor lower case. */ #define NOCASEP(CH) (XSTRING (current_buffer->upcase_table)->data[CH] == (CH)) /* Upcase a character, or make no change if that cannot be done. */ #define UPCASE(CH) \ (XSTRING (current_buffer->downcase_table)->data[CH] == (CH) \ ? UPCASE1 (CH) : (CH)) /* Upcase a character known to be not upper case. */ #define UPCASE1(CH) (XSTRING (current_buffer->upcase_table)->data[CH]) /* Downcase a character, or make no change if that cannot be done. */ #define DOWNCASE(CH) (XSTRING (current_buffer->downcase_table)->data[CH]) /* Current buffer's map from characters to lower-case characters. */ #define DOWNCASE_TABLE XSTRING (current_buffer->downcase_table)->data /* Table mapping each char to the next char with the same lowercase version. This mapping is a no-op only for characters that don't have case. */ #define UPCASE_TABLE XSTRING (current_buffer->upcase_table)->data extern Lisp_Object Vascii_downcase_table, Vascii_upcase_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; } /* 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. I used to have a `do ... while' clause around this to make it interact with semicolons correctly, but this makes some compilers complain that the while is never reached. */ #define RETURN_UNGCPRO(expr) \ { \ Lisp_Object ret_ungc_val; \ ret_ungc_val = (expr); \ UNGCPRO; \ return ret_ungc_val; \ } \ /* 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, 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 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 (), Farray_length (); 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 (); #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 fns.c */ extern Lisp_Object Qstring_lessp; extern Lisp_Object Vfeatures; extern Lisp_Object Fidentity (), Frandom (); extern Lisp_Object Flength (); extern Lisp_Object Fappend (), Fconcat (), Fvconcat (), Fcopy_sequence (); extern Lisp_Object Fsubstring (); extern Lisp_Object Fnth (), Fnthcdr (), Fmemq (), Fassq (), Fassoc (); extern Lisp_Object 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 (); /* Defined in alloc.c */ extern Lisp_Object Vpurify_flag; extern Lisp_Object Fcons (), Flist(), Fmake_list (); 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 (); /* 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 Vrun_hooks; 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 apply_lambda (); extern Lisp_Object internal_catch (); extern Lisp_Object internal_condition_case (); extern Lisp_Object unbind_to (); extern void error (); extern Lisp_Object un_autoload (); /* Defined in editfns.c */ extern Lisp_Object Vprefix_arg, Qminus, Vcurrent_prefix_arg; 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 (); /* defined in buffer.c */ 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 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 Fdirectory_file_name (); extern Lisp_Object Ffile_name_directory (); extern Lisp_Object expand_and_dir_to_file (); extern Lisp_Object Ffile_accessible_directory_p (); /* 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 (); /* 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 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 (); /* 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 Qvertical_scroll_bar; /* defined in keymap.c */ extern Lisp_Object Qkeymap; 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(); /* 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 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_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 (); #ifndef HAVE_X11 extern Lisp_Object Frubber_band_rectangle (); #endif /* HAVE_X11 */ /* defined in emacs.c */ extern Lisp_Object decode_env_path (); extern Lisp_Object Vinvocation_name, Vinvocation_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; /* defined in process.c */ extern Lisp_Object Fget_process (), Fget_buffer_process (), Fprocessp (); extern Lisp_Object Fprocess_status (), Fkill_process (); /* defined in callproc.c */ extern Lisp_Object Vexec_path, Vexec_directory, Vdata_directory; /* defined in doc.c */ extern Lisp_Object Vdoc_file_name; extern Lisp_Object Fsubstitute_command_keys (); extern Lisp_Object Fdocumentation (), Fdocumentation_property (); /* 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 Qinsert_in_front_hooks, Qinsert_behind_hooks; extern Lisp_Object Fnext_property_change (); extern Lisp_Object Fnext_single_property_change (); /* 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 (); emacs-19.22/src/macros.h100444 12241 12 2050 5444474577 13712 0ustar rolandstaff/* 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 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. */ /* 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; /* Nonzero while defining a kbd macro */ extern int defining_kbd_macro; emacs-19.22/src/mem-limits.h100444 12241 12 5765 5444474600 14506 0ustar rolandstaff/* Includes for memory limit warnings. Copyright (C) 1990, 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 _LIBC #include #define BSD4_2 /* Tell code below to use getrlimit. */ #else #if defined(__osf__) && (defined(__mips) || defined(mips)) #include #include #endif #ifdef __bsdi__ #define BSD4_2 #endif #ifndef BSD4_2 #ifndef USG #include #endif /* not USG */ #else /* if BSD4_2 */ #include #include #endif /* BSD4_2 */ #endif /* _LIBC */ #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) \ (((unsigned int) (ptr) & ~DATA_SEG_BITS) >> VALBITS) #else #define EXCEEDS_LISP_PTR(ptr) ((unsigned int) (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 */ /* 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 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 */ #if !defined(BSD4_2) && !defined(__osf__) static void get_lim_data () { lim_data = vlimit (LIM_DATA, -1); } #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 USG */ emacs-19.22/src/mocklisp.h100444 12241 12 2365 5444474602 14245 0ustar rolandstaff/* 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 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. */ /* 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.22/src/ndir.h100444 12241 12 2356 5444474602 13360 0ustar rolandstaff/* -- 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 "dir.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 #define MAXNAMLEN 15 /* maximum filename length */ #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.22/src/param.h100444 12241 12 110 5444474603 13467 0ustar rolandstaff/* This is so that Emacs can run on VMS... */ #define EXEC_PAGESIZE 512 emacs-19.22/src/point.h100444 12241 12 304 5444474605 13527 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.22/src/process.h100444 12241 12 7411 5444474610 14076 0ustar rolandstaff/* Definitions for asynchronous process control 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 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. */ /* * Structure records pertinent information about open channels. * There is one channel associated with each process. */ struct Lisp_Process { 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 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)) /* 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.22/src/puresize.h100444 12241 1 4323 5451144244 14376 0ustar rolanddaemon/* 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 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. */ /* # 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. */ #ifndef PURESIZE #ifdef MULTI_FRAME #define PURESIZE 220000 #else #define PURESIZE 190000 #endif #endif #ifdef VIRT_ADDR_VARIES /* For machines like APOLLO where text and data can go anywhere in virtual memory. */ #define CHECK_IMPURE(obj) \ { extern 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 int 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 int my_edata; \ if (XPNTR (obj) < (unsigned int) &my_edata) \ pure_write_error (); } #endif /* PNTR_COMPARISON_TYPE */ #endif /* VIRT_ADDRESS_VARIES */ emacs-19.22/src/regex.h100666 12241 1 44406 5401254205 13670 0ustar rolanddaemon/* Definitions for data structures and routines for the regular expression library, version 0.12. Copyright (C) 1985, 89, 90, 91, 92, 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. */ #ifndef __REGEXP_LIBRARY_H__ #define __REGEXP_LIBRARY_H__ /* POSIX says that must be included (by the caller) before . */ #ifdef 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) /* 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. */ 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. */ char *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; /* search.c (search_buffer) in Emacs needs this one opcode value. It is defined both in `regex.c' and here. */ #define RE_EXACTN_VALUE 1 /* 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)); /* 4.2 bsd compatibility. */ extern char *re_comp _RE_ARGS ((const char *)); extern int re_exec _RE_ARGS ((const char *)); /* 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.22/src/sink.h100444 12241 12 6370 5444474614 13373 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.22/src/sink11.h100444 12241 12 3711 5444474614 13531 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.22/src/sink11mask.h100444 12241 12 3652 5444474615 14412 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.22/src/sinkmask.h100444 12241 12 3536 5444474615 14251 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.22/src/syntax.h100444 12241 12 10507 5444474617 13775 0ustar rolandstaff/* Declarations having to do with GNU Emacs syntax tables. Copyright (C) 1985, 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 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. */ 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 Lisp vector of length 0400, whose elements are integers. The low 8 bits of the integer 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 */ Smax /* Upper bound on codes that are meaningful */ }; #define SYNTAX(c) \ ((enum syntaxcode) (XINT (XVECTOR (current_buffer->syntax_table)->contents[(unsigned char) (c)]) & 0377)) /* The next 8 bits of the number is a character, the matching delimiter in the case of Sopen or Sclose. */ #define SYNTAX_MATCH(c) \ ((XINT (XVECTOR (current_buffer->syntax_table)->contents[(unsigned char) (c)]) >> 8) & 0377) /* 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) \ ((XINT (XVECTOR (current_buffer->syntax_table)->contents[(unsigned char) (c)]) >> 16) & 1) #define SYNTAX_COMSTART_SECOND(c) \ ((XINT (XVECTOR (current_buffer->syntax_table)->contents[(unsigned char) (c)]) >> 17) & 1) #define SYNTAX_COMEND_FIRST(c) \ ((XINT (XVECTOR (current_buffer->syntax_table)->contents[(unsigned char) (c)]) >> 18) & 1) #define SYNTAX_COMEND_SECOND(c) \ ((XINT (XVECTOR (current_buffer->syntax_table)->contents[(unsigned char) (c)]) >> 19) & 1) #define SYNTAX_PREFIX(c) \ ((XINT (XVECTOR (current_buffer->syntax_table)->contents[(unsigned char) (c)]) >> 20) & 1) /* extract the comment style bit from the syntax table entry */ #define SYNTAX_COMMENT_STYLE(c) \ ((XINT (XVECTOR (current_buffer->syntax_table)->contents[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[13]; emacs-19.22/src/syssignal.h100444 12241 12 10245 5444474621 14455 0ustar rolandstaff/* 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 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. */ #ifdef POSIX_SIGNALS /* Don't #include . That header shouldalways 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 /* 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 #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 #define EMACS_KILLPG(gid, signo) (kill (-(gid), (signo))) #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.22/src/systime.h100444 12241 12 11224 5444474622 14135 0ustar rolandstaff/* systime.h - System-dependent definitions for time manipulations. 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 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. */ #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 /* 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_SET_UTIMES (PATH, ATIME, MTIME) changes the last-access and last-modification times of the file named PATH to ATIME and MTIME, which are EMACS_TIMEs. 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)) #define EMACS_GET_TIME(time) \ { \ struct timezone dummy; \ gettimeofday (&(time), &dummy); \ } #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) \ ((time).tv_sec < 0 \ || ((time).tv_sec == 0 \ && (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)) #ifdef USE_UTIME #define EMACS_SET_UTIMES(path, atime, mtime) \ { \ time_t tv[2]; \ tv[0] = EMACS_SECS (atime); \ tv[1] = EMACS_SECS (mtime); \ utime ((path), tv); \ } #else /* ! defined (USE_UTIME) */ #define EMACS_SET_UTIMES(path, atime, mtime) \ { \ EMACS_TIME tv[2]; \ tv[0] = atime; \ tv[1] = mtime; \ utimes ((path), tv); \ } #endif /* ! defined (USE_UTIME) */ emacs-19.22/src/systty.h100444 12120 1 23522 5474043445 13455 0ustar rmsdaemon/* systty.h - System-dependent definitions for terminals. 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 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. */ #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 */ #include #else #ifdef HAVE_TERMIOS #if defined(_AIX) && defined(_I386) #include /* termios.h needs to be before termio.h */ #include #else #ifndef NO_TERMIO #include #endif #include #endif /* _AIX && _I386 */ #include #else /* neither HAVE_TERMIO nor HAVE_TERMIOS */ #ifndef VMS #include #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; #if 0 /* VAX C doeasn't understand initializing declarations */ extern int input_ef = 0; extern int timer_ef = 0; extern int process_ef = 0; #else extern int input_ef; extern int timer_ef; extern int process_ef; #endif 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 AIX /* 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 #include #define UNISTD_H_INCLUDED #endif /* AIX */ #ifdef IRIX4 /* Get _getpty prototype */ #include #define UNISTD_H_INCLUDED #endif #if defined (POSIX) && !defined (UNISTD_H_INCLUDED) && defined (HAVE_UNISTD_H) #include #define UNISTD_H_INCLUDED #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 waitp) sets the parameters of the tty on FD according to the contents of *P. If waitp is non-zero, we wait for all queued output to be written before making the change; otherwise, we forget any queued input and make the change immediately. 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 struct sgttyb main; #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 #define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3) #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 #define EMACS_TTY_TABS_OK(p) (((p)->main.sg_flags & XTABS) != XTABS) #endif /* not def VMS */ #endif /* not def HAVE_TERMIO */ #endif /* not def HAVE_TERMIOS */ emacs-19.22/src/syswait.h100444 12120 1 5107 5470243224 13551 0ustar rmsdaemon/* Define wait system call interface for Emacs. 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 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 #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 #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 /* 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.22/src/termchar.h100444 12241 12 3631 5444474624 14232 0ustar rolandstaff/* 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 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. */ 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 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.22/src/termhooks.h100444 12120 1 31234 5474025350 14103 0ustar rmsdaemon/* Hooks by which low level terminal operations can be made to call other routines. 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. */ /* 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. */ extern int (*read_socket_hook) (); /* Expedient hack: only provide the below definitions to files that are prepared to handle lispy things. XINT 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. */ delete_window_event /* An X client said "delete this window". */ }; /* 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; Lisp_Object 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. */ 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.22/src/termopts.h100444 12241 12 2662 5444474626 14307 0ustar rolandstaff/* 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 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. */ /* 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.22/src/uaf.h100444 12241 12 21464 5444474627 13227 0ustar rolandstaff/* 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 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. */ /* * 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.22/src/vlimit.h100444 12241 12 106 5444474637 13707 0ustar rolandstaff/* Dummy for Emacs so that we can run on VMS... */ #define LIM_DATA 0 emacs-19.22/src/vms-pwd.h100444 12241 12 2162 5444474641 14017 0ustar rolandstaff/* 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 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. */ #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.22/src/xterm.h100444 12120 1 54452 5444771002 13235 0ustar rmsdaemon/* Definitions and headers for communication with X protocol. 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. */ #ifdef HAVE_X11 #include #include #include #include #include #include #else #include #endif /* HAVE_X11 */ /* Define a queue for X-events. One such queue is used for mouse clicks. Another is used for expose events. */ #define EVENT_BUFFER_SIZE 64 /* Max and Min sizes in character columns. */ #define MINWIDTH 10 #define MINHEIGHT 10 #define MAXWIDTH 300 #define MAXHEIGHT 80 #ifdef HAVE_X11 /* 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. */ #ifndef AIX #define HAVE_X11R4 #endif #endif #ifdef XlibSpecificationRelease #if XlibSpecificationRelease >= 5 #define HAVE_X11R5 #endif #endif #define PIX_TYPE unsigned long #define XDISPLAY x_current_display, #define XFlushQueue() XFlush(x_current_display) #define BLACK_PIX_DEFAULT BlackPixel (x_current_display, \ XDefaultScreen (x_current_display)) #define WHITE_PIX_DEFAULT WhitePixel (x_current_display, \ XDefaultScreen (x_current_display)) #define DISPLAY_SCREEN_ARG x_current_display, \ XDefaultScreen (x_current_display) #define DISPLAY_CELLS DisplayCells (x_current_display, XDefaultScreen (x_current_display)) #define ROOT_WINDOW RootWindow (x_current_display, DefaultScreen (x_current_display)) #define FONT_TYPE XFontStruct #define Color XColor #define XExposeRegionEvent XExposeEvent #define Bitmap Pixmap /* In X11, Bitmaps are are kind of Pixmap. */ #define WINDOWINFO_TYPE XWindowAttributes #define XGetWindowInfo(w, i) XGetWindowAttributes (x_current_display, \ (w), (i)) #define XGetFont(f) XLoadQueryFont (x_current_display, (f)) #define XLoseFont(f) XFreeFont (x_current_display, (f)) #define XStuffPending() XPending (x_current_display) #define XClear(w) XClearWindow (x_current_display, (w)) #define XWarpMousePointer(w,x,y) XWarpPointer (x_current_display, None, w, \ 0,0,0,0, x, y) #define XHandleError XSetErrorHandler #define XHandleIOError XSetIOErrorHandler #define XChangeWindowSize(w,x,y) XResizeWindow(x_current_display,w,x,y) #define FONT_WIDTH(f) ((f)->max_bounds.width) #define FONT_HEIGHT(f) ((f)->ascent + (f)->descent) #define FONT_BASE(f) ((f)->ascent) /* 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 when we ask/unask for mouse movement events (in XTmouse_tracking_enable). We do include ButtonReleases in this set because elisp 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) #else /* X10 */ #define ConnectionNumber(dpy) dpyno() #define PIX_TYPE int #define XDISPLAY #define XFlushQueue() XFlush() #define BLACK_PIX_DEFAULT BlackPixel #define WHITE_PIX_DEFAULT WhitePixel #define DISPLAY_SCREEN_ARG #define DISPLAY_CELLS DisplayCells () #define ROOT_WINDOW RootWindow #define XFree free #define FONT_TYPE FontInfo #define WINDOWINFO_TYPE WindowInfo #define XGetWindowInfo(w, i) XQueryWindow ((w), (i)) #define XGetFont(f) XOpenFont ((f)) #define XLoseFont(f) XCloseFont ((f)) #define XStuffPending() XPending () #define XWarpMousePointer(w,x,y) XWarpMouse (w,x,y) #define XHandleError XErrorHandler #define XHandleIOError XIOErrorHandler #define FONT_WIDTH(f) ((f)->width) #define FONT_HEIGHT(f) ((f)->height) #define FONT_BASE(f) ((f)->base) #define XChangeWindowSize(w,x,y) XChangeWindow(w,x,y) #endif /* X10 */ struct event_queue { int rindex; /* Index at which to fetch next. */ int windex; /* Index at which to store next. */ XEvent xrep[EVENT_BUFFER_SIZE]; }; /* Queue for mouse clicks. */ extern struct event_queue x_mouse_queue; /* This is the X connection that we are using. */ extern Display *x_current_display; extern struct frame *x_window_to_frame (); /* 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 */ extern struct frame *x_focus_frame; #ifdef HAVE_X11 /* Variables associated with the X display screen this emacs is using. */ /* How many screens this X display has. */ extern int x_screen_count; /* The vendor supporting this X server. */ extern Lisp_Object Vx_vendor; /* The vendor's release number for this X server. */ extern int x_release; /* Height of this X screen in pixels. */ extern int x_screen_height; /* Height of this X screen in millimeters. */ extern int x_screen_height_mm; /* Width of this X screen in pixels. */ extern int x_screen_width; /* Width of this X screen in millimeters. */ extern int x_screen_width_mm; /* Does this X screen do backing store? */ extern Lisp_Object Vx_backing_store; /* Does this X screen do save-unders? */ extern int x_save_under; /* Number of planes for this screen. */ extern int x_screen_planes; /* X Visual type of this screen. */ extern Lisp_Object Vx_screen_visual; #endif /* HAVE_X11 */ enum text_cursor_kinds { filled_box_cursor, hollow_box_cursor, bar_cursor }; /* Each X frame object points to its own struct x_display object in the display.x field. The x_display structure contains all the information that is specific to X windows. */ struct x_display { /* 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; #ifdef HAVE_X11 /* 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 */ #endif /* HAVE_X11 */ /* 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 but not always RootWindow. */ Window parent_desc; /* 1 for bitmap icon, 0 for text icon. */ int icon_bitmap_flag; FONT_TYPE *font; /* Pixel values used for various purposes. border_pixel may be -1 meaning use a gray tile. */ PIX_TYPE background_pixel; PIX_TYPE foreground_pixel; PIX_TYPE cursor_pixel; PIX_TYPE border_pixel; PIX_TYPE mouse_pixel; PIX_TYPE cursor_foreground_pixel; /* Descriptor for the cursor in use for this window. */ #ifdef HAVE_X11 Cursor text_cursor; Cursor nontext_cursor; Cursor modeline_cursor; #else Cursor cursor; #endif /* The name that was associated with the icon, the last time it was refreshed. Usually the same as the name of the buffer in the currently selected window in the frame */ char *icon_label; /* 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; /* 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 */ }; /* Get at the computed faces of an X window frame. */ #define FRAME_PARAM_FACES(f) ((f)->display.x->param_faces) #define FRAME_N_PARAM_FACES(f) ((f)->display.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)->display.x->computed_faces) #define FRAME_N_COMPUTED_FACES(f) ((f)->display.x->n_computed_faces) #define FRAME_SIZE_COMPUTED_FACES(f) ((f)->display.x->size_computed_faces) #define FRAME_DEFAULT_FACE(f) ((f)->display.x->computed_faces[0]) #define FRAME_MODE_LINE_FACE(f) ((f)->display.x->computed_faces[1]) /* Return the window associated with the frame F. */ #define FRAME_X_WINDOW(f) ((f)->display.x->window_desc) /* These two really ought to be called FRAME_PIXEL_{WIDTH,HEIGHT}. */ #define PIXEL_WIDTH(f) ((f)->display.x->pixel_width) #define PIXEL_HEIGHT(f) ((f)->display.x->pixel_height) #define FRAME_DESIRED_CURSOR(f) ((f)->display.x->desired_cursor) /* When X windows are used, a glyph may be a 16 bit unsigned datum. The high order byte is the face number and is used as an index in the face table. A face is a font plus: 1) the unhighlighted foreground color, 2) the unhighlighted background color. For highlighting, the two colors are exchanged. Face number 0 is unused. The low order byte of a glyph gives the character within the font. All fonts are assumed to be fixed width, and to have the same height and width. */ #ifdef HAVE_X11 /* Face declared in dispextern.h */ #else /* X10 */ struct face { FONT_TYPE *font; /* Font info for specified font. */ int fg; /* Unhighlighted foreground. */ int bg; /* Unhighlighted background. */ }; #endif /* X10 */ #define MAX_FACES_AND_GLYPHS 256 extern struct face *x_face_table[]; /* 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. */ 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 (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 *) XPNTR (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) \ (XSET ((low), Lisp_Int, (int32) & 0xffff), \ XSET ((high), Lisp_Int, ((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 width for a vertical scroll bar on frame F. */ #define VERTICAL_SCROLL_BAR_PIXEL_WIDTH(f) (2*FONT_WIDTH ((f)->display.x->font)) /* 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) * FONT_HEIGHT ((f)->display.x->font)) /* 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 (3) #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)->display.x->internal_border_width \ + (row) * FONT_HEIGHT ((f)->display.x->font)) #define CHAR_TO_PIXEL_COL(f, col) \ ((f)->display.x->internal_border_width \ + (col) * FONT_WIDTH ((f)->display.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)->display.x->vertical_scroll_bar_extra \ + (f)->display.x->internal_border_width) #define CHAR_TO_PIXEL_HEIGHT(f, height) \ (CHAR_TO_PIXEL_ROW (f, height) \ + (f)->display.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)->display.x->internal_border_width) \ / FONT_HEIGHT ((f)->display.x->font)) #define PIXEL_TO_CHAR_COL(f, col) \ (((col) - (f)->display.x->internal_border_width) \ / FONT_WIDTH ((f)->display.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)->display.x->internal_border_width \ - (f)->display.x->vertical_scroll_bar_extra))) #define PIXEL_TO_CHAR_HEIGHT(f, height) \ (PIXEL_TO_CHAR_ROW (f, ((height) \ - (f)->display.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.22/src/vmspaths.h100444 12241 12 2626 5444474644 14277 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.22/src/vmsproc.h100444 12241 12 647 5444474645 14105 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.22/src/vmstime.h100444 12241 12 2025 5444474646 14111 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.22/src/window.h100444 12241 12 26155 5444474650 13761 0ustar rolandstaff/* Window definitions for GNU Emacs. 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. */ /* 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. */ 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; }; /* 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 char *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; /* 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; /* 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 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_unchangedn 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.22/src/alloca.s100666 12241 1 23610 5444000435 14017 0ustar rolanddaemon/* `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 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. */ /* 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 #include #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 SVR3V5.1 . 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.22/src/README100666 13437 1 2746 5405344636 12734 0ustar jimbdaemonThis 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 Unix, the file `Makefile.in' is used as a template by the script `../configure' to produce `Makefile'. The `Makefile' then uses `cpp' to produce the machine-dependent `ymakefile' from `xmakefile'; `ymakefile' 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.22/src/Makefile.in.in100444 12120 1 61130 5473764671 14406 0ustar rmsdaemon/* Makefile for GNU Emacs. Copyright (C) 1985, 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. */ /* BSD doesn't have it as a default. */ MAKE = make /* Here are the things that we expect ../configure to edit. */ srcdir=@srcdir@ VPATH=@srcdir@ CC=@CC@ CPP=@CPP@ CFLAGS=@CFLAGS@ C_SWITCH_SYSTEM= LN_S=@LN_S@ /* On Xenix and the IBM RS6000, double-dot gets screwed up. */ dot = . lispdir = ${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/ config_h = config.h /* just to be sure the sh is used */ SHELL=/bin/sh #define NO_SHORTNAMES #define THIS_IS_YMAKEFILE #define NOT_C_CODE #include "config.h" /* 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 #else MAKE=make #endif #ifdef C_COMPILER CC = C_COMPILER #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 /* 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 crt0.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 /* 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. */ /* If you want to debug, you can add C_DEBUG_SWITCH to this list. If you want to optimize, you can add C_OPTIMIZE_SWITCH to the list. */ /* -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 $(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 OLDXMENU= libXMenu11.a LIBXMENU= $(OLDXMENU) #else /* ! defined (HAVE_X11) */ LIBXMENU= -lXMenu #endif /* ! defined (HAVE_X11) */ #else /* ! defined (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 /* ! defined (HAVE_X_MENU) */ #ifdef HAVE_X11 LIBX= $(LIBXMENU) LD_SWITCH_X_SITE LIB_X11_LIB LIBX11_MACHINE LIBX11_SYSTEM #else /* ! defined (HAVE_X11) */ LIBX= $(LIBXMENU) LD_SWITCH_X_SITE -lX10 LIBX10_MACHINE LIBX10_SYSTEM #endif /* ! defined (HAVE_X11) */ #endif /* ! defined (HAVE_X_WINDOWS) */ #ifndef ORDINARY_LINK /* Fix linking if compiled with GCC. */ #ifdef __GNUC__ #if __GNUC__ > 1 /* 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 /* LIB_GCC */ GNULIB_VAR = LIB_GCC /* 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 /* __GNUC__ < 2 */ #ifndef LIB_GCC #define LIB_GCC /usr/local/lib/gcc-gnulib #endif /* LIB_GCC */ GNULIB_VAR = `if [ -f LIB_GCC ] ; then echo LIB_GCC; else echo; fi` #endif /* __GNUC__ < 2 */ #else /* ! defined (__GNUC__) */ GNULIB_VAR = #endif /* ! defined (__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 /* ! defined (LINKER) */ LD=ld #endif /* ! defined (LINKER) */ #endif /* ! defined (COFF_ENCAPSULATE) */ #endif /* not ORDINARY_LINK */ LDFLAGS = LD_SWITCH_SYSTEM LD_SWITCH_MACHINE LD_SWITCH_SITE /* A macro which other sections of ymakefile 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". */ #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 /* 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 \ term.o cm.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 \ doprnt.o GETLOADAVG_OBJ #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 /* define otherobj as list of object files that make-docfile should not be told about. */ otherobj= $(termcapobj) lastfile.o $(mallocobj) $(allocaobj) #ifdef LISP_FLOAT_TYPE #define FLOAT_SUPPORT ${lispdir}float-sup.elc #else #define FLOAT_SUPPORT #endif #ifdef MULTI_FRAME #define FRAME_SUPPORT ${lispdir}frame.elc ${lispdir}mouse.elc ${lispdir}select.elc ${lispdir}scroll-bar.elc #else #define FRAME_SUPPORT #endif #ifdef VMS #define VMS_SUPPORT ${lispdir}vmsproc.elc ${lispdir}vms-patch #else #define VMS_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. It should not include version.el. That file is often changed by the build process itself, but most of the files which want to depend on lisp.h don't care about those changes. */ lisp= \ ${lispdir}abbrev.elc \ ${lispdir}buff-menu.elc \ ${lispdir}byte-run.elc \ ${lispdir}c-mode.elc \ ${lispdir}files.elc \ ${lispdir}fill.elc \ FLOAT_SUPPORT \ FRAME_SUPPORT \ ${lispdir}help.elc \ ${lispdir}indent.elc \ ${lispdir}isearch.elc \ ${lispdir}lisp-mode.elc \ ${lispdir}lisp.elc \ ${lispdir}loaddefs.el \ ${lispdir}map-ynp.elc \ ${lispdir}page.elc \ ${lispdir}paragraphs.elc \ ${lispdir}paths.el \ ${lispdir}register.elc \ ${lispdir}replace.elc \ ${lispdir}simple.elc \ ${lispdir}startup.elc \ ${lispdir}subr.elc \ ${lispdir}text-mode.elc \ ${lispdir}vc-hooks.elc \ VMS_SUPPORT \ ${lispdir}window.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 ln temacs emacs #else #ifdef HAVE_SHM -if [ -w ${srcdir}/../lisp ]; then \ w=`pwd`; cd ${srcdir}; $${w}/temacs -nl -batch -l ../lisp/inc-vers; \ else true; fi ./temacs -nl -batch -l loadup dump #else /* ! defined (HAVE_SHM) */ -if [ -w ${srcdir}/../lisp ]; then \ w=`pwd`; cd ${srcdir}; $${w}/temacs -batch -l ../lisp/inc-vers; \ else true; fi ./temacs -batch -l loadup dump #endif /* ! defined (HAVE_SHM) */ #endif /* ! defined (CANNOT_DUMP) */ ${etc}DOC: ${libsrc}make-docfile ${obj} ${lisp} OBJECTS_SYSTEM OBJECTS_MACHINE rm -f ${etc}DOC ${libsrc}make-docfile -d ${srcdir} ${obj} OBJECTS_SYSTEM OBJECTS_MACHINE ${lisp} \ ${lispdir}version.el > ${etc}DOC ${libsrc}make-docfile: cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile ../arch-lib /* 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} ${LDFLAGS}) \ -o temacs ${STARTFILES} ${obj} ${otherobj} \ OBJECTS_SYSTEM OBJECTS_MACHINE ${LIBES} prefix-args: prefix-args.c $(config_h) $(CC) $(ALL_CFLAGS) ${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 #ifdef HAVE_X_WINDOWS #ifdef HAVE_X_MENU #ifdef HAVE_X11 $(OLDXMENU): really-oldXMenu -rm -f $(OLDXMENU) /* We might have a link to an old version. */ ${LN_S} ${oldXMenudir}libXMenu11.a $(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. */ #endif /* ! defined (HAVE_X11) */ #endif /* ! defined (HAVE_X_MENU) */ #endif /* ! defined (HAVE_X_WINDOWS) */ paths.h: paths.h.in @echo "The file paths.h needs to be set up from paths.h.in." @echo "Consult the file \`INSTALL' for instructions for building Emacs." exit 1 config.h: config.h.in @echo "The file config.h needs to be set up from config.h.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. */ 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 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 syntax.h buffer.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 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 $(config_h) pre-crt0.o : pre-crt0.c crt0.o : crt0.c $(config_h) CRT0_COMPILE ${srcdir}/crt0.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 $(config_h) doc.o : doc.c $(config_h) paths.h buffer.h keyboard.h doprnt.o : doprnt.c 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 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 $(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 $(config_h) malloc.o : malloc.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 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 $(config_h) dispextern.h frame.h search.o : search.c regex.h commands.h buffer.h syntax.h blockinput.h $(config_h) 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 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) UNEXEC : UNEXEC_SRC $(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 $(config_h) xmenu.o : xmenu.c xterm.h window.h frame.h keyboard.h blockinput.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 \ 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 alloc.o : blockinput.h $(config_h) INTERVAL_SRC bytecode.o : bytecode.c buffer.h $(config_h) data.o : data.c buffer.h puresize.h syssignal.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 $(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 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 xmakefile* core \#* *.o libXMenu11.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.in ../etc/DOC-* realclean: distclean 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 ymakefile \ config.h.in README COPYING ChangeLog vms.pp-trans unlock: chmod u+w $(SOURCES) relock: chmod -w $(SOURCES) chmod +w paths.h tagsfiles = [a-z]*.h [a-z]*.c ../lisp/[a-z]*.el ../lisp/term/[a-z]*.el TAGS: $(tagsfiles) etags $(tagsfiles) tags: TAGS .PHONY: tags emacs-19.22/src/ChangeLog100666 12120 1 326066 5475620306 13534 0ustar rmsdaemonSat Nov 27 04:41:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) * Version 19.22 released. 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. emacs-19.22/src/OChangeLog100666 12120 1 2337600 5431111501 13651 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. emacs-19.22/src/config.h.in100444 11732 1 16513 5461740705 14116 0ustar bfoxdaemon/* GNU Emacs site configuration template file. -*- C -*- Copyright (C) 1988, 1993 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 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 /* If we're using any sort of window system, define MULTI_FRAME. */ #ifdef HAVE_X_WINDOWS #define MULTI_FRAME #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 /* Some things figured out by the configure script, grouped as they are in configure.in. */ #undef HAVE_SYS_TIMEB_H #undef HAVE_SYS_TIME_H #undef HAVE_UNISTD_H #undef STDC_HEADERS #undef TIME_WITH_SYS_TIME #undef HAVE_LIBDNET #undef HAVE_ALLOCA_H #undef HAVE_GETTIMEOFDAY #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 STACK_DIRECTION #undef UNEXEC_SRC #undef HAVE_LIBXBSD #undef HAVE_XRMSETDATABASE #undef HAVE_XSCREENRESOURCESTRING #undef HAVE_XSCREENNUMBEROFSCREEN #undef HAVE_MKDIR #undef HAVE_RMDIR #undef HAVE_RANDOM #undef HAVE_BCOPY #undef HAVE_LOGB #undef HAVE_FREXP #undef HAVE_FTIME #undef HAVE_RES_INIT /* For -lresolv on Suns. */ #undef HAVE_AIX_SMT_EXP /* If using GNU, then support inline function declarations. */ #ifdef __GNUC__ #define INLINE __inline__ #else #define INLINE #endif /* The configuration script defines opsysfile to be the name of the s/*.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/*.h files. */ #undef config_opsysfile #include config_opsysfile /* The configuration script defines machfile to be the name of the m/*.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/*.h files. */ #undef config_machfile #include config_machfile /* 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 */ /* 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/*.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 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 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 /* The rest of the code currently tests the CPP symbol BSTRING. Override any claims made by the system-description files. */ #undef BSTRING #ifdef HAVE_BCOPY #define BSTRING #endif /* Non-ANSI C compilers usually don't have volatile. */ #ifndef HAVE_VOLATILE #ifndef __STDC__ #define volatile #endif #endif #if 0 /* This should be taken care of by autoconf now. */ /* joe@zircon.uucp says that in order to use XFree386, you have to link against -lXbsd, which insists on defining the random function. faith@cs.unc.edu says this is bogus for Linux and several other OS's. Eventually, we should have autoconf test for this. Anyone want to submit a patch? */ #if defined (HAVE_XFREE386) && !defined (LINUX) #define LIBX11_SYSTEM -lXbsd #define HAVE_RANDOM #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 ymakefile includes config.h. */ #ifndef NOT_C_CODE extern char *getenv (); #endif #endif /* EMACS_CONFIG_H */ emacs-19.22/src/paths.h.in100444 13437 1 2776 5400337022 13730 0ustar jimbdaemon/* 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 docstring file. The lisp variable data-directory is set to this value. */ #define PATH_DATA "/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.22/src/.gdbinit100444 12120 1 10446 5431127023 13333 0ustar rmsdaemon# Set up something to print out s-expressions. define pr set Fprin1 ($, Qexternal_debugging_output) echo \n end document pr Print the emacs s-expression which is $. Works only when an inferior emacs is executing. end # Set this to the same thing as the DATA_SEG_BITS macro in your # machine-description files. set $data_seg_bits = 0 define mips set $data_seg_bits = 0x10000000 end document mips Set up the xfoo macros to deal with the MIPS processor. Specifically, this sets $data_seg_bits to the right thing. end define xtype output (enum Lisp_Type) (($ >> 24) & 0x7f) echo \n end document xtype Print the type of $, assuming it is an Elisp value. end define xint print (($ & 0x00ffffff) << 8) >> 8 end document xint Print $, assuming it is an Elisp integer. This gets the sign right. end define xptr print (void *) (($ & 0x00ffffff) | $data_seg_bits) end document xptr Print the pointer portion of $, assuming it is an Elisp value. end define xwindow print (struct window *) (($ & 0x00ffffff) | $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 Elisp window value. Print the window's position as "WIDTHxHEIGHT+LEFT+TOP". end define xmarker print (struct Lisp_Marker *) (($ & 0x00ffffff) | $data_seg_bits) end document xmarker Print $ as a marker pointer, assuming it is an Elisp marker value. end define xbuffer print (struct buffer *) (($ & 0x00ffffff) | $data_seg_bits) output &((struct Lisp_String *) ((($->name) & 0x00ffffff) | $data_seg_bits))->data echo \n end document xbuffer Set $ as a buffer pointer, assuming it is an Elisp buffer value. Print the name of the buffer. end define xsymbol print (struct Lisp_Symbol *) (($ & 0x00ffffff) | $data_seg_bits) output &$->name->data echo \n end document xsymbol Print the name and address of the symbol $. This command assumes that $ is an Elisp symbol value. end define xstring print (struct Lisp_String *) (($ & 0x00ffffff) | $data_seg_bits) output ($->size > 10000) ? "big string" : ($->data[0])@($->size) echo \n end document xstring Print the contents and address of the string $. This command assumes that $ is an Elisp string value. end define xvector print (struct Lisp_Vector *) (($ & 0x00ffffff) | $data_seg_bits) output ($->size > 1000) ? "big vector" : ($->contents[0])@($->size) echo \n end document xvector Print the contents and address of the vector $. This command assumes that $ is an Elisp vector value. end define xframe print (struct frame *) (($ & 0x00ffffff) | $data_seg_bits) end document xframe Print $ as a frame pointer, assuming it is an Elisp frame value. end define xcons print (struct Lisp_Cons *) (($ & 0x00ffffff) | $data_seg_bits) output *$ echo \n end document xcons Print the contents of $, assuming it is an Elisp cons. end define xcar print ((($ >> 24) & 0x7f) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & 0x00ffffff) | $data_seg_bits))->car : 0) end document xcar Print the car of $, assuming it is an Elisp pair. end define xcdr print ((($ >> 24) & 0x7f) == Lisp_Cons ? ((struct Lisp_Cons *) (($ & 0x00ffffff) | $data_seg_bits))->cdr : 0) end document xcdr Print the cdr of $, assuming it is an Elisp pair. end define xsubr print (struct Lisp_Subr *) (($ & 0x00ffffff) | $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 *) (($ & 0x00ffffff) | $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 *) (($ & 0x00ffffff) | $data_seg_bits))->data end document xfloat Print $ assuming it is a lisp floating-point number. end define xscrollbar print (struct scrollbar *) (($ & 0x00ffffff) | $data_seg_bits) 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 show environment TERMCAP 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 _XPrintDefaultError emacs-19.22/src/.dbxinit100644 13437 1 274 5173427546 13470 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.22/src/temacs.opt100666 13437 1 1420 4314660346 14035 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.22/src/vms-pp.trans100666 13437 1 1045 3753756752 14350 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.22/lib-src/ 40777 12120 24 0 5475722562 12266 5ustar rmsotheremacs-19.22/lib-src/alloca.c100777 12120 1 33333 5447406222 14076 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 #if defined (emacs) || defined (CONFIG_BROKETS) #include #else #include "config.h" #endif #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. */ 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. */ } 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.22/lib-src/b2m.c100444 12241 12 3641 5444560622 13637 0ustar rolandstaff/* * 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 */ #include #include #include #include <../src/config.h> #ifdef USG #include #else #include #endif /* BSD's strings.h does not declare the type of strtok. */ extern char *strtok (); #ifndef TRUE #define TRUE (1) #endif #ifndef FALSE #define FALSE (0) #endif int header = FALSE, printing; time_t ltoday; char from[256], labels[256], data[256], *p, *today; main (argc, argv) int argc; char **argv; { ltoday = time(0); today = ctime(<oday); if (gets(data)) if (strcmp(data, "BABYL OPTIONS:")) { fprintf(stderr, "b2m: not a Babyl mailfile!\n"); exit(-1); } else printing = FALSE; else exit(-1); if (printing) puts(data); while (gets(data)) { #if 0 /* What was this for? Does somebody have something against blank lines? */ if (!strcmp(data, "")) exit(0); #endif if (!strcmp(data, "*** EOOH ***") && !printing) { printing = header = TRUE; printf("From b2m %s", today); continue; } if (!strcmp(data, " ")) { /* save labels */ gets(data); p = strtok(data, " ,\r\n\t"); strcpy(labels, "X-Babyl-Labels: "); while (p = strtok(NULL, " ,\r\n\t")) { strcat(labels, p); strcat(labels, ", "); } labels[strlen(labels) - 2] = '\0'; printing = header = FALSE; continue; } if (!strlen(data) && header) { header = FALSE; if (strcmp(labels, "X-Babyl-Labels")) puts(labels); } if (printing) puts(data); } } emacs-19.22/lib-src/cvtmail.c100444 13437 1 6456 4523340602 14404 0ustar jimbdaemon/* Copyright (C) 1985 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 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. */ /* 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 * RMS, 2 Sept 85: Removed fix maximums on file name sizes. */ #include 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], post[100]; 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 (argc > 1) mfilef = fopen (argv[1], "w"); else { mfile = (char *) xmalloc (strlen (hd) + 7); strcpy (mfile, hd); strcat (mfile, "/OMAIL"); mfilef = fopen (mfile, "w"); } 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"); while ((c = getc(cff)) != EOF) putc (c, mfilef); putc ('\n', mfilef); skip_to_lf (mddf); fclose (cff); } fclose (mddf); fclose (mfilef); return 0; } skip_to_lf (stream) FILE *stream; { register int c; while ((c = getc(stream)) != '\n') ; } int xmalloc (size) int size; { int result = malloc (size); if (!result) fatal ("virtual memory exhausted", 0); return result; } int xrealloc (ptr, size) char *ptr; int size; { int result = realloc (ptr, size); if (!result) fatal ("virtual memory exhausted"); return result; } /* Print error message and exit. */ fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (1); } error (s1, s2) char *s1, *s2; { printf ("cvtmail: "); printf (s1, s2); printf ("\n"); } emacs-19.22/lib-src/digest-doc.c100444 13437 1 1642 4030533467 14765 0ustar jimbdaemon/* 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 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.22/lib-src/emacsclient.c100444 12241 12 14454 5444560625 15475 0ustar rolandstaff/* Client process that communicates with GNU Emacs acting as server. 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 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. */ #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_SYSVIPC) /* BSD code is very different from SYSV IPC code */ #include #include #include #include #include #include extern int sys_nerr; extern char *sys_errlist[]; extern int errno; 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 (); 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, "Can't find socket; have you started the server?\n"); else perror ("stat"); exit (1); } if (statbfr.st_uid != geteuid()) { fprintf (stderr, "Illegal socket owner\n"); 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"); #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); } cwd = getwd (string); if (cwd == 0) { /* getwd puts message in STRING if it fails. */ fprintf (stderr, "%s: %s (%s)\n", argv[0], string, (errno < sys_nerr) ? sys_errlist[errno] : "unknown error"); 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); exit (0); } #else /* This is the SYSV IPC section */ #include #include #include #include main (argc, argv) int argc; char **argv; { int s; key_t key; struct msgbuf * msgp = (struct msgbuf *) malloc (sizeof *msgp + BUFSIZ); struct msqid_ds * msg_st; char *homedir, buf[BUFSIZ]; char gwdirb[BUFSIZ]; char *cwd; char *temp; char *getwd (), *getcwd (), *getenv (); 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); strcat (buf, "/.emacs_server"); 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, cwd); exit (1); } msgp->mtext[0] = 0; argc--; argv++; while (argc) { if (*argv[0] == '+') { char *p = argv[0] + 1; while (*p >= '0' && *p <= '9') p++; if (*p != 0) strcat (msgp->mtext, cwd); } else if (*argv[0] != '/') strcat (msgp->mtext, cwd); strcat (msgp->mtext, argv[0]); strcat (msgp->mtext, " "); argv++; argc--; } strcat (msgp->mtext, "\n"); msgp->mtype = 1; if (msgsnd (s, msgp, strlen (msgp->mtext)+1, 0) < 0) { fprintf (stderr, "%s: ", argv[0]); 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 */ emacs-19.22/lib-src/emacsserver.c100444 12241 12 17551 5444560626 15527 0ustar rolandstaff/* Communication subprocess for GNU Emacs acting as server. Copyright (C) 1986, 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 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_SYSVIPC) /* BSD code is very different from SYSV IPC code */ #include #include #include #include #include #include #include extern int errno; 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; int geteuid (); char *getenv (); 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 ("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 ("unlink"); exit (1); } #else if ((homedir = getenv ("HOME")) == NULL) { fprintf (stderr,"No home directory\n"); exit (1); } strcpy (server.sun_path, homedir); strcat (server.sun_path, "/.emacs_server"); /* Delete anyone else's old server. */ unlink (server.sun_path); #endif if (bind (s, (struct sockaddr *) &server, strlen (server.sun_path) + 2) < 0) { perror ("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 ("listen"); exit (1); } /* Disable sigpipes in case luser kills client... */ signal (SIGPIPE, SIG_IGN); for (;;) { int rmask = (1 << s) + 1; if (select (s + 1, &rmask, 0, 0, 0) < 0) perror ("select"); if (rmask & (1 << s)) /* client sends list of filenames */ { fromlen = sizeof (fromunix); fromunix.sun_family = AF_UNIX; infd = accept (s, (struct sockaddr *) &fromunix, &fromlen); /* open socket fd */ if (infd < 0) { if (errno == EMFILE || errno == ENFILE) printf ("Too many clients.\n"); else perror ("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) { printf ("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 ("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 (rmask & 1) /* 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)) { fprintf (stderr, "server: error reading from standard input\n"); exit (1); } /* 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 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; 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) { fprintf (stderr,"No home directory\n"); exit (1); } strcpy (string, homedir); strcat (string, "/.emacs_server"); creat (string, 0600); key = ftok (string, 1); /* unlikely to be anyone else using it */ s = msgget (key, 0600 | IPC_CREAT); if (s == -1) { perror ("msgget"); exit (1); } /* Fork so we can close connection even if parent dies */ p = fork (); if (setjmp (msgenv)) { msgctl (s, IPC_RMID, 0); kill (p, SIGKILL); exit (0); } signal (SIGTERM, msgcatch); signal (SIGINT, msgcatch); /* If parent goes away, remove message box and exit */ if (p == 0) { p = getppid (); setpgrp (); /* Gnu kills process group on exit */ while (1) { if (kill (p, 0) < 0) { msgctl (s, IPC_RMID, 0); exit (0); } sleep (10); } } while (1) { if ((fromlen = msgrcv (s, msgp, BUFSIZ - 1, 1, 0)) < 0) { perror ("msgrcv"); exit (1); } else { msgctl (s, IPC_STAT, &msg_st); strncpy (string, msgp->mtext, fromlen); string[fromlen] = 0; /* make sure */ /* Newline is part of string.. */ printf ("Client: %d %s", s, string); fflush (stdout); /* Now, wait for a wakeup */ fgets (msgp->mtext, BUFSIZ, stdin); msgp->mtext[strlen (msgp->mtext)-1] = 0; /* strcpy (msgp->mtext, "done");*/ msgp->mtype = msg_st.msg_lspid; msgsnd (s, msgp, strlen (msgp->mtext)+1, 0); } } } #endif /* HAVE_SYSVIPC */ #endif /* HAVE_SOCKETS or HAVE_SYSVIPC */ emacs-19.22/lib-src/emacstool.c100444 13437 13 36600 5405340711 14504 0ustar jimbuser/* * * Copyright (C) 1986, 1988, 1990, 1991 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. * * Everyone is granted permission to copy, modify and redistribute * GNU Emacs, but only under the conditions described in the * document "GNU Emacs copying permission notice". An exact copy * of the document is supposed to have been given to you along with * GNU Emacs so that you can know how you may redistribute it all. * It should be in a file named COPYING. Among other things, the * copyright notice and this notice must be preserved on all copies. * * * 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.22/lib-src/env.c100644 13437 13 16732 5405340712 13315 0ustar jimbuser/* env - manipulate environment and execute a program in that environment Copyright (C) 1986 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. */ /* Mly 861126 */ /* If first argument is "-", then a new environment is constructed from scratch; otherwise the environment is inherited from the parent process, except as modified by other options. So, "env - foo" will invoke the "foo" program in a null environment, whereas "env foo" would invoke "foo" in the same environment as that passed to "env" itself. Subsequent arguments are interpreted as follows: * "variable=value" (i.e., an arg containing a "=" character) means to set the specified environment variable to that value. `value' may be of zero length ("variable="). Note that setting a variable to a zero-length value is different from unsetting it. * "-u variable" or "-unset variable" means to unset that variable. If that variable isn't set, does nothing. * "-s variable value" or "-set variable value" same as "variable=value". * "-" or "--" are used to indicate that the following argument is the program to invoke. This is only necessary when the program's name begins with "-" or contains a "=". * anything else The first remaining argument specifies a program to invoke (it is searched for according to the specification of the PATH environment variable) and any arguments following that are passed as arguments to that program. If no program-name is specified following the environment specifications, the resulting environment is printed. This is like specifying a program-name of "printenv". Examples: If the environment passed to "env" is { USER=rms EDITOR=emacs PATH=.:/gnubin:/hacks } * "env DISPLAY=gnu:0 nemacs" calls "nemacs" in the environment { USER=rms EDITOR=emacs PATH=.:/gnubin:/hacks DISPLAY=gnu:0 } * "env - USER=foo /hacks/hack bar baz" calls the "hack" program on arguments "bar" and "baz" in an environment in which the only variable is "USER". Note that the "-" option clears out the PATH variable, so one should be careful to specify in which directory to find the program to call. * "env -u EDITOR USER=foo PATH=/energy -- e=mc2 bar baz" The program "/energy/e=mc2" is called with environment { USER=foo PATH=/energy } */ #ifdef EMACS #define NO_SHORTNAMES #include "../src/config.h" #endif /* EMACS */ #include extern int execvp (); char *xmalloc (), *xrealloc (); char *concat (); extern char **environ; char **nenv; int nenv_size; char *progname; void setenv (); void fatal (); char *myindex (); main (argc, argv, envp) register int argc; register char **argv; char **envp; { register char *tem; progname = argv[0]; argc--; argv++; nenv_size = 100; nenv = (char **) xmalloc (nenv_size * sizeof (char *)); *nenv = (char *) 0; /* "-" flag means to not inherit parent's environment */ if (argc && !strcmp (*argv, "-")) { argc--; argv++; } else /* Else pass on existing env vars. */ for (; *envp; envp++) { tem = myindex (*envp, '='); if (tem) { *tem = '\000'; setenv (*envp, tem + 1); } } while (argc > 0) { tem = myindex (*argv, '='); if (tem) /* If arg contains a "=" it specifies to set a variable */ { *tem = '\000'; setenv (*argv, tem + 1); argc--; argv++; continue; } if (**argv != '-') /* Remaining args are program name and args to pass it */ break; if (argc < 2) fatal ("no argument for `%s' option", *argv); if (!strcmp (*argv, "-u") || !strcmp (*argv, "-unset")) /* Unset a variable */ { argc--; argv++; setenv (*argv, (char *) 0); argc--; argv++; } else if (!strcmp (*argv, "-s") || !strcmp (*argv, "-set")) /* Set a variable */ { argc--; argv++; tem = *argv; if (argc < 2) fatal ("no value specified for variable \"%s\"", tem); argc--; argv++; setenv (tem, *argv); argc--; argv++; } else if (!strcmp (*argv, "-") || !strcmp (*argv, "--")) { argc--; argv++; break; } else { fatal ("unrecognized option `%s'", *argv); } } /* If no program specified print the environment and exit */ if (argc <= 0) { while (*nenv) printf ("%s\n", *nenv++); exit (0); } else { extern int errno, sys_nerr; extern char *sys_errlist[]; environ = nenv; (void) execvp (*argv, argv); fprintf (stderr, "%s: cannot execute `%s'", progname, *argv); if (errno < sys_nerr) fprintf (stderr, ": %s\n", sys_errlist[errno]); else putc ('\n', stderr); exit (errno != 0 ? errno : 1); } } void setenv (var, val) register char *var, *val; { register char **e; int len = strlen (var); { register char *tem = myindex (var, '='); if (tem) fatal ("environment variable names can not contain `=': %s", var); else if (*var == '\000') fatal ("zero-length environment variable name specified"); } for (e = nenv; *e; e++) if (!strncmp (var, *e, len) && (*e)[len] == '=') { if (val) goto set; else do { *e = *(e + 1); } while (*e++); return; } if (!val) return; /* Nothing to unset */ len = e - nenv; if (len + 1 >= nenv_size) { nenv_size += 100; nenv = (char **) xrealloc (nenv, nenv_size * sizeof (char *)); e = nenv + len; } set: val = concat (var, "=", val); if (*e) free (*e); else *(e + 1) = (char *) 0; *e = val; return; } void fatal (msg, arg1, arg2) char *msg, *arg1, *arg2; { fprintf (stderr, "%s: ", progname); fprintf (stderr, msg, arg1, arg2); putc ('\n', stderr); exit (1); } extern char *malloc (), *realloc (); void memory_fatal () { fatal ("virtual memory exhausted"); } char * xmalloc (size) int size; { register char *value; value = (char *) malloc (size); if (!value) memory_fatal (); return (value); } char * xrealloc (ptr, size) char *ptr; int size; { register char *value; value = (char *) realloc (ptr, size); if (!value) memory_fatal (); return (value); } /* 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; } /* Return a pointer to the first occurrence in STR of C, or 0 if C does not occur. */ char * myindex (str, c) char *str; char c; { char *s = str; while (*s) { if (*s == c) return s; s++; } return 0; } emacs-19.22/lib-src/etags-vmslib.c100444 13437 13 13100 5174232355 15110 0ustar jimbuser/* File name wild card expansion for VMS. This file is part of the etags program. Copyright (C) 1987 Free Software Foundation, Inc. 3 Feb 1987 This program 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. Permission is granted to anyone to distribute verbatim copies of this program's source code as received, in any medium, provided that the copyright notice, the nonwarraty notice above and this permission notice are preserved, and that the distributor grants the recipient all rights for further redistribution as permitted by this notice, and informs him of these rights. Permission is granted to distribute modified versions of this program's source code, or of portions of it, under the above conditions, plus the conditions that all changed files carry prominent notices stating who last changed them and that the derived material, including anything packaged together with it and conceptually functioning as a modification of it rather than an application of it, is in its entirety subject to a permission notice identical to this one. Permission is granted to distribute this program (verbatim or as modified) in compiled or executable form, provided verbatim redistribution is permitted as stated above for source code, and A. it is accompanied by the corresponding machine-readable source code, under the above conditions, or B. it is accompanied by a written offer, with no time limit, to distribute the corresponding machine-readable source code, under the above conditions, to any one, in return for reimbursement of the cost of distribution. Verbatim redistribution of the written offer must be permitted. Or, C. it is distributed by someone who received only the compiled or executable form, and is accompanied by a copy of the written offer of source code which he received along with it. Permission is granted to distribute this program (verbatim or as modified) in executable form as part of a larger system provided that the source code for this program, including any modifications used, is also distributed or offered as stated in the preceding paragraph. 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! */ #include typedef char tbool; /* 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; #define EOS '\0' #define NO 0 #define YES 1 #define NULL 0 /* v1.01 nmm 19-Aug-85 gfnames - return in successive calls the name of each file specified by all the remaining args in the command-line expanding wild cards and stepping over arguments when they have been processed completely */ char* gfnames(pac, pav, p_error) int *pac; char **pav[]; tbool *p_error; { static vspec filename = {MAX_FILE_SPEC_LEN, "\0"}; short fn_exp(); while (1) if (*pac == 0) { *p_error = NO; return(NULL); } else switch(fn_exp(&filename, **pav)) { case 1: *p_error = NO; return(filename.body); break; case 0: --*pac; ++*pav; break; default: *p_error = YES; return(filename.body); break; } } /* 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 tbool pass1 = YES; long status; short retval; if (pass1) { pass1 = NO; 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 = YES; return(retval); } #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 = tolower(*s); return(start); } emacs-19.22/lib-src/etags.c100444 12120 13 211112 5472106762 13510 0ustar rmsuser/* Tags file maker to go with GNU Emacs Copyright (C) 1984, 1987, 1988, 1989, 1993 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` (pot@cnuce.cnr.it) is the current maintainer. 9.8 */ #ifdef HAVE_CONFIG_H #include <../src/config.h> #endif #include #include #include #include #if !defined (S_ISREG) && defined (S_IFREG) # define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) #endif #include "getopt.h" extern char *malloc (), *realloc (); extern char *getenv (); extern char *strcpy (), *strncpy (); extern int strcmp (); char *etags_index (), *etags_rindex (); char *savenstr (); /* Define the symbol ETAGS to make the program "etags", which makes emacs-style tag tables by default. Define CTAGS to make the program "ctags" compatible with the usual one. Define neither one to get behavior that depends on the name with which the program is invoked (but we don't normally compile it that way). */ #if !defined(ETAGS) && !defined(CTAGS) /* If neither is defined, program can be run as either. */ #define ETAGS #define CTAGS #endif /* On VMS, CTAGS is not useful, so always do ETAGS. */ #ifdef VMS #ifndef ETAGS #define ETAGS #endif #endif /* Exit codes for success and failure. */ #ifdef VMS #define GOOD (1) #define BAD (0) #else #define GOOD (0) #define BAD (1) #endif /* * The FILEPOS abstract type, which represents a position in a file, * plus the following accessor functions: * * long GET_CHARNO (pos) * returns absolute char number. * void SET_FILEPOS (pos, fp, charno) * FILE *fp; long charno; * sets `pos' from the current file * position of `fp' and from `charno', * which must be the absolute character * number corresponding to the current * position of `fp'. * * The `pos' parameter is an lvalue expression of type FILEPOS. * Parameters to the accessor functions are evaluated 0 or more times, * and so must have no side effects. * * FILEPOS objects can also be assigned and passed to and from * functions in the normal C manner. * * Implementation notes: the `+ 0' is to enforce rvalue-ness. */ #ifndef DEBUG /* real implementation */ typedef long FILEPOS; #define GET_CHARNO(pos) ((pos) + 0) #define SET_FILEPOS(pos, fp, cno) ((void) ((pos) = (cno))) #else /* debugging implementation */ typedef struct { long charno; } FILEPOS; #define GET_CHARNO(pos) ((pos).charno + 0) #define SET_FILEPOS(pos, fp, cno) \ ((void) ((pos).charno = (cno), \ (cno) != ftell (fp) ? (error ("SET_FILEPOS inconsistency"), 0) \ : 0)) #endif #define streq(s, t) (strcmp (s, t) == 0) #define strneq(s, t, n) (strncmp (s, t, n) == 0) #define logical int #define TRUE 1 #define FALSE 0 #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 */ #define max(I1,I2) ((I1) > (I2) ? (I1) : (I2)) struct nd_st { /* sorting structure */ char *name; /* function or type name */ char *file; /* file name */ logical is_func; /* use pattern or line no */ logical named; /* list name separately */ 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 */ }; long ftell (); typedef struct nd_st NODE; logical header_file; /* TRUE if .h file, FALSE o.w. */ /* boolean "functions" (see init) */ logical _wht[0177], _etk[0177], _itk[0177], _btk[0177]; char *concat (); char *savenstr (); char *savestr (); char *xmalloc (); char *xrealloc (); int L_isdef (), L_isquote (); int PF_funcs (); int total_size_of_entries (); logical consider_token (); logical tail (); long readline (); void Asm_funcs (); void C_entries (); void L_funcs (); void L_getit (); void PAS_funcs (); void Scheme_funcs (); void TEX_funcs (); void add_node (); void error (); void fatal (); void find_entries (); void free_tree (); void getit (); void getline (); void init (); void initbuffer (); void initbuffer (); void pfnote (); void process_file (); void put_entries (); void takeprec (); /* * MACRO * xnew -- allocate storage * * SYNOPSIS * Type *xnew (int n, Type); */ #define xnew(n, Type) ((Type *) xmalloc ((n) * sizeof (Type))) /* * Symbol table stuff. * * Should probably be implemented with hash table; linked list for now. */ enum sym_type { st_none, st_C_struct, st_C_enum, st_C_define, st_C_typedef, st_C_typespec }; struct stab_entry { char *sym; int symlen; enum sym_type type; struct stab_entry *next; }; typedef struct stab_entry Stab_entry; typedef Stab_entry *Stab; /* * NAME * Stab, Stab_entry, stab_create, stab_search, stab_find -- symbol table * * SYNOPSIS * Types: Stab, Stab_entry, enum sym_type * * Stab * stab_create () * * Stab_entry * stab_find (stab, sym) * Stab *stab; * char *sym; * * Stab_entry * stab_search (stab, sym) * Stab *stab; * char *sym; * * DESCRIPTION * stab_create creates a Stab, a symbol table object, and returns a * pointer to it. stab_find finds a symbol in a Stab; it returns a * pointer to the Stab_entry if found, otherwise NULL. stab_search * is like stab_find, except that it creates a new Stab_entry, * initialized with type = st_none, if one did not exist already * (it never returns NULL). * * A Stab_entry is a structure that contains at least the following * members: * * char *name; // must not be modified * enum sym_type type; // should be set * * The type field is initially set to st_none; it should be set to * something else by the caller of stab_search. Other possible values * of an enum sym_type can be added. */ Stab * stab_create () { Stab *sp; sp = xnew (1, Stab); *sp = NULL; /* a Stab starts out as a null Stab_entry* */ return sp; } Stab_entry * stab_find (stab, sym, symlen) Stab *stab; register char *sym; register int symlen; { register Stab_entry *se; for (se = *stab; se != NULL; se = se->next) { if (se->symlen == symlen && strneq (se->sym, sym, symlen)) return se; } return NULL; } Stab_entry * stab_search (stab, sym, symlen) register Stab *stab; char *sym; int symlen; { register Stab_entry *se; se = stab_find (stab, sym, symlen); if (se == NULL) { /* make a new one */ se = xnew (1, Stab_entry); se->sym = savenstr (sym, symlen); se->symlen = symlen; se->type = st_none; se->next = *stab; *stab = se; } return se; } /* * NAME * stab_type -- type of a symbol table entry * * SYNOPSIS * enum sym_type stab_type (Stab_entry *se); * * WARNING * May evaluate its argument more than once. */ #define stab_type(se) ((se)==NULL ? st_none : (se)->type) typedef int LINENO; typedef struct { char *p; int len; LINENO lineno; logical named; } TOKEN; /* C extensions. */ #define C_PLPL 0x00001 /* C++ */ #define C_STAR 0x00003 /* C* */ #define YACC 0x10000 /* yacc file */ char searchar = '/'; /* use /.../ searches */ LINENO 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 */ *outfile, /* output file */ *white = " \f\t\n", /* white chars */ *endtk = " \t\n\"'#()[]{}=-+%*/&|^~!<>;,.:?", /* token ending chars */ /* token starting chars */ *begtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$~", /* valid in-token chars */ *intk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$0123456789"; int append_to_tagfile; /* -a: append to tags */ int emacs_tags_format; /* emacs style output (no -e option any more) */ /* The following three default to 1 for etags, but to 0 for ctags. */ int typedefs; /* -t: create tags for typedefs */ int typedefs_and_cplusplus; /* -T: create tags for typedefs, level */ /* 0 struct/enum/union decls, and C++ */ /* member functions */ int constantypedefs; /* -d: create tags for C #define and enum */ /* constants. Default under etags. Enum */ /* constants not implemented. */ /* -D: opposite of -d. Default under ctags. */ int update; /* -u: update tags */ int vgrind_style; /* -v: create vgrind style index output */ int no_warnings; /* -w: suppress warnings */ int cxref_style; /* -x: create cxref style output */ int cplusplus; /* .[hc] means C++, not C */ int noindentypedefs; /* -S: ignore indentation in C */ /* Name this program was invoked with. */ char *progname; 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' }, { "forward-search", no_argument, NULL, 'F' }, { "help", no_argument, NULL, 'H' }, { "ignore-indentation", no_argument, NULL, 'S' }, { "include", required_argument, NULL, 'i' }, { "no-defines", no_argument, NULL, 'D' }, { "no-warn", no_argument, NULL, 'w' }, { "output", required_argument, NULL, 'o' }, { "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 } }; FILE *inf, /* ioptr for current input file */ *outf; /* ioptr for tags file */ NODE *head; /* the head of the binary tree of tags */ int permit_duplicates = 1; /* Nonzero means allow duplicate 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 filename_lb; /* used to read in filenames */ struct { FILEPOS linepos; struct linebuffer lb; /* used by C_entries instead of lb */ } lbs[2]; void print_version () { #ifdef CTAGS printf ("CTAGS "); #ifdef ETAGS printf ("and "); #endif #endif #ifdef ETAGS printf ("ETAGS "); #endif printf ("for Emacs version 19.\n"); exit (0); } void print_help () { printf ("These are the options accepted by %s. You may use unambiguous\n\ abbreviations for the long option names.\n\n", progname); puts ("-a, --append\n\ Append tag entries to existing tags file."); puts ("-C, --c++\n\ Treat files with `.c' and `.h' extensions as C++ code, not C\n\ code. Files with `.C', `.H', `.cxx', `.hxx', or `.cc'\n\ extensions are always assumed to be C++ code."); fputs ("-d, --defines\n\ Create tag entries for #defines, too.", stdout); #ifdef ETAGS fputs (" This is the default\n\ behavior.", stdout); #endif fputs ("\n\ -D, --no-defines\n\ Don't create tag entries for #defines.", stdout); #ifdef CTAGS fputs (" This is the default\n\ behavior.", stdout); #endif puts ("\n\ -o FILE, --output=FILE\n\ Write the tags to FILE.\n\ -S, --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."); puts ("-t, --typedefs\n\ Generate tag entries for typedefs. This is the default\n\ behavior."); puts ("-T, --typedefs-and-c++\n\ Generate tag entries for typedefs, struct/enum/union tags, and\n\ C++ member functions."); #ifdef ETAGS 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."); #endif #ifdef CTAGS puts ("-B, --backward-search\n\ Write the search commands for the tag entries using '?', the\n\ backward-search command."); puts ("-F, --forward-search\n\ Write the search commands for the tag entries using '/', the\n\ forward-search command."); puts ("-u, --update\n\ Update the tag entries for the given files, leaving tag\n\ entries for other files in place. Currently, this is\n\ 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 ("-x, --cxref\n\ Like --vgrind, but in the style of cxref, rather than vgrind.\n\ The output uses line numbers instead of page numbers, but\n\ beyond that the differences are cosmetic; try both to see\n\ which you like."); puts ("-w, --no-warn\n\ Suppress warning messages about entries defined in multiple\n\ files."); #endif puts ("-V, --version\n\ Print the version of the program.\n\ -H, --help\n\ Print this help message."); exit (0); } void main (argc, argv) int argc; char *argv[]; { char cmd[100]; int i; unsigned int nincluded_files = 0; char **included_files = xnew (argc, char *); char *this_file; #ifdef VMS char got_err; extern char *gfnames (); extern char *massage_name (); #endif progname = argv[0]; #ifndef CTAGS emacs_tags_format = 1; #else emacs_tags_format = 0; #endif /* * If etags, always find typedefs and structure tags. Why not? * Also default is to find macro constants. */ if (emacs_tags_format) typedefs = typedefs_and_cplusplus = constantypedefs = 1; for (;;) { int opt; opt = getopt_long (argc, argv, "aCdDo:f:StTi:BFuvxwVH", 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; /* Common options. */ case 'a': append_to_tagfile++; break; case 'C': cplusplus = 1; break; case 'd': constantypedefs = 1; break; case 'D': constantypedefs = 0; break; case 'f': case 'o': if (outfile) { fprintf (stderr, "%s: -%c flag may only be given once\n", progname, opt); goto usage; } outfile = optarg; break; case 'S': noindentypedefs++; break; case 't': typedefs++; break; case 'T': typedefs++; typedefs_and_cplusplus++; break; case 'V': print_version (); break; case 'H': print_help (); break; /* Etags options */ case 'i': if (!emacs_tags_format) goto usage; included_files[nincluded_files++] = optarg; break; /* Ctags options. */ case 'B': searchar = '?'; if (emacs_tags_format) goto usage; break; case 'F': searchar = '/'; if (emacs_tags_format) goto usage; break; case 'u': update++; if (emacs_tags_format) goto usage; break; case 'v': vgrind_style++; /*FALLTHRU*/ case 'x': cxref_style++; if (emacs_tags_format) goto usage; break; case 'w': no_warnings++; if (emacs_tags_format) goto usage; break; default: goto usage; } } if (optind == argc && nincluded_files == 0) { fprintf (stderr, "%s: No input files specified.\n", progname); usage: fprintf (stderr, "%s: Try `%s --help' for a complete list of options.\n", progname, progname); exit (BAD); } if (outfile == 0) { outfile = emacs_tags_format ? "TAGS" : "tags"; } init (); /* set up boolean "functions" */ initbuffer (&lb); initbuffer (&lbs[0].lb); initbuffer (&lbs[1].lb); initbuffer (&filename_lb); /* * loop through files finding functions */ if (emacs_tags_format) { if (streq (outfile, "-")) outf = stdout; else outf = fopen (outfile, append_to_tagfile ? "a" : "w"); if (!outf) { perror (outfile); exit (1); } } #ifdef VMS argc -= optind; argv += optind; while (gfnames (&argc, &argv, &got_err) != NULL) { if (got_err) { error ("Can't find file %s\n", this_file); argc--, argv++; } else { this_file = massage_name (this_file); #if 0 } } /* solely to balance out the ifdef'd parens above */ #endif #else for (; optind < argc; optind++) { this_file = argv[optind]; if (1) { #endif /* Input file named "-" means read file names from stdin and use them. */ if (streq (this_file, "-")) { while (!feof (stdin)) { (void) readline (&filename_lb, stdin); if (strlen (filename_lb.buffer) > 0) process_file (filename_lb.buffer); } } else process_file (this_file); } } if (emacs_tags_format) { while (nincluded_files-- > 0) fprintf (outf, "\f\n%s,include\n", *included_files++); (void) fclose (outf); exit (0); } if (cxref_style) { put_entries (head); exit (GOOD); } if (update) { /* update cannot be set under VMS, so we may assume that argc and argv have not been munged. */ for (i = optind; i < argc; i++) { sprintf (cmd, "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS", outfile, argv[i], outfile); (void) system (cmd); } append_to_tagfile++; } outf = fopen (outfile, append_to_tagfile ? "a" : "w"); if (outf == NULL) { perror (outfile); exit (GOOD); } put_entries (head); (void) fclose (outf); if (update) { sprintf (cmd, "sort %s -o %s", outfile, outfile); (void) system (cmd); } exit (GOOD); } /* * This routine is called on each file argument. */ void process_file (file) char *file; { struct stat stat_buf; if (stat (file, &stat_buf) || !S_ISREG (stat_buf.st_mode)) { fprintf (stderr, "Skipping %s: it is not a regular file.\n", file); return; } if (streq (file, outfile) && !streq (outfile, "-")) { fprintf (stderr, "Skipping inclusion of %s in self.\n", file); return; } find_entries (file); if (emacs_tags_format) { fprintf (outf, "\f\n%s,%d\n", file, total_size_of_entries (head)); 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) char *file; { char *cp; void prolog_funcs (); inf = fopen (file, "r"); if (inf == NULL) { perror (file); return; } curfile = savestr (file); cp = etags_rindex (file, '.'); header_file = (cp && (streq (cp + 1, "h"))); /* .tex, .aux or .bbl implies LaTeX source code */ if (cp && (streq (cp + 1, "tex") || streq (cp + 1, "aux") || streq (cp + 1, "bbl"))) { TEX_funcs (inf); goto close_and_return; } /* .l or .el or .lisp (or .cl or .clisp or ...) implies lisp source code */ if (cp && (streq (cp + 1, "l") || streq (cp + 1, "el") || streq (cp + 1, "lsp") || streq (cp + 1, "lisp") || streq (cp + 1, "cl") || streq (cp + 1, "clisp"))) { L_funcs (inf); goto close_and_return; } /* .scm or .sm or .scheme or ... implies scheme source code */ if (cp && (streq (cp + 1, "sm") || streq (cp + 1, "scm") || streq (cp + 1, "scheme") || streq (cp + 1, "t") || streq (cp + 1, "sch") || streq (cp + 1, "SM") || streq (cp + 1, "SCM") /* The `SCM' or `scm' prefix with a version number */ || (cp[-1] == 'm' && cp[-2] == 'c' && cp[-3] == 's' && string_numeric_p (cp + 1)) || (cp[-1] == 'M' && cp[-2] == 'C' && cp[-3] == 'S' && string_numeric_p (cp + 1)))) { Scheme_funcs (inf); fclose (inf); return; } /* Assume that ".s" or ".a" is assembly code. -wolfgang. Or even ".sa". */ if (cp && (streq (cp + 1, "s") || streq (cp + 1, "a") || streq (cp + 1, "sa"))) { Asm_funcs (inf); fclose (inf); return; } /* .C or .H or .cxx or .hxx or .cc: a C++ file */ if (cp && (streq (cp + 1, "C") || streq (cp + 1, "H") || streq (cp + 1, "cxx") || streq (cp + 1, "hxx") || streq (cp + 1, "cc"))) { C_entries (C_PLPL); /* C++ */ goto close_and_return; } /* .cs or .hs: a C* file */ if (cp && (streq (cp + 1, "cs") || streq (cp + 1, "hs"))) { C_entries (C_STAR); goto close_and_return; } /* .y: a yacc file */ if (cp && (streq (cp + 1, "y"))) { C_entries (YACC); goto close_and_return; } /* .pl implies prolog source code */ if (cp && streq (cp + 1, "pl")) { prolog_funcs (inf); goto close_and_return; } /* .p or .pas: a Pascal file */ if (cp && (streq (cp + 1, "p") || streq (cp + 1, "pas"))) { PAS_funcs (inf); goto close_and_return; } /* If .f or .for, assume it is fortran or nothing. */ if (cp && (streq (cp + 1, "f") || streq (cp + 1, "for"))) { PF_funcs (inf); goto close_and_return; } /* if not a .c or .h or .y file, try fortran */ if (cp && ((cp[1] != 'c' && cp[1] != 'h' && cp[1] != 'y') || (cp[1] != 0 && cp[2] != 0))) { if (PF_funcs (inf) != 0) goto close_and_return; rewind (inf); /* no fortran tags found, try C */ } C_entries (cplusplus ? C_PLPL : 0); close_and_return: (void) fclose (inf); } /* Nonzero if string STR is composed of digits. */ int string_numeric_p (str) char *str; { while (*str) { if (*str < '0' || *str > '9') return 0; } return 1; } /* Record a tag. */ /* Should take a TOKEN* instead!! */ void pfnote (name, is_func, named, linestart, linelen, lno, cno) char *name; /* tag name */ logical is_func; /* function or type name? */ logical named; /* tag different from text of definition? */ char *linestart; int linelen; int lno; long cno; { register char *fp; register NODE *np; char tem[51]; char c; np = (NODE *) malloc (sizeof (NODE)); if (np == NULL) { if (!emacs_tags_format) { /* It's okay to output early in etags -- it only disrupts the * character count of the tag entries, which is no longer used * by tags.el anyway. */ error ("too many entries to sort"); } put_entries (head); free_tree (head); head = NULL; np = xnew (1, NODE); } /* If ctags mode, change name "main" to M. */ if (!emacs_tags_format && !cxref_style && streq (name, "main")) { fp = etags_rindex (curfile, '/'); name = concat ("M", fp == 0 ? curfile : fp + 1, ""); fp = etags_rindex (name, '.'); if (fp && fp[1] != '\0' && fp[2] == '\0') *fp = 0; named = TRUE; } np->name = savestr (name); np->file = curfile; np->is_func = is_func; np->named = named; np->lno = lno; /* UNCOMMENT THE +1 HERE: */ np->cno = cno /* + 1 */ ; /* our char numbers are 0-base; emacs's are 1-base */ np->left = np->right = 0; if (emacs_tags_format) { c = linestart[linelen]; linestart[linelen] = 0; } else if (cxref_style == 0) { sprintf (tem, strlen (linestart) < 50 ? "%s$" : "%.50s", linestart); linestart = tem; } np->pat = savestr (linestart); if (emacs_tags_format) { linestart[linelen] = c; } 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); 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. */ /* Must avoid static vars within functions since some systems #define static as nothing. */ static 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 (emacs_tags_format) { /* Etags Mode */ if (!last_node) fatal ("internal error in add_node"); 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 (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"); } return; } 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; } /* Maybe refuse to add duplicate nodes. */ if (!permit_duplicates) { if (!strcmp (node->name, cur_node->name) && !strcmp (node->file, cur_node->file)) 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 (emacs_tags_format) { if (node->named) { fprintf (outf, "%s\177%s\001%d,%d\n", node->pat, node->name, node->lno, node->cno); } else { fprintf (outf, "%s\177%d,%d\n", node->pat, node->lno, node->cno); } } else if (!cxref_style) { fprintf (outf, "%s\t%s\t", node->name, node->file); if (node->is_func) { /* a function */ putc (searchar, outf); putc ('^', outf); for (sp = node->pat; *sp; sp++) { if (*sp == '\\' || *sp == searchar) putc ('\\', outf); putc (*sp, outf); } putc (searchar, outf); } else { /* a typedef; text pattern inadequate */ fprintf (outf, "%d", node->lno); } putc ('\n', outf); } 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 emacs_tags_format * is set, 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->named) total += 1 + strlen (node->name); /* \001name */ } return total; } /* * The C symbol tables. */ Stab *C_stab, *C_PLPL_stab, *C_STAR_stab; /* * SYNOPSIS * Stab *get_C_stab (int c_ext); */ #define get_C_stab(c_ext) ((c_ext & C_STAR) ? C_STAR_stab : \ (c_ext & C_PLPL) ? C_PLPL_stab : \ C_stab) void add_keyword (stab, sym, type) Stab *stab; char *sym; enum sym_type type; { stab_search (stab, sym, strlen (sym))->type = type; } Stab * C_create_stab (c_ext) int c_ext; { Stab *stab; stab = stab_create (); /* C, C++ and C* */ if (c_ext & C_PLPL) add_keyword (stab, "class", st_C_struct); if (c_ext & C_STAR) add_keyword (stab, "domain", st_C_struct); add_keyword (stab, "union", st_C_struct); add_keyword (stab, "struct", st_C_struct); add_keyword (stab, "enum", st_C_enum); add_keyword (stab, "typedef", st_C_typedef); add_keyword (stab, "define", st_C_define); add_keyword (stab, "long", st_C_typespec); add_keyword (stab, "short", st_C_typespec); add_keyword (stab, "int", st_C_typespec); add_keyword (stab, "char", st_C_typespec); add_keyword (stab, "float", st_C_typespec); add_keyword (stab, "double", st_C_typespec); add_keyword (stab, "signed", st_C_typespec); add_keyword (stab, "unsigned", st_C_typespec); add_keyword (stab, "auto", st_C_typespec); add_keyword (stab, "void", st_C_typespec); add_keyword (stab, "extern", st_C_typespec); add_keyword (stab, "static", st_C_typespec); add_keyword (stab, "const", st_C_typespec); add_keyword (stab, "volatile", st_C_typespec); return stab; } void C_create_stabs () { C_stab = C_create_stab (0); C_PLPL_stab = C_create_stab (C_PLPL); C_STAR_stab = C_create_stab (C_STAR | C_PLPL); } /* * 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 */ } TYPEDST; TYPEDST typdef; /* struct tags for C++ are recognized using another simple * finite automaton. `structdef' is its state variable. * This machinery is only invoked for C++; otherwise structdef * should remain snone. However, this machinery can easily be * adapted to find structure tags in normal C code. */ 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 structkey is the preceding struct-like keyword. */ char structtag[BUFSIZ]; Stab_entry *structkey; /* * 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 GNUmacs'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; /* * C_entries () * This routine finds functions, typedefs, #define's and * struct/union/enum definitions in C syntax and adds them * to the list. */ #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) /* Save and restore token state. This is used when preprocessor defines are handled, to avoid disturbing active function/typedef/struct states. */ #define TOKEN_SAVED_P (savetok.lineno > 0) #define SAVE_TOKEN (savetok = tok, savetok.p = (char *) tokoff, \ savetok.len = toklen, strcpy(savenameb, nameb)) #define RESTORE_TOKEN (tok = savetok, tokoff = (int) tok.p, \ toklen = tok.len, strcpy(nameb, savenameb), \ savetok.lineno = 0) #define CNL_SAVE_DEFINEDEF \ do { \ SET_FILEPOS (curlinepos, inf, charno); \ lineno++; \ charno += readline (&curlb, inf); \ lp = curlb.buffer; \ quotednl = FALSE; \ newndx = curndx; \ } while (FALSE) #define CNL \ do { \ CNL_SAVE_DEFINEDEF; \ if (TOKEN_SAVED_P) \ RESTORE_TOKEN; \ definedef = dnone; \ } while (FALSE) #define MAKE_TAG_FROM_NEW_LB(isfun) pfnote (nameb, isfun, tok.named, \ newlb.buffer, tokoff + toklen + 1, tok.lineno, GET_CHARNO (newlinepos)) #define MAKE_TAG_FROM_OTH_LB(isfun) pfnote (nameb, isfun, tok.named, \ othlb.buffer, tokoff + toklen + 1, tok.lineno, GET_CHARNO (othlinepos)) void C_entries (c_ext) int c_ext; /* extension of C? */ { 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 for funcdef & structdef */ char nameb[BUFSIZ]; /* latest token name for funcdef & structdef */ register int tokoff; /* offset in line of start of latest token */ register int toklen; /* length of latest token */ int cblev; /* current curly brace level */ int parlev; /* current parenthesis level */ logical incomm, inquote, inchar, quotednl, midtoken; logical cplpl; TOKEN savetok; /* saved token during preprocessor handling */ logical saveisfunc; char savenameb[BUFSIZ]; /* ouch! */ savetok.lineno = 0; 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; cblev = 0; parlev = 0; cplpl = c_ext & C_PLPL; C_create_stabs (); 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) { if (c == '\'') inchar = FALSE; 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 (lp == newlb.buffer + 1 && definedef == dnone) definedef = dsharpseen; continue; } /* switch (c) */ /* Consider token only if some complicated conditions are satisfied. */ if (((cblev == 0 && structdef != scolonseen) || (cblev == 1 && cplpl && structdef == sinbody)) && definedef != dignorerest && (funcdef != finlist || (definedef != dnone && definedef != dignorerest))) { if (midtoken) { if (endtoken (c)) { if (cplpl && c == ':' && *lp == ':' && begtoken(*(lp + 1))) { /* * This handles :: in the middle, but not at beginning * of an identifier. */ lp += 2; toklen += 3; } else { logical is_func = FALSE; tok.lineno = lineno; tok.p = newlb.buffer + tokoff; tok.len = toklen; tok.named = FALSE; if (yacc_rules || consider_token (c, lp, &tok, c_ext, cblev, &is_func)) { if (structdef == sinbody && definedef == dnone && is_func) /* function defined in C++ class body */ { tok.named = TRUE; sprintf (nameb, "%s::%.*s", ((structtag[0] == '\0') ? "_anonymous_" : structtag), tok.len, tok.p); } else { sprintf (nameb, "%.*s", tok.len, tok.p); } if (structdef == stagseen || typdef == tend) tok.named = TRUE; if (definedef == dnone && (funcdef == ftagseen || structdef == stagseen || typdef == tend)) { if (newndx == curndx) curndx = 1 - curndx; /* switch line buffers */ } else MAKE_TAG_FROM_NEW_LB (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_FROM_OTH_LB (TRUE); funcdef = fignore; break; case ftagseen: funcdef = fnone; break; } if (structdef == stagseen) structdef = snone; break; case dsharpseen: /* Take a quick peek ahead for define directive, so we can avoid saving the token when not absolutely necessary. [This is a speed hack.] */ if (c == 'd' && strneq(lp, "efine", 5) && iswhite(*(lp + 5))) { SAVE_TOKEN; definedef = ddefineseen; lp += 6; } else definedef = dignorerest; continue; } if (!yacc_rules || lp == newlb.buffer + 1) { tokoff = lp - 1 - newlb.buffer; toklen = 1; midtoken = TRUE; } continue; } } /* 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_FROM_OTH_LB (FALSE); funcdef = fignore; } break; case fstartlist: funcdef = fnone; break; } break; case ';': if (definedef != dnone) break; if (cblev == 0 && typdef == tend) { typdef = tnone; MAKE_TAG_FROM_OTH_LB (FALSE); } if (funcdef != fignore) funcdef = fnone; /* FALLTHRU */ case ',': /* FALLTHRU */ case '[': if (definedef != dnone) break; if (funcdef != finlist && funcdef != fignore) funcdef = fnone; if (structdef == stagseen) structdef = snone; break; case '(': if (definedef != dnone) break; switch (funcdef) { 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; } } 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[0] = '\0'; structdef = sinbody; break; case stagseen: case scolonseen: /* named struct */ structdef = sinbody; MAKE_TAG_FROM_OTH_LB (FALSE); break; } switch (funcdef) { case flistseen: MAKE_TAG_FROM_OTH_LB (TRUE); /* FALLTHRU */ case fignore: funcdef = fnone; } 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; structdef = snone; (void) strcpy (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 */ } /* * 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 (c, lp, tokp, c_ext, cblev, is_func) register char c; /* IN: first char after the token */ register char *lp; /* IN: lp points to 2nd char after the token */ register TOKEN *tokp; /* IN: token pointer */ int c_ext; /* IN: C extensions mask */ int cblev; /* IN: curly brace level */ logical *is_func; /* OUT */ { Stab_entry *tokse = stab_find (get_C_stab (c_ext), tokp->p, tokp->len); enum sym_type toktype = stab_type (tokse); /* * 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. */ definedef = dignorerest; *is_func = (c == '('); if (!*is_func && !constantypedefs) return (FALSE); else return (TRUE); case dignorerest: return (FALSE); default: error ("internal error: definedef value"); } /* * Now typedefs */ switch (typdef) { case tnone: if (toktype == st_C_typedef) { if (typedefs) typdef = ttypedseen; 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; structkey = tokse; } return (FALSE); } if (structdef == skeyseen) { if (stab_type (structkey) == st_C_struct) { (void) strncpy (structtag, tokp->p, tokp->len); structtag[tokp->len] = '\0'; /* for struct/union/class */ } else { structtag[0] = '\0'; /* for enum (why is it treated differently?) */ } structdef = stagseen; return (TRUE); } /* Avoid entering funcdef stuff if typdef is going on. */ if (typdef != tnone) { definedef = dnone; return (FALSE); } /* Detect GNUmacs's function-defining macros. */ if (definedef == dnone) { if (strneq (tokp->p, "DEF", 3) || strneq (tokp->p, "ENTRY", 5) || strneq (tokp->p, "SYSCALL", 7) || strneq (tokp->p, "PSEUDO", 6)) { next_token_is_func = TRUE; return (FALSE); } if (strneq (tokp->p, "EXFUN", 5)) { next_token_is_func = FALSE; return (FALSE); } } if (next_token_is_func) { next_token_is_func = FALSE; funcdef = fnone; *is_func = TRUE; /* to force search string in ctags */ return (TRUE); } /* A function? */ switch (toktype) { case st_C_typespec: funcdef = fnone; /* should be useless */ return (FALSE); default: if (funcdef == fnone) { funcdef = ftagseen; *is_func = TRUE; return (TRUE); } } return (FALSE); } /* Fortran parsing */ char *dbp; int pfcnt; int PF_funcs (fi) FILE *fi; { lineno = 0; charno = 0; pfcnt = 0; while (!feof (fi)) { lineno++; linecharno = charno; charno += readline (&lb, fi); dbp = lb.buffer; if (*dbp == '%') dbp++; /* Ratfor escape to fortran */ while (isspace (*dbp)) dbp++; if (*dbp == 0) continue; switch (*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 (*dbp | ' ') { case 'f': if (tail ("function")) getit (); continue; case 's': if (tail ("subroutine")) getit (); continue; case 'e': if (tail ("entry")) getit (); continue; case 'p': if (tail ("program")) { getit (); continue; } if (tail ("procedure")) getit (); continue; } } return (pfcnt); } logical tail (cp) char *cp; { register int len = 0; while (*cp && (*cp & ~' ') == ((*(dbp + len)) & ~' ')) cp++, len++; if (*cp == 0) { dbp += len; return (1); } return (0); } void takeprec () { while (isspace (*dbp)) dbp++; if (*dbp != '*') return; dbp++; while (isspace (*dbp)) dbp++; if (!isdigit (*dbp)) { --dbp; /* force failure */ return; } do dbp++; while (isdigit (*dbp)); } void getit () { register char *cp; char c; char nambuf[BUFSIZ]; while (isspace (*dbp)) dbp++; if (*dbp == 0 || (!isalpha (*dbp) && *dbp != '_' && *dbp != '$')) return; for (cp = dbp + 1; *cp && (isalpha (*cp) || isdigit (*cp) || (*cp == '_') || (*cp == '$')); cp++) continue; c = cp[0]; cp[0] = 0; (void) strcpy (nambuf, dbp); cp[0] = c; pfnote (nambuf, TRUE, FALSE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); pfcnt++; } /* Handle a file of assembler code. */ void Asm_funcs (fi) FILE *fi; { int i; register char c; lineno = 0; charno = 0; pfcnt = 0; while (!feof (fi)) { lineno++; linecharno = charno; charno += readline (&lb, fi); dbp = lb.buffer; for (i = 0; ((c = dbp[i]) && !isspace (c)) && (c != ':'); i++) ; if ((i > 0) && (c == ':')) getit (); } } /* 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 PAS_funcs (fi) FILE *fi; { struct linebuffer tline; /* mostly copied from C_entries */ long save_lcno; int save_lineno; char c, *cp; char nambuf[BUFSIZ]; logical /* each of these flags is TRUE iff: */ incomm1, /* point is inside {..} comment */ incomm2, /* point is inside (*..*) 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; initbuffer (&tline); incomm1 = incomm2 = 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 (fi)) { 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 (incomm1) /* within { - } comments */ { if (c == '}') incomm1 = FALSE; continue; } else if (incomm2) /* within (* - *) comments */ { if (c == '*') { while ((c = *dbp++) == '*') continue; if (c == 0) GET_NEW_LINE; if (c == ')') incomm2 = FALSE; } continue; } else if (inquote) { if (c == '\'') inquote = FALSE; continue; } else switch (c) { case '\'': inquote = TRUE; /* found first quote */ continue; case '{': /* found open-{-comment */ incomm1 = TRUE; continue; case '(': if (*dbp == '*') /* found open-(*-comment */ { incomm2 = 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 ((*dbp == 'e') || (*dbp == 'E')) { if (tail ("extern")) /* superfluous, really! */ { found_tag = FALSE; verify_tag = FALSE; } } else if ((*dbp == 'f') || (*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 (nambuf, TRUE, FALSE, tline.buffer, cp - tline.buffer + 1, save_lineno, save_lcno); continue; } } if (get_tagname) /* grab name of proc or fn */ { if (*dbp == 0) continue; /* save all values for later tagging */ tline.size = lb.size; strcpy (tline.buffer, lb.buffer); save_lineno = lineno; save_lcno = linecharno; /* grab block name */ for (cp = dbp + 1; *cp && (!endtoken (*cp)); cp++) continue; c = cp[0]; cp[0] = 0; strcpy (nambuf, dbp); cp[0] = c; dbp = cp; /* restore dbp to e-o-token */ get_tagname = FALSE; found_tag = TRUE; continue; /* and proceed to check for "extern" */ } if ((!incomm1) && (!incomm2) && (!inquote) && (!found_tag) && (!get_tagname)) { /* check for proc/fn keywords */ switch (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 e-o-f */ } /* * lisp tag functions * just look for (def or (DEF */ void L_funcs (fi) FILE *fi; { lineno = 0; charno = 0; pfcnt = 0; while (!feof (fi)) { lineno++; linecharno = charno; charno += readline (&lb, fi); 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 (); } } } } } } int L_isdef (dbp) register char *dbp; { return ((dbp[1] == 'd' || dbp[1] == 'D') && (dbp[2] == 'e' || dbp[2] == 'E') && (dbp[3] == 'f' || dbp[3] == 'F')); } int L_isquote (dbp) register char *dbp; { return ((*(++dbp) == 'q' || *dbp == 'Q') && (*(++dbp) == 'u' || *dbp == 'U') && (*(++dbp) == 'o' || *dbp == 'O') && (*(++dbp) == 't' || *dbp == 'T') && (*(++dbp) == 'e' || *dbp == 'E') && isspace(*(++dbp))); } void L_getit () { register char *cp; char c; char nambuf[BUFSIZ]; if (*dbp == '\'') /* Skip prefix quote */ dbp++; else if (*dbp == '(' && L_isquote (dbp)) /* Skip "(quote " */ { dbp += 7; while (isspace(*dbp)) dbp++; } for (cp = dbp /*+1*/; *cp && *cp != '(' && *cp != ' ' && *cp != ')'; cp++) continue; if (cp == dbp) return; c = cp[0]; cp[0] = 0; (void) strcpy (nambuf, dbp); cp[0] = c; pfnote (nambuf, TRUE, FALSE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); pfcnt++; } /* * Scheme tag functions * look for (def... xyzzy * look for (def... (xyzzy * look for (def ... ((...(xyzzy .... * look for (set! xyzzy */ static void get_scheme (); void Scheme_funcs (fi) FILE *fi; { lineno = 0; charno = 0; pfcnt = 0; while (!feof (fi)) { lineno++; linecharno = charno; charno += readline (&lb, fi); 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 (); } } } static void get_scheme () { register char *cp; char c; char nambuf[BUFSIZ]; 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; /* Null terminate the string there. */ c = cp[0]; cp[0] = 0; /* Copy the string */ strcpy (nambuf, dbp); /* Unterminate the string */ cp[0] = c; /* Announce the change */ pfnote (nambuf, TRUE, FALSE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); pfcnt++; } /* 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. */ static char *TEX_defenv = ":chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem:typeout"; void TEX_mode (); struct TEX_tabent *TEX_decode_env (); void TEX_getit (); int TEX_Token (); static char TEX_esc = '\\'; static char TEX_opgrp = '{'; static char TEX_clgrp = '}'; /* * TeX/LaTeX scanning loop. */ void TEX_funcs (fi) FILE *fi; { char *lasthit; lineno = 0; charno = 0; pfcnt = 0; /* Select either \ or ! as escape character. */ TEX_mode (fi); /* Initialize token table once from environment. */ if (!TEX_toktab) TEX_toktab = TEX_decode_env ("TEXTAGS", TEX_defenv); while (!feof (fi)) { /* Scan each line in file */ lineno++; linecharno = charno; charno += readline (&lb, fi); dbp = lb.buffer; lasthit = dbp; while (dbp = etags_index (dbp, TEX_esc)) /* Look at each escape in line */ { register int i; if (!*(++dbp)) break; linecharno += dbp - lasthit; lasthit = dbp; i = TEX_Token (lasthit); if (0 <= i) { TEX_getit (lasthit, TEX_toktab[i].len); 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 (f) FILE *f; { int c; while ((c = getc (f)) != EOF) { /* Skip to next line if we hit the TeX comment char. */ if (c == TEX_cmt) while (c != '\n') c = getc (f); 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 (f); } /* 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_index (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_index (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; } /* 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; char nambuf[BUFSIZ]; if (*name == 0) return; /* Let tag name extend to next group close (or end of line) */ while (*p && *p != TEX_clgrp) p++; (void) strncpy (nambuf, name, p - name); nambuf[p - name] = 0; pfnote (nambuf, TRUE, FALSE, lb.buffer, strlen (lb.buffer), lineno, linecharno); pfcnt++; } /* If the text at CP matches one of the tag-defining TeX command names, return the etags_index 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 (strncmp (TEX_toktab[i].name, cp, TEX_toktab[i].len) == 0) return i; return -1; } /* Support for Prolog. */ /* whole head (not only functor, but also arguments) is gotten in compound term. */ void prolog_getit (s, lineno, linecharno) char *s; int lineno; long linecharno; { char nambuf[BUFSIZ], *save_s, tmpc; int insquote, npar; save_s = s; insquote = FALSE; npar = 0; while (1) { if (*s == '\0') /* syntax error. */ return; else if (insquote && *s == '\'' && *(s + 1) == '\'') s += 2; else if (*s == '\'') { insquote = !insquote; s++; } else if (!insquote && *s == '(') { npar++; s++; } else if (!insquote && *s == ')') { npar--; s++; if (npar == 0) break; else if (npar < 0) /* syntax error. */ return; } else if (!insquote && *s == '.' && (isspace (*(s + 1)) || *(s + 1) == '\0')) { /* fullstop. */ if (npar != 0) /* syntax error. */ return; s++; break; } else s++; } tmpc = *s; *s = '\0'; strcpy (nambuf, save_s); *s = tmpc; pfnote (nambuf, TRUE, FALSE, save_s, strlen (nambuf), lineno, linecharno); } /* It is assumed that prolog predicate starts from column 0. */ void prolog_funcs (fi) FILE *fi; { void skip_comment (), prolog_getit (); lineno = linecharno = charno = 0; while (!feof (fi)) { lineno++; linecharno += charno; charno = readline (&lb, fi) + 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, fi, &lineno, &linecharno); else /* found. */ prolog_getit (dbp, lineno, linecharno); } } void skip_comment (plb, fi, plineno, plinecharno) struct linebuffer *plb; FILE *fi; int *plineno; /* result */ long *plinecharno; /* result */ { while (!substr ("*/", plb->buffer)) { (*plineno)++; *plinecharno += readline (plb, fi) + 1; } /* 1 for newline. */ } /* Return TRUE if 'sub' exists somewhere in 's'. */ int substr (sub, s) char *sub; char *s; { while (*s && (s = etags_index (s, *sub))) if (prestr (sub, s)) return (TRUE); else s++; return (FALSE); } /* Return TRUE if 'pre' is prefix of string 's'. */ int prestr (pre, s) char *pre; char *s; { if (*pre == '\0') return (TRUE); else if (*pre == *s) return (prestr (pre + 1, s + 1)); else return (FALSE); } /* 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 (linebuffer, stream) struct linebuffer *linebuffer; register FILE *stream; { char *buffer = linebuffer->buffer; register char *p = linebuffer->buffer; register char *pend; int newline; /* 1 if ended with newline, 0 if ended with EOF */ 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 < 0 || c == '\n') { *p = 0; newline = (c == '\n' ? 1 : 0); break; } *p++ = c; } return p - buffer + newline; } char * savestr (cp) char *cp; { return savenstr (cp, strlen (cp)); } char * savenstr (cp, len) char *cp; int len; { register char *dp; dp = xnew (len + 1, char); (void) 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 v7 rindex, included for portability. */ char * etags_rindex (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 v7 index, included for portability. */ char * etags_index (sp, c) register char *sp, c; { do { if (*sp == c) return (sp); } while (*sp++); return (NULL); } /* Print error message and exit. */ /* VARARGS1 */ void fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (1); } /* 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"); } /* 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); (void) strcpy (result, s1); (void) strcpy (result + len1, s2); (void) strcpy (result + len1 + len2, s3); *(result + len1 + len2 + len3) = 0; return result; } /* Like malloc but get fatal error if memory is exhausted. */ char * xmalloc (size) int size; { char *result = malloc (size); if (!result) fatal ("virtual memory exhausted", 0); return result; } char * xrealloc (ptr, size) char *ptr; int size; { char *result = realloc (ptr, size); if (!result) fatal ("virtual memory exhausted"); return result; } emacs-19.22/lib-src/fakemail.c100444 12241 12 34506 5444560632 14755 0ustar rolandstaff/* sendmail-like interface to /bin/mail for system V, 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 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. */ #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. */ main () { } #else /* not BSD 4.2 (or newer) */ /* 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 (); extern char *malloc (), *realloc (); #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 char * xmalloc (size) int size; { char *result = malloc (((unsigned) size)); if (result == ((char *) NULL)) fatal ("virtual memory exhausted", 0); return result; } static char * xrealloc (ptr, size) char *ptr; int size; { char *result = realloc (ptr, ((unsigned) size)); if (result == ((char *) 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 - linebuffer->buffer; end += buffer - linebuffer->buffer; linebuffer->buffer = buffer; } if (c < 0 || c == '\n') { *p = 0; break; } *p++ = c; } return p - buffer; } 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]; } boolean has_keyword (field) char *field; { char *ignored; return (get_keyword (field, &ignored) != ((char *) NULL)); } char * add_field (the_list, field, where) line_list the_list; register char *field, *where; { register char c; while (true) { *where++ = ' '; while ((c = *field++) != '\0') { if (c == '(') { while (*field && *field != ')') ++field; if (! (*field++)) break; /* no closer */ if (! (*field)) break; /* closerNULL */ c = *field; } *where++ = ((c == ','||c=='>'||c=='<') ? ' ' : 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++; } /* 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 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; } } 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; } 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; } 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 BSD 4.2 (or newer) */ emacs-19.22/lib-src/getdate.c100666 21641 13 140311 5470477436 15035 0ustar friedmanuser /* A Bison parser, made from getdate.y */ #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 nine shift/reduce conflicts. ** ** This code is in the public domain and has no copyright. */ /* SUPPRESS 287 on yaccpar_sccsid *//* Unusd static variable */ /* SUPPRESS 288 on yyerrlab *//* Label unused */ #ifdef HAVE_CONFIG_H #if defined (emacs) || defined (CONFIG_BROKETS) #include #else #include "config.h" #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 /* The following block of alloca-related preprocessor directives is here solely to allow compilation by non GNU-C compilers of the C parser produced from this file by old versions of bison. Newer versions of bison include a block similar to this one in bison.simple. */ #ifdef __GNUC__ #define alloca __builtin_alloca #else #ifdef HAVE_ALLOCA_H #include #else #ifdef _AIX #pragma alloca #else void *alloca (); #endif #endif #endif #ifdef __GNUC__ #undef alloca #define alloca __builtin_alloca #else #ifdef HAVE_ALLOCA_H #include #else #ifdef _AIX /* for Bison */ #pragma alloca #else void *alloca (); #endif #endif #endif #include #include /* The code at the top of get_date which figures out the offset of the current time zone checks various CPP symbols to see if special tricks are need, but defaults to using the gettimeofday system call. Include if that will be used. */ #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 /* ** We use the obsolete `struct timeb' as part of our interface! ** Since the system doesn't have it, we define it here; ** our 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 (); #if !defined(lint) && !defined(SABER) static char RCS[] = "$Header: str2date.y,v 2.1 90/09/06 08:15:06 cronan Exp $"; #endif /* !defined(lint) && !defined(SABER) */ #define EPOCH 1970 #define HOUR(x) ((time_t)(x) * 60) #define SECSPERDAY (24L * 60L * 60L) /* ** An entry in the lexical lookup table. */ typedef struct _TABLE { 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 203 "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 __STDC__ #define const #endif #define YYFINAL 51 #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 }; 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, 75, 80, 83, 87, 90, 92, 95, 98, 100, 103, 106, 108, 111, 114, 116, 118, 119 }; 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, 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 }; #if YYDEBUG != 0 static const short yyrline[] = { 0, 217, 218, 221, 224, 227, 230, 233, 236, 239, 245, 251, 258, 264, 274, 278, 282, 289, 293, 297, 303, 307, 312, 318, 322, 327, 331, 338, 342, 345, 348, 351, 354, 357, 360, 363, 366, 369, 374, 402, 405 }; 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, 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, 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, 31, 0, 37, 34, 0, 38, 14, 2, 3, 4, 6, 5, 7, 28, 8, 18, 23, 30, 35, 32, 19, 9, 29, 25, 36, 33, 0, 0, 0, 16, 27, 0, 26, 22, 39, 20, 24, 40, 11, 0, 10, 0, 39, 21, 13, 12, 0, 0 }; static const short yydefgoto[] = { 1, 11, 12, 13, 14, 15, 16, 17, 18, 44 }; static const short yypact[] = {-32768, 0, -15,-32768,-32768, -10,-32768,-32768, 25, 11, -8, -32768,-32768,-32768,-32768,-32768,-32768, 13,-32768,-32768, 7, -32768,-32768,-32768,-32768,-32768,-32768, 4,-32768,-32768, 14, 15, 19,-32768,-32768, 24,-32768,-32768, 18, 20,-32768, -32768,-32768, 26,-32768, 27, -6,-32768,-32768,-32768, 31, -32768 }; static const short yypgoto[] = {-32768, -32768,-32768,-32768,-32768,-32768,-32768,-32768,-32768, -5 }; #define YYLAST 41 static const short yytable[] = { 50, 41, 19, 20, 2, 3, 48, 33, 4, 5, 6, 7, 8, 9, 10, 24, 34, 36, 25, 26, 27, 28, 29, 30, 35, 41, 37, 31, 38, 32, 42, 51, 39, 21, 43, 22, 23, 40, 45, 46, 47, 49 }; static const short yycheck[] = { 0, 7, 17, 13, 4, 5, 12, 15, 8, 9, 10, 11, 12, 13, 14, 4, 3, 13, 7, 8, 9, 10, 11, 12, 17, 7, 12, 16, 13, 18, 12, 0, 13, 8, 16, 10, 11, 13, 18, 13, 13, 46 }; /* -*-C-*- Note some compilers choke on comments on `#line' lines. */ #line 3 "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 "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 221 "getdate.y" { yyHaveTime++; ; break;} case 4: #line 224 "getdate.y" { yyHaveZone++; ; break;} case 5: #line 227 "getdate.y" { yyHaveDate++; ; break;} case 6: #line 230 "getdate.y" { yyHaveDay++; ; break;} case 7: #line 233 "getdate.y" { yyHaveRel++; ; break;} case 9: #line 239 "getdate.y" { yyHour = yyvsp[-1].Number; yyMinutes = 0; yySeconds = 0; yyMeridian = yyvsp[0].Meridian; ; break;} case 10: #line 245 "getdate.y" { yyHour = yyvsp[-3].Number; yyMinutes = yyvsp[-1].Number; yySeconds = 0; yyMeridian = yyvsp[0].Meridian; ; break;} case 11: #line 251 "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 258 "getdate.y" { yyHour = yyvsp[-5].Number; yyMinutes = yyvsp[-3].Number; yySeconds = yyvsp[-1].Number; yyMeridian = yyvsp[0].Meridian; ; break;} case 13: #line 264 "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 274 "getdate.y" { yyTimezone = yyvsp[0].Number; yyDSTmode = DSToff; ; break;} case 15: #line 278 "getdate.y" { yyTimezone = yyvsp[0].Number; yyDSTmode = DSTon; ; break;} case 16: #line 283 "getdate.y" { yyTimezone = yyvsp[-1].Number; yyDSTmode = DSTon; ; break;} case 17: #line 289 "getdate.y" { yyDayOrdinal = 1; yyDayNumber = yyvsp[0].Number; ; break;} case 18: #line 293 "getdate.y" { yyDayOrdinal = 1; yyDayNumber = yyvsp[-1].Number; ; break;} case 19: #line 297 "getdate.y" { yyDayOrdinal = yyvsp[-1].Number; yyDayNumber = yyvsp[0].Number; ; break;} case 20: #line 303 "getdate.y" { yyMonth = yyvsp[-2].Number; yyDay = yyvsp[0].Number; ; break;} case 21: #line 307 "getdate.y" { yyMonth = yyvsp[-4].Number; yyDay = yyvsp[-2].Number; yyYear = yyvsp[0].Number; ; break;} case 22: #line 312 "getdate.y" { /* ISO 8601 format. yyyy-mm-dd. */ yyYear = yyvsp[-2].Number; yyMonth = -yyvsp[-1].Number; yyDay = -yyvsp[0].Number; ; break;} case 23: #line 318 "getdate.y" { yyMonth = yyvsp[-1].Number; yyDay = yyvsp[0].Number; ; break;} case 24: #line 322 "getdate.y" { yyMonth = yyvsp[-3].Number; yyDay = yyvsp[-2].Number; yyYear = yyvsp[0].Number; ; break;} case 25: #line 327 "getdate.y" { yyMonth = yyvsp[0].Number; yyDay = yyvsp[-1].Number; ; break;} case 26: #line 331 "getdate.y" { yyMonth = yyvsp[-1].Number; yyDay = yyvsp[-2].Number; yyYear = yyvsp[0].Number; ; break;} case 27: #line 338 "getdate.y" { yyRelSeconds = -yyRelSeconds; yyRelMonth = -yyRelMonth; ; break;} case 29: #line 345 "getdate.y" { yyRelSeconds += yyvsp[-1].Number * yyvsp[0].Number * 60L; ; break;} case 30: #line 348 "getdate.y" { yyRelSeconds += yyvsp[-1].Number * yyvsp[0].Number * 60L; ; break;} case 31: #line 351 "getdate.y" { yyRelSeconds += yyvsp[0].Number * 60L; ; break;} case 32: #line 354 "getdate.y" { yyRelSeconds += yyvsp[-1].Number; ; break;} case 33: #line 357 "getdate.y" { yyRelSeconds += yyvsp[-1].Number; ; break;} case 34: #line 360 "getdate.y" { yyRelSeconds++; ; break;} case 35: #line 363 "getdate.y" { yyRelMonth += yyvsp[-1].Number * yyvsp[0].Number; ; break;} case 36: #line 366 "getdate.y" { yyRelMonth += yyvsp[-1].Number * yyvsp[0].Number; ; break;} case 37: #line 369 "getdate.y" { yyRelMonth += yyvsp[0].Number; ; break;} case 38: #line 374 "getdate.y" { if (yyHaveTime && yyHaveDate && !yyHaveRel) yyYear = yyvsp[0].Number; else { if(yyvsp[0].Number>10000) { time_t date_part; date_part= yyvsp[0].Number/10000; yyHaveDate++; yyDay= (date_part)%100; yyMonth= (date_part/100)%100; yyYear = date_part/10000; } 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 39: #line 402 "getdate.y" { yyval.Meridian = MER24; ; break;} case 40: #line 405 "getdate.y" { yyval.Meridian = yyvsp[0].Meridian; ; break;} } /* the action file gets copied in in place of this dollarsign */ #line 480 "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 410 "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 */ { "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 Stanard, 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; return (Hours * 60L + Minutes) * 60L + Seconds; case MERpm: if (Hours < 1 || Hours > 12) return -1; 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 time_t 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); return ( ( ( /* 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 */ + (time_t)(ay-by) * 365 )*24 + (a->tm_hour - b->tm_hour) )*60 + (a->tm_min - b->tm_min) )*60 + (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. */ ftz.timezone = difftm (&gmt, localtime (&ftz.time)) / 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 */ main(ac, av) int ac; char *av[]; { char buff[128]; time_t d; (void)printf("Enter date, or blank line to exit.\n\t> "); (void)fflush(stdout); while (gets(buff) && 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.22/lib-src/COPYING100666 12120 24 43070 5475722562 13442 0ustar rmsother 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.22/lib-src/getdate.y100666 74504 13 57443 5467730617 15117 0ustar meyeringuser%{ /* ** 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 nine shift/reduce conflicts. ** ** This code is in the public domain and has no copyright. */ /* SUPPRESS 287 on yaccpar_sccsid *//* Unusd static variable */ /* SUPPRESS 288 on yyerrlab *//* Label unused */ #ifdef HAVE_CONFIG_H #if defined (emacs) || defined (CONFIG_BROKETS) #include #else #include "config.h" #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 /* The following block of alloca-related preprocessor directives is here solely to allow compilation by non GNU-C compilers of the C parser produced from this file by old versions of bison. Newer versions of bison include a block similar to this one in bison.simple. */ #ifdef __GNUC__ #define alloca __builtin_alloca #else #ifdef HAVE_ALLOCA_H #include #else #ifdef _AIX #pragma alloca #else void *alloca (); #endif #endif #endif #ifdef __GNUC__ #undef alloca #define alloca __builtin_alloca #else #ifdef HAVE_ALLOCA_H #include #else #ifdef _AIX /* for Bison */ #pragma alloca #else void *alloca (); #endif #endif #endif #include #include /* The code at the top of get_date which figures out the offset of the current time zone checks various CPP symbols to see if special tricks are need, but defaults to using the gettimeofday system call. Include if that will be used. */ #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 /* ** We use the obsolete `struct timeb' as part of our interface! ** Since the system doesn't have it, we define it here; ** our 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 (); #if !defined(lint) && !defined(SABER) static char RCS[] = "$Header: str2date.y,v 2.1 90/09/06 08:15:06 cronan Exp $"; #endif /* !defined(lint) && !defined(SABER) */ #define EPOCH 1970 #define HOUR(x) ((time_t)(x) * 60) #define SECSPERDAY (24L * 60L * 60L) /* ** An entry in the lexical lookup table. */ typedef struct _TABLE { 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; } | 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) { time_t date_part; date_part= $1/10000; yyHaveDate++; yyDay= (date_part)%100; yyMonth= (date_part/100)%100; yyYear = date_part/10000; } 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 */ { "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 Stanard, 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; return (Hours * 60L + Minutes) * 60L + Seconds; case MERpm: if (Hours < 1 || Hours > 12) return -1; 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 time_t 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); return ( ( ( /* 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 */ + (time_t)(ay-by) * 365 )*24 + (a->tm_hour - b->tm_hour) )*60 + (a->tm_min - b->tm_min) )*60 + (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. */ ftz.timezone = difftm (&gmt, localtime (&ftz.time)) / 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 */ main(ac, av) int ac; char *av[]; { char buff[128]; time_t d; (void)printf("Enter date, or blank line to exit.\n\t> "); (void)fflush(stdout); while (gets(buff) && 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.22/lib-src/getopt.c100777 12241 1 52216 5447406213 14630 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, 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef HAVE_CONFIG_H #if defined (emacs) || defined (CONFIG_BROKETS) /* We use instead of "config.h" so that a compilation using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h (which it would do because it found this file in $srcdir). */ #include #else #include "config.h" #endif #endif #ifndef __STDC__ /* This is a separate conditional since some stdc systems reject `defined (const)'. */ #ifndef const #define const #endif #endif /* This tells Alpha OSF/1 not to define a getopt prototype in . */ #ifndef _NO_PROTO #define _NO_PROTO #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. */ /* If GETOPT_COMPAT is defined, `+' as well as `--' can introduce a long-named option. Because this is not POSIX.2 compliant, it is being phased out. */ /* #define GETOPT_COMPAT */ /* 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 = 0; /* 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; #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. (Supposedly there are some machines where it might get a warning, but changing this conditional to __STDC__ is too risky.) */ #ifdef __GNUC__ #ifdef IN_GCC #include "gstddef.h" #else #include #endif extern size_t strlen (const char *); #endif #endif /* GNU C 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; } /* 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; { int option_index; optarg = 0; /* Initialize the internal data when the first call is made. 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. */ if (optind == 0) { first_nonopt = last_nonopt = optind = 1; nextchar = NULL; /* 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 (getenv ("POSIXLY_CORRECT") != NULL) ordering = REQUIRE_ORDER; else ordering = PERMUTE; } if (nextchar == NULL || *nextchar == '\0') { 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; /* Now skip any additional non-options and extend the range of non-options previously skipped. */ while (optind < argc && (argv[optind][0] != '-' || argv[optind][1] == '\0') #ifdef GETOPT_COMPAT && (longopts == NULL || argv[optind][0] != '+' || argv[optind][1] == '\0') #endif /* GETOPT_COMPAT */ ) optind++; last_nonopt = optind; } /* 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') #ifdef GETOPT_COMPAT && (longopts == NULL || argv[optind][0] != '+' || argv[optind][1] == '\0') #endif /* GETOPT_COMPAT */ ) { if (ordering == REQUIRE_ORDER) return EOF; optarg = argv[optind++]; return 1; } /* We have found another option-ARGV-element. Start decoding its characters. */ nextchar = (argv[optind] + 1 + (longopts != NULL && argv[optind][1] == '-')); } if (longopts != NULL && ((argv[optind][0] == '-' && (argv[optind][1] == '-' || long_only)) #ifdef GETOPT_COMPAT || argv[optind][0] == '+' #endif /* GETOPT_COMPAT */ )) { const struct option *p; char *s = nextchar; int exact = 0; int ambig = 0; const struct option *pfound = NULL; int indfound; while (*s && *s != '=') s++; /* Test all options for either exact match or abbreviated matches. */ for (p = longopts, option_index = 0; p->name; p++, option_index++) if (!strncmp (p->name, nextchar, s - nextchar)) { if (s - 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 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 (*s) { /* Don't test has_arg with >, because some C compilers don't allow it to be used on enums. */ if (pfound->has_arg) optarg = s + 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] == '-' #ifdef GETOPT_COMPAT || argv[optind][0] == '+' #endif /* GETOPT_COMPAT */ || 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 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 0 if (c < 040 || c >= 0177) fprintf (stderr, "%s: unrecognized option, character code 0%o\n", argv[0], c); else fprintf (stderr, "%s: unrecognized option `-%c'\n", argv[0], c); #else /* 1003.2 specifies the format of this message. */ fprintf (stderr, "%s: illegal option -- %c\n", argv[0], c); #endif } 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 = 0; 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) { #if 0 fprintf (stderr, "%s: option `-%c' requires an argument\n", argv[0], c); #else /* 1003.2 specifies the format of this message. */ fprintf (stderr, "%s: option requires an argument -- %c\n", argv[0], c); #endif } 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.22/lib-src/getopt.h100777 12241 1 10474 5372534261 14637 0ustar rolanddaemon/* Declarations for getopt. Copyright (C) 1989, 1990, 1991, 1992, 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, 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 __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 __STDC__ #if defined(__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 /* not __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 /* not __STDC__ */ #ifdef __cplusplus } #endif #endif /* _GETOPT_H */ emacs-19.22/lib-src/getopt1.c100777 12241 1 10640 5447406211 14702 0ustar rolanddaemon/* getopt_long and getopt_long_only entry points for GNU getopt. Copyright (C) 1987, 88, 89, 90, 91, 92, 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef HAVE_CONFIG_H #if defined (emacs) || defined (CONFIG_BROKETS) /* We use instead of "config.h" so that a compilation using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h (which it would do because it found this file in $srcdir). */ #include #else #include "config.h" #endif #endif #include "getopt.h" #ifndef __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.22/lib-src/hexl.c100444 13437 1 7307 4437420351 13705 0ustar jimbdaemon#include #include #define DEFAULT_GROUPING 0x01 #define DEFAULT_BASE 16 #undef TRUE #undef FALSE #define TRUE (1) #define FALSE (0) extern void exit(), perror(); int base = DEFAULT_BASE, un_flag = FALSE, iso_flag = FALSE, endian = 1; int group_by = DEFAULT_GROUPING; char *progname; 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 { (void) 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]; for (;;) { register int i, c, d; #define hexchar(x) (isdigit(x) ? x - '0' : x - 'a' + 10) (void) 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); (void) putchar(c); if ((i&group_by) == group_by) (void) getc(fp); } if (c == ' ') { while ((c = getc(fp)) != '\n' && c != EOF) ; if (c == EOF) break; } else { if (i < 16) break; (void) fread(buf, 1, 18, fp); /* skip 18 bytes */ } } } else { 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; (void) fputs(" ", stdout); string[i+1] = '\0'; } else { if (!i) (void) 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; (void) printf("%02x", c); } if ((i&group_by) == group_by) (void) putchar(' '); } if (i) (void) puts(string); if (c == EOF) break; address += 0x10; } } if (fp != stdin) (void) close(fp); } while (*argv != NULL); return 0; } usage() { (void) fprintf(stderr, "usage: %s [-de] [-iso]\n", progname); exit(1); } emacs-19.22/lib-src/leditcfns.c100444 13437 1 653 3461063135 14674 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.22/lib-src/make-docfile.c100444 12120 13 37347 5470776042 14727 0ustar rmsuser/* Generate doc-string file for GNU Emacs from source files. 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 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. */ #include FILE *outfile; main (argc, argv) int argc; char **argv; { int i; int err_count = 0; outfile = stdout; /* 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; } for (; i < argc; i++) err_count += scan_file (argv[i]); /* err_count seems to be {mis,un}used */ #ifndef VMS exit (err_count); /* see below - shane */ #endif /* VMS */ } /* Read file FILENAME and output its doc strings to outfile. */ /* Return 1 if file is not found, 0 if it is found. */ scan_file (filename) char *filename; { int len = strlen (filename); if (!strcmp (filename + len - 4, ".elc")) return scan_lisp_file (filename); else if (!strcmp (filename + len - 3, ".el")) return scan_lisp_file (filename); else return scan_c_file (filename); } 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. */ 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 the function whose text is in BUF. MINARGS and MAXARGS are the minimum and maximum number of arguments. */ write_c_args (out, buf, minargs, maxargs) FILE *out; char *buf; int minargs, maxargs; { register char *p; int in_ident = 0; int just_spaced = 0; fprintf (out, "arguments: "); 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 (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) putc (c, out); just_spaced = (c == ' '); } } /* 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. */ scan_c_file (filename) char *filename; { FILE *infile; register int c; register int commas; register int defunflag; register int defvarperbufferflag; register int defvarflag; int minargs, maxargs; if (filename[strlen (filename) - 1] == 'o') filename[strlen (filename) - 1] = 'c'; infile = fopen (filename, "r"); /* No error if non-ex input file */ if (infile == NULL) { perror (filename); return 0; } 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, 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. 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); } scan_lisp_file (filename) char *filename; { FILE *infile; register int c; infile = fopen (filename, "r"); if (infile == NULL) { perror (filename); return 0; /* No error */ } c = '\n'; while (!feof (infile)) { char buffer [BUFSIZ]; char *fillp = buffer; char type; if (c != '\n') { c = getc (infile); continue; } c = getc (infile); 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); /* 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; } } /* 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 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, there is a docstring that we should gobble. The opening quote (and leading backslash-newline) have already been read. */ putc ('\n', outfile); putc (037, outfile); putc (type, outfile); fprintf (outfile, "%s\n", buffer); read_c_string (infile, 1); } fclose (infile); return 0; } emacs-19.22/lib-src/make-path.c100444 12120 13 4225 5377743667 14240 0ustar rmsuser/* Make all the directories along a path. 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 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. */ /* This program works like mkdir, except that it generates intermediate directories if they don't exist. This is just like the `mkdir -p' command on most systems; unfortunately, the mkdir command on some of the purer BSD systems (like Mt. Xinu) don't have that option. */ #include #include #include #include extern int errno; char *prog_name; int touchy_mkdir (path) char *path; { struct stat buf; /* If PATH already exists and is a directory, return success. */ if (stat (path, &buf) >= 0 && (buf.st_mode & S_IFMT) == S_IFDIR) return 0; /* Otherwise, try to make it. If PATH exists but isn't a directory, this will signal an error. */ if (mkdir (path, 0777) < 0) { fprintf (stderr, "%s: ", prog_name); perror (path); return -1; } return 0; } int main (argc, argv) int argc; char **argv; { prog_name = *argv; for (argc--, argv++; argc > 0; argc--, argv++) { char *path = *argv; int i; /* Stop at each slash in path and try to create the directory. Skip any initial slash. */ for (i = (path[0] == '/') ? 1 : 0; path[i]; i++) if (path[i] == '/') { path[i] = '\0'; if (touchy_mkdir (path) < 0) goto next_pathname; path[i] = '/'; } touchy_mkdir (path); next_pathname: ; } return 0; } emacs-19.22/lib-src/movemail.c100444 12120 13 40102 5470626032 14170 0ustar rmsuser/* movemail foo bar -- move file foo to file bar, locking file foo the way /bin/mail respects. Copyright (C) 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 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. */ /* Important notice: defining MAIL_USE_FLOCK *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 *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 * */ #include #include #include #include #define NO_SHORTNAMES /* Tell config not to load remap.h */ #include <../src/config.h> #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 XENIX #include #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 char *malloc (); char *strcpy (); char *concat (); char *xmalloc (); #ifndef errno extern int errno; #endif /* Nonzero means this is name of a lock file to delete on fatal error. */ char *delete_lockname; main (argc, argv) int argc; char **argv; { char *inname, *outname; int indesc, outdesc; int nread; #ifndef MAIL_USE_FLOCK struct stat st; long now; int tem; char *lockname, *p; char *tempname; int desc; #endif /* not MAIL_USE_FLOCK */ delete_lockname = 0; if (argc < 3) fatal ("two arguments required"); inname = argv[1]; outname = argv[2]; #ifdef MAIL_USE_MMDF mmdf_init (argv[0]); #endif /* 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 *) malloc (strlen (outname) + 1); char *p, q; 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; char *user; for (user = &inname[strlen (inname) - 1]; user >= inname; user--) if (*user == ':') break; status = popmail (user, 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_FLOCK /* Use a lock file named /usr/spool/mail/$USER.lock: 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 /usr/spool/mail, 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_FLOCK in config.h or the s-*.h file and recompile movemail. If the s- file for your system should define MAIL_USE_FLOCK 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 = strcpy (xmalloc (strlen (inname)+1), 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, 0666); if (desc < 0) pfatal_with_name ("lock file--see source file lib-src/movemail.c"); close (desc); tem = link (tempname, lockname); unlink (tempname); if (tem >= 0) break; sleep (1); /* If lock file is a minute old, unlock it. */ if (stat (lockname, &st) >= 0) { now = time (0); if (st.st_ctime < now - 60) unlink (lockname); } } delete_lockname = lockname; #endif /* not MAIL_USE_FLOCK */ #ifdef MAIL_USE_FLOCK indesc = open (inname, O_RDWR); #else /* if not MAIL_USE_FLOCK */ indesc = open (inname, O_RDONLY); #endif /* not MAIL_USE_FLOCK */ #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_FLOCK #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 /* MAIL_USE_FLOCK */ { 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_FLOCK #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_FLOCK */ #ifdef MAIL_USE_MMDF lk_close (indesc, 0, 0, 0); #else close (indesc); #endif #ifndef MAIL_USE_FLOCK /* 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); #ifndef MAIL_USE_MMDF unlink (lockname); #endif /* not MAIL_USE_MMDF */ #endif /* not MAIL_USE_FLOCK */ exit (0); } /* Print error message and exit. */ 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. */ error (s1, s2, s3) char *s1, *s2, *s3; { printf ("movemail: "); printf (s1, s2, s3); printf ("\n"); } pfatal_with_name (name) char *name; { extern int errno, sys_nerr; extern char *sys_errlist[]; char *s; if (errno < sys_nerr) s = concat ("", sys_errlist[errno], " for %s"); else s = "cannot open %s"; fatal (s, name); } pfatal_and_delete (name) char *name; { extern int errno, sys_nerr; extern char *sys_errlist[]; char *s; if (errno < sys_nerr) s = concat ("", sys_errlist[errno], " for %s"); else s = "cannot open %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. */ char * xmalloc (size) unsigned size; { char *result = 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 Errmsg[80]; static int debug = 0; char *get_errmsg (); char *getenv (); int mbx_write (); popmail (user, outfile) char *user; char *outfile; { char *host; int nmsgs, nbytes; char response[128]; register int i; int mbfi; FILE *mbf; struct passwd *pw = (struct passwd *) getpwuid (getuid ()); if (pw == NULL) fatal ("cannot determine user name"); host = getenv ("MAILHOST"); if (host == NULL) { fatal ("no MAILHOST defined"); } if (pop_init (host) == NOTOK) { fatal (Errmsg); } if (getline (response, sizeof response, sfi) != OK) { fatal (response); } if (pop_command ("USER %s", user) == NOTOK || pop_command ("RPOP %s", pw->pw_name) == NOTOK) { pop_command ("QUIT"); fatal (Errmsg); } if (pop_stat (&nmsgs, &nbytes) == NOTOK) { pop_command ("QUIT"); fatal (Errmsg); } if (!nmsgs) { pop_command ("QUIT"); return 0; } mbfi = open (outfile, O_WRONLY | O_CREAT | O_EXCL, 0666); if (mbfi < 0) { pop_command ("QUIT"); pfatal_and_delete (outfile); } fchown (mbfi, getuid (), -1); if ((mbf = fdopen (mbfi, "w")) == NULL) { pop_command ("QUIT"); pfatal_and_delete (outfile); } for (i = 1; i <= nmsgs; i++) { mbx_delimit_begin (mbf); if (pop_retr (i, mbx_write, mbf) != OK) { pop_command ("QUIT"); close (mbfi); unlink (outfile); fatal (Errmsg); } mbx_delimit_end (mbf); fflush (mbf); } if (fsync (mbfi) < 0) { pop_command ("QUIT"); pfatal_and_delete (outfile); } if (close (mbfi) == -1) { pop_command ("QUIT"); pfatal_and_delete (outfile); } for (i = 1; i <= nmsgs; i++) { if (pop_command ("DELE %d", i) == NOTOK) { /* Better to ignore this failure. */ } } pop_command ("QUIT"); return (0); } pop_init (host) char *host; { register struct hostent *hp; register struct servent *sp; int lport = IPPORT_RESERVED - 1; struct sockaddr_in sin; register int s; hp = gethostbyname (host); if (hp == NULL) { sprintf (Errmsg, "MAILHOST unknown: %s", host); return NOTOK; } sp = getservbyname ("pop", "tcp"); if (sp == 0) { strcpy (Errmsg, "tcp/pop: unknown service"); return NOTOK; } sin.sin_family = hp->h_addrtype; bcopy (hp->h_addr, (char *)&sin.sin_addr, hp->h_length); sin.sin_port = sp->s_port; s = rresvport (&lport); if (s < 0) { sprintf (Errmsg, "error creating socket: %s", get_errmsg ()); return NOTOK; } if (connect (s, (char *)&sin, sizeof sin) < 0) { sprintf (Errmsg, "error during connect: %s", get_errmsg ()); close (s); return NOTOK; } sfi = fdopen (s, "r"); sfo = fdopen (s, "w"); if (sfi == NULL || sfo == NULL) { sprintf (Errmsg, "error in fdopen: %s", get_errmsg ()); close (s); return NOTOK; } return OK; } pop_command (fmt, a, b, c, d) char *fmt; { char buf[128]; char errmsg[64]; sprintf (buf, fmt, a, b, c, d); if (debug) fprintf (stderr, "---> %s\n", buf); if (putline (buf, Errmsg, sfo) == NOTOK) return NOTOK; if (getline (buf, sizeof buf, sfi) != OK) { strcpy (Errmsg, buf); return NOTOK; } if (debug) fprintf (stderr, "<--- %s\n", buf); if (*buf != '+') { strcpy (Errmsg, buf); return NOTOK; } else { return OK; } } pop_stat (nmsgs, nbytes) int *nmsgs, *nbytes; { char buf[128]; if (debug) fprintf (stderr, "---> STAT\n"); if (putline ("STAT", Errmsg, sfo) == NOTOK) return NOTOK; if (getline (buf, sizeof buf, sfi) != OK) { strcpy (Errmsg, buf); return NOTOK; } if (debug) fprintf (stderr, "<--- %s\n", buf); if (*buf != '+') { strcpy (Errmsg, buf); return NOTOK; } else { sscanf (buf, "+OK %d %d", nmsgs, nbytes); return OK; } } pop_retr (msgno, action, arg) int (*action)(); { char buf[128]; sprintf (buf, "RETR %d", msgno); if (debug) fprintf (stderr, "%s\n", buf); if (putline (buf, Errmsg, sfo) == NOTOK) return NOTOK; if (getline (buf, sizeof buf, sfi) != OK) { strcpy (Errmsg, buf); return NOTOK; } while (1) { switch (multiline (buf, sizeof buf, sfi)) { case OK: (*action)(buf, arg); break; case DONE: return OK; case NOTOK: strcpy (Errmsg, buf); return NOTOK; } } } getline (buf, n, f) char *buf; register int n; FILE *f; { register char *p; int c; p = buf; while (--n > 0 && (c = fgetc (f)) != EOF) if ((*p++ = c) == '\n') break; if (ferror (f)) { strcpy (buf, "error on connection"); return NOTOK; } if (c == EOF && p == buf) { strcpy (buf, "connection closed by foreign host"); return DONE; } *p = NULL; if (*--p == '\n') *p = NULL; if (*--p == '\r') *p = NULL; return OK; } multiline (buf, n, f) char *buf; register int n; FILE *f; { if (getline (buf, n, f) != OK) return NOTOK; if (*buf == '.') { if (*(buf+1) == NULL) return DONE; else strcpy (buf, buf+1); } return OK; } char * get_errmsg () { extern int errno, sys_nerr; extern char *sys_errlist[]; char *s; if (errno < sys_nerr) s = sys_errlist[errno]; else s = "unknown error"; return (s); } putline (buf, err, f) char *buf; char *err; FILE *f; { fprintf (f, "%s\r\n", buf); fflush (f); if (ferror (f)) { strcpy (err, "lost connection"); return NOTOK; } return OK; } mbx_write (line, mbf) char *line; FILE *mbf; { fputs (line, mbf); fputc (0x0a, mbf); } mbx_delimit_begin (mbf) FILE *mbf; { fputs ("\f\n0, unseen,,\n", mbf); } mbx_delimit_end (mbf) FILE *mbf; { putc ('\037', mbf); } #endif /* MAIL_USE_POP */ emacs-19.22/lib-src/qsort.c100444 13437 1 20410 5431023136 14116 0ustar jimbdaemon/* 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 1, 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.22/lib-src/sorted-doc.c100444 13437 13 12640 5264625225 14570 0ustar jimbuser/* 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 and exit. */ fatal (s1, s2) char *s1, *s2; { error (s1, s2); exit (1); } /* Print error message. `s1' is printf control string, `s2' is arg for it. */ error (s1, s2) char *s1, *s2; { fprintf (stderr, "sorted-doc: "); fprintf (stderr, s1, s2); fprintf (stderr, "\n"); } /* 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 * strsav (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" }; main () { register DOCSTR *dp = NULL; /* allocated DOCSTR */ register LINE *lp = NULL; /* allocated line */ register char *bp; /* ptr inside line buffer */ int notfirst = 0; /* set after read something */ 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 = strsav (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.22/lib-src/tcp.c100666 12120 13 12607 5400255607 13163 0ustar rmsuser/* * 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.22/lib-src/test-distrib.c100444 13437 13 3045 5375265171 15124 0ustar jimbuser#include /* 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; } } 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], 0); 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. */ #else exit (0); #endif } emacs-19.22/lib-src/timer.c100444 12241 12 16055 5444560637 14330 0ustar rolandstaff/* timer.c --- daemon to provide a tagged interval timer service This little daemon runs forever waiting for signals. SIGIO (or SIGUSR1) causes it to read an event spec from stdin; that is, a date followed by colon followed by an event label. 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. It was written anonymously in 1990. This version was documented and rewritten for portability by esr@snark.thyrsus.com, Aug 7 1992. */ #include #include #include /* FASYNC */ #include /* time_t */ #include <../src/config.h> #ifdef USG #undef SIGIO #define SIGIO SIGUSR1 #endif #ifdef LINUX /* Perhaps this is correct unconditionally. */ #undef signal #endif extern int errno; extern char *sys_errlist[], *malloc (); extern time_t time (); /* * The field separator for input. This character shouldn't be legal in a date, * and should be printable so event strings are readable by people. Was * originally ';', then got changed to bogus `\001'. */ #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; /* programme name for error messages */ /* Accepts 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); /* Should timer exit now? Well, we've still got other events in the queue, and more memory might become available in the future, so we'll just toss this event. This will screw up whoever scheduled the event, but maybe someone else will survive. */ return; } 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, sys_errlist[errno], str, FS, p); return; } strcpy (ep->token, p); num_events++; } void notify () { time_t now, tdiff, waitfor = -1; register struct event *ep; /* If an alarm timer runs out while this function is executing, it could get called recursively. This would be bad, because it's not re-entrant. So we must try to suspend the signal. */ #if 0 /* This function isn't right for BSD. Fix it later. */ sighold(SIGIO); #endif 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); #if 0 /* This function isn't right for BSD. */ sigrelse(SIGIO); #endif } void getevent () { int i; char *buf; int buf_size; /* 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. */ 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++) { int c; if (i >= buf_size) { buf_size *= 2; buf = (char *) realloc (buf, buf_size); /* If we're out of memory, toss this event. */ do { c = getchar (); } while (c != '\n' && c != EOF); return; } c = getchar (); if (c == EOF) exit (0); if (c == '\n') { buf[i] = '\0'; break; } buf[i] = c; } /* Register the event. */ schedule (buf); free (buf); /* Who knows what this interrupted, or if it said "now"? */ notify (); } SIGTYPE sigcatch (sig) int sig; /* dispatch on incoming signal, then restore it */ { struct event *ep; switch (sig) { case SIGALRM: notify (); break; case SIGIO: getevent (); 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; } /* required on older UNIXes; harmless on newer ones */ signal (sig, sigcatch); } /*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 (SIGIO, sigcatch); signal (SIGALRM, sigcatch); signal (SIGTERM, sigcatch); #ifndef USG if (fcntl (0, F_SETOWN, getpid ()) == -1) { fprintf (stderr, "%s: can't set ownership of stdin\n", pname); fprintf (stderr, "%s\n", sys_errlist[errno]); exit (1); } if (fcntl (0, F_SETFL, fcntl (0, F_GETFL, 0) | FASYNC) == -1) { fprintf (stderr, "%s: can't request asynchronous I/O on stdin\n", pname); fprintf (stderr, "%s\n", sys_errlist[errno]); exit (1); } #endif /* USG */ /* In case Emacs sent some input before we set up the handling of SIGIO, read it now. */ kill (0, SIGIO); for (;;) pause (); } /* timer.c ends here */ emacs-19.22/lib-src/wakeup.c100444 12241 0 1510 5444554456 13405 0ustar roland/* 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 (); 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.22/lib-src/yow.c100444 12241 12 5551 5444476261 14004 0ustar rolandstaff/* * yow.c * * Print a quotation from Zippy the Pinhead. * Qux March 6, 1986 * * 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 main (argc, argv) int argc; char *argv[]; { FILE *fp; char file[BUFSIZ]; void yow(), setup_yow(); 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) { perror(file); exit(1); } /* initialize random seed */ srand((int) (getpid() + time((long *) 0))); setup_yow(fp); yow(fp); fclose(fp); exit(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, "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("fseek 1"); 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; char *malloc(), *realloc(); offset = rand() % len + header_len; if (fseek(fp, offset, 0) == -1) { perror("fseek 2"); 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, "can't allocate any memory\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, "can't allocate more memory\n"); exit (3); } } } buf[i++] = 0; printf("%s\n", buf); } emacs-19.22/lib-src/aixcc.lex100444 13437 13 14326 5405340704 14156 0ustar jimbuser%Start ErrorText ErrorMessage OtherText EC [0-9][0-9][0-9][0-9]-[0-9][0-9][0-9] D [0-9] D3 [0-9 ][0-9 ][0-9] D4 [0-9 ][0-9 ][0-9 ][0-9] D5 [0-9 ][0-9 ][0-9 ][0-9 ][0-9] DS [0-9 ] %{ /* moore@wilma.cs.utk.edu * Hack to work around the AIX C compiler's brain-damaged error messages * so that emacs can parse them. It runs /bin/cc as a subprocess, and * tries to rearrange the error messages so that (a) each message contains * both the filename and line number where the error occurred, and (b) * the error message(s) for a particular line get displayed *before* the * line itself. * * to compile: * lex aixcc.lex * cc -o aixcc lex.yy.c * * * Copyright December 1991 by Keith Moore * * 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. * * * TODO: figure out how the compiler counts file numbers for included * files, keep track of which file corresponds to which number, and * always output the right file name. */ #include #include char *current_file; int line; int debug = 0; char bigbuf[10240]; char *bufptr = bigbuf; int last_line_was_error = 0; spaces (s) char *s; { while (*s++) *bufptr++ = ' '; } char * strsave (s) char *s; { char *ptr = malloc (strlen (s) + 1); strcpy (ptr, s); return ptr; } yywrap () { *bufptr = '\0'; bufptr = bigbuf; while (*bufptr) putc (*bufptr++, yyout); return 1; } %} %% ^File\ Line\ Column\ Message\ text[^\n]* { /* * ignore this. don't treat it as error text */ } ^{DS}{DS}{DS}\ {D5}\ \| { /* * (optional) nesting level, followed by line number, followed * by the source code fragment that caused the error */ /* * save the line number for later */ line = atoi (yytext+4); if (debug) { fprintf (yyout, "line <= %d\n", line); fprintf (yyout, "%s\n", yytext); } /* * if the last line was an error message, to flush out all of * the old source text before starting to save the new source text. */ if (last_line_was_error) { *bufptr = '\0'; bufptr = bigbuf; while (*bufptr) putc (*bufptr++, yyout); bufptr = bigbuf; last_line_was_error = 0; } /* * stuff enough spaces in the text buffer so that the * saved text will line up properly when displayed. */ spaces (yytext); BEGIN ErrorText; /* continue below */ } [^\n]*$ { char *ptr; /* * Save the text until we see the error message(s), then print it. * This because emacs puts the error message at the top of the * window, and it's nice to be able to see the text below it. */ ptr = yytext; while (*ptr) *bufptr++ = *ptr++; *bufptr++ = '\n'; BEGIN 0; } ^Processing\ include\ file\ .*$ { /* * name of a new include file being processed. Increment file number * and remember the file name corresponding to this file number. */ current_file = strsave (yytext+24); if (debug) { fprintf (yyout, "current_file <= %s\n", current_file); fprintf (yyout, "%s\n", yytext); } } ^([a-z]\ -)?\ *{EC}: { /* * error message (which we print immediately) preceded by an * error code (which we ignore) */ fprintf (yyout, "\"%s\", line %d: %c -", current_file, line, *yytext); last_line_was_error = 1; BEGIN ErrorMessage; } ^{D3}\ {D5}\ {D4}\ {EC}: { /* * (optional) nesting level, followed by line number, followed * by column number, followed by error message text. */ /* * save the line number for later */ line = atoi (yytext+4); if (debug) { fprintf (yyout, "line <= %d\n", line); fprintf (yyout, "%s\n", yytext); } /* * if the last line was an error message, flush out all of * the old source text before printing this error message. */ if (last_line_was_error) { *bufptr = '\0'; bufptr = bigbuf; while (*bufptr) putc (*bufptr++, yyout); bufptr = bigbuf; last_line_was_error = 0; } fprintf (yyout, "\"%s\", line %d:", current_file, line); last_line_was_error = 1; BEGIN ErrorMessage; } [^\n]*$ { fprintf (yyout, "%s\n", yytext); BEGIN 0; } ^[^ :]+".c:"\ *$ { /* name of new source file being processed */ char *ptr; if (current_file) free (current_file); ptr = strchr (yytext, ':'); *ptr = '\0'; current_file = strsave (yytext); } ^[^\n] { /* * other text starting with a newline. We have to break it up this * way to keep this rule from matching any of the above patterns */ if (last_line_was_error) { *bufptr = '\0'; bufptr = bigbuf; while (*bufptr) putc (*bufptr++, yyout); bufptr = bigbuf; last_line_was_error = 0; } *bufptr++ = *yytext; BEGIN OtherText; } [^\n]*$ { char *ptr; ptr = yytext; while (*ptr) *bufptr++ = *ptr++; *bufptr++ = '\n'; BEGIN 0; } \n ; %% main (argc, argv) char **argv; { int pfd[2]; int child_pid; int i; current_file = strsave ("/dev/null"); line = 0; for (i = 1; i < argc; ++i) { char *ptr = strrchr (argv[i], '.'); if (ptr && ptr[1] == 'c' && ptr[2] == '\0') { current_file = strsave (argv[i]); break; } } if (pipe (pfd) < 0) { perror ("pipe"); exit (1); } if ((child_pid = fork()) > 0) { int status; close (pfd[1]); yyin = fdopen (pfd[0], "r"); yyout = stderr; yylex(); wait (&status); exit ((status >> 8) & 0xff); } else if (child_pid == 0) { dup2 (pfd[1], 2); close (pfd[0]); close (pfd[1]); argv[0] = "cc"; execv ("/bin/cc", argv); perror ("/bin/cc"); exit (1); } else { perror ("fork"); exit (1); } } emacs-19.22/lib-src/ChangeLog100666 12120 13 143773 5475620342 14040 0ustar rmsuserSat 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.22/lib-src/Makefile.in100444 12120 13 23131 5475361660 14273 0ustar rmsuser# 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. # add -DUSG for SysV movemail and timer # For Xenix, add the following for movemail: # LOADLIBES= -lx # For Mips, the following is needed for who knows what. # LOADLIBES = -lmld /usr/bsd43/usr/lib/libc.a # 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@ C_SWITCH_SYSTEM=@c_switch_system@ LOADLIBES=@libsrc_libs@ YACC=@YACC@ version=@version@ configname=@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 # --libdir option to `../configure'. libdir=@libdir@ # 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@ # ==================== 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@ # ============================= Targets ============================== # 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= test-distrib make-path wakeup make-docfile digest-doc sorted-doc \ movemail cvtmail fakemail yow env emacsserver hexl timer # 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 aixcc.lex emacs.csh \ makedoc.com *.[chy] rcs2log vcdiff ### 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} -Demacs -DHAVE_CONFIG_H \ -I. -I../src -I${srcdir} -I${srcdir}/../src ${CFLAGS} CPP_CFLAGS = ${C_SWITCH_SYSTEM} -Demacs -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: ${UTILITIES} ${INSTALLABLES} ### Install the internal utilities. Until they are installed, we can ### just run them directly from lib-src. ${archlibdir}: all @echo @echo "Installing utilities run internally by Emacs." ./make-path ${archlibdir} if [ `(cd ${archlibdir} && /bin/pwd)` != `/bin/pwd` ]; then \ for file in ${UTILITIES}; do \ $(INSTALL_PROGRAM) $$file ${archlibdir}/$$file ; \ chmod 755 ${archlibdir}/$$file ; \ done ; \ for file in ${SCRIPTS}; do \ $(INSTALL_PROGRAM) ${srcdir}/$$file ${archlibdir}/$$file ; \ chmod 755 ${archlibdir}/$$file ; \ done ; \ fi # We don't need to install `wakeup' explicitly, because it will be copied when # this whole directory is copied. # We use .n, not .new as before, to avoid exceeding the 14-character limit. install: ${archlibdir} @echo @echo "Installing utilities for users to run." for file in ${INSTALLABLES} ; do \ cp $${file} ${bindir}/$${file}.n ; \ chmod 755 ${bindir}/$${file}.n ; \ done for file in ${INSTALLABLE_SCRIPTS} ; do \ cp ${srcdir}/$${file} ${bindir}/$${file}.n ; \ chmod 755 ${bindir}/$${file}.n ; \ done -for file in ${INSTALLABLES} ${INSTALLABLE_SCRIPTS} ; do \ rm -f ${bindir}/$${file} ; \ mv ${bindir}/$${file}.n ${bindir}/$${file} ; \ done uninstall: (cd ${bindir}; \ rm -f ${INSTALLABLES} ${INSTALLABLE_SCRIPTS}) (cd ${archlibdir}; \ rm -f ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS}) mostlyclean: -rm -f core *.o clean: mostlyclean -rm -f ${INSTALLABLES} ${UTILITIES} distclean: clean -rm -f ../etc/DOC* *.tab.c *.tab.h aixcc.c TAGS realclean: distclean true extraclean: realclean -rm -f *~ \#* unlock: chmod u+w $(SOURCES) relock: chmod u-w $(SOURCES) # Test the contents of the directory. check: @echo "We don't have any tests for GNU Emacs yet." TAGS: etags etags *.[ch] # This verifies that the non-ASCII characters in the file `testfile' # have not been clobbered by whatever means were used to copy and # distribute Emacs. If they were clobbered, all the .elc files were # clobbered too. test-distrib: ${srcdir}/test-distrib.c $(CC) -o test-distrib ${srcdir}/test-distrib.c ./test-distrib ${srcdir}/testfile GETOPTOBJS = getopt.o getopt1.o $(ALLOCA) GETOPTDEPS = $(GETOPTOBJS) ${srcdir}/getopt.h getopt.o: ${srcdir}/getopt.c ${srcdir}/getopt.h ${CC} -c ${CPP_CFLAGS} ${srcdir}/getopt.c getopt1.o: ${srcdir}/getopt1.c ${srcdir}/getopt.h ${CC} -c ${CPP_CFLAGS} ${srcdir}/getopt1.c etags: ${srcdir}/etags.c $(GETOPTDEPS) ../src/config.h $(CC) ${CPP_CFLAGS} -DETAGS ${srcdir}/etags.c $(GETOPTOBJS) $(LOADLIBES) -o etags # We depend on etags to assure that parallel makes don't write two # etags.o files on top of each other. ctags: ${srcdir}/etags.c $(GETOPTDEPS) etags $(CC) ${CPP_CFLAGS} -DCTAGS ${srcdir}/etags.c $(GETOPTOBJS) $(LOADLIBES) -o ctags wakeup: ${srcdir}/wakeup.c $(CC) ${CPP_CFLAGS} ${srcdir}/wakeup.c $(LOADLIBES) -o wakeup make-docfile: ${srcdir}/make-docfile.c $(CC) ${CPP_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) -o make-docfile digest-doc: ${srcdir}/digest-doc.c $(CC) ${CPP_CFLAGS} ${srcdir}/digest-doc.c $(LOADLIBES) -o digest-doc sorted-doc: ${srcdir}/sorted-doc.c ${ALLOCA} $(CC) ${CPP_CFLAGS} ${srcdir}/sorted-doc.c ${ALLOCA} $(LOADLIBES) -o sorted-doc b2m: ${srcdir}/b2m.c ../src/config.h $(CC) ${CPP_CFLAGS} ${srcdir}/b2m.c $(LOADLIBES) -o b2m movemail: ${srcdir}/movemail.c ../src/config.h $(CC) ${CPP_CFLAGS} ${srcdir}/movemail.c $(LOADLIBES) -o movemail cvtmail: ${srcdir}/cvtmail.c $(CC) ${CPP_CFLAGS} ${srcdir}/cvtmail.c $(LOADLIBES) -o cvtmail fakemail: ${srcdir}/fakemail.c ../src/config.h $(CC) ${CPP_CFLAGS} ${srcdir}/fakemail.c $(LOADLIBES) -o fakemail yow: ${srcdir}/yow.c ../src/paths.h $(CC) ${CPP_CFLAGS} ${srcdir}/yow.c $(LOADLIBES) -o yow env: ${srcdir}/env.c ../src/config.h $(CC) -DEMACS ${CPP_CFLAGS} ${srcdir}/env.c $(LOADLIBES) -o env emacsserver: ${srcdir}/emacsserver.c ../src/config.h $(CC) ${CPP_CFLAGS} ${srcdir}/emacsserver.c $(LOADLIBES) -o emacsserver emacsclient: ${srcdir}/emacsclient.c ../src/config.h $(CC) ${CPP_CFLAGS} ${srcdir}/emacsclient.c $(LOADLIBES) -o emacsclient hexl: ${srcdir}/hexl.c $(CC) ${CPP_CFLAGS} ${srcdir}/hexl.c $(LOADLIBES) -o hexl TIMEROBJS=getdate.o timer.o $(ALLOCA) getdate.o: ${srcdir}/getdate.y ../src/config.h ${YACC} ${YFLAGS} ${srcdir}/getdate.y $(CC) $(CPP_CFLAGS) -c y.tab.c mv y.tab.o getdate.o timer.o: ${srcdir}/timer.c ../src/config.h $(CC) -c $(CPP_CFLAGS) ${srcdir}/timer.c timer: ${TIMEROBJS} $(CC) $(ALL_CFLAGS) ${TIMEROBJS} $(LOADLIBES) -o timer make-path: ${srcdir}/make-path.c ../src/config.h $(CC) $(CPP_CFLAGS) ${srcdir}/make-path.c -o make-path # These are NOT included in INSTALLABLES or UTILITIES. # See ../src/ymakefile. emacstool: ${srcdir}/emacstool.c $(CC) ${srcdir}/emacstool.c -o emacstool ${CPP_CFLAGS} \ -lsuntool -lsunwindow -lpixrect $(LOADLIBES) # For SUN Japanese Language Environment nemacstool: ${srcdir}/emacstool.c $(CC) -o nemacstool -DJLE ${CPP_CFLAGS} ${srcdir}/emacstool.c \ -lsuntool -lmle -lsunwindow -lpixrect $(LOADLIBES) xvetool: ${srcdir}/emacstool.c $(CC) -o xvetool -DXVIEW ${CPP_CFLAGS} ${srcdir}/emacstool.c \ -lxview -lX -I$(OPENWINHOME)/include -L$(OPENWINHOME)/lib \ $(LOADLIBES) xveterm: ${srcdir}/emacstool.c $(CC) -o xveterm -DXVIEW -DTTERM ${CPP_CFLAGS} ${srcdir}/emacstool.c \ -lxview -lolgx -lX -I$(OPENWINHOME)/include -L$(OPENWINHOME)/lib \ $(LOADLIBES) aixcc: ${srcdir}/aixcc.c $(CC) $(CPP_CFLAGS) -o aixcc ${srcdir}/aixcc.c aixcc.c: ${srcdir}/aixcc.lex lex ${srcdir}/aixcc.lex mv lex.yy.c aixcc.c emacs-19.22/lib-src/README100666 13437 1 243 5117251351 13435 0ustar jimbdaemonThis directory contains the source code for the architecture-dependent files that go in ../arch-lib. At present, these are mostly utility programs used by Emacs. emacs-19.22/lib-src/testfile100666 13437 1 336 3463055225 14326 0ustar jimbdaemonTesting distribution of nonprinting chars: Should be 0177:  Should be 0377: ÿ Should be 0212: Š. Should be 0000: . This file is read by the `test-distribution' program. If you change it, you will make that program fail. emacs-19.22/lib-src/vcdiff100555 74720 14 2364 5436620204 14233 0ustar eggertguest#!/bin/sh # # Enhanced sccs diff utility for use with vc mode. # This version is more compatible with rcsdiff(1). # # $Id: vcdiff,v 1.3 1993/08/25 08:18:56 eggert Exp $ # DIFF="diff" usage="$0: Usage: vcdiff [-q] [-r] [-r] [diffopts] sccsfile..." PATH=$PATH:/usr/ccs/bin:/usr/sccs # common SCCS hangouts echo= sid1=-r sid2= for f do case $f in -*) case $f in -q) echo=:;; -r?*) case $sid1 in -r) sid1=$f ;; *) case $sid2 in ?*) echo "$usage" >&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.22/lib-src/rcs2log100555 74720 13 26666 5460652767 14246 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.16 1993/10/19 02:50:31 eggert Exp $ # Copyright 1992, 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; see the file COPYING. If not, write to # the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. nl=' ' # Parse options. # defaults : ${TMPDIR=/tmp} hostname= # name of local host (if empty, will deduce it later) indent=8 # indent of log line initialize_fullname= # awk assignments to set up fullname array initialize_mailaddr= # awk assignments to set up mailaddr array length=79 # suggested max width of log line logins= # login names for people we know fullnames and mailaddresses of loginsout= # temporary file holding sorted logins rlog_options= # options to pass to rlog tabwidth=8 # width of horizontal tab while : do case $1 in -i) indent=${2?};; -h) hostname=${2?};; -l) length=${2?};; -n) logins=$logins$nl${2?} loginsout=$TMPDIR/rcs2log$$l case $2${3?}${4?} in *\"* | *\\* | *"$nl"*) echo >&2 "$0: -n '$2' '$3' '$4': special characters not allowed" exit 1 esac initialize_fullname="$initialize_fullname fullname[\"$2\"] = \"$3\"" initialize_mailaddr="$initialize_mailaddr mailaddr[\"$2\"] = \"$4\"" shift; shift;; -r) rlog_options=$rlog_options$nl${2?};; -t) tabwidth=${2?};; -*) echo >&2 "$0: usage: $0 [options] [file ...] Options: [-h hostname] [-i indent] [-l length] [-n login fullname mailaddr]... [-r rlog_option]... [-t tabwidth]" exit 1;; *) break esac shift; 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 ' # Log into $rlogout the revisions checked in since the first ChangeLog entry. 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++ } } } } } printf "%d/%02d/%02d %02d:%02d:%02d\n", year, i+1, dd, hh, mm, ss exit } ' d=`awk "$e" $rlogout || 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. case $loginsout in ?*) sort -u -o $loginsout </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 ~ /[^ ]/) { 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 ' /^Working file:/ { filename = $3 } /^date: /, /^(-----------*|===========*)$/ { if ($0 ~ /^branches: /) { next } if ($0 ~ /^date: [0-9][ \/0-9:]*;/) { time = substr($3, 1, length($3)-1) author = substr($5, 1, length($5)-1) printf "%s %s %s %s %c", filename, $2, 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 awks 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 ~ /^\{[^ }]*}[ ]/) { i = index(newlog, "}") newclumpname = substr(newlog, 1, i) while (substr(newlog, i+1) ~ /^[ ]/) 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 $loginsout $rlogout emacs-19.22/lib-src/emacs.csh100666 13437 13 2272 5405340705 14130 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.22/lib-src/rcs-checkin100555 74720 14 6077 5426025552 15174 0ustar eggertguest#!/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. <$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.22/oldXMenu/ 40777 12120 24 0 5475722510 12457 5ustar rmsotheremacs-19.22/oldXMenu/Activate.c100666 12120 1 35723 5475327376 14622 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 "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.22/oldXMenu/AddPane.c100666 13437 1 4621 5401324405 14436 0ustar jimbdaemon#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 "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.22/oldXMenu/AddSel.c100666 13437 1 4327 5401324406 14302 0ustar jimbdaemon#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 "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.22/oldXMenu/ChgPane.c100666 13437 1 2726 5347150201 14453 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.22/oldXMenu/ChgSel.c100666 13437 1 4021 5347150204 14304 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.22/oldXMenu/Create.c100666 13437 1 51162 5405344630 14375 0ustar jimbdaemon/* $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 "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 (); 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 && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &mouse_color, &color_def) ); else if (reverse && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &mouse_color, &color_def) ); else if (XAllocNamedColor(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 && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &bkgnd_color, &color_def) ); else if (reverse && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), "black", &bkgnd_color, &color_def) ); else if (XAllocNamedColor(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 ) XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &p_frg_color, &color_def); else if (reverse) XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &p_frg_color, &color_def); else XAllocNamedColor(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 && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &p_bdr_color, &color_def) ); else if (reverse && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &p_bdr_color, &color_def) ); else XAllocNamedColor(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 && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &s_frg_color, &color_def) ); else if (reverse && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &s_frg_color, &color_def) ) ; else if (XAllocNamedColor(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 && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), def_val, &s_bdr_color, &color_def) ) ; else if (reverse && XAllocNamedColor(display, DefaultColormap(display, DefaultScreen(display)), "white", &s_bdr_color, &color_def) ) ; else if (XAllocNamedColor(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 = dimple1_bits; width = dimple1_width; height = dimple1_height; break; case 1: data = dimple3_bits; width = dimple3_width; height = dimple3_height; break; case 2: data = gray1_bits; width = gray1_width; height = gray1_height; break; case 3: data = gray3_bits; width = gray3_width; height = gray3_height; break; case 4: data = 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.22/oldXMenu/DelPane.c100666 13437 1 4001 5401324406 14443 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.22/oldXMenu/DelSel.c100666 13437 1 3415 5401324407 14314 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.22/oldXMenu/Destroy.c100666 13437 1 6446 5347150226 14611 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.22/oldXMenu/Error.c100666 13437 1 1266 5347150231 14240 0ustar jimbdaemon#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() { 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.22/oldXMenu/EvHand.c100666 13437 1 1045 5347150233 14311 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.22/oldXMenu/FindPane.c100666 13437 1 2356 5347150236 14641 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.22/oldXMenu/FindSel.c100666 13437 1 2640 5347150240 14470 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.22/oldXMenu/InsPane.c100666 13437 1 5271 5401324410 14475 0ustar jimbdaemon#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 "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.22/oldXMenu/InsSel.c100666 13437 1 5117 5401324411 14335 0ustar jimbdaemon#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 "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.22/oldXMenu/Internal.c100666 12120 1 63676 5426300271 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 "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.22/oldXMenu/Locate.c100666 13437 1 4276 5347150253 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.22/oldXMenu/Post.c100666 13437 1 5253 5405344633 14102 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.22/oldXMenu/Recomp.c100666 13437 1 4412 5405344633 14376 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.22/oldXMenu/SetAEQ.c100666 13437 1 1363 5347150264 14235 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.22/oldXMenu/SetFrz.c100666 13437 1 1267 5347150266 14375 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.22/oldXMenu/SetPane.c100666 13437 1 2001 5347150271 14476 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.22/oldXMenu/SetSel.c100666 13437 1 2333 5347150273 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.22/oldXMenu/XCrAssoc.c100666 13437 1 4025 5371331030 14623 0ustar jimbdaemon/* $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 "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.22/oldXMenu/X10.h100666 13437 1 5406 5405344634 13533 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.22/oldXMenu/XDelAssoc.c100666 13437 1 4213 5401324412 14762 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.22/oldXMenu/XDestAssoc.c100666 13437 1 2542 5354227510 15170 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.22/oldXMenu/XLookAssoc.c100666 13437 1 4335 5371331030 15167 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.22/oldXMenu/XMakeAssoc.c100666 13437 1 6630 5401324413 15141 0ustar jimbdaemon/* $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 "X10.h" #include #ifndef NULL #define NULL 0 #endif extern int errno; extern int (*_XIOErrorFunction)(); /* X system error reporting routine. */ 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 *) malloc(sizeof(XAssoc)); if (new_entry == NULL) { /* Malloc failed! */ errno = ENOMEM; (*_XIOErrorFunction)(dpy); } 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.22/oldXMenu/insque.c100666 13437 1 1567 5401324617 14461 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.22/oldXMenu/XMenu.h100666 13437 1 21736 5405344636 14245 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.22/oldXMenu/XMenuInt.h100666 13437 1 3257 5347154722 14676 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.22/oldXMenu/copyright.h100666 13437 1 1411 5347150326 15161 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.22/oldXMenu/Makefile.in100666 12120 1 5400 5471117670 14716 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_X_SITE) \ $(C_SWITCH_X_SYSTEM) $(C_SWITCH_MACHINE) $(CPPFLAGS) $(CFLAGS) \ -DEMACS_BITMAP_FILES .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 realclean: distclean tags:: $(TAGS) -t *.[ch] emacs-19.22/oldXMenu/README100666 13437 1 373 5174232417 13646 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.22/oldXMenu/Imakefile100666 13437 1 3026 5347156610 14617 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.22/oldXMenu/ChangeLog100666 12120 1 22345 5475620364 14455 0ustar rmsdaemonSat 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.22/oldXMenu/compile.com100644 13437 13 7576 5354207440 14702 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.22/oldXMenu/descrip.mms100644 13437 13 3003 5354207441 14677 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.22/etc/ 40777 12120 24 0 5475722561 11505 5ustar rmsotheremacs-19.22/etc/COPYING100666 12120 24 43070 5475722561 12661 0ustar rmsother 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.22/etc/3B-MAXMEM100666 13437 1 3571 4220366660 13201 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.22/etc/AIX.DUMP100666 12120 13 26140 5423443641 12560 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.22/etc/APPLE100666 13437 13 6521 5407624241 12350 0ustar jimbuser @unnumbered Special Report: Apple's New Look and Feel You might have read about the new look-and-feel copyright lawsuit, Apple vs. Hewlett Packard and Microsoft. Apple claims the power to stop people from writing any program that works even vaguely like a Macintosh. If they and other look-and-feel plaintiffs triumph, they will use this new power over the public to put an end to free software that could substitute for commercial software. In the weeks after the suit was filed, USENET reverberated with condemnation for Apple. GNU supporters Richard Stallman, John Gilmore, and Paul Rubin decided to take action against Apple's no-longer-deserved reputation as a force for progress. Apple's reputation comes from having made better computers; but now, Apple is working to make all non-Apple computers worse. If this deprives the public of the future work of many companies, the harm done would be many times the good that any one company does. Our hope was that if the user community realizes how destructive Apple's present actions are, Apple would lose customers and have more trouble finding employees. Our method of action was to print 5000 buttons that say ``Keep Your Lawyers Off My Computer'' and hand them out at the West Coast Computer Faire. The center of the button shows the rainbow-apple logo with a Gigeresque mouth full of ferocious teeth. The picture was drawn by Etienne Suvasa, who also drew the cover for the GNU Emacs manual. We call the picture ``Apple's New Look and Feel''. We gave out nearly 4000 buttons at the show (saving the rest for afterwards). The result was a great success: the extent of anger at Apple was apparent to everyone at the show. Many of the invited speakers at the show wore our buttons, spoke about them, or even waved them from the podium. The press noticed this: at least one Macintosh user's magazine carried a photo of the button afterwards. Some of you may be considering using, buying, or recommending Macintoshes; you might even be writing programs for them or thinking about it. Please think twice and look for an alternative. Doing those things means more success for Apple, and this could encourage Apple to persist in its aggression. It also encourages other companies to try similar obstructionism. [It is because of this boycott that we don't include support for Macintosh Unix in GNU software.] You might think that your current project ``needs'' a Macintosh now. If you find yourself thinking this way, consider the far future. You probably plan to be alive a year or two from now, and working on some other project. You will want to get good computers for that, too. But an Apple monopoly could easily make the price of such computers at that time several times what it would otherwise be. Your decision to use some other kind of machine, or to defer your purchases now, might make sure that the machines your next project needs are affordable when you need them. Newspapers report that Macintosh clones will be available soon. If you must buy a Macintosh-like machine, buy a clone. Don't feed the lawyers! If you would like further information about the boycott, or want to help please ask: League for Programming Freedom 1 Kendall Square #143 P.O. Box 9171 Cambridge, MA 02139 E-Mail: lpf@uunet.uu.net Phone: 617-243-4091 Dues: $42.00/yr for programmers $10.50/yr for students $21.00/yr for others. emacs-19.22/etc/BABYL100666 12120 13 12236 5405033156 12221 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.22/etc/COOKIES100666 13437 13 11560 5405340621 12615 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.22/etc/ChangeLog100666 12120 13 66075 5475620421 13235 0ustar rmsuserSat 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.22/etc/DEBUG100666 13437 13 10275 5405340622 12352 0ustar jimbuserDebugging 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. ** 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.22/etc/DISTRIB100666 13035 13 12653 5365062371 13556 0ustar gnulistsuser -*- 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'. GNU Emacs availability information, January 1993 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993 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 675 Massachusetts Avenue Cambridge, MA 02139 +1-617-876-3296 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.22/etc/FAQ100444 13437 13 573474 5405347212 12166 0ustar jimbuser GNU Emacs FAQ: Introduction [To find what has changed, see the "Changes" posting.] [The FAQ post date slipped big-time this time. Now that school is over with and I can get on with the rest of my life, posting should become a lot more regular. - sbyrnes] This is the introduction to a list of frequently asked questions (FAQ) about GNU Emacs with answers. This article contains a listing of the questions; subsequent articles contain the questions and answers. The FAQ list 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 of a question is in the FAQ list, please reply to the question by e-mail instead of posting. Help reduce noise! The FAQ list is crossposted to `comp.emacs' because some sites do not receive the `gnu.*' newsgroups. The FAQ list is also crossposted to `news.answers'. Please suggest new questions, answers, wording changes, deletions, etc. The most helpful form for suggestions is a context diff (ie., 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. :-( Full instructions for getting the latest FAQ are in question 22. Also see the `Introduction to news.answers' posting in the `news.answers' newsgroup, or send e-mail to `mail-server@rtfm.mit.edu' with `help' on a body line, or use FTP, WAIS, or Prospero to rtfm.mit.edu. These ideas have already been suggested, but we have not had time to implement them: * A Texinfo version. * Marking questions in the table of contents that have been changed recently. -- Steven Byrnes (and Joe Wells ) E-mail lpf@uunet.uu.net for details about the League for Programming Freedom. ---------------------------------------------------------------------- GNU Emacs FAQ: Table of Contents 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 and why should I join it? 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: When will GNU Emacs 19 be available? 26: What is different about GNU Emacs 19? 27: What variants of GNU Emacs exist? Common Things People Want To Do 28: How do I set up a .emacs file properly? 29: How do I debug a .emacs file? 30: How do I make Emacs display the current line (or column) number? 31: How do I turn on Abbrevs by default just in mode XXX? 32: How do I turn on Auto-Fill mode by default? 33: How do I make Emacs use a certain major mode for certain files? 34: How do I search for, delete, or replace unprintable (8-bit or control) characters? 35: How can I highlight a region of text in Emacs? 36: How do I control Emacs's case-sensitivity when searching/replacing? 37: How do I make Emacs wrap words for me? 38: Where can I get a better spelling checker for Emacs? 39: How can I spell-check TeX or *roff documents? 40: How do I change load-path? 41: How do I use an already running Emacs from another window? 42: How do I make Emacs recognize my compiler's funny error messages? 43: How do I indent switch statements like this? 44: How can I make Emacs automatically scroll horizontally? 45: How do I make Emacs "typeover" or "overwrite" instead of inserting? 46: How do I stop Emacs from beeping on a terminal? 47: How do I turn down the bell volume in Emacs running under X Windows? 48: How do I tell Emacs to automatically indent a new line to the indentation of the previous line? 49: How do I show which parenthesis matches the one I'm looking at? 50: In C mode, can I show just the lines that will be left after #ifdef commands are handled by the compiler? 51: Is there an equivalent to the `.' (dot) command of vi? 52: What are the valid X resource settings (ie., stuff in .Xdefaults)? 53: How do I execute a piece of Emacs Lisp code? 54: How do I change Emacs's idea of the tab character's length? 55: How do I insert `>' at the beginning of every line? 56: How do I insert `_^H' before each character in a paragraph to get an underlined paragraph? 57: How do I repeat a command as many times as possible? 58: 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? 59: How do I tell Emacs to iconify itself? 60: How do I use regexps (regular expressions) in Emacs? 61: How do I perform a replace operation across more than one file? 62: Where is the documentation for `etags'? Bugs/Problems 63: Does Emacs have problems with files larger than 8 megabytes? 64: Why can't Emacs find files in current directory on startup? 65: How do I get rid of the ^M junk in my Shell buffer? 66: Why do I get `Process shell exited abnormally with code 1'? 67: Why can't I cut from Emacs and paste in other X programs? 68: Where is the termcap/terminfo entry for terminal type `emacs'? 69: Why does Emacs spontaneously start displaying `I-search:' and beeping? 70: Why can't Emacs talk to certain hosts (or certain hostnames)? 71: Why does Emacs say `Error in init file'? 72: Why does Emacs ignore my X resources (my .Xdefaults file)? 73: Why does Emacs take 20 seconds to visit a file? 74: How do I edit a file with a `$' in its name? 75: Why does Shell mode lose track of the shell's current directory? 76: Why doesn't my change to load-path work? 77: Why does the cursor always go to the wrong column when I move up or down one line? 78: Why does Emacs hang with message `Unknown XMenu error' with X11R4? 79: Why doesn't display-time show the load average in the mode line anymore? 80: Why does ispell sometimes ignore the local dictionary? 81: Why does Ispell treat each line as a single word? 82: Are there any security risks in GNU Emacs? Difficulties Building/Installing/Porting Emacs 83: What should I do if I have trouble building Emacs? 84: How do I stop Emacs from failing when the executable is stripped? 85: Why does linking Emacs with -lX11 fail? 86: Why does Emacs 18.55 say `Fatal error (6).Abort' under SunOS 4.1? Finding/Getting Emacs and Related Packages 87: Where can I get GNU Emacs on the net (or by snail mail)? 88: How do I find a GNU Emacs Lisp package that does XXX? 89: Where can I get GNU Emacs Lisp packages that don't come with Emacs? 90: How do I submit code to the Emacs Lisp Archive? 91: Where can I get other up-to-date GNU stuff? 92: Where can I get an Emacs with better mouse and X window support? 93: What is the difference between GNU Emacs and Epoch? 94: What is the difference between GNU Emacs and Lucid GNU Emacs? 95: Where can I get the "unofficial HP GNU Emacs"? 96: Where can I get Emacs for my PC running MS-DOS? 97: Where can I get Emacs for my PC running Windows? 98: Where can I get Emacs for my PC running OS/2? 99: Where can I get Emacs for my Atari ST? 100: Where can I get Emacs for my Amiga? 101: Where can I get Emacs for my Apple computer? 102: Where can I get Emacs with NeWS support? 103: Where do I get Emacs that runs on VMS under DECwindows? 104: Where can I get modes for Lex, Yacc/Bison, Bourne Shell, Csh, C++, Objective C, Pascal, Awk? 105: What is the IP address of XXX.YYY.ZZZ? Major Emacs Lisp Packages, Emacs Extensions, and Related Programs 106: VM (View Mail) -- another mail reader within Emacs 107: Supercite -- mail and news citation package within Emacs 108: GNUS -- news reader within Emacs 109: Calc -- poor man's Mathematica within Emacs 110: Calendar/Diary -- calendar manager within Emacs 111: Ange-FTP -- transparent FTP access for Emacs's file access routines 112: VIP -- vi emulation for Emacs 113: Dired -- better directory editor for Emacs 114: AUC TeX -- enhanced LaTeX mode with debugging facilities 115: Hyperbole -- extensible hypertext management system within Emacs 116: Byte Compiler -- enhanced version of Emacs's byte compiler 117: comint -- hugely enhanced shell mode and other derived modes 118: BBDB -- personal info rolodex integrated with mail/news readers 119: Ispell -- spell checker in C with interface for Emacs 120: Epoch -- enhanced GNU Emacs with better X interface 121: Lucid GNU Emacs -- alternative Emacs 19 with better X interface 122: Demacs -- GNU Emacs altered to run on MS-DOS on 386/486 machines 123: Freemacs -- a small Emacs for MS-DOS 124: Patch -- program to apply "diffs" for updating files Changing Key Bindings and Handling Key Binding Problems 125: How do I bind keys (including function keys) to commands? 126: Why does Emacs say `Key sequence XXX uses invalid prefix characters'? 127: Why doesn't this [terminal or window-system setup] code work in my .emacs file, but it works just fine after Emacs starts up? 128: How do I use function keys under X Windows? 129: How do I tell what characters my function or arrow keys emit? 130: How do I set the X key "translations" for Emacs? 131: How do I handle C-s and C-q being used for flow control? 132: How do I use commands bound to C-s and C-q (or any key) if these keys are filtered out? 133: Why does the `BackSpace' key invoke help? 134: Why doesn't Emacs look at the stty settings for Backspace vs. Delete? 135: Why don't the arrow keys work? 136: How do I "swap" two keys? 137: How do I produce C-XXX with my keyboard? 138: What if I don't have a Meta key? 139: What if I don't have an Escape key? 140: How do I type DEL on PC terminal emulators? 141: Can I make my `Compose Character' key behave like a Meta key? 142: How do I bind a combination of modifier key and function key? 143: Why doesn't my Meta key work in an xterm window? 144: Why doesn't my ExtendChar key work as a Meta key under HP-UX 8.0? 145: Where can I get key bindings to make Emacs emulate WordStar? 146: Where can I get an XEDIT emulator for Emacs? Using Emacs with Alternate Character Sets 147: How do I make Emacs display 8-bit characters? 148: How do I input 8-bit characters? 149: Where can I get an Emacs that can handle kanji characters? 150: Where can I get an Emacs that can handle Chinese? 151: Where is an Emacs that can handle Semitic (right-to-left) alphabets? Mail and News 152: How do I change the included text prefix in mail/news followups? 153: How do I save a copy of outgoing mail? 154: Why doesn't Emacs expand my aliases when sending mail? 155: Why does RMAIL think all my saved messages are one big message? 156: How can I sort the messages in my RMAIL folder? 157: Why does RMAIL need to write to /usr/spool/mail? 158: How do I recover my mail files after RMAIL munges their format? 159: How do I make Emacs automatically start my mail/news reader? 160: How do I read news under Emacs? 161: Why does `rnews' say "No News is good news" when there is news? 162: Why doesn't GNUS work anymore via NNTP? 163: How do I view text with embedded underlining (eg., ClariNews)? 164: When I try to post a long article in GNUS (about 10K or longer), I get the error, "Writing to process: no more processes, nntpd" 165: How do I save all the items of a multi-part posting in GNUS? 166: Why does GNUS put the subjects in replies beyond the 80th column? 167: Why is GNUS so slow to start up? 168: How do I catch up all newsgroups in GNUS? 169: Why can't I kill in GNUS on the Newsgroups/Keywords/Control line? 170: How do I get rid of flashing messages in GNUS for slow connections? 171: Why is catch up slow in Gnews/GNUS? 172: Why does GNUS hang for a long time when posting? 173: Why don't my news postings in GNUS get past the local machine? 174: Why is the GNUS-generated `Date:' header invalid? 175: Why doesn't GNUS generate the `Lines:' header? 176: Why do I get "Cannot open load file" "nntp" when compiling GNUS? 177: How do I kill all articles in GNUS but those matching a pattern? GNU Emacs FAQ: Notation/General/Help/Status 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. A `+' in the 78th column means something was inserted on the line. A `-' means something was deleted and a `!' means some combination of insertions and deletions occurred. Full instructions for getting the latest FAQ are in question 22. Also see the `Introduction to news.answers' posting in the `news.answers' newsgroup, or send e-mail to `mail-server@rtfm.mit.edu' with `help' on a body line, or use FTP, WAIS, or Prospero to rtfm.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. I put any key sequence that is longer than one key (and some single-key sequences) inside double quotes or on a line by itself. 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 online 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, and "?" for a list of possibilities. 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 53. 3: How do I read topic XXX in the on-line manual? When I 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 the Info facility. If you don't already know how to use Info, type "?" from within Info. If I refer you to topic XXX:YYY, you need to 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 properly. 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 exec-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. 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 commercial organization which wants to provide an alternative, standardized version of Unix not controlled by AT&T. 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 and why should I join it? 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 me, jbw@cs.bu.edu; I will be happy to talk with you about the LPF.} Here is the contact information: E-mail address: league@prep.ai.mit.edu Phone number: (617) 243-4091 Postal address: League for Programming Freedom 1 Kendall Square, Number 143 Post Office Box 9171 Cambridge, MA 02139, USA 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) is however it is interpreted by a judge. 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, Epsilon, etc. 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, instead 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. Anonymous FTP: /prep.ai.mit.edu:/pub/gnu/MailingListArchives/ There is a WAIS database named `comp.emacs' on wais.oit.unc.edu that makes available the last few days of articles in comp.emacs. 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 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 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's help facility works best if help 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 online 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 file in the Emacs distribution. {Are PostScript versions of this available for FTP?} * 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". NOTE: You may find that command-apropos and apropos are extremely slow on your system. This will be fixed in Emacs 19. If you can't wait that long, there is a fast-apropos.el file available in the Emacs Lisp Archive (see question 89) that contains the fix. 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 $20. For 6 or more manuals the price is $13 each. The price may be tax-deductible as a business expense. 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 300 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: /cs.ubc.ca:pub/archive/gnu/manuals_ps/emacs-18.57.ps.Z ! which 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.Z If you don't have TeX you can convert the Texinfo sources into {t,n,ps}roff format with the `texi2roff' program, which is available via anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/texi2roff/texi2roff.shar.Z See also question 14 for how to view the manual online. 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 for Emacs 18 under Unix. It is available from the FSF for $50 (or 5 for $200). The latest revision available for FTP is edition 1.03 dated 28 January 1991. For online use, a set of pregenerated Info files is available with the Texinfo source for the Emacs Lisp manual via anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/ /prep.ai.mit.edu:pub/gnu/elisp-manual-1.03.tar.Z (You can also create the Info files from the Texinfo source.) See question 17 for details on how to install these files online. If you are daring enough to try to print this 550 page manual out yourself, for instructions see question 18. Also, as a popular USENET saying goes, "Use the Force, Read the Source". 17: How do I install a piece of Texinfo documentation? First create Info files from the Texinfo files with the `makeinfo' program. makeinfo is available as part of the latest Texinfo package: /prep.ai.mit.edu:pub/gnu/texinfo-2.14.tar.Z 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 online. Neither texinfo-format-buffer nor the makeinfo program install 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 are 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 setting the value of the variable Info-directory to its pathname. For example, to use a private Info directory which is a subdirectory of your home directory named `Info', you could do this: (setq Info-directory (expand-file-name "~/Info")) You will need a top-level Info file named `dir' in this directory. You can include the system-wide Info directory in your private Info directory with symbolic links or by copying it. * You can use an enhanced version of lisp/info.el that handles multiple Info directories. Then you can more easily use a mix of private and shared Info files. Dave Gillespie has written one such enhancement and I believe there are others. Dave's info.el also handles compressed Info files. Anonymous FTP: /archive.cis.ohio-state.edu:modes/info.el.Z /ftp.uu.net:languages/emacs-lisp/modes/info.el.Z ! According to Jay Bourland , a version of Dave's info.el comes with `xinfo' (see question 19). 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', and `ivinfo' programs do this. info uses curses, xinfo uses standard X11 libraries, 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.Z /export.lcs.mit.edu: ivinfo is available in a comp.sources.misc archive or from Tom Horsley . For ivinfo, you need Stanford's InterViews C++ X library, available via anonymous FTP (interviews.stanford.edu). 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 doen'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: DIFF -- Differences between GNU Emacs and Twenex Emacs CCADIFF -- Differences between GNU Emacs and CCA Emacs GOSDIFF -- Differences between GNU Emacs and Gosling (Unipress??) Emacs 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) OPTIONS -- a complete explanation of startup option handling 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. These additional files are available from the FSF via e-mail: * GNU's Bulletin, June, 1991 -- this file includes: GNU'S Who What Is the Free Software Foundation? What Is Copyleft? A Small Way to Help Free Software GNUs Flashes (important recent developments for project GNU) Free Software Support (and how to get it!) Copyrighted Programming Languages AT&T Threatens Users of X Windows (and other software patent threats) Project Gutenberg GNU Project Status Report GNU in Japan GNU Wish List Help Keep Government Software Free GNU Software Available Now Contents of the Emacs Tape Contents of the Compiler Tape Contents of the X11 Tapes VMS Emacs and Compiler Tapes GNU Documentation How to Get GNU Software Free Software for Microcomputers GNU Software on Apple computers GNU Software on the Amiga GNU Software on the Atari GNUish MS-DOS project Freemacs, an Extensible Editor for MS-DOS GNU in Japan FSF Order Form Thank GNUs * Legal issues about contributing code to GNU * GNU Project Status Report A collection of past GNU's Bulletins is available via anonymous FTP: /ftp.funet.fi:pub/gnu/Bulletins/ 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). 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 of which I know will 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 G" from the *Subject* buffer or "C-u SPC" from the *Newsgroup* buffer to view all articles in a newsgroup. The FAQ articles' message IDs are: ! ! ! ! ! ! If you are viewing this in the GNUS *Article* buffer, you can move point within one of the above message IDs and type "r" to fetch the referenced article. Type "o" in the *Article* buffer to restore the previous contents. If this text is not in the GNUS *Article* buffer, use M-r from the *Subject* buffer instead. 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 July 3, 1993. ! * Via anonymous FTP. You can fetch the FAQ articles via anonymous FTP /rtfm.mit.edu:pub/usenet/news.answers/GNU-Emacs-FAQ/ part* * Via e-mail. You can send the following magical incantation in the body of a message to mail-server@rtfm.mit.edu: send usenet/news.answers/GNU-Emacs-FAQ/part0 send usenet/news.answers/GNU-Emacs-FAQ/part1 send usenet/news.answers/GNU-Emacs-FAQ/part2 send usenet/news.answers/GNU-Emacs-FAQ/part3 send usenet/news.answers/GNU-Emacs-FAQ/part4 send usenet/news.answers/GNU-Emacs-FAQ/part5 * Via WAIS. The GNU Emacs FAQ is available via WAIS indexed on a per-question basis from the `faq' database on bigbird.bu.edu on the non-standard IP port number of 2210. This is probably the best way to find out if there is something in the FAQ related to your question. I use this myself to answer questions I see posted on gnu.emacs.help. The articles of the GNU Emacs FAQ are also available from the `usenet' database on rtfm.mit.edu (on the standard IP port: 210), along with a lot of other FAQ articles. However, these are all indexed at the whole article level instead of at the question level. This is a better place to look if you want to fetch the entire FAQ. * 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. 18.59 is the latest version, and it was released in October 1992. * There is an old version of the FAQ list available for FTP in the GNU archives at MIT: /prep.ai.mit.edu:pub/gnu/GNUinfo/FAQ.emacs * 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 keybindings at MIT. Many people have told me that TECO code looks a lot like line noise. See alt.lang.teco if you are interested. I think 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 18.59 is the current version. Fixes from 18.57 include better mail address parsing, an X visual bell speedup, a call-process enhancement, a regexp matching change, the ability to apply a numeric argument to a self-inserting digit, getting X resource values from the RESOURCE_MANAGER property, more reliable shell mode job control, and a change to copy-keymap. Also, support has been added for many new system types. Fixes from 18.55 include the removal of arbitrary limits on the undo facility. According to the January 1992 GNU's Bulletin, "Emacs 18 maintenance continues for simple bug fixes.". To visit a file with information about what has changed in recent versions, type "C-h n". 25: When will GNU Emacs 19 be available? Richard Stallman recently (February 19, 1993) posted in gnu.emacs.help ! the following: ! ! People should keep in mind that the successor of Emacs 18 does not ! come from Lucid. Its is GNU Emacs 19. I still can't say exactly when ! public release is going to be, but we are about to start testing at a ! number of sites. ! ! GNU Emacs 19 will support a broad spectrum of machines, like Emacs ! 18. Ensuring this is the purpose of the testing we are about to do. ! ! (Please don't volunteer; we have enough pretesters, and if more people ! offer, dealing with those messages will slow things down.) ! ! Once we make sure it is indeed working reliably on various different ! systems, we will have a public beta test release. ! ! Emacs 19 does support adding properties to ranges of text, and using ! these to switch fonts. In the future, the Epoch people will help ! merge support for variable-width fonts. ! ! Meanwhile, I have almost finished updating the Emacs Lisp manual. Its ! next edition will describe Emacs 19. There will be an announcement ! when we know when this edition will be available. ! Lucid has released Lucid GNU Emacs 19.6, which is based on an early ! unreleased version of GNU Emacs 19. This will be similar to Emacs 19 when it finally arrives, but they are not the same. See question 121. Work has begun on features for Emacs 20. 26: What is different about GNU Emacs 19? From the January 1992 GNU's Bulletin: Version 19 will enter beta test late this year. Among its new features are: before and after change hooks, source-level debugging of Emacs Lisp programs, X selection processing (including clipboard selections), scrollbars, support for European character sets, floating point numbers, per-buffer mouse commands, X resource manager interfacing, mouse-tracking, Lisp-level binding of function keys, multiple X windows (`screens' to Emacs), a new input system, and buffer allocation, which uses a new mechanism capable of returning storage to the system when a buffer is killed. The input stream is now a sequence of Lisp objects, instead of a sequence of characters. This allows a reasonable representation for mouse clicks, function keys, menu selections, etc. Thanks go to Alan Carroll and the people who worked on Epoch for generating initial feedback to a multi-windowed Emacs, and to Eric Raymond for help in polishing the Emacs 19 Lisp libraries. The June 1991 GNU's bulletin had this to say about future plans for Emacs: Features being considered for later releases of Emacs include: associating property lists with regions of text in a buffer; multiple fonts, color, and pixmaps defined by those properties; different visibility conditions for the regions, and for various windows showing one buffer; hooks to be run if point or mouse moves outside a certain range; incrementally saving undo history in a file; static menu bars; and better pop-up menus. Mention of this feature disappeared in the January 1992 GNU's bulletin: Emacs 19 supports two styles of multiple windows, one with a separate screen for the minibuffer, and another with a minibuffer attached to each screen. Mention of these two proposed features disappeared in the January 1991 GNU's bulletin: * Incremental syntax analysis for various programming languages (Leif). * A more sophisticated emacsclient/server model, which would provide network transparent Emacs widget functionality. 27: What variants of GNU Emacs exist? * Nemacs (Nihongo Emacs), which can handle Japanese text, is derived from GNU Emacs 18.55. See question 149. * Demacs, which can run under MS-DOS on 386 machines, is derived from Nemacs. See question 122. * Epoch, which has better X support, is derived from GNU Emacs 18.58. See question 120 and 92. * Nepoch (Nihongo Epoch), which can handle Japanese text, is derived from Epoch. * Mule (the MULtilingual Enhancement of GNU Emacs) can handle many character sets simultaneously. It is derived from Emacs 18.58. It is available for FTP: /sh.wide.ad.jp:/JAPAN/mule/ /etlport.etl.go.jp:/pub/mule/ * Lucid GNU Emacs is derived from an early unreleased version of GNU Emacs 19. See question 121 and 92. GNU Emacs FAQ: Common Requests/Problems 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. A `+' in the 78th column means something was inserted on the line. A `-' means something was deleted and a `!' means some combination of insertions and deletions occurred. Full instructions for getting the latest FAQ are in question 22. Also see the `Introduction to news.answers' posting in the `news.answers' newsgroup, or send e-mail to `mail-server@rtfm.mit.edu' with `help' on a body line, or use FTP, WAIS, or Prospero to rtfm.mit.edu. Common Things People Want To Do 28: 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. :-) 29: How do I debug a .emacs file? First start Emacs with the `-q' command line option. Then, in the *scratch* buffer, type the following: (setq debug-on-error t) LFD (load-file "~/.emacs") LFD (Type LFD by pressing C-j.) If you have an error in your .emacs file, this will invoke the debugger when the error occurs. If you don't know how to use the debugger do (setq stack-trace-on-error t) instead. WARNING: this will not discover errors caused by trying to do something that requires the terminal/window-system initialization code to have been loaded. See question 127. 30: 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)". Typing "C-x l" 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. WARNING: "C-x l" gives the wrong value when point is at the beginning of a line. There is no "correct" way to constantly display the current (or total) line (or column) number on the mode line in Emacs 18, or to display the line numbers next to the lines like vi can. Emacs is not a line-oriented editor, and really has no idea what "lines" of the buffer are displayed in the window. It would require a lot of work at the C code level to make Emacs keep track of this. It would not be that hard to get the column number, but it would still require changes at the C code level. None of the vi emulation modes provide the `set number' capability of vi (as far as I know). Emacs 19 will probably be able to show the line number on the mode-line, but probably very inefficiently. People have written various kludges to display line numbers. One is `display-line-numbers' by Wayne Mesard . Look in the Lisp Code Directory. (See question 88.) 31: How do I turn on Abbrevs by default just in mode XXX? Put this in your .emacs file: (condition-case () (read-abbrev-file nil t) (file-error nil)) (setq XXX-mode-hook (function (lambda () (setq abbrev-mode t)))) 32: 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: (setq 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) 33: 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-*- 34: 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 (ie., 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 a 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. {I need to write the text for this part of the answer!} Notes: * With isearch, you can type RET to get a quoted LFD (not a quoted RET). * You don't need to quote TAB with either isearch or typing something in the minibuffer. Here are the Emacs Lisp forms of the above regexps: ;; regexp matching all printable characters: "[\t\n\r\f -~]" ;; regexp matching all unprintable characters: "[^\t\n\r\f -~]" 35: How can I highlight a region of text in Emacs? There are ways to get highlighting (reverse video, inverse video) in GNU Emacs 18.59, but either they require patching the C code of Emacs and rebuilding, or they are slow and the highlighting disappears if you scroll or redraw the screen and it can not follow the point. Howard Gayle's patches for 8-bit output appear to allow highlighting (see question ^8-bit-output). Another patch for highlighting is by Kenichi Handa . There is a patch for use with X by Andy Norman (and modified for 18.57 by Matthieu Herrb ), which is available for FTP: /laas.laas.fr:pub/emacs/patch-X11-18.55 /laas.laas.fr:pub/emacs/patch-X11-18.57 You can highlight regions in a variety of ways in Epoch and Lucid Emacs. GNU Emacs 19 may not be able to just temporarily highlight a region. Similar comments apply to displaying text in different fonts, except that it is even harder. 36: 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: (setq XXX-mode-hook (function (lambda () (setq case-fold-search nil)))) 37: How do I make Emacs wrap words for me? M-x auto-fill-mode. The default maximum line width is 74, determined by the variable fill-column. To find how to turn this on automatically see question 32. 38: Where can I get a better spelling checker for Emacs? Use Ispell. See question 119. 39: How can I spell-check TeX or *roff documents? If you want to spell-check TeX or *roff documents with Ispell, you need to arrange for a filter program that understands how to strip TeX or *roff formatting commands to be run. In the TeX distribution, there are several different programs named `detex', all with incompatible options, and a very old pair of programs named `detex' and `delatex', which should probably be avoided. The most useful one for Ispell is `detex' by Daniel Trinkle. A more recent version is available via FTP: /arthur.cs.purdue.edu:pub/trinkle/detex-2.4.tar Raphael Cerf recently released a program for this named `xetal': /spi.ens.fr:pub/unix/tex/ There is a program that comes with Unix named `deroff' for stripping formatting commands from *roff files. Here is an example of code you can put in a .emacs file to use these programs: ;; Based on suggestions by David G. Grubbs and Paul Palmer ;; . ;; Assuming the use of detex 2.3 by Daniel Trinkle: ;; -w means one word per line. ;; -n means don't expand \input or \include commands. ;; -l means force LaTeX mode. (require 'ispell) ; for the make-variable-buffer-local statements (setq plain-TeX-mode-hook (function (lambda () (setq ispell-filter-hook "detex") (setq ispell-filter-hook-args '("-nw"))))) (setq LaTeX-mode-hook (function (lambda () (setq ispell-filter-hook "detex") (setq ispell-filter-hook-args '("-lnw"))))) (setq nroff-mode-hook (function (lambda () (setq ispell-filter-hook "deroff") (setq ispell-filter-hook-args '("-w"))))) You will have to adjust the arguments for programs other than Trinkle's detex or for other versions of deroff. Experiment running the command from the shell to find the correct options. If you don't have a filter that knows how to output one word per line, you must pipe its output through another filter to break up the output. 40: 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 (append load-path '("/XXX/YYY/"))) To do this relative to your home directory: (setq load-path (append load-path (list (expand-file-name "~/YYY/")))) 41: 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 #" to indicate this. This will switch to another buffer created at the request of emacsclient if there are any. When "C-x #" has been invoked on all of the files that the emacsclient requested to be edited, Emacs will send notification of this to `server' which will pass this on to the emacsclient, which will then exit. 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). 42: How do I make Emacs recognize my compiler's funny error messages? Write a program which runs the compiler as a child and filters its output, rearranging as necessary. Install with same name as compiler somewhere in path. Keith Moore wrote one such for a C compiler under AIX. Available via FTP: /cs.utk.edu:readonly/aixcc.lex Jim Frost wrote another for the IBM xlc compiler on the RS/6000. (I don't know if these are both for the same compiler.) Johnathan Vail wrote something for a High C compiler (`hc', which is one of the compilers on the RS/6000, although I think Johnathan wrote his program for hc on a different computer). 43: 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; } } I don't believe there is any way to do this exactly without modifying the Lisp code in c-mode.el. You can set c-indent-level to 4 and c-label-offset to -2, but this has bad effects elsewhere. {Anyone have a solution?} 44: How can I make Emacs automatically scroll horizontally? There is no completely correct way of doing this that does not involve rewriting all commands or writing your own top-level command loop (not a completely bad idea). Wayne Mesard has written a particularly advanced kludge called `hscroll.el' that checks once a second to make sure point is visible. 45: How do I make Emacs "typeover" or "overwrite" instead of inserting? M-x overwrite-mode (a minor mode). 46: 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) 47: How do I turn down the bell volume in Emacs running under X Windows? Under versions of Emacs before 18.58, the bell volume was annoying loud and difficult to turn off. So upgrading to 18.58 or higher will reduce the volume. If you want to turn it off completely, use `xset'. There is no way to turn the bell off just for Emacs without affecting all other programs. Under Epoch you can do: (setq epoch::bell-volume 20) Stu Grossman wrote a patch that allows the bell volume to be adjusted from inside Emacs just for Emacs. 48: 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 32), 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. 49: How do I show which parenthesis matches the one I'm looking at? 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 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))))) 50: 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.) You may have to (load "hideif") first. If you want to do this regularly, put this in your .emacs file: (autoload 'hide-ifdef-mode "hideif" nil t) {Yes, I know, this should be in lisp/loaddefs.el already.} 51: 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" (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 I recommend using keyboard macros. 52: What are the valid X resource settings (ie., stuff in .Xdefaults)? See the Emacs man page, or the etc/OPTIONS file. Ignore the information in etc/XDOC which is way out of date. 53: 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 54: How do I change Emacs's idea of the tab character's length? Example: (setq default-tab-width 10). 55: 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 M-x replace-regexp RET ^ RET > RET C-x w". WARNING: The command narrow-to-region (C-x n) is disabled by default because it can be very confusing (ie., "Oh no! Where did my file go?"). 56: How do I insert `_^H' before each character in a paragraph to get an underlined paragraph? M-x underline-region. 57: 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. 58: 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 ...) 59: How do I tell Emacs to iconify itself? You need to modify C source and recompile. Either that or get Epoch or Lucid Emacs instead. Patches have been written by Robert Forsman and Johan Vromans to allow Emacs to iconify itself and by Matt Wette and Manavendra K. Thakur (for 18.57, plus icon geometry) to allow Emacs to start up iconified. I don't know which of these patches work together. Anonymous FTP: /csi.jpl.nasa.gov:pub/emax.patch1 (Matt Wette) /ftp.eu.net:gnu/emacs/FP-Xfun.Z (Johan Vromans) /ftp.urc.tue.nl:/pub/tex/emacs/FP-Xfun (Johan Vromans) 60: How do I use regexps (regular expressions) in Emacs? See `Regexps' in the online 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 (eg. `\sw') are not meaningful inside character set regexps (eg. `[aeiou]'). (This is actually typical for regexp syntax.) 61: 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 online 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 62: Where is the documentation for `etags'? `etags' takes options just like a prior version of ctags, so your ctags manual (if any) may be useful. Eoin Woods, in comp.emacs, writes the ! following: ! ! From reading the source (!) the way I use it is: ! ! for f in `find ` ! do ! etags -at -f ETAGS $f ! done ! ! The "-t" option means to create tags for typedefs as well as functions. ! The "-a" option tells it to append to the output file. If you have a ! small number of files (up to a few hundred I think) you can use it ! direct as: ! ! etags -f ETAGS file1 file2 file3 ... filen ! ! The option list is: ! ! -f file - Specify the output file name (Default is "TAGS") ! -a - Append to the output file. (Default is to rewrite it) ! -t - Create tags for typedefs (default is just functions) ! -u - Update the output file. Do not re-create it. ! -w - Suppress warnings ! -v - Create vgrind style indexed output (What is vgrind??) ! -x - Create cxref style output (default is Emacs Tags) ! -e - Emacs tags style output (the default the way I ! compile it) ! ! Having got it working, it works fine! ! Bugs/Problems 63: Does Emacs have problems with files larger than 8 megabytes? 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, eg., 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. 64: Why can't Emacs find files in current directory on startup? The PWD bug has been fixed as of GNU Emacs 18.59. Read on if you are running an older version of Emacs. Most likely, you have an environment variable named PWD that is set to a value other than the name of your current directory. This is most likely caused by using two different shell programs. `ksh' and (some versions of) `csh' set and maintain the value of the PWD environment variable, but `sh' doesn't. If you start sh from ksh, change your current directory inside sh, and then start Emacs from inside sh, PWD will have the wrong value but Emacs will use this value. An invalid setting for PWD can also be a problem if you use X Windows and csh on an RS/6000. See the etc/OPTIONS file for more details. Perhaps an easier solution is not to use two shells. The `chsh' program can often be used to change one's default login shell. You may have PWD set for other reasons. Another possibility is that you are setting default-directory from your .emacs file. Here is a fix by Jim Blandy : >--- emacs/jjj/emacs-18.58/lisp/startup.el Tue Jan 15 23:19:04 1991 >+++ startup.el Mon Apr 20 00:21:01 1992 >@@ -81,5 +81,7 @@ > ;; In presence of symlinks, switch to cleaner form of default directory. > (if (and (not (eq system-type 'vax-vms)) >- (getenv "PWD")) >+ (getenv "PWD") >+ (equal (nthcdr 10 (file-attributes default-directory)) >+ (nthcdr 10 (file-attributes (getenv "PWD"))))) > (setq default-directory (file-name-as-directory (getenv "PWD")))) > (unwind-protect 65: How do I get rid of the ^M junk in my Shell buffer? 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.) 66: 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. This program should be compiled (for the correct architecture!) and installed with execute permission for everyone in Emacs's program directory, which is normally /usr/local/emacs/etc. 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". `env' should also be for the correct architecture (check using `file' command). You should also check for other programs named `env' in your path (eg., SunOS has a program named /usr/bin/env). I don't understand why this can cause a failure and I 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 (ie. had a controlling tty) but the xterm was later terminated. See also etc/PROBLEMS for other possible causes of this message. 67: Why can't I cut from Emacs and paste in other X programs? Emacs stores things you "cut" in the X "cut buffers". It also pastes from the cut buffer `CUT_BUFFER0'. This is obsolete. Most modern X programs now expect to work with "selections" instead of cut buffers, although some like `xterm' will try to use the cut buffers if the selection is null. Emacs 18.58 contains a "fix" that makes xterm work by default. This "fix" is that Emacs clears the `PRIMARY' selection when it stores something in the cut buffer. By making the selection null, xterm will then fetch from the cut buffer when you try to paste. For versions of Emacs prior to 18.58, you can make pasting from Emacs into xterm work with the following X resources: ! Solution by Thomas Narten, should work under X11R3 and later GNU ! Emacs only copies to CUT_BUFFER0. xterm by default wants to paste ! from the PRIMARY selection. XTerm*VT100.Translations: #override \ ~Meta : insert-selection(CUT_BUFFER0,PRIMARY) You may have problems copying between Emacs and programs other than xterm that won't store cut text in the cut buffers or look in the cut buffers for text to paste (for backwards compatibility with obsolete applications like Emacs :-). The best workaround is to use the `xcutsel' program as an intermediary. This problem does not exist for Epoch or Lucid Emacs. 68: 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 (eg., 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 69: 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 131. 70: 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 gethosbyname 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. 71: 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 29. 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 127. 72: Why does Emacs ignore my X resources (my .Xdefaults file)? * Try compiling Emacs with the XBACKWARDS macro defined. There is a bug in some implementations of XGetDefault, which do not correspond to the documentation or the header files. * Make sure you are either using the class name of `Emacs' (oops, apparently this is buggy in Emacs 18.58!) or the correct instance name. The instance name is normally the same as the name of the file Emacs is in (ie., the last part of argv[0]), but this can be overridden by -rn command line option or the WM_RES_NAME environment variable. WARNING: Reports say using the class name fails in Emacs 18.58. WARNING: The advice the man page gives to use `emacs' is often wrong. WARNING: Older versions of Emacs got the class name wrong. * Emacs currently ignores the -xrm command line argument. * Emacs does not yet handle X11R5 screen-specific resources. * Emacs has a bug where it ignores color specifications if running on a 1-bit display (ie. a non-color display). * I don't think Emacs will use either of the application-specific resource files. Thus these environment variables don't affect it: XAPPLRESDIR, XUSERFILESEARCHPATH, XFILESEARCHPATH. {Correct?} 73: 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. 74: 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. 75: 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 88). 76: Why doesn't my change to load-path work? If you added a directory name containing a tilde (~) to your load-path, expecting the tilde to be interpreted as your home directory, then you need to do something like this: (setq load-path (mapcar 'expand-file-name load-path)) 77: Why does the cursor always go to the wrong column when I move up or down one line? You have inadvertently typed "C-x C-n" (set-goal-column) which sets the "goal column" to the column where the cursor was. To undo this type "C-u C-x C-n". If you make this mistake frequently, you might want to unbind or disable this command by doing one of these two: (define-key ctl-x-map "\C-n" nil) (put 'set-goal-column 'disabled t) 78: Why does Emacs hang with message `Unknown XMenu error' with X11R4? Many different X errors can produce this message. Here is the solution to one problem: X11 Release 4 (and later, including OpenWindows) enforces some conditions in the X protocol that were previously allowed to pass unnoticed. You need to put the X11R4 server into X11R3 bug compatibility mode for Emacs's Xmenu code to work. You can do this with the command `xset bc'. 79: Why doesn't display-time show the load average in the mode line anymore? In GNU Emacs 18.56, a change was made in the display-time code. Formerly, in version 18.55, Emacs used a program named `loadst' to notify Emacs of the change in time every minute. loadst also sent Emacs the system load average if it was installed with sufficient privilege to get that information (or was on a system where no such privilege was needed). Emacs then displayed this information in the mode line. In version 18.56, this code was changed to use a program named `wakeup'. wakeup doesn't send Emacs any information, it's only purpose is to send Emacs *something* every minute, thus invoking the filter function in Emacs once a minute. The filter function in Emacs does all the work of finding the time, date, and load average. However, getting the load average requires the privilege to read kernel memory on most systems. Since giving Emacs this privilege would destroy any security a system might have, for almost everyone this is not an option. In addition, Emacs does not have the code built into it to get this information on the systems which have special system calls for this purpose, even though loadst had code for this. The solution I use is to get the files lisp/display-time.el and etc/loadst.c from version 18.55 and use those with 18.58. (I have heard a rumor that loadst disappeared because of the legal action Unipress threatened against IBM.) WARNING: Do not install Emacs setgid kmem unless you wish to destroy any security your system might have!!!!!!!!!! If you are using Emacs 18.55 or earlier, or already using the solution I describe above, read further: The most likely cause of the problem is that `loadst' can't read the special file /dev/kmem. To properly install loadst, it should be either setuid to the owner of /dev/kmem, or is should be setgid to the group to which /dev/kmem belongs. In either case, /dev/kmem should be readable by its owner or its group, respectively. Assuming the existence of a group named `kmem', here is an example of how to do this: chgrp kmem /dev/kmem chmod g+r /dev/kmem chgrp kmem /usr/local/emacs/etc/loadst chmod g+s /usr/local/emacs/etc/loadst Another possibility is that your version of Unix doesn't have the load average data available in /dev/kmem. Your version of Unix might have a special system call to retrieve this information (eg., inq_stats under UMAX), and loadst might not have been enhanced to cope with this. 80: Why does ispell sometimes ignore the local dictionary? You need to update the version of Ispell to 2.0.02. (Or you can switch to version 3.0 which is still in beta-testing.) A patch is available via anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/ispell/patch2.Z You also need to change a line in ispell.el from: (defconst ispell-version "2.0.01") ; Check against output of "ispell -v". to: (defconst ispell-version "2.0.02") ; Check against output of "ispell -v". 81: Why does Ispell treat each line as a single word? Ispell expects to get its input one word per line. The ispell filter, which is specified by the variables ispell-filter-hook and ispell-filter-hook-args, should output at most one word per line. 82: Are there any security risks in GNU Emacs? * the `movemail' incident (No, this is not a risk.) Cliff Stoll in his book `The Cuckoo's Egg' describes this in chapter 4. The site at LBL had installed the `etc/movemail' program setuid root. 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. I 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 online manual (which, incidentally, does not describe how to disable the feature). There is a new variable in Emacs 18.58 named ignore-local-eval which turns out to be useless as currently implemented. Ignore it. * 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. Lucid GNU Emacs does not accept synthetic X events unless you set a variable. * autosave file permissions (Yes, a risk, hard to work around.) The file permissions for autosave files are determined solely by the Emacs process's `umask' value. The permissions of the file being autosaved are not used. The easiest workaround is to keep sensitive files in protected directories. Sebastian Kremer has written an enhanced version of the autosave file name picking code that can avoid this problem by keeping autosave files in a protected directory. {FTP information please?} This problem will be fixed in Emacs 19. Difficulties Building/Installing/Porting Emacs 83: What should I do if I have trouble building Emacs? First look in the file etc/PROBLEMS 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. 84: 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. 85: 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. 86: Why does Emacs 18.55 say `Fatal error (6).Abort' under SunOS 4.1? I had hoped this question would go away after Emacs 18.57 was released, but people continue to compile 18.55. Easiest solution: upgrade. This is a result of the SunOS localtime/tzsetwall malloc bug, which was (finally!) fixed in SunOS 4.1.2. If you actually need the full explanation, send me e-mail. If you absolutely must compile Emacs 18.55 (eg., you are compiling Nemacs), the easiest workaround was to put `#define SYSTEM_MALLOC' in src/config.h. GNU Emacs FAQ: Getting Emacs/Packages 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. A `+' in the 78th column means something was inserted on the line. A `-' means something was deleted and a `!' means some combination of insertions and deletions occurred. Full instructions for getting the latest FAQ are in question 22. Also see the `Introduction to news.answers' posting in the `news.answers' newsgroup, or send e-mail to `mail-server@rtfm.mit.edu' with `help' on a body line, or use FTP, WAIS, or Prospero to rtfm.mit.edu. Finding/Getting Emacs and Related Packages 87: 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. If you don't already have GNU Emacs, see question 20 for how to get these two files. The latest version is always available via anonymous FTP at MIT: /prep.ai.mit.edu:pub/gnu/emacs-18.59.tar.Z See question 91. 88: 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 and Dave Sill . You can search through this list to find if someone has written something that fits your needs. This list is file LCD-datafile.Z in the Emacs Lisp Archive. (See question 89 for methods for getting this file.) The files lispdir.el.Z and lispdir.doc.Z in the archive contain 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 look things up in the database. For example, the command "M-x lisp-dir-apropos RET ange-ftp RET" produces this (outdated) output: GNU Emacs Lisp Code Apropos -- "ange-ftp" ange-ftp (3.112) 91-08-12 Andy Norman, archive.cis.ohio-state.edu: /pub/gnu/emacs/elisp-archive/as-is/ange-ftp.el.Z transparent FTP Support for GNU Emacs 89: 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 88). Then check local archives and the Emacs Lisp Archive to find a copy of the relevant files. Then, 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/ Fetch 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. NOTE: Any files with names ending in `.Z' are compressed, and 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'. 90: How do I submit code to the Emacs Lisp Archive? Submissions should be 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. Mail messages (submissions) are automatically saved and periodically archived. Urgent mail may be sent directly to Dave Sill or Dave Brennan or should contain the string `urgent' in the subject. The incoming ftp directory is no longer available at the request of Ohio State. {Is this still true?} However, if someone has a submission with multiple files (which would be archived as a tar file) or binary files, then FTP transfer is preferred and can be arranged via an anonymous FTP site. This is faster than uudecoding, unsharing, etc., and re-packaging files. Before submitting anything, please read the file guidelines.Z, which is available in the archive. Whenever possible, submissions should contain a complete LCD entry since this helps reduce administrative overhead for the maintainers. You can include an entry in this format: ;; LCD Archive Entry: ;; package name|author's name|email address ;; |description ;; |date|version|archive path For example: ;; LCD Archive Entry: ;; tex-complete|Sebastian Kremer|sk@thp.Uni-Koeln.DE ;; |Minibuffer name completion for editing [La]TeX. ;; |91-03-26|$Revision: 1.5 $|~/packages/tex-complete.el.Z ! Dave Brennan has software which automatically looks for data in this format. The format is fairly flexible. The entry ends when a line is reached with a different prefix or the seventh field terminator is seen. If you are submitting a multi-file submission you should include a file named "LCD-entry" which contains the archive entry, instead of placing it in one or more of the individual files. 91: 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. See the files etc/DISTRIB and etc/FTP for more information. (To get copies of these files, see question 20.) The following sites are all mirror images of the GNU distribution area: /prep.ai.mit.edu:pub/gnu/ /ftp.uu.net:packages/gnu/ /src.doc.ic.ac.uk:gnu/ (available via FTP, NIFTP, FTAM) /ftp.win.tue.nl:pub/gnu/ /utsun.s.u-tokyo.ac.jp:ftpsync/prep/ /nic.funet.fi:pub/gnu/ The directory at ftp.uu.net is a mirror of prep.ai.mit.edu:pub/gnu, except that files larger than 1 megabyte {right?} are automatically 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. Some of the other mirror sites may have the same property. {Can someone check this out? Thanks!} Information was provided by Lee McLoughlin , Jonathan R. Ferro , Arjan de Vet , and Simon Marshall . 92: Where can I get an Emacs with better mouse and X window support? Emacs 18 has some limited X Window System support, but there are problems. Emacs 19 will have amazing mouse and window support. Right now, there are Epoch which is derived from GNU Emacs 18.58 and Lucid GNU Emacs which is derived from an early unreleased version of GNU Emacs 19, both of which have greatly improved mouse and window support. See questions 120 and 121. The HP unofficial GNU Emacs also has nice mouse support. See question 95. There are numerous Emacs Lisp packages that have been written to extend Emacs 18's mouse handling capabilities. Some of these packages also have patches to the C code to provide enhanced capabilities. Look up `mouse' in the Lisp Code Directory (see question 88). There is a package called BAM (Born Again Menus) which provides menus for GNU Emacs via an external C program. It does not provide mouse support in the Emacs window such as scrollbars, cut-and-paste, etc. NOTE: Epoch only works with the X Window System; it works on ordinary terminals by invoking regular GNU Emacs. Lucid Emacs does not currently work on ordinary terminals, although there are plans to fix this. 93: What is the difference between GNU Emacs and Epoch? Marc Andreessen writes: Epoch is GNU Emacs on steroids: an adaptation of GNU Emacs with lots of additional support for features made possible by the X11 windowing system. These features include multiple editing windows, arbitrary colors and fonts (fixed-width and proportional), selectable zones per buffer with arbitrary display styles (font, color, underline, stipple, pixmap), an optional separate minibuffer window, improved keyboard and mouse handling, full 8-bit character set support, and more. 94: What is the difference between GNU Emacs and Lucid GNU Emacs? This information is condensed from the release notice: Lucid GNU Emacs is based on an early version of GNU Emacs version 19 with many enhancements. It currently requires X Windows to run. For information on where to get Lucid GNU Emacs see 121. X Windows support is greatly enhanced over GNU Emacs version 18, including support for multiple X Windows (a.k.a. screens in Emacs), Zmacs/Lispm style region highlighting, a customizable, Motif-like menubar, more powerful keymap support (allowing different actions to be associated with Backspace, Control-h, etc.), flexible text attribute (e.g. font, color) support on regional and screen-local basis through X resources and/or lisp, and support for the X11 selection mechanism. Some other features include run-time computation of the load-path, support for floating point numbers, native timer support, and sound file support on Sun SPARCstations. To build Lucid GNU Emacs, an ANSI C compiler (e.g. gcc) is required. 95: Where can I get the "unofficial HP GNU Emacs"? The unofficial HP GNU Emacs is available via anonymous FTP: /ee.utah.edu:HUGE/ (PLEASE FTP DURING NON-WORK HOURS!!!) and takes about 35 megabytes of disk space to build. It is useful for non-HP machines, but some of the added features will only work under HP-UX. You will need to get patches to work with HP-UX 8.0 or on 700 series machines via e-mail from Darryl Okahata . 96: Where can I get Emacs for my PC running MS-DOS? * Demacs For 386 or 486 PCs running MS-DOS, there is a version of GNU Emacs called Demacs. To get Demacs see question 122. From the announcement message: Demacs is almost a full set of GNU Emacs but does not support some features: asynchronous process, locking a file, etc. Demacs provides following DOS specific features: * File type: text or binary file translation. * "8-bit clean" display mode. * 8086 software interrupt call by int86 lisp function. * Machine specific features such as function key support. * File name completion with drive name. * Child process (suspend-emacs, call-process). * Enhanced dired mode which can work without 'ls.exe'. To our regret `shell-mode' does not work, but `compile' command works properly. 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. There are a variety of other Emacses for MS-DOS including among them the following. * Freemacs Russ Nelson , the author, describes Freemacs: * Freemacs is free, and it was designed from the start to be programmable. * Freemacs is the only IBM-PC editor that tries to be like GNU Emacs. * Freemacs can only edit files less than 64K in length. * Freemacs doesn't have undo. Carl Witty reviews Freemacs: Better is Freemacs, which follows the tradition of ITS and GNU Emacs by having an full, turing-complete extension language which is incompatible with everything else. In fact, it's even closer to ITS Emacs than GNU Emacs is, because Mint (Freemacs' extension language) is absolutely illegible without weeks of study, much like TECO. To get Freemacs see question 123. * MicroEmacs MicroEmacs is a descendant of Microemacs {originally by Dave Conroy?}. It is programmable in a BASIC-like language. Many of the keybindings are different from GNU Emacs. The author is Daniel Lawrence - . The latest version is 3.12 ! and it is available via anonymous FTP: /midas.mgmt.purdue.edu:dist/uemacs312/ (outside business hours) ! ! Version 3.12 includes Windows and Windows NT versions and a DOS ! protected mode (DMPI) version. ! * JOVE Another Emacs for small machines is JOVE (Jonathan's Own Version of Emacs). The latest official version is 4.14. There appears to be a newer version. People rumored to be working on JOVE include Mark Moraes and Bill Marsh . It is available via anonymous FTP: /cs.toronto.edu:/pub/moraes/jove4.14.7.tar.Z * MG MG is another descendant of Microemacs. MG used to stand for MicroGNUEmacs, but now just stands for MG. The look-and-feel of MG is intended to be close to that of GNU Emacs. It is rumored that MG can not correctly edit files larger than memory. The current version is rumored to be 2. There is a version 3 in beta which works on the Amiga. It is also available via anonymous FTP: /ftp.white.toronto.edu:pub/mg/ /wuarchive.wustl.edu:/mirrors/unix-c/editors/ /procyon.cis.ksu.edu: (source and executable) 97: Where can I get Emacs for my PC running Windows? I believe that no version of GNU Emacs runs under Windows. Pierre Perret has ported MicroEMACS 3.11c to Windows. Anonymous FTP: /ftp.cica.indiana.edu:pub/pc/win3/util/mewin10.zip /ftp.cica.indiana.edu:pub/pc/win3/util/mewin10s.zip /ftp.cica.indiana.edu:pub/pc/win3/util/mewri.zip 98: Where can I get Emacs for my PC running OS/2? From the OS/2 Programmer's FAQ: GNU Emacs 18.58 is available. It requires you to have EMX installed on your machine, but it comes with all the EMX files you will need. Emacs is available on ftp-os2 in /pub/os2/2.0/gnu/emacs. (If you want to recompile emacs, you will need the full EMX distribution see question 1.2.) The above quote may be out of date. See the latest OS/2 Programmer's FAQ {perhaps in comp.os.os2.misc?} for the latest news. Anonymous FTP info: /ftp-os2.nmsu.edu:pub/os2/2.0/gnu/emacs/ ("ftp-os2" was formerly named "hobbes") Thanks go to Stephen Simpson , Jonathan Miller , Terry Kane , J. D. Baldwin , and Ken Bass . 99: Where can I get Emacs for my Atari ST? Emacs 18.57 is the latest version for TOS. Stefan Mueller-Pfeiffer says: There is also a version for MiNT, the multitasking enhancement for ATARI's TOS, which behaves almost like EMACS on a "real computer". This port was done by Erling Henanger . Anonymous FTP: /atari.archive.umich.edu:atari/gnustuff/tos/ (TOS Emacs 18.57) /atari.archive.umich.edu:atari/new/mntemacs.zoo (MiNT Emacs) /cs.uni-sb.de:/pub/atari/emacs/ 100: Where can I get Emacs for my Amiga? All of the files are lharc-ed. Anonymous FTP: /oes.orst.edu:/pub/almanac/comp/amiga/software/gnuemacs-1.10/ Via e-mail: To: almanac@oes.orst.edu body: mode uuencode send computer amiga software gnuemacs is replaced by one of the following: Required: d1.lzh d2.lzh Recommended: d3_info.lzh d3_infolisp.lzh Optional: d3_autoloaded.lzh d3_entertainmentetc.lzh d3_entertainmentlisp.lzh d4_src.lzh d5_languagelisp.lzh d5_viclone.lzh d6_gnulibsrc.lzh d6_mailpackage.lzh d6_mathpackage.lzh d6_misc.lzh d6_textformat.lzh The `d#' at the beginning of each file is its disk number, which is referred to by the documentation. 101: 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. 102: Where can I get Emacs with NeWS support? Chris Maio's NeWS support package for GNU Emacs is available via anonymous FTP: /columbia.edu:pub/ps-emacs.tar.Z /archive.cis.ohio-state.edu:pub/gnu/emacs/ps-emacs.tar.Z and via e-mail: To: archive-server@columbia.edu body: send NeWS emacs-support 103: Where do I get Emacs that runs on VMS under DECwindows? Hal R. Brand is said to have a VMS save set with a ready-to-run VMS version of Emacs 18.55 for X Windows. It is available via anonymous FTP (addvax.llnl.gov). It is possible that the VMS versions of Emacs at other sites have X support compiled in. See etc/FTP for locations. Johan Vromans writes: Getting Emacs to run on VMS with DECwindows requires a number of changes to the sources. Fortunately this has been done already. Joshua Marantz did most of the work for Emacs 18.52, and the mods were ported to 18.55 by Johan Vromans . Also included is the handling of DEC's LK201 keyboard. You need to apply the changes to a fresh Emacs 18.55 distribution on a Unix system, and then you can copy the sources to VMS to perform the compile/link/build. The set of changes have been posted a number of times three times the last 12 months, so they should be widely available. Richard Levitte tells us that there are patches for Emacs 18.57, 18.58, and 18.59 available via e-mail: ! To: EMACS-FILESERV@e.kth.se ! body: SEND EMACS-1857-PATCHES or: SEND EMACS-1858-PATCHES or: SEND EMACS-1859-PATCHES + + or via anonymous ftp at: + + /lucy.merrimack.edu:emacs-1859-patches.share + + The set of patches weighs in at around 2.7 MB. + 104: Where can I get modes for Lex, Yacc/Bison, Bourne Shell, Csh, C++, Objective C, Pascal, Awk? As usual, look in the Lisp Code Directory (see question 88). For C++, if you use lisp-dir-apropos, you must specify the pattern like this: M-x lisp-dir-apropos RET c\+\+ RET 105: 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') hname 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 tell me. Having its own mailing list or newsgroup or more than half a megabyte of source code are good signs. 106: VM (View Mail) -- another mail reader within Emacs Author: Kyle Jones Latest released version: 4.41 Beta test version: 5.32 Anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/vm-4.41.tar.Z /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/as-is/timer.shar.Z /ftp.uu.net:mail/vm-4.41.tar.Z /ftp.uu.net:mail/vm-5.32beta.tar.Z Newsgroups and mailing lists: Info-VM: gnu.emacs.vm.info info-vm-request@uunet.uu.net (for subscriptions) info-vm@uunet.uu.net (for submissions) Bug-VM: gnu.emacs.vm.bug bug-vm-request@uunet.uu.net (for subscriptions) bug-vm@uunet.uu.net (for submissions) 107: Supercite -- mail and news citation package within Emacs Author: Barry Warsaw Mailing list: supercite-request@anthem.nlm.nih.gov (for subscriptions) supercite@anthem.nlm.nih.gov (for submissions) Latest version: 2.3 ! Anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/sc-2.3.tar.Z ! /ftp.cme.nist.gov:pub/gnu/sc2.3.tar.Z ! Via e-mail: To: library@cme.nist.gov Subject: help NOTE: Superyank is an old version of Supercite. 108: GNUS -- news reader within Emacs Author: Masanobu Umeda Latest official version: 3.13 Unofficial test version: 3.14.1 Anonymous FTP: /aun.uninett.no:pub/gnus-3.14.1.tar.Z - /wnoc-fuk.wide.ad.jp:pub/GNU/etc/gnus-3.14.1.tar.Z /liasun3.epfl.ch:pub/gnu/emacs/gnus-3.14.1.tar.Z /aix370.rrz.uni-koeln.de:/pub/gnu/emacs/gnus-3.14.1.tar.Z /funet.fi:/networking/news/gnus-3.14.1.tar.Z /src.doc.ic.ac.uk:/gnu/EmacsBits/gnus/gnus-3.14.1.tar.Z /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/gnus-3.13.tar.Z Newsgroups and mailing lists: English-only: gnu.emacs.gnus 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) 109: Calc -- poor man's Mathematica within Emacs Author: Dave Gillespie Latest released version: 2.02 Anonymous FTP: /csvax.cs.caltech.edu:pub/calc-2.02.tar.Z /prep.ai.mit.edu:pub/gnu/calc-2.02.tar.Z NOTE: Unlike Wolfram Research, Dave has never threatened to sue anyone for having a program with a similar command language to Calc. :-) 110: Calendar/Diary -- calendar manager within Emacs Author: Edward M. Reingold Latest version: 4.02 Anonymous FTP: /emr.cs.uiuc.edu:pub/emacs/calendar {???} Via e-mail: To: reingold@cs.uiuc.edu Subject: send-emacs-cal Put your best internet e-mail address in the body. 111: Ange-FTP -- transparent FTP access for Emacs's file access routines Author: Andy Norman Latest official version: 4.20 Anonymous FTP: /alpha.gnu.ai.mit.edu:ange-ftp/ange-ftp.tar.Z /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/ange-ftp.tar.Z /ugle.unit.no:pub/gnu/emacs-lisp/ange-ftp.tar.Z Mailing lists: ange-ftp-lovers-request@anorman.hpl.hp.com (for subscriptions) Ange-FTP Lovers: 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 with support for accessing VMS, CMS, and MTS systems 112: VIP -- vi emulation for Emacs Author: Aamod Sane Latest released 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. 113: Dired -- better directory editor for Emacs Author: Sebastian Kremer Latest released version: 5.239 Anonymous FTP: /ftp.cs.buffalo.edu:pub/Emacs/diredall.tar.Z /ftp.uni-koeln.de:pub/gnu/emacs/diredall.tar.Z NOTE: This is a huge improvement over the Dired distributed with Emacs. This version will be in Emacs 19. 114: AUC TeX -- enhanced LaTeX mode with debugging facilities Author: Kresten Krab Thorup Latest released version: 6.1 {???} Anonymous FTP: /iesd.auc.dk:pub/emacs-lisp/auctex_6_1d.tar.Z /iesd.auc.dk:pub/emacs-lisp/auctex.tar.Z 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) 115: Hyperbole -- extensible hypertext management system within Emacs Author: Bob Weiner Anonymous FTP: /wilma.cs.brown.edu:pub/hyperbole/ h*.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. 116: Byte Compiler -- enhanced version of Emacs's byte compiler Author: Jamie Zawinski , Hallvard B. Furuseth Anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/bytecomp.tar.Z /ftp.uu.net:languages/elisp/packages/bytecomp.tar.Z /src.doc.ic.ac.uk:gnu/EmacsBits/elisp-archive/packages/bytecomp.tar.Z 117: comint -- hugely enhanced shell mode and other derived modes Author: Olin Shivers Anonymous FTP: /cs.cmu.edu:/afs/cs.cmu.edu/user/shivers/lib/emacs/ {comint,cmu{tex,shell,scheme,lisp},ml}.el (anonymous password must contain `@', cannot cd to intermediate directories) 118: BBDB -- personal info rolodex integrated with mail/news readers Author: Jamie Zawinski Latest released version: 1.47 Anonymous FTP: /archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/bbdb.tar.Z Mailing list: info-bbdb-request@lucid.com (for subscriptions) info-bbdb@lucid.com bbdb-announce-request@lucid.com (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. 119: Ispell -- spell checker in C with interface for Emacs Author: Geoff Kuenning Latest released version: 2.0.02 Beta test version: 3.0 (9 patches) Anonymous FTP: /archive.cis.ohio-state.edu:/pub/gnu/ispell/ (version 2.0.02) /ftp.cs.ucla.edu:/pub/ispell/ (version 3.0, patches, dictionaries) /argus.math.orst.edu:pub/ispell/ (version 3.0, patches, dictionaries) /ftp.th-darmstadt.de:pub/dicts/ispell/ (mirror of argus) NOTE: Do not send mail to Geoff asking him to send you the latest version of Ispell. He does not have free e-mail. 120: Epoch -- enhanced GNU Emacs with better X interface Latest released version: 4.2 Anonymous FTP: /cs.uiuc.edu:pub/epoch-files/epoch/epoch-4.2.tar.Z /cs.uiuc.edu:pub/epoch-files/epoch/epoch-diff-4.1-4.2.tar.Z /src.doc.ic.ac.uk:gnu/epoch/ /aix370.rrz.uni-koeln.de:gnu/emacs/epoch/ Newsgroup and mailing lists: Epoch: gnu.emacs.epoch epoch-request@cs.uiuc.edu (for subscriptions) epoch@cs.uiuc.edu (for submissions) Epoch-Design: epoch-design-request@cs.uiuc.edu (for subscriptions) epoch-design@cs.uiuc.edu (for submissions) FAQ list: Maintainer: Marc Andreessen Anonymous FTP: /rtfm.mit.edu:pub/usenet/news.answers/epoch-faq /ftp.ncsa.uiuc.edu:outgoing/marca/epoch/Epoch.FAQ 121: Lucid GNU Emacs -- alternative Emacs 19 with better X interface Primary Maintainer: Jamie Zawinski Other Developers: Eric Benson Matthieu Devin Harlan Sexton Latest released version: 19.6 ! Anonymous FTP: /labrea.stanford.edu:pub/gnu/lucid/lemacs-19.6.tar.Z (source) ! /labrea.stanford.edu:pub/gnu/lucid/lemacs-19.6-sun4.tar.Z (Sun4binaries) ! Newsgroup and mailing lists: Bugs: alt.lucid-emacs.bug + bug-lucid-emacs-request@lucid.com (for subscriptions) bug-lucid-emacs@lucid.com (for submissions) Help: alt.lucid-emacs.help + help-lucid-emacs-request@lucid.com (for subscriptions) help-lucid-emacs@lucid.com (for submissions) 122: Demacs -- GNU Emacs altered to run on MS-DOS on 386/486 machines Authors: Manabu Higashida HIRANO Satoshi Latest released version: 1.2.0 Anonymous FTP: /utsun.s.u-tokyo.ac.jp:GNU/demacs/ (nearest to U.S.A.) /ftp.sigmath.osaka-u.ac.jp:pub/Msdos/Demacs/ /wnoc-fuk.wide.ad.jp:pub/msdos/Demacs/ /ftp.3com.com:pub/gnu/msdos/demacs/ /mindseye.berkeley.edu:pub/kanji/demacs/ /ftp.hawaii.edu:pub/editors/demacs.tar.Z /ftp.math.ksu.edu:pub/pc/demacs/ /wsmr-simtel20.army.mil:pd1: {ange-ftp syntax?} /ftp.uni-koeln.de:msdos/gnuprogs/dem120e.zip (executables, lisp-code, doc) (PLEASE USE ONLY OUTSIDE WORKING HOURS!) /ftp.uni-koeln.de:msdos/gnuprogs/dem120s.zip (sources, diffs) (PLEASE USE ONLY OUTSIDE WORKING HOURS!) /ftp.lysator.liu.se:pub/msdos/gnu/emacs/ /mizar.docs.uu.se:pub/gnu/demacs/ /iamsun.unibe.ch:PC/demacs/ /flop.informatik.tu-muenchen.de:outgoing/demacs.tar /ftp.funet.fi:pub/gnu/emacs/demacs/ /garbo.uwasa.fi:pc/editor/dem120e.zip /garbo.uwasa.fi:pc/editor/dem120s.zip /ftp.win.tue.nl:pub/gnu/demacs/ /ugle.unit.no:pub/gnu/Demacs/ {Does anyone know which sites have the Kanji version?} Via e-mail: From garbo.uwasa.fi: To: mailserv@garbo.uwasa.fi Subject: garbo-request Body: send pc/editor/dem120e.zip send pc/editor/dem120s.zip quit Downloading: EXEC-PC (Milwaukee, WI) 414-789-4210 (2400 bps) in the Mahoney MS-DOS file area in its Editors/wordprocessors library (F), named GNUEMACS.ZIP Channel 1 (Cambridge, MA) 617-345-8873 (9600 bps) in the New Uploads file area, named GNUEMACS.ZIP NOTE: Use the -d option of [pk]unzip for all .zip archives. Some sites have Demacs lharc'ed. If you need to find programs to unpack lharc and zip format archives, Chris Dean points out that you should see the comp.compression FAQ, available for FTP: /rtfm.mit.edu:pub/usenet/comp.compression/ Mailing list: NOTE: There is no mailing list for Demacs. However, there is a list for DJGPP, which is the environment that Demacs runs in. Many Demacs problems are actually issues with DJGPP. DJGPP: Subscriptions: To: listserv@sun.soe.clarkson.edu body: add djgpp or put `help' in the body. If this fails, mail to djgpp-request@sun.soe.clarkson.edu. Submissions: djgpp@sun.soe.clarkson.edu FAQ list: Maintainer: Dave Steibel Anonymous FTP: algol.cs.umbc.edu:pub/demacs/demacs.faq 123: Freemacs -- a small Emacs for MS-DOS Author: Russ Nelson Latest released version: 1.6a Anonymous FTP: /simtel20.army.mil:PD: {ange-ftp syntax?} /grape.ecs.clarkson.edu:pub/msdos/freemacs/ Via e-mail: To: archive-server@sun.soe.clarkson.edu body: help Via snail mail: address: Russell Nelson, 11 Grant St., Potsdam, NY 13676 Send $15 copying fee, and specify preferred floppy disk format: 5.25", 360K, or 3.50", 720K Mailing lists: Subscriptions: To: listserv@sun.soe.clarkson.edu body: add or put `help' in the body. List distribution addresses: freemacs-announce@sun.soe.clarkson.edu freemacs-help@sun.soe.clarkson.edu freemacs-workers@sun.soe.clarkson.edu (send bug reports here) 124: Patch -- program to apply "diffs" for updating files Author: Larry Wall Latest version: 2.0 patchlevel 12u8 (This is the version that supports the new unified diff format.) Anonymous FTP: /prep.ai.mit.edu:pub/gnu/patch-2.0.12u8.tar.Z /prep.ai.mit.edu:pub/gnu/patch-2.0.12g8.tar.Z (GNU version) GNU Emacs FAQ: Keybindings/Output 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. A `+' in the 78th column means something was inserted on the line. A `-' means something was deleted and a `!' means some combination of insertions and deletions occurred. Full instructions for getting the latest FAQ are in question 22. Also see the `Introduction to news.answers' posting in the `news.answers' newsgroup, or send e-mail to `mail-server@rtfm.mit.edu' with `help' on a body line, or use FTP, WAIS, or Prospero to rtfm.mit.edu. Changing Key Bindings and Handling Key Binding Problems 125: How do I bind keys (including function keys) to commands? 1. Find out what character sequence is generated by the keystroke sequence you wish to bind to a command. See question 129 for how to do this. Keep in mind that the character sequences generated by a keystroke sequence varies from one terminal to another. You may also get different results depending on what type of machine you are running on (see question 128). For example, these keystrokes may generate these character sequences: F1 ---> ESC [ 2 2 4 z Shift-R10 ---> ESC O t L7 ---> ESC [ 3 1 ~ Remove ---> C-@ 2. Figure out what the Emacs Lisp syntax is for this character sequence. Inside an Emacs Lisp string, RET, LFD, DEL, ESC, SPC, and TAB are specified with `\r', `\n', `\C-?', `\e', ` ', and `\t'. C-x is specified by `\C-x'. M-x is specified the same was as "ESC x". (Control characters may also be specified as themselves, but I don't recommend it.) An Emacs Lisp string begins and ends with the double quote character, `"'. Here are some examples: ESC [ D ---> "\e[D" ESC [ 2 2 7 z ---> "\e[227z" ESC [ 1 8 ~ ---> "\e[18~" C-M-r ---> "\e\C-r" 3. If some prefix of the character sequence is already bound, you must unbind it by binding it to `nil'. For example: (global-set-key "\e[" nil) 4. Pick a command to bind your key sequence to. A command can be a "symbol" with a function definition, or a "lambda list", or a string (which is treated as a macro). For example: (global-set-key "\e[D" 'backward-char) (global-set-key "\e[227~" "\exgoto-line\r") ; macro See `Key Bindings' and `Rebinding' in the online manual. In Emacs 19 (including Lucid Emacs), you can bind function key F24 like this: (global-set-key 'f24 'some-command) 126: Why does Emacs say `Key sequence XXX uses invalid prefix characters'? A prefix of the character sequence you were trying to bind was already bound. Usually, the sequence is "ESC [", in which case you should evaluate this form first: (define-key esc-map "[" nil) NOTE: By default, "ESC [" is bound to backward-paragraph, and if you do this you will lose this key binding. For most people, this is not a problem. See question 125. 127: Why doesn't this [terminal or window-system setup] code work in my .emacs file, but it works just fine after Emacs starts up? This is because you're trying to do something in your .emacs file that needs to be postponed until after the terminal/window-system setup code is loaded. This is a result of the order in which things are done during the startup of Emacs. For more details see question 135. In order to postpone the execution of Emacs Lisp code until after the terminal/window-system setup, set the value of the variable term-setup-hook or window-setup-hook to be a function which does what you want. See etc/OPTIONS for a complete explanation of what Emacs does every time it is started. Here is a simple example of how to set term-setup-hook: (setq term-setup-hook (function (lambda () (cond ((string-match "\\`vt220" (or (getenv "TERM") "")) ;; Make vt220's "Do" key behave like M-x: (define-key CSI-map "29~" 'execute-extended-command)) )))) 128: How do I use function keys under X Windows? This depends on whether you are running Emacs inside a terminal emulator window, or whether you are allowing Emacs to create its own X window. You can tell which you are doing by noticing whether Emacs creates a new window when you start it. If you are running Emacs inside a terminal emulator window, then it behaves exactly as it does on any other tty. In this case, for function keys to be useful, they must generate character sequences that are sent to the programs running inside the window as input. The `xterm' program has two different sets of character sequences that it generates when function keys are pressed, depending on the sunFunctionKeys X resource and the -sf and +sf command line options. (To find out what these key sequences are, see question 129.) In addition, with xterm, you can override what key sequence a specific function key (or any other key) will generate with the `translations' resource. This, for example: XTerm.VT100.Translations: #override \ F1: string(0x1b) string("[xyzzy") makes the function key F1 generate the character sequence "ESC [xyzzy". On the other hand, if Emacs is managing its own X window, the following description applies. Emacs receives `KeyPress' events from the X server when a key is pressed while the keyboard focus is in its window. The KeyPress event contains an X "keysym" code, which is simply an arbitrary number corresponding to the name of the keysym, and information on which "modifiers" such as `control' and `shift' are active. For example, the `Tab' keysym is 0xff09. (Generally, a key on the keyboard will generate a keysym whose name is the same as the label on the key, ie. the `Tab' key will normally generate the `Tab' keysym. This can be changed with the xmodmap program.) Emacs recognizes all the keysyms that correspond to standard ASCII characters and internally uses the ASCII character instead. (WARNING: I am about to describe a gross, disgusting hack to you, have your barf bag ready.) When Emacs receives the X keysym of one of the arrow keys, it behaves the same as if it had received a letter key with the control modifier down as follows (this is hard-coded): Up becomes C-p Down becomes C-n Right becomes C-f Left becomes C-b The way Emacs treats other keysyms depends on what kind of machine it was compiled on. The type of the display machine is irrelevant! Function keys are mapped internally to escape sequences, while other keys are completely ignored. 1. If compiled on a Sun, Emacs recognizes these X keysyms that are normally on a Sun keyboard: F1 through F9 L1 through L10 (same as F11 through F20) R1 through R15 (same as F21 through F35) (The keys labelled R8, R10, R12, and R14 usually are mapped to the X keysyms Up, Left, Right, and Down.) Break (the `Alternate' key is given this keysym) These keys work like Sun function keys. When Emacs receives the keysym, it will internally use character sequences that look like "ESC [ ### z", where ### is replaced by a number. The character sequences are identical to those generated by Sun's keyboard under SunView. Any function key not listed above generates "ESC [ - 1 z". In order to use these key sequences, they should be bound to commands using the standard key binding methods, just as if Emacs were running on a regular terminal. WARNING: F11 and L1 are the same keysym in X, as are F12 and L2, etc. {Yes, this is stupid. Complain to the X consortium.} 2. If not compiled on a Sun, the function keys will appear to Emacs in a way remarkably similar to the keys of a DEC LK201 keyboard (used on some VT series terminals). These X keysyms will be recognized: F1 through F20 Help (treated same as F15) Menu (treated same as F16, is the LK201 `Do' key) Find Insert (LK201 `Insert Here' key) Select Prior (LK201 `Prev Screen' key *** ONLY IN 18.58 AND LATER ***) Next (LK201 `Next Screen' key *** ONLY IN 18.58 AND LATER ***) And finally, the LK201 key labelled `Remove' (or `Delete') is often mapped to the Delete keysym which generates the DEL character (C-?) instead of the key sequence given by the LK201 `Remove' key. It may also be mapped to some other keysym, such as `_Remove', in which case you can't use it from within Emacs at all. Each function key will be internally converted to a character sequence that looks like "ESC [ ## ~", where ## is replaced by a number. The character sequences are identical to those generated by a LK201 keyboard. Any function key not listed above generates "ESC [ - 1 ~". For the complete list of the numbers which are generated by the function keys, look in the file src/x11term.c at the definitions of the function stringFuncVal. If you are running Emacs on a Sun machine, even if your X display is running on a non-Sun machine (eg., an X terminal), you get the setup described above for Suns. The determining factor is what type of machine Emacs is running (was compiled) on, not what type of machine your X display is on. If you have function keys not listed above on your keyboard, you can use `xmodmap' to change their keysym assignments to get keys that Emacs will recognize, but that may screw up other programs. X resources are not used by Emacs to affect the key sequences generated. In particular, there are no X key "translations" for Emacs. If you have function keys not listed above and you don't want to use xmodmap to change their names, you might want to make a modification to your Emacs. Johan Vromans has made available a patch for Emacs that adds the x-rebind-key function of Epoch to Emacs 18.58. This allows another layer of key rebinding before Emacs even sees the keys, and in this layer you can rebind all of the keys and modifier combinations as well. Anonymous FTP: /ftp.eu.net:gnu/emacs/FP-Xfun.Z /ftp.urc.tue.nl:pub/tex/emacs/FP-Xfun Johan Vromans explains what this buys for you: After implementing this, all keyboard keys can be configured to send user definable sequences, eg., (x-rebind-key "KP_F1" 0 "\033OP") This will have the keypad key PF1 send the sequence "ESC O P", just like an ordinary VT series terminal. 129: How do I tell what characters my function or arrow keys emit? Use this function by Randal L. Schwartz : (defun see-chars () "Displays characters typed, terminated by a 3-second timeout." (interactive) (let ((chars "") (inhibit-quit t)) (message "Enter characters, terminated by 3-second timeout.") (while (not (sit-for 3)) (setq chars (concat chars (list (read-char))) quit-flag nil)) ; quit-flag maybe set by C-g (message "Characters entered: %s" (key-description chars)))) Alternatively, use the "C-h l" view-lossage command, which will display the last 100 characters Emacs has seen in its input stream. Kevin Gallagher suggests typing some unique string like "wxyz", typing the key in question, then typing "C-h l". The characters that appear between "wxyz" and "C-h l" were generated by the key. 130: 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). 131: 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 what is 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. I don't know 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 this form: (set-input-mode nil t) 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 unclear. I don't know if this has any effect when used in lisp/site-init.el when building Emacs; I've never tried that. {Can someone tell me whether it works?} Putting things in users' .emacs files has a number of problems. 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). A possible solution is to initially disable C-s and C-q by setting keyboard-translate-table in lisp/site-init.el, either with swap-keys (see question 136) or with the following form: ;; by Roger Crew : (setq keyboard-translate-table "\C-@\C-a\C-b\C-c\C-d\C-e\C-f\C-g\C-h\C-i\C-j\C-k\C-l\C-m\C-n\C-o\C-p\C-^\C-r\C-\\\C-t\C-u\C-v\C-w\C-x\C-y\C-z\C-[\C-s\C-]\C-q\C-_") This will at least prevent Emacs from being confused by the flow control characters, even if lisp/default.el cannot be loaded. Then, in lisp/default.el, enable XON/XOFF flow control with set-input-mode. For further discussion of this issue, read the file PROBLEMS in the Emacs distribution. 132: How do I use commands bound to C-s and C-q (or any key) if these keys are filtered out? I suggest swapping C-s with C-\ and C-q with C-^: (swap-keys ?\C-s ?\C-\\) (swap-keys ?\C-q ?\C-^) See question 136 for the implementation of swap-keys. This method has the advantage that it simultaneously swaps the characters everywhere throughout Emacs, while just switching the keybindings will miss important places where the character codes are stored (eg., the search-repeat-char variable, major mode keymaps, etc.). To do this for an entire site, you may want to swap the keys in lisp/default.el. If only some of your users are connecting through XON/XOFF flow-controlled connections, you will want to do this conditionally. I suggest pre-swapping them in lisp/site-init.el when Emacs is built, and then in lisp/default.el, if it is determined to be safe, they can be reenabled (being careful not to screw up any other key mappings users might have established using keyboard-translate-table). See question 131 for an easy way to pre-swap these keys. WARNING: 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. 133: Why does the `BackSpace' key invoke help? The BackSpace key (on every keyboard I've used) 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. * Under X Windows, the easiest solution is to change the BackSpace key into a Delete key like this: xmodmap -e "keysym BackSpace = Delete" * Some terminals (eg., 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: (swap-keys ?\C-h ?\C-?) See question 136 for the implementation of swap-keys. * Another approach is to switch keybindings and put help on "C-x h" instead: (global-set-key "\C-h" 'delete-backward-char) (global-set-key "\C-xh" 'help-command) ; override mark-whole-buffer Other popular key bindings for help are M-? and "C-x ?". WARNING: Don't try to bind DEL to help-command, because there are many modes that have local bindings of DEL that will interfere. 134: Why doesn't Emacs look at the stty settings for Backspace vs. Delete? Good question! 135: Why don't the arrow keys work? When Emacs starts up, it doesn't know anything about arrow keys at all (except when running under X, see question 128). During the process of starting up, Emacs will load a terminal-specific initialization file for your terminal type (as determined by the environment variable TERM), if one exists. This file has the responsibility for enabling the arrow keys. There are several things that can go wrong: 1. There is no initialization file for your terminal. You can determine this by looking in the lisp/term directory. If your terminal type (as determined by the TERM environment variable) is xxx-yy-z, then the first of these files in the lisp/term directory will be loaded as the terminal-specific initialization file: xxx-yy-z.el, xxx-yy.el, or xxx.el. There are two major cases of this problem: * Your terminal type is very similar to one that has an init file. In this case, there are several techniques suggested by Colin Jensen , Ben Liblit , and Marc Auslander : A. Add a symbolic link in lisp/term for your terminal type that points to the similar type. For example, you could make VT102 terminals work with this command: ln -s vt100.el vt102.el This fixes things for everyone on the system who uses the terminal type. B. If you can't do the solution in part A, you can add code to your term-setup-hook that loads the correct file like this: (setq term-setup-hook (function (lambda () (cond ((equal "vt102" (or (getenv "TERM") "")) (load (concat term-file-prefix "vt100"))) (;; Code for other terminal types goes here ... ))))) C. If you use `tset' to set your TERM environment variable when you login, you can use the `-m' switch to tell tset to use a terminal type known by Emacs instead of another similar one. For example, specifying this: tset ... -m 'dec-vt220:vt220' ... will make tset say you are on a `vt220' instead of a `dec-vt220'. D. Interactively, you can type "M-x load-library RET term/vt100" to load the terminal-specific initialization files for VT100 terminals. * Your terminal type is not similar to one that has an init file. One can be made for your terminal, or you can just add code to your own .emacs to handle this problem for yourself. For example, if your terminal's arrow keys send these character sequences: Up: ESC [ A Down: ESC [ B Right: ESC [ C Left: ESC [ D then you can bind these keys to the appropriate commands with code in your .emacs like this: (setq term-setup-hook (function (lambda () (cond ((string-match "\\`xyzzy" (or (getenv "TERM") "")) ;; First, must unmap the binding for left bracket (or (keymapp (lookup-key global-map "\e\[")) (define-key global-map "\e\[" nil)) ;; Enable terminal type xyzzy's arrow keys: (define-key global-map "\e\[A" 'previous-line) (define-key global-map "\e\[B" 'next-line) (define-key global-map "\e\[C" 'forward-char) (define-key global-map "\e\[D" 'backward-char)) ((string-match "\\`abcde" (or (getenv "TERM") "")) ;; Do something different for terminal type abcde ;; ..... ))))) NOTE: You may have to restart Emacs to get changes to take effect. NOTE: Your arrow keys may send sequences beginning with "ESC O" when Emacs is running, even if they send sequences beginning with "ESC [" at all other times. This is because Emacs uses any command there may be in your terminal's termcap entry for putting the terminal into "Application Keypad Mode". Just map these sequences the same way as above. The next two cases are problems even if there is a initialization file for your terminal type. 2. The initialization file for your terminal doesn't bind arrow keys. If your terminal type is `xterm', you will have to bind the arrow keys as in part 1 above, since the xterm.el file doesn't do anything useful. There may be other terminal types with the same problem. 3. Your terminal's arrow keys send individual control characters. For example, the arrow keys on an ADM-3 send C-h, C-j, C-k, and C-l. There is not much Emacs can do in this situation, since all the control characters except for C-^ and C-\ are already used as Emacs commands. It may be possible to convince the terminal to send something else when you press the arrow keys; it is worth investigating. You have to make the hard choices of how to rebind keys to commands to make things work the way you want. Another alternative is to start learning the standard Emacs keybindings for moving point around: C-b, C-f, C-p, and C-n. Personally, I no longer use the arrow keys when editing because I have switched keyboards so many times. 4. Your terminal's arrow keys send sequences beginning with "ESC [". Due to an extremely poor design decision (ie., these sequences are ANSI standard), none of the the terminal-specific initialization files that are distributed with Emacs will bind these character sequences to the appropriate commands by default. (This also applies to any other function keys which generate character sequences starting with "ESC [".) This is because it was deemed far more important to preserve the binding of M-[ to the backward-paragraph command. It appears that this will change in Emacs 19. Some of the terminal-specific initialization files that come with Emacs provide a command enable-arrow-keys that will fix this problem. To get this automatically invoked, put this in your .emacs: (setq term-setup-hook (function (lambda () (if (fboundp 'enable-arrow-keys) (enable-arrow-keys))))) We put this in our lisp/default.el file, so users don't have to worry about it: ;; don't override a user's term-setup-hook (or term-setup-hook (setq term-setup-hook (function (lambda () (and (fboundp 'enable-arrow-keys) ;; don't override a user key mapping (eq 'backward-paragraph (lookup-key esc-map "[")) (enable-arrow-keys)))))) If your terminal type is `sun', you should put this in your .emacs instead (or in addition to the above): (setq sun-esc-bracket t) It is possible that the terminal-specific initialization file for your terminal type was written locally and does not follow the rule mentioned above. In this case you may need to inspect it to find out how to enable the arrow keys. (Actually, if it was written locally, it probably enables the arrow keys by default.) 136: How do I "swap" two keys? When Emacs receives a character, you can make Emacs behave as though it received another character by setting the value of keyboard-translate-table. The following Emacs Lisp will do this for you, allowing you to "swap" keys. After arranging for this Lisp to be evaluated by Emacs, you can evaluate `(swap-keys ?A ?B)' to swap A and B. (defun swap-keys (key1 key2) "Swap keys KEY1 and KEY2 using map-key." (map-key key1 key2) (map-key key2 key1)) (defun map-key (from to) "Make key FROM behave as though key TO was typed instead." (setq keyboard-translate-table (concat keyboard-translate-table (let* ((i (length keyboard-translate-table)) (j from) (k i) (str (make-string (max 0 (- j (1- i))) ?X))) (while (<= k j) (aset str (- k i) k) (setq k (1+ k))) str))) (aset keyboard-translate-table from to) (let ((i (1- (length keyboard-translate-table)))) (while (and (>= i 0) (eq (aref keyboard-translate-table i) i)) (setq i (1- i))) (setq keyboard-translate-table (if (eq i -1) nil (substring keyboard-translate-table 0 (1+ i)))))) NOTE: You must evaluate the definition of these functions before calling them! For example, list the function definitions before their use in your .emacs file. NOTE: These functions take two numbers as arguments. The example above, `(swap-keys ?A ?B)' is actually `(swap-keys 65 66)', because `?A' is merely notation for 65, the ASCII value of `A'. NOTE: These functions only work for single characters. You cannot swap two multi-character sequences. 137: How do I produce C-XXX with my keyboard? For C-@ and C-^, often you can just type Control-2 and Control-6. For C-_, you may have to hold down the shift key, typing Control-Shift-Hyphen. C-@ can often be generated by typing Control-Space. C-@ is often called the NUL character, and has ASCII value 0. C-_ can often be generated by typing Control-7 or Control-/. C-? (aka DEL) may be generated by typing Shift-BackSpace or Control-BackSpace or a key labelled Delete or Del. Try Control with all of the digits on your keyboard to see what gets generated. 138: What if I don't have a Meta key? Instead of typing M-a, you can type "ESC a" instead. In fact, Emacs converts M-a internally into "ESC a" anyway (depending on the value of meta-prefix-char). 139: What if I don't have an Escape key? Type C-[ instead. This should send ASCII code 27 just like an Escape key would. Try also C-;. 140: How do I type DEL on PC terminal emulators? Some IBM PC compatibles do not have a key labeled `Del' or `Delete' {is this true?}. Those that do generally have it in an inconvenient location. (Also, in some terminal emulators, the `Del' key does not transmit DEL.) The result is the standard "BackSpace invoking help" problem (see question 133). The usual solution, suggested by Michael Covington , is to somehow tell the terminal emulator program that BackSpace should transmit DEL. Read the program's manual. Shift-BackSpace or Control-BackSpace may send DEL. The `Del' key may only send DEL if the NumLock key hasn't been pressed. 141: 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 (this is what I do). 142: How do I bind a combination of modifier key and function key? Unless you're using Emacs under emacstool (or xvetool?), have a working version of x-rebind-key (see question 128), or are using Emacs 19 (Lucid Emacs), you can't do this with Emacs alone. If you are using emacstool, Emacs sees different character sequences for the combination of a modifier and a function key from what it sees for the function key alone. See etc/emacstool.1 for more information. Since Emacs sees different character sequences, you can bind these different sequences to different commands. If you are running Emacs inside a terminal emulator window like xterm, you can modify its translation tables to make it generate different character sequences for the combination of a modifier and a function key. For example, this X resource setting: XTerm.VT100.Translations: #override \ ShiftF1: string(0x1b) string("[xyzzy") makes Shift-F1 generate the character sequence "ESC [ xyzzy". You can bind these character sequences in Emacs as normal. Nick Ruprecht has written an extensive X translation mapping for xterm that does this. {Does this have an FTP site?} If you have x-rebind-key, you can have any arbitrary combination of modifiers with a key replaced by any sequence of "normal" characters. For example, this makes Shift-Return behave as though you had typed "C-x C-e" (example from Jerry Graves): (x-rebind-key "Return" 'shift "\C-x\C-e") In Emacs 19 (Lucid Emacs), you can bind Meta-Left-Arrow like this (example from Jamie Zawinski): (global-set-key '(meta left) 'backward-word) With the last two methods, use `xmodmap' and `xev' to discover the keysym and modifier names. 143: 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 X11R4: 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'. 144: 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. 145: Where can I get key bindings to make Emacs emulate WordStar? There is a package `wordstar' by Jim Frost and `ws-mode.el' by Juergen Nickelsen . Check in the Emacs Lisp Archive (see question 89). 146: Where can I get an XEDIT emulator for Emacs? This question comes up once every couple of months. I have never seen a positive reply, so I presume no one has ever written one. Using Emacs with Alternate Character Sets 147: How do I make Emacs display 8-bit characters? There is a patch called the `8-bit ctl-arrow patch' that allows Emacs to display characters with codes from 128 to 255. {The original appears to have been by Kenneth Cline .} Partially based on Johan Widen's earlier work, Johan Vromans has updated this patch for Emacs 18.58 along with some other 8-bit improvements. Anonymous FTP: /ftp.eu.net:gnu/emacs/FP-EightBit.Z /ftp.urc.tue.nl:/pub/tex/emacs/FP-EightBit /cs.purdue.edu:pub/ygz/cemacs.tar.Z:cemacs/8bit-patch-18.57 /sics.se:archive/emacs-18.55-8bit-diff /laas.laas.fr:pub/emacs/patch-8bit-18.55 /laas.laas.fr:pub/emacs/patch-8bit-18.57 Via e-mail: To: mail-server@sics.se body: send emacs-18.55-8bit-diff Anders Edenbrandt has produced a more comprehensive patch for Emacs 18.59 that allows for 8-bit input and output. Anonymous FTP: /ftp.efd.lth.se:pub/gnu/emacs_8-bit.patch In the words of the author: With these patches, Emacs becomes fully 8-bit operational. There is support for displaying 8-bit characters, as well as for entering such characters from the keyboard. In addition, upcase/lowcase translation is supported, accented characters are recognized as "letters" (important when doing 'forward-word', for example), and text with 8-bit characters can be sorted correctly. A Meta-shift key can still be used, provided that you run in an environment where it is possible to distinguish between a character entered using the Meta-shift key and one entered directly. The diffs include patches to make this work under SunView (with emacstool) as well as under X. If you can't use a Meta-shift key, you have to enter Meta-commands with the ESC-prefix. The most comprehensive patches for 8-bit output are by Howard Gayle (originally for Emacs 18.55. These patches allow displaying any arbitrary string for a given 8-bit character (except TAB and C-j). Also supported is defining the sorting order and the uppercase and lowercase translations. It is reported that the 8-bit character support in Emacs 19 is largely based on these patches. Thomas Bellman has updated these patches for Emacs 18.59. Anonymous FTP: /sics.se:archive/emacs-gayle.tar.Z (patches for 18.55) /ftp.lysator.liu.se:pub/emacs/gayle-18.58.diff.tar.Z (patches) /ftp.lysator.liu.se:pub/emacs/emacs-18.59-gayle.tar.Z (patched Emacs) Epoch's 8-bit character support is based on Anders Edenbrandt's patches. Lucid Emacs has the ctl-arrow patch installed. Nemacs displays 8-bit characters, and it may be useful for displaying the 8-bit ISO-8859 alphabet, but I don't know for sure (see question 149). 148: How do I input 8-bit characters? Minor modes for ISO Latin-1 that allow one to easily input this character set have been written by several people. Such modes have been written by Matthieu Herrb (laas.laas.fr:pub/emacs/iso-latin-1.el), Johan Vromans {FTP site??}, and Marc Shapiro {FTP site??}. These approaches differ from the one taken by Anders Edenbrandt in that his method uses direct 8-bit input, while these methods use a compose sequence for 8-bit characters. {I have heard conflicting reports on whether this results in losing the Meta key. Perhaps this depends on whether Emacs is running under X. Can someone resolve this?} Karl Heuer is said to have a patch to allow 8-bit input. Georg-Wilhelm Koltermann also has a patch for either 18.57 or 18.58 that allows 8-bit input. Epoch comes with a patch that allows it to input 8-bit characters, but it is not enabled by default. {Is this right?} Jamie Zawinski says: Lucid GNU Emacs allows the input of any ISO-8859/1 keysyms that your keyboard generates (see xmodmap), and contains a package that implements a DEC/OpenWindows-like "Compose" key for systems which don't have one. 149: 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 /miki.cs.titech.ac.jp:JAPAN/nemacs/nemacs-3.3.2.tar.Z 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 Window client. 150: 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: /crl.nmsu.edu:pub/chinese/cemacs.tar.Z /cs.purdue.edu:pub/ygz/cemacs.tar.Z Cxterm is available from the same place: /cs.purdue.edu:pub/ygz/cxterm-11.5.1.tar.Z 151: 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/msdos/ibelbe.zip /israel.nysernet.org:israel/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'. GNU Emacs FAQ: Mail and News This portion of the GNU Emacs FAQ list is cross-posted to `gnu.emacs.gnus' because many of the questions herein deal with GNUS. See `gnu.emacs.help' for the rest of the FAQ list. 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. A `+' in the 78th column means something was inserted on the line. A `-' means something was deleted and a `!' means some combination of insertions and deletions occurred. Full instructions for getting the latest FAQ are in question 22. Also see the `Introduction to news.answers' posting in the `news.answers' newsgroup, or send e-mail to `mail-server@rtfm.mit.edu' with `help' on a body line, or use FTP, WAIS, or Prospero to rtfm.mit.edu. Mail and News 152: How do I change the included text prefix in mail/news followups? Many people want Emacs to prefix included text with something like ` > ' instead of with three spaces. One way is to change the code of the function `mail-yank-original' in lisp/sendmail.el that prefixes with spaces. A more flexible solution is to use Supercite, which provides wide configurability in how you format included text in replies. See question 107. Both of these solutions work for RMAIL and GNUS. 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. 153: How do I save a copy of outgoing mail? Two methods: 1. (setq mail-self-blind t) will result in a `BCC:' header line with your address being added to mail composition buffers. This will cause the mail system to send a copy of the mail back to you. 2. (setq mail-archive-file-name (expand-file-name "~/outgoing")) will result in an `FCC:' header line with the pathname of ~/outgoing being added to mail composition buffers. When you send the mail, Emacs will save a copy of the mail in the file ~/outgoing and then strip off the `FCC:' line before actually sending. WARNING: There is a bug in Emacs 18.58 that prevents mail readers such as RMAIL from reading the saved mail messages individually. See question 155. WARNING: If you are visiting the file ~/outgoing at the time you send the mail, this can cause a variety of horrible problems. Jamie Zawinski has written a solution for this. It does not work to put `set record filename' in the .mailrc file. 154: 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. 155: Why does RMAIL think all my saved messages are one big message? There is a bug for FCC-ed messages in Emacs 18.58 where it adds a timezone on the "From " line after the year instead of before the year. (Before it didn't add the timezone at all.) This is incompatible with the standard format for the "From " line, and RMAIL in particular can no longer distinguish between the messages. Karl Berry , Felix Lee , Nick Gianniotis and many others have all posted patches for this. Karl's is the simplest and just stops Emacs from adding the timezone: >*** ./ORIG/sendmail.el Tue Jan 28 16:22:56 1992 >--- ./sendmail.el Thu May 14 18:23:48 1992 >*************** >*** 285,287 **** > (insert "\nFrom " (user-login-name) " " >! (current-time-string) " " timezone "\n") > (insert-buffer-substring rmailbuf) >--- 285,287 ---- > (insert "\nFrom " (user-login-name) " " >! (current-time-string) "\n") > (insert-buffer-substring rmailbuf) 156: How can I sort the messages in my RMAIL folder? Use rmailsort.el by Masanobu Umeda. 157: 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. 158: How do I recover my mail files after RMAIL munges their format? Users who just want to try RMAIL out to see how it works end up trapped using it because saved mail in their `mbox' file has been converted into an incompatible format (BABYL) that only RMAIL understands. RMAIL provides no obvious way to reverse this transformation. Kyle Jones has aptly named this "the great Emacs Mail Eating Monster". To convert a mail file back to standard Unix format, there are several methods: * Use the rmail-output ("C-o") command within RMAIL on each message in the file. First use M-x rmail or M-x rmail-input to visit the RMAIL file in Rmail mode. Type "1 j" to go to the first message. Use the C-o command to output the message to a Unix format file. Type "n" to go to the next message. Repeat. * If the file contains hundreds of messages, you may not want to repeat this for all of them. Instead of the above, after getting to the first message type this (where "mbox" is the file you want to put the messages in): C-x ( C-o mbox RET M-s ^From: RET M-0 C-x ) (The rmail-search command ("M-s") is used instead of just "n" because it is the only command which will cause an error when it reaches the last message in the file, which is necessary to terminate the keyboard macro. This will fail if there are messages in the file that don't have a `From:' header. This assumes rmail-delete-after-output is nil.) It is wise to save a copy of the RMAIL file first, in case you make a mistake. * There are software packages available for converting files or even entire directories of BABYL files to standard Unix format. These are helpful in this situation, but are intended mainly for people who have used RMAIL for a long time and are converting to some other mail reader. Lookup `rmail', `vm', and `babyl' in the Emacs Lisp Archive (see question 89). You may wish to disable RMAIL to avoid accidentally destroying your mbox file (I have this in my .emacs): (put 'rmail 'disabled t) ; avoid mbox destruction 159: How do I make Emacs automatically start my mail/news reader? Example: emacs -f gnus Also: alias gnus 'emacs -f 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. 160: How do I read news under Emacs? There are at least three news reading packages that operate inside Emacs. `rnews' comes with Emacs. GNUS and Gnews come separately. rnews will be replaced by GNUS in Emacs 19. rnews works only with a local news spool directory. Both GNUS and Gnews handle reading news remotely via NNTP in addition to reading from a local news spool. GNUS supports reading mail stored in MH folders or articles saved by GNUS. Gnews is styled after `rn' and seems to work like RMAIL. GNUS feels more like VM. People have complained that GNUS uses a lot of CPU time (it does). Some people have complained that Gnews is slower than GNUS. For more information about GNUS, see question 108. Gnews was written by Matthew P. Wiener . The latest version seems to be 2.0, posted October 3, 1988. Matthew posted some fixes on October 26, 1988. Gnews does not appear to have been supported after this date. In particular, it has been reported that Gnews does not work with Emacs 18.57. There is a newsgroup for Gnews called gnu.emacs.gnews. 161: Why does `rnews' say "No News is good news" when there is news? rnews doesn't speak NNTP. You may need to use GNUS or Gnews. 162: Why doesn't GNUS work anymore 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) I also have a patch for NNTP 1.5.10 by Mike Pelletier that is based on the timeout code that was in 1.5.9. However, please try to upgrade to 1.5.11 first. 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 (ie., `telnet server-machine 119'). The server should give its version number in the welcome message. Type `quit' to get out. 163: How do I view text with embedded underlining (eg., 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. 164: When I try to post a long article in GNUS (about 10K or longer), I get the error, "Writing to process: no more processes, nntpd" Upgrade to Emacs 18.58 or higher. 165: How do I save all the items of a multi-part posting in GNUS? Use gnus-mark.el by Jamie Zawinski . 166: 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. (I have an enhancement to GNUS 3.13 that will make it only hide the subject of a posting when it is unchanged from the followed-up-to posting. Thus, you can use the subject hiding feature and still know when someone changes the subject. (I have forgotten who originally gave me the idea for this.)) 167: Why is GNUS so slow to start up? GNUS does several things that take quadratic time of the number of newsgroups that are listed in .newsrc. The quick fix for this is to remove all the newsgroups in which you have no interest from your .newrc file by using GNUS's C-k command in the `*Newsgroup*' buffer after displaying all newsgroups with the L command. If you were to directly edit your .newsrc to remove the newsgroups, GNUS would add them back. GNUS uses a quadratic algorithm to check for duplicates when the .newsrc file is newer than the .newsrc.el file (ie., you edited your .newsrc). GNUS uses a quadratic algorithm to check for new newsgroups every time it connects to the news server. {There may be other quadratic algorithms that I am not aware of.} You can speed up GNUS by using the C-k command in the *Newsgroup* buffer to remove newsgroups from your .newsrc file. Of course, GNUS will run faster if you make sure it is byte-compiled. Felix Lee wrote some enhancements called `gnus-speedups.el' that fix some of the problems. See the Emacs Lisp Archive. 168: How do I catch up all newsgroups in GNUS? In the `*Newsgroup*' buffer, type the following magical incantation: M-< C-x ( C-@ c y C-u C-@ C-e C-f C-f M-0 C-x ) Leave off the "M-<" if you only want to catch up from point to the end of the `*Newsgroup' buffer. 169: Why can't I kill in GNUS on the Newsgroups/Keywords/Control line? GNUS 3.14.1 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. 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\\)") Various people (eg., Greg Holley ) have posted solutions to allow more efficient killing on these headers than the preceding solution. Masanobu Umeda plans to fix this problem. 170: How do I get rid of flashing messages in GNUS for slow connections? GNUS outputs "NNTP: Reading..." message and then clears them, over and over. In version 3.14.1 there is a variable named nntp-debug-read that can help. Johan Vromans wrote a fix. Others have also written fixes. 171: Why is catch up slow in Gnews/GNUS? Because GNUS is marking crosspostings read. {I think it should do this at the time the article is read to spread out the load. Maybe someone will write the code to do this.} 172: 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. 173: Why don't my news postings in GNUS get past the local machine? Three possible reasons: local distribution, C News date problem (see question 174, and the path problem. This piece of code may fix the path problem for you: (setq gnus-use-generic-path t) 174: Why is the GNUS-generated `Date:' header invalid? GNUS generates `Date:' headers without time zones. C-News's `inews' doesn't replace it with a valid header, but will generate it if not already there. If it is invalid, the article will not be forwarded properly. Quick fix: (defun gnus-inews-date () nil) This is not fixed as of GNUS 3.14.1. 175: Why doesn't GNUS generate the `Lines:' header? GNUS was written for B news, which would generate the `Lines:' header. C news doesn't. There is a comment in C news's `inews' that you can uncomment to enable this functionality. Or you can have GNUS generate the header, for example: ;; idea by jbryans@beach.csulb.edu (Jack Bryans) (defun add-lines-header () ;; Count the number of lines in the current posting and insert the ;; header line Lines into the message. (save-excursion (goto-char (point-min)) (if (search-forward "\n\n") ;; ***** I suspect this is wrong ***** (let ((lines (count-lines (point) (point-max)))) (forward-line -1) (insert-string "Lines: " lines "\n"))))) Mike Williams has written something similar. Ronald Florence has a patch for GNUS that makes it calculate the `Lines:' header for incoming articles when necessary that works for sites with local news spools. David Lawrence says that GNUS 3.14.1 generates Lines if gnus-news-system is Cnews. 176: Why do I get "Cannot open load file" "nntp" when compiling GNUS? Specifically, the error message is this: Error occurred processing gnus.el: File error (("Cannot open load file" "nntp")) This means that nntp.el is not in Emacs's load-path, which is easy to happen when compiling using the Makefile. Easiest solution: set EMACSLOADPATH in Makefile (idea from Glenn Gribble ): EMACSLOADPATH=/usr/local/emacs/lisp:. ELC= env EMACSLOADPATH=$(EMACSLOADPATH) emacs -batch -f batch-byte-compile Another solution, in hack.el put this: (defun gross-hack () (setq load-path (cons "/directory" load-path))) Then in Makefile: ELC= emacs -batch -l hack.el -f gross-hack -f batch-byte-compile 177: How do I kill all articles in GNUS but those matching a pattern? Example: ;; 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-Subject-clear-mark-forward 1)))) t) ---------------------------------------------------------------------- Copyright (C) 1990, 1991, 1992 Joseph Brian Wells Copyright (C) 1992, 1993 Steven Byrnes 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, etc.), 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. emacs-19.22/etc/FTP100666 13035 13 23545 5473304721 13107 0ustar gnulistsuser -*- text -*- How to get GNU Software by Internet FTP or by UUCP. Last updated 21 Apr 93. * 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 prep.ai.mit.edu, 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.71.0.38 (as of 11 April 89) 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 versions of GNU Emacs and How To FTP It. You can anonymously ftp a VMS version of GNU emacs from: - addvax.llnl.gov - VMSA.OAC.UCI.EDU or VMSD.OAC.UCI.EDU - RIGEL.EFD.LTH.SE [130.235.48.3] - ctrsci.cc.utah.edu - The 00readme.txt file gives details - cc.utah.edu [128.110.8.24], user anonymous, pass guest. It has already been compiled and linked so it is ready to run. You will need to ftp the reblock.for program to reblock the saveset so that the backup utility can restore that saveset. Do a backup/list on the ftp'd saveset and catch the header info that backup puts out. It contains the correct block size to reblock the file to. Remember to ftp it in binary mode. ** A VMS version of GCC/G++ and How To FTP It. mango.rsmas.miami.edu has a VMS version of the GCC/G++ compiler. Contact angel@flipper.miami.edu (angel li) for 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. ** TeX and How to FTP It We don't distribute TeX now, but it is free software. You can get TeX sources via anonymous FTP from labrea.stanford.edu in pub/tex. The directory pub/tex/unix3.0 probably contains what you want, but see pub/tex/README to be sure. The most recent incarnation of the LaTeX macros are in labrea:pub/tex/latex. If you'd like to support TUG and/or don't have access to the Internet, then write to elisabet@max.acs.washington.edu about getting their tape distribution. ** Scheme and How to FTP It The latest distribution version of C Scheme is on the machine zurich.ai.mit.edu. To obtain a "tarred" copy of this directory, telnet to zurich.ai.mit.edu and log in as scheme (password: scheme). A file called dist.tar will be created (if there isn't one already), and you will be given a choice of the file transfer program to run (of all the ones supported by zurich). It should be self-explanatory (ha, ha! [try ? for help]). Read the files INSTALL and README in the top level C Scheme directory. ** Alternative Internet FTP Sources 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) labrea.stanford.edu, wuarchive.wustl.edu:/mirrors/gnu, col.hp.com:/mirrors/gnu, ftp.cs.columbia.edu:/archives/gnu/prep, ftp.cs.widener.edu, itstd.sri.com, a.cs.uiuc.edu, uxc.cso.uiuc.edu, scam.berkeley.edu, jaguar.utah.edu, ftp.hawaii.edu:/mirrors/gnu, gatekeeper.dec.com:/pub/gnu, archive.cis.ohio-state.edu, and ftp.uu.net:/archive/systems/gnu. And these foreign sites: ftp.cs.ubc.ca:/mirror2/gnu (Canada, daily full mirror, ran by ftp-admin@cs.ubc.ca), 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.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, ftp.stacken.kth.se or ftp.luth.se:/pub/unix/gnu (Sweden), hp4nl.nluug.nl (Netherlands), ftp.win.tue.nl (Netherlands, Internet Address 131.155.70.100), 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), archive.eu.net (Europe, 192.16.202.1), cair.kaist.ac.kr:/pub/gnu (Korea 143.248.11.170), 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). 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. * 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. These UK sites have just anonymous FTP access: ftp.mcc.ac.uk [130.88.203.12], unix.hensa.ac.uk:/pub/uunet/systems/gnu. * 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.22/etc/GNU100666 12120 13 63303 5471636062 12032 0ustar rmsuserCopyright (C) 1985 Richard M. Stallman 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 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.22/etc/INTERVIEW100666 13437 1 57721 4123560506 13352 0ustar jimbdaemon 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. 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.22/etc/JOKES100644 21641 13 27533 5472543727 13257 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.22/etc/LEDIT100666 13437 1 5750 3461063270 12612 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.22/etc/LNEWS100666 12120 13 403435 5405042575 12312 0ustar rmsuserThis is Info file LNEWS, produced by Makeinfo-1.54 from the input file news.texi. 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.22/etc/LPF100666 13437 13 11564 5405340650 12150 0ustar jimbuser Protect Your Freedom to Write Programs Join the League for Programming Freedom (Version of January 15, 1991) 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. The new monopolies, 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 intended--copyright on individual programs. Our aim is to reverse the recent changes made by judges in response to special interests, often explicitly rejecting the public interest principles of the Constitution. The League works to abolish the new monopolies by publishing articles, talking with public officials, boycotting egregious offenders, and in the future may intervene in court cases. On May 24, 1989, the League picketed Lotus headquarters on account of their lawsuits, and then again on August 2, 1990. These marches stimulated widespread media coverage for the issue. 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 or phone (617) 243-4091. Or send Internet mail to league@prep.ai.mit.edu. Jack Larsen, President Chris Hofstader, Secretary Steve Sisak, Treasurer Jack Larsen can be contacted at (708) 698-1160; Fax (708) 698-6221. 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 correspondent bank, to save us check cashing fees.) Your name: The address for League mailings (a few each year): 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.) 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.22/etc/MACHINES100666 12120 13 120625 5475640261 12611 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. 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 18.58 and OS version 2.2, compiler version 1.3. 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. Amiga Apollo running Domain (m68k-apollo-bsd) 18.52 works, to some extent. Code for dumping Emacs has been written, but we cannot distribute it yet. There are reports of bugs in cc -O on this system. In `lib-src/Makefile', don't expect emacsclient and emacsserver to compile. You might want to remove them from your makefile. Supposedly something in dired.c runs into a compiler bug. Paraphrasing the statement should avoid the problem. I have not yet received word as to the exact statement this is. The Apollo has a bizarre operating system which does not permit Emacs to be dumped with preloaded pure Lisp code. Therefore, each time you start Emacs on this system, the standard Lisp code is loaded into it. Expect it to take a long time. You can prevent loading of the standard Lisp code by specifying the -nl switch. It must come at the beginning of the command line; only the -t and -batch switches may come before it. There is one remaining problem on the Apollo. You must replace the CPP line in src/Makefile with "CPP = /usr/lib/cpp". The C preprocessor lives there rather than in /lib/cpp because the Aegis OS uses the /lib directory as the repository for shared libraries. Here is a design for a method of dumping and reloading the relevant necessary impure areas of Emacs. On dumping, you need to dump only the array `pure' plus the locations that contain values of forwarded Lisp variables or that are protected for garbage collection. The former can be found by a garbage- collection-like technique, and the latter are in the staticprolist vector (see alloc.c for both things). Reloading would work in an Emacs that has just been started; except when a switch is specified to inhibit this, it would read the dump file and set all the appropriate locations. The data loaded must be relocated, but that's not hard. Those locations that are of type Lisp_Object can be found by a technique like garbage-collection, and those of them that point to storage can be relocated. The other data read from the file will not need to be relocated. The switch to inhibit loading the data base would be used when it is time to dump a new data base. This would take a few seconds, which is much faster than loading the Lisp code of Emacs from scratch. 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 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) 18.53 supposedly to work. 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. DECstation (mips-dec-ultrix or mips-dec-osf) 19.22 is believed to work on Ultrix 4.2. If you are not using DECnet, then remove the definition of LIBS_MACHINE from `src/m/pmax.h', in order to prevent linking with the `libdnet.a' library. 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) Emacs runs as of version 19.17. Motorola Delta boxes running System V/68 release 3. Tested on 147 board with SVR3V7, no X and gcc. Tested on 167 board with SVR3V7, no X, cc, gnucc and gcc. There are three ways to use the gnucc provided with R3V7. Either link /bin/ccd/cc to /bin/cc and then configure (supposing that CC is unset or set to cc). Or configure like this: `CC=/bin/ccd/cc configure', or else configure like this: `CC=gnucc configure'. If you have not installed the optional NSE package (Network Services Extensions), then edit src/m/delta.h and remove the line where HAVE_SOCKETS is defined. Motorola Delta 187 (m88k-motorola-sysv, m88k-motorola-sysvr4, or m88k-motorola-m88kbcs) As of version 19.13, Emacs is reported to run under SYSVr3 and SYSVr4. Machine support added in version 19. HAVE_X_MENU does not work due to lack of insque. 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. 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. 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) These files support HP's Precision Architecture machines running HP/UX. It has been moderately tested on the Series 840. Use hppa1.1 for the 700 series and hppa1.0 for the 800 series machines. (Emacs may not actually care which one you use.) As of version 19.16, Emacs is reported to build (using GCC) and run on HP 9000/700 series machines running HP/UX versions 8.07 and 9.01. Some people report trouble using the GNU memory allocator under HP/UX version 9. We are told that these problems go away if you obtain the latest patches for the HP/UX C compiler. James J Dempsey says that this set of versions works for him: /bin/cc: HP92453-01 A.09.28 HP C Compiler /lib/ccom: HP92453-01 A.09.28 HP C Compiler HP-UX SLLIC/OPTIMIZER HP-UX.09.00.23 02/18/93 Ucode Code Generator - HP-UX.09.00.23.5 (patch) 2/18/93 For 700 series machines, the HP-UX patch needed is known as PHSS_2653. (Perhaps for 800 series machines as well; we don't know.) If you are on the Internet, you should be able to obtain this patch by using telnet to access the machine support.mayfield.hp.com and logging in as "hpslreg" and following the instructions there. Do not ask FSF for further support on this. If you have any trouble obtaining the patch, contact HP Software Support. If you are running HP/UX release 8.0 or later, you need the optional "C/ANSI C" software in order to build Emacs (older releases of HP/UX 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.7 runs. 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. 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-*-xenix, i386-*-linux, i386-intsys-sysv, i386-*-sysv3, i386-*-sysv4, i386-*-sysv4.2, i386-*-sysv5.3, i386-*-bsd4.2, i386-*-sco3.2v4, i386-*-bsd386, i386-*-386bsd) 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). 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 Linux; Emacs runs as of version 19.7. 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.6. Use i386-*-bsd386 for BSDI BSD/386; Emacs runs as of version 19.10. Make on that system is broken; use GNU make instead. 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 CC=/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. 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[45].*) 19.22 is known to work on all Silicon Graphics machines running IRIX 4.0.5 or IRIX 5.1. Emacs 18.58 works with IRIX 3.3. Compiling with GCC on IRIX 5 is said to fail, perhaps because GCC produces something src/unexelfsgi.c doesn't understand. 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. Macintosh We are boycotting Apple because of Apple's efforts to take away our freedom to write compatible imitations of existing software. If you value your freedom to write such programs, we urge you not to buy from Apple, not to develop software for Apple, and certainly not to accept a job with Apple. See the file APPLE in this directory for more information. 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; go complain to Masscomp. 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) Changes merged in 18.39. Some fixes in 18.56. 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-bsd, m68k-next-mach2) 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. 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) 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) Emacs 19 should work. However, if you compile with the Sequent compiler, you may find Emacs does not restore the terminal settings on exit. If this happens, compile with GCC. SONY News (m68k-sony-bsd4.2 or m68k-sony-bsd4.3) 18.52 worked. Use m68k-sony-bsd4.3 for system release 3. SONY News 3000 series (RISC NEWS) (mips-sony-bsd) Worked, as of 18.56. Note that this is a MIPS architecture machine. 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 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-solaris2.*) 19.22 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. 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'. Use `m68k' for the 68000-based Sun boxes, `sparc' for Sparcstations, and `i386' for Sun Roadrunners. i386 calls for Sunos4.0. 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 2.2 with SUNWspro 2.0.1, src/Makefile gets bad data-- spurious spaces. This is probably the fault of CPP. No workaround yet except to compile with GCC instead. On Solaris, if linking gives the error that `bss_end' and `main' are undefined, it may mean that the C preprocessor did the wrong thing when processing `src/ymakefile' into `src/xmakefile'. A tell-tale sign of this in `src/xmakefile' is the presence of extra spaces, as in unexelf.o: unexelf . o $(config_h) If this happens, try using GCC to compile Emacs, or at least to preprocess `src/ymakefile' into `src/xmakefile'. 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. 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*) Minor changes merged in 19.19, which should work. Tektronix 16000 box (6130?) (ns16k-tektronix-bsd) Emacs 17.61 worked. Tektronix 4300 (m68k-tektronix-bsd) Emacs 18.51 worked. 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". 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. 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.22/etc/MAILINGLISTS100666 12130 13 113565 5454350240 13656 0ustar toweruser GNU Project Electronic Mailing Lists. Last Updated 22 Sep 93 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. * 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-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. 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'. * 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.22/etc/MORE.STUFF100666 74777 13 3141 5354756550 13163 0ustar ericuserMore 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.22/etc/MOTIVATION100666 13437 1 21127 4071350006 13450 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.22/etc/Makefile100666 13437 13 610 5407640035 13174 0ustar jimbuserDESTDIR= LIBDIR=/usr/local/lib BINDIR=/usr/local/bin MANDIR=/usr/man/man1 MANEXT=1 all: mostlyclean clean: -rm -f core distclean realclean: -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) emacs-19.22/etc/NEWS100666 12120 13 320362 5475717677 12216 0ustar rmsuserGNU Emacs NEWS -- history of user-visible changes. 27 Nov 1993 Copyright (C) 1993 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. For Lisp changes in Emacs 19, see the file LNEWS. 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 (if prompt (message "%s%s" prompt (single-key-description (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 Emacs 19, see the file news.texi. ---------------------------------------------------------------------- Copyright information: Copyright (C) 1993 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.22/etc/ONEWS100666 12120 13 202523 5335275264 12315 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.22/etc/OONEWS100666 12120 13 173762 5335275277 12454 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.22/etc/OOONEWS100666 12120 13 144044 5335275332 12552 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.22/etc/OOOONEWS100666 12120 1 135467 3617255326 13146 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.22/etc/ORDERS100664 12130 13 51335 5436462124 12734 0ustar toweruserThe actual order form follows the descriptions of media contents Please send suggestions for improvements to gnu@prep.ai.mit.edu or the postal address at the end of the order form. Thank You. Contents of CD-ROM, Deluxe Distribution, and Each Tape on the FSF Order Form **************************************************************************** PRICE AND CONTENTS MAY CHANGE WITHOUT NOTICE AFTER January 31, 1994. GNU Source Code CD-ROM The 2nd edition of the GNU Source Code CD-ROM contains sources to the distribution of the GNU Project including: Emacs 18 and 19, GCC, G++, GDB, Bison, GAS, Make, GAWK, Texinfo, the GNU Utilities, RCS and CVS, f2c, Ghostscript, tar, gnuplot, diff, and BASH, as well as the MIT X Window System required components. This CD includes everything on our Emacs, Languages, Utilities, Experimental, and X11 Required tapes as of May 1993. Note that the contents of the BSD-Net2, X11 Optional and MIT Scheme tapes are not on the CD. The CD also contains some packages ported to Intel 80386 and 80486-based machines running MS-DOS: Demacs, DJGPP, and MIT Scheme. In addition, it contains Mtools, which is a public domain collection of programs to allow Unix systems to read, write, and manipulate files on an MS-DOS file system (typically a diskette). The CD is in ISO 9660 format with Rockridge extensions, and can be mounted as a read-only file system on most operating systems. You can build most of this software without needing to copy the sources off the CD. It requires only enough free disk space for the object files and the intermediate build targets. Except for several of the MS-DOS packages and GCC for Sun's Solaris 2, there are no precompiled programs on this CD. You will need a C compiler (programs which need some other interpreter or compiler normally provide the C source for a bootstrapping program). Deluxe Distribution The Deluxe Distribution Package includes executables and source for all GNU software in a choice of formats, as well as a printed copy of each of GNU manuals and an ISO 9660 CD-ROM that contains sources of GNU software. You may choose one of the following machines and operating systems: HP 9000 series 200, 300, 700, or 800 (4.3 BSD or HPUX); RS/6000 (AIX); Sony NEWS 68k (4.3 BSD or NewsOS 4); Sun 3, 4, or SPARC (SunOS 4 or Solaris). If your machine or system is not listed, or if a specific program has not been ported to that machine, please call the FSF office. We will supply the software on one of the following media in Unix tar format: 1600 or 6250 bpi, 1/2 inch, reel to reel tape; Sun DC300XLP 1/4 inch cartridge, QIC-24; HP 16 track DC600HC 1/4 inch cartridge; IBM RS/6000 1/4 inch cartridge, QIC-150; and Exabyte 8mm tape. If your computer cannot read any of these, please call us. The manuals included are one each of the Bison, Calc, Gawk, GNU C Compiler, GNU C Library Reference, GNU Debugger, Flex, GNU Emacs Lisp Reference, Make, Texinfo, and Termcap manuals; six copies of the GNU Emacs manual; and a packet of reference cards for GNU Emacs, Calc, the GNU Debugger, Bison, and Flex. GNU Emacs Tape The tape includes source code for: * GNU Emacs 18 and 19 (the extensible, customizable, self-documenting, real-time display editor) * The GNU Emacs Manual, as Texinfo source * The GNU Emacs Lisp Reference Manual, as Texinfo source * Calc (the extensible, advanced desk calculator and mathematical tool that runs as part of GNU Emacs) * The Calc Manual, as Texinfo source * CLISP (a Common Lisp implementation) * Xerox's PCL (a large subset of CLOS, the Common Lisp Object System) * gzip (GNU's data compression program to uncompress source on the tape) * Texinfo (beta-test of an enhanced Texinfo. Texinfo is GNU's structured documentation system, included with GNU Emacs. Texinfo is used to produce both on-line and printed documents.) * The Texinfo Manual, as Texinfo source * GNU make * The GNU Make Manual, as Texinfo source GNU Languages Tape The tape includes source code for: * GCC 1 (the GNU C Compiler, including COFF support) * The Manual `Using and Porting GNU CC 1', as Texinfo source * G++ 1 (the C++ front end to GCC) * The GNU G++ Users Guide, as Texinfo source (not yet published on paper) * libg++ 1 (the G++ class library) * NIH Class Library (formerly known as OOPS) * BFD (Binary File Descriptor Library) * GDB 4 (The GNU source-level C and C++ debugger) * The manual, Debugging with GDB, as Texinfo source * ae (works with GCC to produce more complete profiling information) * GNU binary file utilities (ar, gprof, ld, nm, ranlib, size, & strip) * Bison (a free, compatible replacement for yacc) * The Bison Manual, as Texinfo source * COFF support for GNU software tools * DejaGnu (a framework for testing other programs) * expect (runs scripts to conduct dialogs with programs) * tcl (an embeddable tool command language) * dld (a dynamic linker) * f2c (a FORTRAN-77 to C translator) * Flex (Vern Paxson's fast rewrite of lex) * The Flex Manual, as Texinfo source * Gas (the GNU Assembler) * Gawk (the GNU implementation of the AWK programming language) * The Gawk Manual, as Texinfo source * gdbm library (GNU implementation of the standard dbm & ndbm libraries) * gmp library (arbitrary precision arithmetic on signed integers & rationals) * gperf (a perfect hash-table generator) * GNU indent * p2c (a Pascal-to-C translator) * Perl (a programming language interpreter) * GNU Smalltalk (the GNU implementation of this programming language system) * regexp library (GNU implementation of the regular expression library) * superopt (optimal function sequence generator) * Tile Forth (an implementation of the Forth language) * Texinfo (beta-test of an enhanced Texinfo. Texinfo is GNU's structured documentation system, included with GNU Emacs. Texinfo is used to produce both on-line and printed documents.) * The Texinfo Manual, as Texinfo source * gzip (GNU's data compression program to uncompress source on the tape) * GNU make * The GNU Make Manual, as Texinfo source GNU Utilities Tape The tape includes source code for: * autoconf (produces shell scripts to automatically configure software builds) * Bash (GNU's Bourne Again SHell) * GNU bc, dc & cpio * CVS (Concurrent Version System) * GNU diffutils (cmp, diff, diff3 & sdiff) * doschk (checks if file names are under 15 characters and in MS-DOS format) * elvis (a clone of the vi/ex Unix editor) * es (extensible rc-like shell with lexical scope, first class functions, etc.) * Fax (a fax spooling system) * Gnats (a bug-tracking system) * GNU find & finger * GNU fontutils (create and support fonts for use with Ghostscript or TeX) * acm (multiplayer aerial combat simulation for the X window system) * ms (MandelSpawn, a parallel Mandelbrot program for the X window system) * GNU Chess (a chess playing program with interfaces to both X & ttys) * GNU Shogi (plays a japanese game like chess; has both tty & X interfaces) * Nethack (a rogue-like game) * GNU GO (the GNU implementation of the game of GO) * GNU hello (produces a familiar, friendly greeting) * hp2xx * Ghostscript (a Postscript interpreter) * Ghostview (an X11 user interface for the Ghostscript interpreter) * gnuplot (an interactive mathematical plotting program) * GNU gptx (a permuted index generator, including KWIC) * GNU grep, egrep & fgrep * groff & mgm macros (GNU troff & pic, eqn, tbl, refer; -man, -ms, -mm macros; drivers for Postscript and typewriter-like devices; & xditview previewer) * less (display paginator similar to more & pg with better features) * GNU m4 * mtools (allows Unix systems to manipulate files on an MS-DOS file system) * patch * rc (shell with far more C-like syntax and far cleaner quoting than csh or sh) * RCS (Revision Control System) * recode (converts files between many character sets and usages) * screen (a terminal multiplexor that allows you to handle several independent ``screens'' (ttys) on a single physical terminal) * GNU sed & tar * GNU Termcap library * The GNU Termcap Manual, as Texinfo source * GNU time * GNU tput (a portable way to allow shell scripts to use special terminal capabilities) * Taylor UUCP (the GNU implementation of the UUCP communication suite) * wdiff (report diffs on a word by word basis) * GNU fileutils (chgrp, chmod, chown, cp, dd, df, du, install, ln, ls, mkdir, mkfifo, mknod, mktime, mv, mvdir, rm, rmdir, touch & vdir) * GNU shellutils (basename, date, dirname, echo, env, expr, false, groups, id, logname, nice, nohup, pathchk, printenv, printf, sleep, stty, su, tee, test, true, tty, uname, who, whoami, & yes) * GNU textutils (cat, cksum, comm, csplit, cut, expand, fold, head, join, nl, od, paste, pr, sort, split, sum, tac, tail, tr, unexpand, uniq, & wc) * Texinfo (beta-test of an enhanced Texinfo. Texinfo is GNU's structured documentation system, included with GNU Emacs. Texinfo is used to produce both on-line and printed documents.) * The Texinfo Manual, as Texinfo source * GNU make * The GNU Make Manual, as Texinfo source * gzip (GNU's data compression program to uncompress source on the tape) GNU Experimental Tape The tape includes source code for: * GCC 2 (the GNU C/C++/Objective-C Compiler with many new features) * The Manual `Using and Porting GNU CC 2', as Texinfo source * Compiled binaries of GCC for Sun Solaris systems * GNU binary file utilities 2 (ar, gprof, ld, nm, ranlib, size, & strip - completely rewritten to use the BFD library) * BFD (Binary File Descriptor Library) * GNU C Library (POSIX.1 compliant, upward compatible with 4.3 BSD & System V) * The GNU C Library Reference Manual * libg++ 2 (the G++ class library) * Oleo (a spreadsheet program) * GNU Graphics (graph, plot, xplot, plot2ps, spline, et al.) * Texinfo (beta-test of an enhanced Texinfo. Texinfo is GNU's structured documentation system, included with GNU Emacs. Texinfo is used to produce both on-line and printed documents.) * The Texinfo Manual, as Texinfo source * GNU make * The GNU Make Manual, as Texinfo source * gzip (GNU's data compression program to uncompress source on the tape) Berkeley Networking 2 Tape The Berkeley "Net2" release contains the second 4.3 BSD distribution and is newer than both 4.3BSD-Tahoe and 4.3BSD-Reno. It includes nearly the entire BSD software system except for a few utilities, some parts of the kernel, and some library routines which your own C library is likely to provide. This release contains much more software than the older releases, including third party software like Kerberos and some GNU software (for example, GCC, now the standard BSD compiler). Except for kernel sources, the GNU Project has replacements on other tapes for many of the missing programs. MIT Scheme tape The tape contains sources, and binaries for various machines, for MIT Scheme (a dialect of Lisp). X11r5 Required Tape This tape has source code for the required MIT X Window System X11r5, including core software and documentation, and contributed client software. X11r5 Optional Tape This tape has source code for the optional MIT X Window System X11r5, including contributed software, libraries, games, Andrew and toolkits. Free Software Foundation Order Form *********************************** Price and contents may change without notice after January 31, 1994. All items are distributed with permission to copy and to redistribute. Texinfo source for each manual is on the appropriate tape, diskette, or CD-ROM; the prices for these magnetic media do not include printed manuals. 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, 1994. The following tapes in the formats indicated: Please circle the dollar amount for each tape you order. Reel to Sun (1) HP IBM (2) Exabyte reel RS/6000 (c.t. = cartridge tape) Unix tar Unix tar Unix tar Unix tar Unix tar (n/a = not available) 9-track QIC-24 16-track QIC-150 1600 bpi DC300XLP DC600HC DC600A Tape contents above. 1/2" reel 1/4" c.t. 1/4" c.t. 1/4" c.t. 8mm c.t. Emacs $200 $210 $230 $215 (3) $205 Languages $200 $210 $230 n/a $205 Experimental $200 $210 $230 $215 $205 Utilities $200 $210 $230 $215 $205 BSD-Net2 $200 $210 $230 $215 $205 Scheme $200 $210 $230 $215 $205 X11r5-Required $200 $210 $230 $215 $205 X11r5-Optional $200 $210 $230 $215 $205 (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: FSF's Subscription Service provides four new versions of the tape of your choice. It is offered only for tapes that change frequently. Emacs $600 $630 $690 $645 $615 Languages $600 $630 $690 n/a $615 Experimental $600 $630 $690 $645 $615 Utilities $600 $630 $690 $645 $615 X11r5-Required $600 $630 $690 $645 $615 Subtotal $ ______ Please put total of the above circled amounts here. The following, on 1600 bpi reel-to-reel 9 track 1/2" tapes, in VMS BACKUP format (aka interchange format): ____ @ $195 = $ ______ VMS Emacs, GNU Emacs source & executables only. None of the other software on the GNU Emacs Tape, described above, is included ____ @ $195 = $ ______ VMS Languages, GCC, GAS, and Bison source and executables only. None of the other software on the GNU Languages Tape, described above, is included. FSF Deluxe Distribution (contents described above): Machine: _____________________________________________________________________ Operating system: ____________________________________________________________ Media type: __________________________________________________________________ ____ @ $5000 = $ ______ Deluxe Distribution, with manuals, reference cards. source code and executables. The following source and executables for MS-DOS, on 3.5" 1.44MB diskettes: ____ @ $ 90 = $ ______ Demacs (a port of GNU Emacs) on diskettes, for 80386 and up. Two versions are included. One handles 8-bit characters sets. The other, based on Nemacs, handles 16-bit character sets, including Kanji. ____ @ $ 80 = $ ______ DJGPP on diskettes, GCC version 2, for 80386 and up. DJGPP is a complete port of GCC, libraries, development utilities, and a symbolic debugger, for Intel 80386 and 80486--based machines running MS-DOS. DJGPP requires at least 5MB of hard disk space to install, and 512K of RAM to use. It is compatible with XMS memory managers and VCPI, but not with Microsoft Windows extended mode or other DPMI managers. It cannot emulate multitasking (e.g. fork) or signals. ____ @ $ 85 = $ ______ Selected Utilities from the GNUish MS-DOS Project on diskettes, 8086 and up. The utilities include: RCS, flex, GAWK, cpio, diff, MicroEmacs, find, some file utilities, gdbm, grep, libc, ptx, indent, less, m4, make, sed, shar, sort, and Texinfo. Some of these utilities are necessarily missing features. ____ @ $ 40 = $ ______ Windows diskette, GNU Chess and gnuplot for Microsoft Windows. CD-ROM, in ISO 9660 format (CD-ROM described above): ____ @ $400 = $ ______ GNU Source Code CD-ROM for corporations and other organizations. ____ @ $100 = $ ______ GNU Source Code CD-ROM for individuals. The following manuals, 6 by 9.25 inches, soft cover with an illustration, offset printed, "lay-flat" binding: *** NEW !!! *** ____ @ $ 25 = $ ______ GNU Emacs manual, unit price for 1 to 5 copies, 430 pages, new 8th edition with a reference card. ____ @ $ 17 = $ ______ GNU Emacs manuals, unit price for 6 or more. ____ @ $ 50 = $ ______ GNU Emacs Lisp Reference manual, 614 pages in 2 volumes. ____ @ $200 = $ ______ A box of 5 GNU Emacs Lisp Reference manuals. ____ @ $ 20 = $ ______ Debugging with GDB, 182 pages, with a reference card. ____ @ $ 20 = $ ______ Texinfo manual, 248 pages. Texinfo is GNU's structured documentation system, included with GNU Emacs. Texinfo is used to produce both on-line and printed documents. This manual describes how to write Texinfo documents. ____ @ $ 20 = $ ______ Gawk manual, 191 pages. ____ @ $ 20 = $ ______ Make manual, 164 pages. ____ @ $ 15 = $ ______ Bison manual, 98 pages, with a reference card. ____ @ $ 15 = $ ______ Flex manual, 120 pages, with a reference card. The following manual, 6 by 9.25 inches, soft cover, photocopied, GBC binding: ____ @ $ 15 = $ ______ Termcap manual, 68 pages. Documents the termcap library and GNU's extensions to it. The GNU termcap library is included with GNU Emacs. The following manuals, 8.5 by 11 inches, soft cover, photocopied, GBC binding: ____ @ $ 50 = $ ______ Using and Porting GNU CC version 2.4, 388 pages. ____ @ $ 20 = $ ______ Using and Porting GNU CC version 1.42, 206 pages. *** NEW !!! *** ____ @ $ 50 = $ ______ GNU C Library Reference Manual, 698 pages. NEW! ____ @ $ 50 = $ ______ GNU Emacs Calc manual, 596 pages, with a reference card. Calc is an extensible, advanced mathematical tool and desk calculator that runs under GNU Emacs. The following reference cards, unit price, without the manuals: ____ @ $ 2 = $ ______ GNU Emacs reference card - version 18. ____ @ $ 2 = $ ______ GNU Emacs reference card - version 19. ____ @ $ 2 = $ ______ GNU Emacs Calc reference card. ____ @ $ 2 = $ ______ GDB reference card. ____ @ $ 2 = $ ______ Bison reference card. ____ @ $ 2 = $ ______ Flex reference card. The following reference cards, in packets of ten: ____ @ $ 10 = $ ______ GNU Emacs reference cards. ____ @ $ 10 = $ ______ GNU Emacs Calc reference cards. ____ @ $ 10 = $ ______ GDB reference cards. ____ @ $ 10 = $ ______ Bison reference cards. ____ @ $ 10 = $ ______ Flex reference cards. GNU/FSF T-shirts, thick 100% cotton: The front of the t-shirt has an image of a GNU hacking at a workstation with the text "GNU's Not Unix" above and the text "Free Software Foundation below. Natural is an off-white, unbleached, undyed, environment-friendly cotton, printed with black ink. Black is printed with white ink. ____ @ $ 15 = $ ______ Size M ____ natural ____ black. ____ @ $ 15 = $ ______ Size L ____ natural ____ black. ____ @ $ 15 = $ ______ Size XL ____ natural ____ black. ____ @ $ 15 = $ ______ Size XXL ____ natural ____ black. ------ Subtotal $ ______ + $ ______ 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, or $20 per box. For all other items, add $5 base charge, then $1 per item except reference cards; i.e., shipping for all other items = $5 + $1 * n. + $ ______ Outside of U.S., Canada, and Puerto Rico for shipping: for each box of GNU Emacs Lisp Reference manuals, add $60. For all other items, add $20 base charge, and then add $10 more for each item (except reference cards) in the order; i.e., shipping for all other items = $20 + $10 * n. + $ ______ Optional (tax-deductible in the U.S.) donation. ------ TOTAL $ ______ We pay for shipping via UPS ground transportation in the contiguous 48 states and Canada. Orders filled only upon receipt of check or money order in U.S. dollars. 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. Please make checks payable to the Free Software Foundation. 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. Overseas orders, please put FAX numbers. _____________________________________ For orders from outside the U.S.: Orders must be paid in U.S. dollars. 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 mail orders to: Free Software Foundation 675 Massachusetts Avenue PRICES AND CONTENTS MAY CHANGE Cambridge, MA 02139 USA WITHOUT NOTICE AFTER January 31, 1994. +1 617 876 3296 ---------------------------------------------------------------------- local variables: mode: text fill-column: 78 end: emacs-19.22/etc/ORDERS.EUROPE100666 13035 13 1246 5353115422 14417 0ustar gnulistsuserYou can order FSF tapes and manuals from the Free Software Association of Germany (FSAG) at: FSAG c/o Michaela Merz Heimatring 19 6000 Frankfurt/Main 70 Germany fidonet: fsag, 2:247/14 fsag@eurom.fsag.incom.de phone: ++49-69-6312083 bbs: ++49-69-6312934 bbs: ++49-69-6312083 bbs: ++49-69-634588 If you are in Europe and find it inconvenient to do business across the Atlantic, we urge you to get your GNU software from FSAG as a way of supporting the GNU Project. FSAG is a group of people developing free software. However, they also want to support the Free Software Foundation. They have offered to sell FSF tapes through their offices and send the proceeds to the FSF. emacs-19.22/etc/ORDERS.JAPAN100666 12130 13 15532 5400532263 13556 0ustar toweruser GNU ORDER FORM FOR JAPAN Item Unit Price Quantity Item Price ---------------------------------------- ---------- -------- ---------- * indicates New or Substantially Updated items. * Source Code CD-ROM v. 2, if a corporation Y49,000 ________ __________ or other organization is ultimately paying. * Source Code CD-ROM v. 2, if an individual Y15,000 ________ __________ is ultimately paying. * Source Code on Tape Y34,500 ________ __________ (per tape; see bulletin of file etc/ORDERS in the GNU Emacs distribution for more details) * Emacs manual, with reference card Y4,600 ________ __________ (Eighth Edition for v. 19) Emacs Lisp Reference manual (Ed. 1.05) Y8,850 ________ __________ Emacs Calc manual, with reference card Y9,300 ________ __________ (v. 2.02) Using and Porting GNU CC version 2.4 Y8,850 ________ __________ Using and Porting GNU CC version 1.42 Y3,900 ________ __________ * GNU C Library Reference manual Y9,300 ________ __________ Debugging with GDB, with reference card Y3,900 ________ __________ (Ed. 4.03 for v. 4.3) Texinfo manual (Ed. 2.16) Y3,450 ________ __________ Termcap manual (Second edition) Y2,700 ________ __________ Bison manual, with reference card (v. 1.20) Y2,700 ________ __________ Gawk manual (Ed. 0.13 for v. 2.13) Y3,450 ________ __________ Make manual (Ed. 0.40 for v. 3.63) Y3,450 ________ __________ Flex manual, with reference card Y2,700 ________ __________ (Ed. 1.02 for v. 2.3) Packet of ten Emacs reference cards Y1,500 ________ __________ 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,500 ________ __________ Color: Natural or Black (circle) FSF T-shirt (size L) Y5,500 ________ __________ Color: Natural or Black (circle) FSF T-shirt (size XL) Y5,500 ________ __________ Color: Natural or Black (circle) FSF T-shirt (size XXL) Y5,500 ________ __________ Color: Natural or Black (circle) Shipping Y1,500 Optional donation to the FSF. Help us 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. Tel: __________________ 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. Prices and contents may change without notice after January 31, 1994. Fax toll-free to 0066-3382-0158 or 0031-13-2473. For use in Japan only. Free Software Foundation 675 Massachusetts Avenue Cambridge, MA 02139 U.S.A. ------------------------------------------------------------------------------- GNU ORDER FORM ADDITIONAL INSTRUCTIONS Within Japan, you may fax your order toll-free to 0066-3382-0158. If you are able to pay for international direct dial, please fax your order directly to 001-1-617-492-9057. This will save the FSF the toll charges. Orders may also be sent by e-mail to japan-fsf-orders@prep.ai.mit.edu or by ordinary mail to: Free Software Foundation 675 Massachusetts Avenue Cambridge, MA 02139 U.S.A. All orders must be prepaid. Payment may be made by bank transfer 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, 1994. 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-876-3296 or by fax at 001-1-617-492-9057 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: Emacs, Languages, Experimental, Utilities, BSD NET2, Scheme, X11R5-Required, and X11R5-Optional. The following tape formats are available: Generic Unix tar 9-track 1600bpi 1/2" reel Generix 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 (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 June 1993 GNU Bulletin or a recent copy of the file etc/ORDERS in the GNU Emacs distribution. If you do not have a copy 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, 1994. Please do not fax this page. For use in Japan only. Free Software Foundation 675 Massachusetts Avenue Cambridge, MA 02139 U.S.A. emacs-19.22/etc/OTHER.EMACSES100644 74777 13 117517 5352203000 13513 0ustar ericuserHow 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.22/etc/README100444 13437 13 506 5316226003 12404 0ustar jimbuserThis 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.dat' is for VMS. It is a copy of the `/etc/termcap' file used on Unix. emacs-19.22/etc/SERVICE100666 13035 13 101643 5450337231 13567 0ustar gnulistsuserGNU Service Directory -*- text -*- 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 this file alphabetical **  Joseph Arceneaux PO Box 460633 San Francisco, CA 94146-0633 +1 415 285 9088 Former FSF staffmember. Performed X11 implementation of Emacs version 19 and worked on WYSIWYG Emacs. Installed and administered FSF network. Maintainer of GNU indent. 10 years experience with Unix systems, from writing ROM monitors to UI design. I provide installation, porting, debugging and customization or extensions of GNU and other Unix software. I also design and implement free software projects. Handholding, teaching, and installations are available. Rates: $150 hour or fixed project prices. Free to selected non-profit and activist organizations. Ask if you are interested in support and update contracts. Updated: 2/15/93  Giuseppe Attardi Dipartimento di Informatica Corso Italia 40 I-56125 Pisa, Italy +39 (50) 510-111 GNU: help on obtaininig GNU, for italian sites. Updated: 18/11/91  Randolph Back Back Software & Consulting, Inc. 1705 14th St. #344 Boulder, CO 80302 (303) 443-7758 Consulting, installation, cutomization and training for GNU emacs, and other GNU software. Entered: 3/13/91  Andrea Baldi European Space Agency (ESA) European Space Operations Center (ESOC) Robert-Bosch-Str 5 D-6100 DARMSTADT West-Germany Phone 0049-6151-902762 (Work) Bitnet : Fax 0049-6151-90-495 Uucp : Your Rate: Free Programs Supported: Emacs, bison, gcc, g++, gdb, bash, X11 Emacs: installation and upgrading aid, answering, customization. Gcc, g++, gdb, bash: installation and upgrading aid. X11: quick questions Experience (with gnu software) I have maintained Emacs for more than 4 years as well as bison, gcc, g++, gdb, bash, X11. I have written/modified several Emacs lisp programs. Currently I maintain many GNU programs for my department. Updated: 11 Sept 91  Bard Bloom Department of Computer Science Cornell University Ithaca, NY 14850 607-255-9211 Your Rate: $200/hour. I might do work for friends and worthy organizations for free. Programs Supported: GNU Emacs Experience: Lots. For example, in 1989 I wrote a safe multi-user database program of sorts in Gnu Emacs in about a week. I've written some 30,000 lines of Gnu Lisp code in total. Degree: PhD in CS from MIT. Other: My real life as a professor takes precedence over consulting. Updated: 11 Sept 91  James Craig Burley 4 Mountain Gate Rd. Ashland, MA 01721-2326 (508) 881-6087, -4745 Email: (preferred) Expertise: Compiler Internals (author of GNU Fortran, for example) Operating Systems Internals (lately Linux on the ix86) Tools/Utilities Development and Maintenance Microcode Development and Maintenance (primarily VLIW machines) 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: $75/hour, though somewhat volatile due to commitments regarding GNU Fortran -- willing to consider flat-fee arrangements Entered: 10 Jul 92  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: $50/hr, negotiable, less for non-profit organizaions. Updated: 10/29/91  C2V Renaud Dumeur 82 bd Haussmann Jean-Alain Le Borgne 75009 Paris France Tel (1) 40.08.07.07 Fax (1) 43.87.35.99 Emacs: questions answered, installation, teaching (all levels), elisp and C extensions and customization, porting, troubleshooting gcc: installation, extensions, porting gdb: installation, debugging, porting X11: installation, debugging, internationalization Experience: yes (ask for details) Rates: 500ff/hr, negotiable. Entered: 12/17/91  Mr. David J. Camp 6103 Charlotte Avenue Saint Louis, MO 63120-1201 Background: Bachelor of Science in Computer Science, Washington University Master of Science in Computer Science, Washington University Over 12 years experience in the computer industry. Author of the future GNU uu/xxen/decoder program. Skilled in many languages, including C and Unix scripts. Tasks: I can do on-site service in the St. Louis area. I prefer short-term projects. I can handle long projects given time. I reserve the right to refuse work. Rates: $50 per hour, including travel time Entered: 1/1/91  Computing Support Team (CSTeam) 111 College Place, Rm 2-212 Syracuse, NY, 13244-4100 phone: 1-315-443-3929, fax: 1-315-443-4745, email: The Computing Support Team offers a wide variety of support services including system design, installation, software support, contract programming, network design, integration and migration services, training, e-mail and telephone support. Experienced with GNU, X, TeX, and other public domain software. Rates: $50-$80/hr, 33% non-profit discount. Entered: 10 Jul 92  Contributed Software Graefestr. 76 1000 Berlin 61, Germany phone: (+49 30) 694 69 07 modems: (+49 30) 694 {61 82 | 67 49 | 68 09} email: internet: scuzzy.contrib.de [192.109.39.1] We distribute, install/port, teach and support free software in general, i.e. X11, GNU, khoros etc. Rates are DM 150,-- plus tax per hour, educational sites get rebates. Entered: 10 Jul 92  Stuart Cracraft The MSM Company Unix & PC Consulting Services 25682 Cresta Loma Laguna Niguel, Ca. 92677 GNUline: 714-347-8106 GNUbeeper: 714-509-3133 (leave number for callback) Rate: based on your ability to afford. Programs supported: all GNU programs. 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: 1 Jul 93  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 1 Kendall Square Cambridge, MA 02139 +1 617 494 1040 Cygnus Support offers warranty protection (service contracts) for a number of free software tools. For a fixed annual fee our customers receive binary and source distributions, mail and phone support, documentation and customization assistance on a variety of popular platforms. At the time of this writing we offer support for a development package including (among other things) gcc, g++, gdb, and of course, GNU Emacs. We also offer support for a network facilities package including many of the Athena tools like Kerberos and Hesiod. However the set of supported tools and platforms increases frequently so contact us for the latest information. For those who need on-site assistance, support is also available from our Cambridge office. Annual Support starts at $3,000. Updated: 16 Feb 93  DePalma SoftCraft Contact: Mauro DePalma 2923 Cohansey Drive Voice: (408) 259-4789 San Jose, CA 95132-1619 Fax: (408) 259-6935 Internet: (or ) DePalma SoftCraft provides distribution, installation, setup, and support for the X Window System (X11R4). This small business provides consulting in every area of a computer s/w project life cycle. We specialize in UNIX, GNU Development Tools (gcc, g++, ...), RCS, and XView. Updated: 4/29/91  Free Software Association of Germany Michaela Merz Heimatring 19 6000 Frankfurt/Main 70 phone: (+49 69) 6312083 modems: (+49 69) 6312934 | 6311235 | 634588 email: We distribute, install and/or port, teach, support free software and offer regular consulting. We accept software development contracts for any (unix) software as long as you will release it into free software. Rates are DM 200,-- plus VAT per hour. 25 % will be donated to the Free Software Foundation. For worthy organizations, we may offer our services for free. Please ask. Entered: 12/24/92  Andy Gaynor -- [Ag] 597 Hoes Lane, Piscataway, NJ 08854 908-463-3376 GNU Emacs: Lisp development, customization, troubleshooting, support, etc User instruction and management for all levels of experience Umpteen-thousand lines of Lisp code, careful study of GNU Emacs organization, years of monitoring the UseNet Emacs and GNU groups, etc Version 19 is due soon -- I will be up-to-speed as quickly as possible $50/hour starting, negotiable on difficulty, organization, distribution, etc Other Tasks: General programming/software engineering (language software preferred) Familiar with Unix, C, Lisp, networking, standard Unix utilities, various other languages, etc Contact me for more info Entered: 10 Feb 92  Ron Guilmette 396 Ano Nuevo Ave. #216 Sunnyvale, CA 94086 408-732-7839 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. Finished GCC2 port to the Intel i860 RISC processor. Now developing GDB code for System V Release 4 support of ELF and Dwarf. Experience: 9+ years UNIX systems experience, all working on compilers and related tools. 3+ 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: Holder of both a Bachelor's and a Master's degree, both in Computer Science. Observer Member of ANSI X3J16 (C++ standardization) committee. Former vice-chairman of UNIX International Programming Languages Special Interest Group (UI/PLSIG). Rates: Variable depending upon contract duration. Call for quote. Updated: 9 Feb 92  Johannes M. Heuft Pfarrweg 2c D-8000 Munich 90 Germany Telephone: Germany+89/681773 Rate: min. DM 180.- ($ 120.-) per hour interesting tasks for non-profit organisations may be free Supported Programs: gcc, gas, g++, gdb, binutils, gnuplot, ...; (not emacs) Experience: 10 years of operating system, network, and compiler construction; also includes engineering management. Degrees: Dipl. Inform. (similar to MS CS) Updated: 11/9/91  Sanjay Hiranandani <4393472@mcimail.com> 16 Campus Plaza, Suite 180 Vestal, NY 13850 Work:607-729-7834 ext. 180 Home:607-748-2709 Fax:607-748-0243 Rate: $40/hr. Phone questions for free are ok as far as my schedule will permit Lower rates for students and certain non-profit organizations Can help with installation/customization/modification of most GNU software. Experience: Software Development, System Administration, and Consulting on a variety of computing platforms. Updated: 11 Sept 91  Hundred Acre Software Consultants 1280 Terminal Way, Suite 26 Reno NV 89502-3243 (702) 329-9333 Hundred Acre is a consulting group providing support and development services to organizations of all sizes. We support all kinds of publicly available software, not just GNU; write for the current list. We work on a "service contract" basis for support -- for a yearly fee, we provide email and toll free telephone support, and free updates and bug fixes. Certain support levels even have free on-site support. Development is charged on either an hourly or fixed bid basis. Consulting rates: $50 to $70 per hour, or fixed bid. Support contracts: Several levels, from $500 to $30000 per year. Updated: 2 Jul 91  Jose A. Fernandez WORK: Inference Corporation HOME: 550 N. Continental Blvd. 1025 Hillside Dr. El Segundo, CA 90245 Chino Hills, CA 91709 (310) 322-0200 (714) 528-2523 RATES: $50-$200/hour plus expenses (or possibly free), depending on task. SERVICES: GNU software: installation, troubleshooting, and customization. X11 software: installation and troubleshooting. SysAdmin: installation, configuration, and trouble-shooting. NetAdmin: installation, configuration, and trouble-shooting. Education: teaching how to fish opens the demand for fishing poles. Advice: free over email. Entered: 10 Jul 92  Scott D. Kalter 970 Palm Ave. #218 West Hollywood, CA 90069 Home: (213)657-9174 Work: (213)524-1805 Emacs: e-lisp and C level customization/extension training for general use and customization user support, installation, troubleshooting Rates: approx. $50/hr, negotiable Very willing to answer quick questions for free. Prefer e-mail communication to telephone. Qualifications: BS Math/CS 1985: Carnegie Mellon University MS CS 1988: UCLA Extensive e-lisp level modification for rapid prototyping of designs used in groupware research. Very familiar with all levels of elisp programming. Taught Emacs use and customization in universities and industry. Extensive troubleshooting and user support experience. Updated: 10/10/91  Scott J. Kramer P.O. Box 3392 San Rafael, CA 94912 +1 415-454-1295 Emacs: Tutoring, installations/upgrades, Lisp customizations, general troubleshooting/support. Prefer that work I do becomes part of the official Free Software Foundation distribution. Rate: Task- and time-dependent; non-monetary offers considered. Updated: 28Aug91  Fen Labalme Broadcatch Technologies 40 Carl St. #4 San Francisco CA 94117 (415) 731-1174 Rates: Free phone consultation Extended project or consultation: $70/hour plus expenses Non-profits get lower rates or free; barter welcome! Emacs: Anything but specific termcap questions (general ones OK). Includes elisp extensions & teaching beginning or advanced users. Experience: I've been "hacking Emacs" for just about 15 years now. Updated: 7/30/91  David C Lawrence P.O. Box 61 North Chatham, NY 12132-0061 Home:518 766-9098 Work:518 851-2813 Rates: $30 hour for projects less than 8 hours. $20 hour for longer projects. Course fees vary with level of subject being taught. Short queries answered free of charge. All rates negotiable. Support: Emacs (both lisp and C aspects), GCC, GAWK, sed, fileutils, binutils, miscellaneous others. Definitely not G++. Consulting via email or telephone, or possibly on-site. Updated: 11 Sept 91  Greg Lehey LEMIS Schellnhausen 2 W-6324 Feldatal Germany Phone: +49-6637-1488 Fax: +49-6637-1489 Mail Services: Supply, porting, installation, consultation on all GNU products. Experience: 20 years OS and compiler experience, portations of most GNU products. Entered: 10 Jul 92  Marty Leisner 332 Shaftsbury Road Rochester, New York 14610 Home:(716) 654-7931 Experience: 10 years C/Unix, 7 years DOS. Extensive experience with GNU binary tools, cross-compilers, embedded/hosted systems. Degree : BS CS, Cornell University Rates: $75/hr Updated: 3 Apr 93  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 parts of the GNU Hurd. Author of several Emacs Lisp packages and parts of Emacs 19. FSF employee summer 1989, fall 1990 to the present. Installation, maintenance, porting, enhancement of all GNU software. Fees negotiable. I can work anywhere in the Boston or SF Bay Area, or anywhere on the Internet. Updated: 10/18/92  Lee McLoughlin Department of Computing, Imperial College, 180 Queens Gate, London SW7 2BZ, UK work: +44 71 589 5111 X 5085 gcc, emacs: can support and port to new machines other: some experience with most gnu packages Ported emacs to two new platforms (WhiteChappel Worstations, HLH Orion). Worked on gcc port to Intergraph Clipper. Support various gnu packages as part of a teaching service. Rates: Quick phone questions are free. Degrees:.Sc(Hons) Computer Science Other: I'm a general workaholic and well versed in compilers, communications and most things related to Unix. Updated: 10.10.91  T.S.Mohan KBCS Group Supercomputer Education and Research Centre Indian Institute of Science Bangalore 560 012 INDIA Telephone (01-91-812)-341811, -341805 Rate: NIL. Availability for consultancy depends on work load. High preference for academic institutions. Support: emacs, gdb, gcc, g++ and other small public domain utilities Experience: Installed and supported these + other gnu programs in our centre for the past three years. General help to sister academic departments and other academic institutions. Degrees: Master of Engineering in CS. Currently working towards a PhD in Distributed computing and programming languages. Updated: 1 Dec 91  Mojave Systems 1254 Harvard Avenue Claremont, CA 91711 714-621-7372 Mojave Systems offers porting services, warranty protection, and software support for several GNU products. Porting services are provided for a fixed fee. Software support is provided for fixed annual fee. Mojave Systems is able to provide these services for a wide variety of hosts. We are currently porting GNU make and RCS to non-Unix hosts. Entered: 12 Dec 90  Eric Raible Nasa Ames Research Center Mail Stop T045-1 Moffett Field, CA, 94035 (415) 604-4320 (W) Rates: $40 hour; email questions free. Gnu emacs C/lisp programming and porting. General unix/graphics/emacs hacking, especially on Silicon Graphics workstations. Degree: MIT 83 BS CS. Updated: 11 Sept 91  Paul Reilly 721 Bennington Drive Raleigh, NC 27615 Work: 919 248 6210 Home: 919 847 7294 Services: access, installation, porting, customizing and debugging Unix Free software: X11, GNU, TeX, etc. Rates: $150/hour Updated: Dec 91  Adam J. Richter ...!ucbvax!soda!adam 409 Evelyn Avenue, Apartment 312 (510) 528-3209 Albany, CA 94706 fax: (510) 528-8508 X windows server expert. Freeware (especially copylefted) projects preferred. Updated: 18 Nov 91  Wolfgang S. Rupprecht PO Box 6524 Alexandria, VA 22306-0524 (703) 768-2640 Emacs: 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 to appear in Emacs 19. Rates: $75/hr. Updated: 7/20/91  John Sechrest Jasmic Systems Internet: 2140 SW 49th St. UUCP: Corvallis, Oregon 97333 Gnu software: Questions about gnu emacs general use, training and classes, documentation, system set up and design. Experience: 11 years of Unix work. Heavy on System administration. Teaching classes in Unix system administraion, Unix Kernal Programming, Networking and Consulting services. Currently working as the Support Coordinator for Oregon State University (for 8 years). Familiar with BSD systems mostly. Some SysVR4. I have supported VAxes, HP's with HPUX, HP's with 4.3 BSD, Sequent's, Next's and a few other misc. machines. Updated: 28 Oct 91  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. Entered: 11 Jun 93  Steve Simmons Inland Sea 9353 Hidden Lake Circle Dexter, MI 48130 313-769-4086 (office1) 313-426-2086 (office2) Rate: $75.00/hr for straight time until Jan 1, 1992. Rates will go up an undetermined amount at that time. Free advice for short questions by phone or email. Programs Supported: Any. Quality of support I can offer depends on the nature of the software; in particular I am *not* a compiler person. Experiance: 13 years in computing, 10 with UNIX and various derivatives. Specialist in systems administration. Lots of network admin. Degree: Bachelors from University of Michigan, 1980. Updated: 10 Oct 91  Lynn Slater 42075 Lawrence Place Fremont Ca 94538 Office (415) 438-2048; Home (415) 793-1864; Fax (415) 438-2034 Programs: Gnu Emacs Ada Mode, Gnu Emacs Empire Tool, Emacs, g++ and gnumake (limited support only). Experiance: Gnu Emacs Ada Mode -- Co-author, principle integrator Gnu Emacs Empire Tool -- Originator, co-author, principle distributor Emacs -- Almost all parts. Authored super-apropos, headers, first GDB interface, fancy-lisp, enhanced scribe mode,and lots of small stuff g++ -- Have maintained, modified, and used G++ on 300+ user commercial OLTP software. gnumake -- Have bug fixed and extended. Have single makefile that can merge in local changes and build the following systems in a consistent manner in multiple releases on multiple machines: asm, bison, gcc, g++, emacs, rcs, gdb, libg++, att c++ libs, gnumake, diff, tex2iroff The makefile and related techniques are a bit hard to explain, but they enable use and local changes in a broad spectrum of FSF code on many platforms without having to remember all the individual make procedures. Rate: Free for good cause or short stuff as there is time. Am most likely to help in areas in which I have had problems or expect to have problems. Updated: 10 Oct 91  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: 11 Sept 91  Randall D. Smith 20 Watson Street Cambridge, MA 02139, USA +1 (617) 983-0276 Will work on most GNU software. Installation, handholding, trouble shooting, extensions, teaching, GCC, GDB, GNU-EMACS, and other ports. Rates: Upward from $50.00/hour depending on my expertise in the area of the job. GDB consulting at $80.00/hour. Experience: 4 years of intensive experience with Unix and C including system hacking and modification. Experience in porting GNU-EMACS (to SGI Iris 4D) and GCC (to use Sun FPA chip). Experience working full-time for the GNU project on other GNU programs (June 1988 - August 1989). Primary maintainer of GDB and the GNU loader for that period. Resume available on request. Entered: 10 Feb 92  Julian H. Stacey Holz Strasse 27d, Munich, 80469, Germany. +49 89 268616 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) Commercial Freelance Consultancy: Custom designs, provision & support of Unix, C, FSF tools, X Windows, 386BSD, own tools, systems engineering, hardware, multi lingual systems (inc. Cyrillic etc), real time etc. Resume on request. No Emacs work. Rate: 140 DM/hour FSF sources: on 1/4" QIC tape (60M/150M/525M) ~170 DM, to inc. an FSF contrib. Updated: 9 Aug 93  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. Entered: 5/24/90  Jonathan Stone c/o- Institute of Statistics and Operations Research Victoria University of Wellington P.O Box 600 Wellington New Zealand Work: +64 4 715-315 Fax: +64 4 712-070 Rate: hourly rate: NZ $ 150/hr. Quick phone questions are free. Reduced rates available for for non-profit/educational insts and daily rate work. Fixed-price contracts also considered. Programs: GNU Emacs, GCC, GDB, GNU binutils, Ghostscript, MIT X11 I am the author of the Pyramid ports of gcc and gdb. Experiance: Five years administration of Unix systems and GNU tools in University environments, and support of Unix administrators and GNU tools as an external contractor to New Zealand Government departments. Degrees: M.Sc (Distinction) for a thesis involving work done on GCC. Updated: 28 Aug 91  Bob Sutterfield work: home: Morning Star Technologies 1760 Zollinger Road 3542 Norwood Street Columbus, Ohio 43221 USA Columbus, Ohio 43224-3424 USA (614)451-1883 (614)267-7611 Rates: $50/hr (negotiable) plus travel expenses Gratis to Christian missionaries and mission agencies Services: Installation, troubleshooting, and mild customization of most GNU production and beta-test software; tutorials, training, and handholding; general UNIX system and network consulting. Entered: 2/16/92  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.3BSD, SVR3 and SVR4, 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: 10 Jul 92  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: 12 Feb 92  Joe Wells care of: Boston University Computer Science Department 111 Cummington Street, Room 138 Boston, Massachusetts 02215 Work: (617) 353-3381; Home: (617) 352-7508 (until mid-May 1994) 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 primary programming languages are Emacs Lisp, Perl, and Bourne shell. 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. Send e-mail for my complete resume. 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 can do part-time (less than 20 hours per week including travel) work. I can either work in or near Boston or via the Internet or via telephone. My schedule is fairly flexible. Any programs I write will normally have the copying conditions of the GNU General Public License. Rates: $60/hour as an independent contractor. travel and telephone expenses. higher rates if extensive travel is required. Updated: 21Sep93  Chris Welty RPI Computer Science Dept Troy, NY 12180 518-276-2816 (W) EMail correspondance preferred. Rates vary depending on need, barter often accepted. Programs: emacs, especially emacs lisp. Lots of experience in various areas. BS, MS from RPI. Currently working on PhD. Updated: 10/10/91  Pace Willisson Blitz Product Development Corporation 4 Spruce Road Medway, MA 02053, USA Work: (508) 533-6430 Rates: $80.00/hour Will work on any GNU software. Experience: 12 years working with C, Unix and Lisp Machines including compilation systems, networks, device drivers, demand paging systems, boot programs and window systems. Ported GDB to 80386. Designed COFF encapsulation scheme to run GNU linker output on System 5 kernels. Author of Unix "ispell". Degree: BS in Computer Science from MIT Updated: 7/31/91  Patrick Wood Pipeline Associates, Inc. 2740 Route 10 West Morris Plains, NJ 07950 Rate: Free Support For: gcc, binutils, gnulib, using gcc for cross compiling Experiance: used gcc for cross compiling for over 2 years; used gcc for three years; installed and support gcc on several BSD and System V UNIX systems; wrote peephole optimizer for gcc on 68K, wrote portable replacement for FP routines in gnulib.c. Modified gcc and binutils to work in byte-swapped environments. Other: email consulting only , uunet!motown!pipeline!phw,sun!pipeline!phw, amdcad!pipeline!phw Updated: 18 Sept 91  xprt Computer Consulting, Inc. 17200 El Camino Real Suite 110 T Houston, TX 77058 (713) 480 UNIX (713) 486 8575 (Fax) Programs Supported: X11, TeX, and all of GNU. Experience: We have supported and maintained all of GNU, X11 and TeX for over four years for a major oil company's research division on several different Unix platforms. Rates: $150/hour Entered: 10 Jul 92  Name: david d [zoo] zuhn Company: armadillo zoo software Fees: $50/hour, discounts for educational institutions and non-profits GNU and X11 installation and maintainance on SGI Iris, Sun [68k & SPARC], and Sequent machines. Additional machines a possibility. Any GNU software installed. Most supported. Updated: 7/11/92  For a current copy of this directory, or to have yourself listed, ask: gnu@prep.ai.mit.edu ** Please keep this file alphabetical ** emacs-19.22/etc/SUN-SUPPORT100666 13437 13 20630 5405340660 13341 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.22/etc/TERMS100666 13437 1 22065 4732061061 12657 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.22/etc/TO-DO100444 12241 12 6415 5444560612 13001 0ustar rolandstaffThings useful to do for GNU Emacs: * Primitive for random access insertion of part of a file. * Making I/O streams for files, so that read and prin1 can be used on files directly. The I/O stream itself would serve as a function to read or write one character. * If a file you can't write is in a directory you can write, make sure it works to modify and save this file. * Make dired's commands handle correctly the case where ls has listed several subdirectories' contents. It needs to be able to tell which directory each file is really in, by searching backward for the line which identifies the start of a directory. * Add more dired commands, such as sorting (use the sort utility through call-process-region). * Make display.c record inverse-video-ness on a character by character basis. Then make non-full-screen-width mode lines inverse video, and display the marked location in inverse video. * VMS code to list a file directory. Make dired work. Long range: Ideas for extending GNU Emacs to deal with arbitrary character sets. I would like GNU Emacs to be extended to handle all the world's alphabets and word signs. I don't expect to have time to do such a thing in the next few years, so here are my ideas on the best way to do it. * Each graphic is represented by a sequence of ordinary 8-bit characters. * All the characters that make up such a sequence have codes >= 0200. * The first character of such a sequence is between 0200 and 0237. * The remaining characters of such a sequence are all 0240 or higher. * The first character of the sequence determines the number of characters in the sequence. Thus, 0200...0207 could start two-character sequences, 0210...0227 could start three-character sequences, and 0230 could start four-character sequences. (Codes 0231...0237 would be reserved.) * Several common alphabets, and some mathematical symbols, would get two-character sequences. (Probably Greek, Russian, Hebrew(?), Arabic(?), Korean, and Japanese kana). The remaining alphabets, and some versions of Chinese, would get three-character sequences. Other sets of Chinese characters would get four-character sequences. Each country that uses Chinese characters has its own standard character set, and it is not easy to correlate them to avoid overlap. So there may need to be several sets of Chinese characters. That is why they need so much code space. True support for Hebrew and Arabic requires dealing with the problem of writing direction for mixed text; I don't know what to do for that. * The functions that use syntax table would determine the syntax of a sequence from its first character. * Functions in indent.c for computing widths and columns would determine the width of a sequence from its first character. So would display routines. * Only a few other editing routines would need any change. In particular, searching and regexp matching might not need any change. * Most of the work required would be in redisplay. The only case that needs to be supported is with X windows, since ordinary terminals can't display all these characters anyway. * There might need to be code to translate files from this format to whatever format is typically stored on disk. I would be very unhappy with half-measures, such as support for Japanese only. emacs-19.22/etc/TUTORIAL100444 12120 13 107114 5426134163 12650 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). 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 key down while typing . If there is no META or EDIT key, type , release it, then type the character . "" stands for the key labelled "ALT" or "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 , you get a new window appearing on the screen, telling you that M-ESC is a "disabled command" and asking whether you really want to execute it. The command M-ESC is marked as disabled because you probably don't want to use it until you know more about Emacs, and we expect it would confuse you if it were allowed to go ahead and run. If you really want to try the M-ESC command, you could type a Space in answer to the question and M-ESC would go ahead. Normally, if you do not want to execute M-ESC, 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 might be labelled "Delete" instead of "Rubout" on some terminals. 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." 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 usual way to exit Emacs, because it is always better not to kill the Emacs if you are going to do any more editing. 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 where suspending is not possible, C-z creates a subshell running under Emacs to give you the chance to run other programs and return to Emacs afterward, but 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. You would use C-x C-c if you were about to log out. You would also use it to exit an Emacs invoked under mail handling programs and other random utilities, since they may not believe you have really finished using the Emacs if it continues to exist. 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. * 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. 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. >> 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. >> 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. 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.22/etc/Xkeymap.txt100666 13437 1 23327 4200740752 14224 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.22/etc/celibacy.1100666 13437 1 270 4022773675 13646 0ustar jimbdaemonCELIBACY(1) UNIX Programmer's Manual CELIBACY(1) NAME celibacy - don't have sex SYNOPSIS celibacy DESCRIPTION Does nothing worth mentioning. emacs-19.22/etc/condom.1100666 13437 13 11771 5405340661 13147 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.22/etc/copying.paper100666 12120 13 120216 5471317220 14164 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.22/etc/ctags.1100666 13437 13 21 5231576065 12701 0ustar jimbuser.so man1/etags.1 emacs-19.22/etc/echo.msg100666 13437 1 6500 3755367602 13462 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.22/etc/emacs.1100666 12120 13 32766 5406003054 12624 0ustar rmsuser.TH EMACS 1 "1990 November 13" .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 new version of .I Emacs, written by the author of the original (PDP-10) .I Emacs, Richard Stallman. Its user functionality 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 " commandfile" Edit in batch mode using the commands found in .I commandfile. The editor will send messages to stdout. This option must be the first in the argument list. .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 for $20.00/copy postpaid from the Free Software Foundation, which develops GNU software (contact them for quantity prices on the manual). Their address is: .nf Free Software Foundation 675 Mass Ave. Cambridge, MA 02139 .fi 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 able to use the GNU system for free. .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.22/etc/emacs.bash100666 12120 13 2404 5370475112 13353 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.22/etc/emacs.csh100666 13437 13 2272 5405340662 13352 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.22/etc/emacs.icon100666 13437 1 3615 4410034104 13753 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.22/etc/emacs.xbm100666 21641 13 5223 5321217067 14221 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.22/etc/emacstool.1100666 13437 13 11522 5405340663 13652 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.22/etc/etags.1100666 13437 13 13356 5231623716 12776 0ustar jimbuser.\" Copyright (c) 1992 Free Software Foundation .\" See section COPYING for conditions for redistribution .TH etags 1 "10feb1992" "GNU Tools" "GNU Tools" .de BP .sp .ti -.2i \(** .. .SH NAME etags -- generate tag file for Emacs .br ctags -- generate tag file for vi .SH SYNOPSIS .hy 0 .na .B etags [\|\-CDSTVHadt\|] [\|\-i \fIfile\fP\|] [\|\-o \fIoutfile\fP\|] .br [\|\-\-defines\|] [\|\-\-no\-defines\|] [\|\-\-c++\|] [\|\-\-typedefs\|] [\|\-\-typedefs\-and\-c++\|] [\|\-\-ignore\-indentation\|] .br [\|\-\-help\|] [\|\-\-version\|] .br [\|\-\-include=\fIfile\fP\|] [\|\-\-output=\fIoutfile\fP\|] [\|\-\-append\|] \fIfile\fP .\|.\|. .B ctags [\|\-CDSTVHadt\|] [\|\-BFuvwx\|] [\|\-o \fIoutfile\fP\|] .br [\|\-\-defines\|] [\|\-\-no\-defines\|] [\|\-\-c++\|] [\|\-\-typedefs\|] [\|\-\-typedefs\-and\-c++\|] [\|\-\-ignore\-indentation\|] [\|\-\-no\-warn\|] .br [\|\-\-backward\-search\|] [\|\-\-forward\-search\|] [\|\-\-vgrind\|] [\|\-\-cxref\|] .br [\|\-\-help\|] [\|\-\-version\|] .br [\|\-\-output=\fIoutfile\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, Fortran, LaTeX, Scheme and Emacs Lisp/Common Lisp. 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; there are no switches for specifying the language. .SH OPTIONS Some options make sense only for \fBvi\fP style tag files; \fBetags\fP does not recognize them. The programs accept unambiguous abbreviations for long option names. .TP .B \-d, \-\-defines Create tag entries for C preprocessor definitions, too. This is the default behavior for -\Betags\fP. .TP .B \-D, \-\-no\-defines Do not create tag entries for C preprocessor definitions. This is the default behavior for -\Bctags\fP. .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 \-t, \-\-typedefs Record typedefs in C code as tags. .TP .B \-T, \-\-typedefs\-and\-c++ Generate tag entries for typedefs, struct, enum, and union tags, and C++ member functions. .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. .TP .B \-w, \-\-no\-warn Suppress warning messages about duplicate entries. The \fBetags\fP program does not check for duplicate entries, so this option has no effect on it. .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. Only \fBctags\fP accepts this option. .TP .B \-F, \-\-forward\-search Tag files written in the format expected by \fBvi\fP contain regular expression search instructions; the \fB\-F\fP option writes them using the delimiter `\|\fB/\fP\|', to search \fIforwards\fP through files. Only \fBctags\fP accepts this option; it is the default behavior. .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 \-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. .TP \fB\-i\fP \fIfile\fP, \fB\-\-include=\fIfile\fP Include a note in tag file indicating that, when searching for a tag, one should also consult the tags file \fIfile\fP after checking the current file. Only \fBetags\fP accepts this option. .TP \fB\-o\fP \fIoutfile\fP, \fB\-\-output=\fIoutfile\fP Explicit name of file for tag table; overrides default `\|TAGS\|' or `\|tags\|'. (But ignored with \fB\-v\fP or \fB\-x\fP.) .TP .B \-a, \-\-append Append to existing tag file. (For vi-format tag files, see also \fB\-\-update\fP.) .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. (Implies vi-format tag file.) .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.22/etc/etags.notes100666 13437 13 17307 5405340664 13767 0ustar jimbuserReturn-Path: Date: Thu, 19 Jan 89 12:06:02 EST From: kendall%saber@harvard.harvard.edu To: rms@wheaties.ai.mit.edu Cc: kendall@harvard.harvard.edu Subject: Here you go The papers I signed should arrive tomorrow if they haven't already. There are three files here: TAGS.README, a file of random comments in lieu of real documentation (I didn't get around to modifying the info tree); etags.c; and tags.el. Testing is needed for languages other than elisp, C, and C++. I'll be back next Thursday. Hope you like the stuff; talk to you then. --Sam ------------------------------- TAGS.README ---------------------------- Changes and suggested enhancements to etags.c and tags.el Sam Kendall 1/19/89 etags options added (all the options should be documented in the info tree, but I didn't get around to doing that): -D C/C++ only: Do not find macro constants. For many programs, this option halves the size of the TAGS file. Note a bug: macro constants defined to nothing are not found. -S C/C++ only: Do not assume that a '}' at the beginning of a line means the end of a function. -S is helpful for some poorly indented programs, such as "cfront". Do not use -S if your braces are unbalanced (as can happen with conditional compilation). There was a -C option, meaning assume that .h and .c files are C++ rather than C, but I made it the default. It seems to produce very few spurious C++ tags in C programs. I've made it illegal to pass most ctags options to etags. (To use the program as ctags, it must be compiled with -DCTAGS, or with neither -DETAGS nor -DCTAGS.) I haven't documented the ctags-only options here. tags.el modified as follows: 1. find-tag modified to handle the new "tag" field in a tag line. A tag line can either be in the old format: definition\177lineno,charno or can have the additional "tag" field: definition\177lineno,charno,\001tag This "tag" field is necessary for C++, where the entire tag is NOT necessarily found on the definition line. The "tag" field also helps with exact tag matching. There may be more than one tag, separated by \001 characters. The theory here is that you provide the tag field when the definition field does not contain the correct tag. This theory could be made more rigorous, to help with, for instance, exact tag matching in mixed Lisp/C programs. The old tags.el will fail with new-format lines in TAGS files, but there are many new-format lines only in C++ programs. This tags.el will work fine with old-format TAGS files. 2. All tags functions modified to ignore the character count that follows each filename in the TAGS file. Behavior is not changed, but this makes it much easier to write a program that edits the TAGS file. 3. When finding multiple matches for the same tag (via a prefix arg to find-tag, usually invoked with "ESC ,"), exact matches are found first; then word matches; then other matches. tags.el enhancements needed: doesn't know how to handle included TAGS files yet per-mode and/or local versions of find-tag-default, for easy customization eliminate duplicates in alist when prompting Enhancements to make: * Generalize file suffix stuff -- clumsy and verbose now. Should be config-file- or environment variable- or option-driven. * Treat C++ "operator token" as a single identifier -- canonicalize to leave one space between "operator" and token when token is an identifier, no space when token is an operator. * Make a tag for a struct tag in plain C as `struct name' (likewise for union etc.). In canonical form, exactly one space in between. Currently we make `name' into a tag in etags only; we can't in ctags because `name' may not be unique, which breaks ctags. * Symbol table should be implemented as a hash table instead of as a linked list. * The TeX stuff should use the Stab abstraction. * Needs profiling and performance enhancements. * Can -C be eliminated? It is (nearly) unnecessary complexity. Perhaps merge -C and -t into a single option that indicates "well-formed programs". This option should probably be the default. In etags only, not ctags. (ctags must not find struct tags by default in plain C.) * Is it possible to match C global variables? It would be real nice. * The C line "struct foo { ... };" will create a tag line that searches for "struct foo ". If the search included the "{" it would be more specific. This point is even more true if "foo" and "{" are separated by a newline rather than a space, but having the search pattern include a newline would require changes in the TAGS file format. * Needs config file to handle typical heavy C++ macrification. Config file must allow the definition of macros that expand to types (e.g. `Seq(T)' expands to `Seq_T'), symbol-defining macros (e.g. `DefineSeq(T)' should be interpreted as a definition of `Seq_T'), macros that expand to symbols (e.g. `M(Foo,Bar)' expands to `Class_Foo::Bar'), and macros that cause unbalanced braces or parens (e.g. `LOOP' (whose C definition is "while(1){") leaves one left brace). Probably others. * Config file should also handle definition of the "DEF" convention of the Gnu Emacs source, and definition of the C* language ("domain" keyword), so these can be taken out of the etags source. * For C++, "::" is only understood if it occurs between identifiers with no intervening whitespace. This style of C++ function definition: returntype classname:: functionname(formals) { ... } is not understood. * Is there "::" handling needed for Common Lisp? * Nroff/troff handling would be easy to write and useful. It could be one of the default file modes, along with Pascal, Fortran and C -- if a source file starts with "'" or ".", it's nroff/troff source. * There should be a defined interface between the language-independent part of etags and the language modules. This would make it easier to add a module. * Macros defined inside braces aren't found, e.g., struct foo { #define FOO() BAR ... }; * '#' is only recognized to start a preprocessor line if it is in column 0. According to ANSI it can be preceded by whitespace. * A constant macro with no definition, e.g. `#define FOO', will not be tagged, because `definedef' is prematurely reset by CNL. * `typedef unsigned char TOK;' will get `char' defined as well as `TOK'. Items about the format of the TAGS file: * Should make some special indication in a tags line that means both (1) the pattern is an exact match for the definition line, and (2) the ^? immediately follows the tag. In absence of this indication, the pattern is only the beginning of the definition line, and the last character before the ^? is not part of the tag. Helps in the following situation: struct foo *p; struct foo { ... }; Currently find-tag finds the first line instead of the correct second one. * Some way to tell whether the line `char *foo^?5,200' is the tag `foo' or `*foo'. Since there are no modes in the TAGS file, we can't (easily) say that since this is C, it can't be `*foo'. So this line should be `char *foo^?5,200,^Afoo'. We need to decide on the characters that are not in identifiers for any language. How about space, TAB, FF, `(', `)', and `;'? * Along the same lines, both etags and tags.el should canonicalize tags to lowercase for case-independent languages. So `(defun Foo^?5,200' in Lisp (but not Elisp) should be `(defun Foo^?5,200,^Afoo'. emacs-19.22/etc/etags.vms100666 13437 1 1127 4255357672 13670 0ustar jimbdaemonVMS-ed version of etags ----------------------- 1. The changes made allow the program to compile correctly, to give error messages more meaningful to VMS, to allow '$' in identifier tokens in C programs, and to expand wild-cards in the input filespecs. 2. To minimize the differences from the original version, the VMS filename expansion converts filenames to lower case, and strips version numbers. This does indeed mean that some input specs (containing version wildcards) will cause curious effects, it is reasonably consistent with Emacs, which ignores file versions. emacs-19.22/etc/ledit.l100666 13437 1 11352 3461063034 13315 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.22/etc/ms-kermit100666 13437 1 7536 5013650551 13664 0ustar jimbdaemon;;; This file is designed for an 8-bit connection. ;;; Use the file ms-kermit-7bit 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.22/etc/ms-kermit-7bit100666 13437 1 22322 5013650467 14543 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.22/etc/news.texi100666 12241 13 412005 5417061555 14023 0ustar rolanduser\input texinfo @c -*-texinfo-*- @setfilename LNEWS @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.22/etc/refcard.ps100644 74507 1 356577 5405423301 14616 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.22/etc/refcard.tex100666 12120 13 46721 5405422707 13607 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 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. % 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} \metax{blank out rectangle}{M-x clear-rectangle} \metax{prefix each line with a string}{M-x string-rectangle} \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--5)}{{\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 "\