Test jpeglib version.
config.cache
Makefile
emacs*.tar.gz
-leim*.tar.gz
-*.xdelta
TOOLKIT is `athena' or `motif' (`yes' and `lucid' are synonyms for
`athena'). On some systems, it does not work to use a toolkit with
shared libraries. A free implementation of Motif, called LessTif, is
-available ftom <http://www.lesstif.org>. Compiling with LessTif or
-Motif causes a standard File Selection Dialog to pop up when you type
-"C-x C-f" and similar commands. You can get fancy 3D-style scroll
-bars, even without LessTif/Motif, if you have the Xaw3d library
+available ftom <http://www.lesstif.org>. You can get fancy 3D-style
+scroll bars, even without LessTif/Motif, if you have the Xaw3d library
installed (see "Image support libraries" above for Xaw3d
availability).
esac ; \
fi ; \
done
- (cd ${archlibdir} && rm -f fns-*)
- -rm -rf ${libexecdir}/emacs/${version}
- (cd ${infodir} && rm -f cl* ada-mode* autotype* ccmode* ebrowse* efaq* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* widget* woman* dired-x* ediff* emacs* forms* gnus* info* mh-e* sc* vip*)
+ (cd ${infodir} && rm -f cl* dired-x* ediff* emacs* forms* gnus* info* mh-e* sc* vip*)
(cd ${man1dir} && rm -f emacs.1 etags.1 ctags.1)
(cd ${bindir} && rm -f emacs-${version} $(EMACS))
extraclean:
for i in ${SUBDIR}; do (cd $$i; $(MAKE) $(MFLAGS) extraclean); done
${top_distclean}
- -rm -f config-tmp-*
+ -rm config-tmp-*
-rm -f *~ \#*
### Unlocking and relocking. The idea of these productions is to reduce
# The src subdir knows how to do the right thing
# even when the build directory and source dir are different.
-TAGS tags: lib-src src
+TAGS tags:
+ lib-src src
cd src; $(MAKE) tags
check:
+++ /dev/null
-This file describes various problems that have been encountered
-in compiling, installing and running GNU 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.
-
-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 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 starts in a directory other than the one that is current in the shell.
-
-If the PWD environment variable exists, Emacs uses this variable as
-the initial working directory.
-
-Some shells automatically update this variable, while other shells fail
-to do so. If you use two such shells in combination, the variable can
-end up wrong. This confuses Emacs.
-
-The solution is to put something in the start-up file for the shell
-that does not update PWD, to get rid of that environment variable.
-For example, in csh, use `unsetenv PWD'.
-
-* Emacs gets error message from linker on Sun.
-
-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.
-
-* Watch out for .emacs files and EMACSLOADPATH environment vars
-
-These control the actions of Emacs.
-~/.emacs is your Emacs init file.
-EMACSLOADPATH overrides which directories the function
-"load" will search.
-
-If you observe strange problems, check for these and get rid
-of them, then try again.
-
-* Shell mode ignores interrupts on Apollo Domain
-
-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 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.
-
-Some people have found that Emacs was unable to connect to the local
-host by name, as in DISPLAY=prep:0 if you are running on prep, but
-could handle DISPLAY=unix:0. Here is what tale@rpi.edu said:
-
- Seems as
- though gethostbyname was bombing somewhere along the way. Well, we
- had just upgrade from SunOS 3.5 (which X11 was built under) to SunOS
- 4.0.1. Any new X applications which tried to be built with the pre
- OS-upgrade libraries had the same problems which Emacs was having.
- Missing /etc/resolv.conf for a little while (when one of the libraries
- was built?) also might have had a hand in it.
-
- The result of all of this (with some speculation) was that we rebuilt
- X and then rebuilt Emacs with the new libraries. Works as it should
- now. Hoorah.
-
-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
-
-* 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")
-
-An even more drastic measure is to make Emacs use flow control.
-To do this, evaluate the Lisp expression (set-input-mode nil t).
-Emacs will then interpret C-s and C-q as flow control commands. (More
-precisely, it will allow the kernel to do so as it usually does.) You
-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.
-
-* 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 <Key>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.
-
-This directory tree holds version 21.0.98 of GNU Emacs, the extensible,
+This directory tree holds version 21.0.96 of GNU Emacs, the extensible,
customizable, self-documenting real-time display editor.
You may encounter bugs in this release. If you do, please report
LD_SWITCH_X_SITE_AUX=-R`echo ${x_libraries} | sed -e "s/:/ -R/g"`
x_default_search_path=""
for x_library in `echo ${x_libraries} | sed -e "s/:/ /g"`; do
- x_search_path="\
-${x_library}/X11/%L/%T/%N%C%S:\
-${x_library}/X11/%l/%T/%N%C%S:\
-${x_library}/X11/%T/%N%C%S:\
-${x_library}/X11/%L/%T/%N%S:\
-${x_library}/X11/%l/%T/%N%S:\
-${x_library}/X11/%T/%N%S"
+ x_search_path="${x_library}/X11/%L/%T/%N%C%S:\
+${x_library}/X11/%L/%T/%N%C%S:${x_libary}/X11/%l/%T/%N%C%S:\
+${x_library}/X11/%T/%N%C%S:${x_library}/X11/%L/%T/%N%S:\
+${x_library}/X11/%l/%T/%N%S:${x_library}/X11/%T/%N%S"
if test x"${x_default_search_path}" = x; then
x_default_search_path=${x_search_path}
else
GNU_MALLOC=yes
doug_lea_malloc=yes
echo $ac_n "checking for malloc_get_state""... $ac_c" 1>&6
-echo "configure:3892: checking for malloc_get_state" >&5
+echo "configure:3889: checking for malloc_get_state" >&5
if eval "test \"`echo '$''{'ac_cv_func_malloc_get_state'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3897 "configure"
+#line 3894 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char malloc_get_state(); below. */
; return 0; }
EOF
-if { (eval echo configure:3920: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3917: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_malloc_get_state=yes"
else
fi
echo $ac_n "checking for malloc_set_state""... $ac_c" 1>&6
-echo "configure:3941: checking for malloc_set_state" >&5
+echo "configure:3938: checking for malloc_set_state" >&5
if eval "test \"`echo '$''{'ac_cv_func_malloc_set_state'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3946 "configure"
+#line 3943 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char malloc_set_state(); below. */
; return 0; }
EOF
-if { (eval echo configure:3969: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3966: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_malloc_set_state=yes"
else
fi
echo $ac_n "checking whether __after_morecore_hook exists""... $ac_c" 1>&6
-echo "configure:3990: checking whether __after_morecore_hook exists" >&5
+echo "configure:3987: checking whether __after_morecore_hook exists" >&5
if eval "test \"`echo '$''{'emacs_cv_var___after_morecore_hook'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 3995 "configure"
+#line 3992 "configure"
#include "confdefs.h"
extern void (* __after_morecore_hook)();
int main() {
__after_morecore_hook = 0
; return 0; }
EOF
-if { (eval echo configure:4002: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3999: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
emacs_cv_var___after_morecore_hook=yes
else
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:4043: checking for $ac_hdr" >&5
+echo "configure:4040: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4048 "configure"
+#line 4045 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4053: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:4050: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
for ac_func in getpagesize
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:4082: checking for $ac_func" >&5
+echo "configure:4079: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4087 "configure"
+#line 4084 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:4110: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4107: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
done
echo $ac_n "checking for working mmap""... $ac_c" 1>&6
-echo "configure:4135: checking for working mmap" >&5
+echo "configure:4132: checking for working mmap" >&5
if eval "test \"`echo '$''{'ac_cv_func_mmap_fixed_mapped'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
ac_cv_func_mmap_fixed_mapped=no
else
cat > conftest.$ac_ext <<EOF
-#line 4143 "configure"
+#line 4140 "configure"
#include "confdefs.h"
/* Thanks to Mike Haertel and Jim Avera for this test.
Here is a matrix of mmap possibilities:
exit (0);
}
EOF
-if { (eval echo configure:4277: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:4274: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
ac_cv_func_mmap_fixed_mapped=yes
else
LIBS="$libsrc_libs $LIBS"
echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6
-echo "configure:4306: checking for dnet_ntoa in -ldnet" >&5
+echo "configure:4303: checking for dnet_ntoa in -ldnet" >&5
ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-ldnet $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4314 "configure"
+#line 4311 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
dnet_ntoa()
; return 0; }
EOF
-if { (eval echo configure:4325: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4322: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6
-echo "configure:4354: checking for main in -lXbsd" >&5
+echo "configure:4351: checking for main in -lXbsd" >&5
ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lXbsd $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4362 "configure"
+#line 4359 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:4369: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4366: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6
-echo "configure:4391: checking for cma_open in -lpthreads" >&5
+echo "configure:4388: checking for cma_open in -lpthreads" >&5
ac_lib_var=`echo pthreads'_'cma_open | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lpthreads $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4399 "configure"
+#line 4396 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
cma_open()
; return 0; }
EOF
-if { (eval echo configure:4410: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4407: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
echo $ac_n "checking for XFree86 in /usr/X386""... $ac_c" 1>&6
-echo "configure:4439: checking for XFree86 in /usr/X386" >&5
+echo "configure:4436: checking for XFree86 in /usr/X386" >&5
if test -d /usr/X386/include; then
HAVE_XFREE386=yes
: ${C_SWITCH_X_SITE="-I/usr/X386/include"}
if test "${opsys}" = "gnu-linux"; then
echo $ac_n "checking whether X on GNU/Linux needs -b to link""... $ac_c" 1>&6
-echo "configure:4471: checking whether X on GNU/Linux needs -b to link" >&5
+echo "configure:4468: checking whether X on GNU/Linux needs -b to link" >&5
cat > conftest.$ac_ext <<EOF
-#line 4473 "configure"
+#line 4470 "configure"
#include "confdefs.h"
int main() {
XOpenDisplay ("foo");
; return 0; }
EOF
-if { (eval echo configure:4480: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4477: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
xlinux_first_failure=no
else
CPPFLAGS="$CPPFLAGS -b i486-linuxaout"
LIBS="$LIBS -b i486-linuxaout"
cat > conftest.$ac_ext <<EOF
-#line 4500 "configure"
+#line 4497 "configure"
#include "confdefs.h"
int main() {
XOpenDisplay ("foo");
; return 0; }
EOF
-if { (eval echo configure:4507: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4504: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
xlinux_second_failure=no
else
# Reportedly, some broken Solaris systems have XKBlib.h but are missing
# header files included from there.
echo $ac_n "checking for Xkb""... $ac_c" 1>&6
-echo "configure:4536: checking for Xkb" >&5
+echo "configure:4533: checking for Xkb" >&5
cat > conftest.$ac_ext <<EOF
-#line 4538 "configure"
+#line 4535 "configure"
#include "confdefs.h"
#include <X11/Xlib.h>
#include <X11/XKBlib.h>
XkbDescPtr kb = XkbGetKeyboard (0, XkbAllComponentsMask, XkbUseCoreKbd);
; return 0; }
EOF
-if { (eval echo configure:4546: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4543: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
emacs_xkb=yes
else
XScreenNumberOfScreen XSetWMProtocols
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:4568: checking for $ac_func" >&5
+echo "configure:4565: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4573 "configure"
+#line 4570 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:4596: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4593: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
if test "${window_system}" = "x11"; then
echo $ac_n "checking X11 version 6""... $ac_c" 1>&6
-echo "configure:4624: checking X11 version 6" >&5
+echo "configure:4621: checking X11 version 6" >&5
if eval "test \"`echo '$''{'emacs_cv_x11_version_6'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4629 "configure"
+#line 4626 "configure"
#include "confdefs.h"
#include <X11/Xlib.h>
int main() {
; return 0; }
EOF
-if { (eval echo configure:4639: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4636: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
emacs_cv_x11_version_6=yes
else
if test "${window_system}" = "x11"; then
echo $ac_n "checking X11 version 5""... $ac_c" 1>&6
-echo "configure:4664: checking X11 version 5" >&5
+echo "configure:4661: checking X11 version 5" >&5
if eval "test \"`echo '$''{'emacs_cv_x11_version_5'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4669 "configure"
+#line 4666 "configure"
#include "confdefs.h"
#include <X11/Xlib.h>
int main() {
; return 0; }
EOF
-if { (eval echo configure:4679: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4676: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
emacs_cv_x11_version_5=yes
else
if test x"${USE_X_TOOLKIT}" = xmaybe; then
if test x"${HAVE_X11R5}" = xyes; then
echo $ac_n "checking X11 version 5 with Xaw""... $ac_c" 1>&6
-echo "configure:4707: checking X11 version 5 with Xaw" >&5
+echo "configure:4704: checking X11 version 5 with Xaw" >&5
if eval "test \"`echo '$''{'emacs_cv_x11_version_5_with_xaw'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4712 "configure"
+#line 4709 "configure"
#include "confdefs.h"
#include <X11/Intrinsic.h>
; return 0; }
EOF
-if { (eval echo configure:4721: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4718: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
emacs_cv_x11_version_5_with_xaw=yes
else
if test "${USE_X_TOOLKIT}" != "none"; then
echo $ac_n "checking X11 toolkit version""... $ac_c" 1>&6
-echo "configure:4749: checking X11 toolkit version" >&5
+echo "configure:4746: checking X11 toolkit version" >&5
if eval "test \"`echo '$''{'emacs_cv_x11_toolkit_version_6'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4754 "configure"
+#line 4751 "configure"
#include "confdefs.h"
#include <X11/Intrinsic.h>
int main() {
; return 0; }
EOF
-if { (eval echo configure:4764: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4761: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
emacs_cv_x11_toolkit_version_6=yes
else
LIBS="-lXt $LIBS"
fi
echo $ac_n "checking for XmuConvertStandardSelection in -lXmu""... $ac_c" 1>&6
-echo "configure:4794: checking for XmuConvertStandardSelection in -lXmu" >&5
+echo "configure:4791: checking for XmuConvertStandardSelection in -lXmu" >&5
ac_lib_var=`echo Xmu'_'XmuConvertStandardSelection | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lXmu $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4802 "configure"
+#line 4799 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
XmuConvertStandardSelection()
; return 0; }
EOF
-if { (eval echo configure:4813: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4810: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${HAVE_X11}" = "yes"; then
if test "${USE_X_TOOLKIT}" != "none"; then
echo $ac_n "checking for XShapeQueryExtension in -lXext""... $ac_c" 1>&6
-echo "configure:4847: checking for XShapeQueryExtension in -lXext" >&5
+echo "configure:4844: checking for XShapeQueryExtension in -lXext" >&5
ac_lib_var=`echo Xext'_'XShapeQueryExtension | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lXext $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4855 "configure"
+#line 4852 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
XShapeQueryExtension()
; return 0; }
EOF
-if { (eval echo configure:4866: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4863: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${USE_X_TOOLKIT}" = "MOTIF"; then
echo $ac_n "checking for Motif version 2.1""... $ac_c" 1>&6
-echo "configure:4898: checking for Motif version 2.1" >&5
+echo "configure:4895: checking for Motif version 2.1" >&5
if eval "test \"`echo '$''{'emacs_cv_motif_version_2_1'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4903 "configure"
+#line 4900 "configure"
#include "confdefs.h"
#include <Xm/Xm.h>
int main() {
#endif
; return 0; }
EOF
-if { (eval echo configure:4914: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:4911: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
emacs_cv_motif_version_2_1=yes
else
EOF
echo $ac_n "checking for XpCreateContext in -lXp""... $ac_c" 1>&6
-echo "configure:4935: checking for XpCreateContext in -lXp" >&5
+echo "configure:4932: checking for XpCreateContext in -lXp" >&5
ac_lib_var=`echo Xp'_'XpCreateContext | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lXp $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 4943 "configure"
+#line 4940 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
XpCreateContext()
; return 0; }
EOF
-if { (eval echo configure:4954: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4951: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${USE_X_TOOLKIT}" != "none"; then
ac_safe=`echo "X11/Xaw3d/Scrollbar.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for X11/Xaw3d/Scrollbar.h""... $ac_c" 1>&6
-echo "configure:4989: checking for X11/Xaw3d/Scrollbar.h" >&5
+echo "configure:4986: checking for X11/Xaw3d/Scrollbar.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 4994 "configure"
+#line 4991 "configure"
#include "confdefs.h"
#include <X11/Xaw3d/Scrollbar.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4999: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:4996: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
echo $ac_n "checking for XawScrollbarSetThumb in -lXaw3d""... $ac_c" 1>&6
-echo "configure:5016: checking for XawScrollbarSetThumb in -lXaw3d" >&5
+echo "configure:5013: checking for XawScrollbarSetThumb in -lXaw3d" >&5
ac_lib_var=`echo Xaw3d'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lXaw3d $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5024 "configure"
+#line 5021 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
XawScrollbarSetThumb()
; return 0; }
EOF
-if { (eval echo configure:5035: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5032: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${with_xpm}" != "no"; then
ac_safe=`echo "X11/xpm.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for X11/xpm.h""... $ac_c" 1>&6
-echo "configure:5103: checking for X11/xpm.h" >&5
+echo "configure:5100: checking for X11/xpm.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5108 "configure"
+#line 5105 "configure"
#include "confdefs.h"
#include <X11/xpm.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5113: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5110: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
echo $ac_n "checking for XpmReadFileToPixmap in -lXpm""... $ac_c" 1>&6
-echo "configure:5130: checking for XpmReadFileToPixmap in -lXpm" >&5
+echo "configure:5127: checking for XpmReadFileToPixmap in -lXpm" >&5
ac_lib_var=`echo Xpm'_'XpmReadFileToPixmap | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lXpm -lX11 $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5138 "configure"
+#line 5135 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
XpmReadFileToPixmap()
; return 0; }
EOF
-if { (eval echo configure:5149: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5146: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${HAVE_XPM}" = "yes"; then
echo $ac_n "checking for XpmReturnAllocPixels preprocessor define""... $ac_c" 1>&6
-echo "configure:5175: checking for XpmReturnAllocPixels preprocessor define" >&5
+echo "configure:5172: checking for XpmReturnAllocPixels preprocessor define" >&5
cat > conftest.$ac_ext <<EOF
-#line 5177 "configure"
+#line 5174 "configure"
#include "confdefs.h"
#include "X11/xpm.h"
#ifndef XpmReturnAllocPixels
if test "${with_jpeg}" != "no"; then
ac_safe=`echo "jerror.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for jerror.h""... $ac_c" 1>&6
-echo "configure:5217: checking for jerror.h" >&5
+echo "configure:5214: checking for jerror.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5222 "configure"
+#line 5219 "configure"
#include "confdefs.h"
#include <jerror.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5227: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5224: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
echo $ac_n "checking for jpeg_destroy_compress in -ljpeg""... $ac_c" 1>&6
-echo "configure:5244: checking for jpeg_destroy_compress in -ljpeg" >&5
+echo "configure:5241: checking for jpeg_destroy_compress in -ljpeg" >&5
ac_lib_var=`echo jpeg'_'jpeg_destroy_compress | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-ljpeg $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5252 "configure"
+#line 5249 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
jpeg_destroy_compress()
; return 0; }
EOF
-if { (eval echo configure:5263: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5260: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${with_png}" != "no"; then
ac_safe=`echo "png.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for png.h""... $ac_c" 1>&6
-echo "configure:5303: checking for png.h" >&5
+echo "configure:5300: checking for png.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5308 "configure"
+#line 5305 "configure"
#include "confdefs.h"
#include <png.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5313: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5310: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
echo $ac_n "checking for png_get_channels in -lpng""... $ac_c" 1>&6
-echo "configure:5330: checking for png_get_channels in -lpng" >&5
+echo "configure:5327: checking for png_get_channels in -lpng" >&5
ac_lib_var=`echo png'_'png_get_channels | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lpng -lz -lm $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5338 "configure"
+#line 5335 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
png_get_channels()
; return 0; }
EOF
-if { (eval echo configure:5349: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5346: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${with_tiff}" != "no"; then
ac_safe=`echo "tiffio.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for tiffio.h""... $ac_c" 1>&6
-echo "configure:5389: checking for tiffio.h" >&5
+echo "configure:5386: checking for tiffio.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5394 "configure"
+#line 5391 "configure"
#include "confdefs.h"
#include <tiffio.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5399: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5396: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
# At least one tiff package requires the jpeg library.
if test "${HAVE_JPEG}" = yes; then tifflibs="-ljpeg $tifflibs"; fi
echo $ac_n "checking for TIFFGetVersion in -ltiff""... $ac_c" 1>&6
-echo "configure:5419: checking for TIFFGetVersion in -ltiff" >&5
+echo "configure:5416: checking for TIFFGetVersion in -ltiff" >&5
ac_lib_var=`echo tiff'_'TIFFGetVersion | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-ltiff $tifflibs $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5427 "configure"
+#line 5424 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
TIFFGetVersion()
; return 0; }
EOF
-if { (eval echo configure:5438: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5435: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${with_gif}" != "no"; then
ac_safe=`echo "gif_lib.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for gif_lib.h""... $ac_c" 1>&6
-echo "configure:5478: checking for gif_lib.h" >&5
+echo "configure:5475: checking for gif_lib.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5483 "configure"
+#line 5480 "configure"
#include "confdefs.h"
#include <gif_lib.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:5488: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:5485: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
echo "$ac_t""yes" 1>&6
echo $ac_n "checking for DGifOpen in -lungif""... $ac_c" 1>&6
-echo "configure:5505: checking for DGifOpen in -lungif" >&5
+echo "configure:5502: checking for DGifOpen in -lungif" >&5
ac_lib_var=`echo ungif'_'DGifOpen | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lungif $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5513 "configure"
+#line 5510 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
DGifOpen()
; return 0; }
EOF
-if { (eval echo configure:5524: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5521: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
# If netdb.h doesn't declare h_errno, we must declare it by hand.
echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6
-echo "configure:5560: checking whether netdb declares h_errno" >&5
+echo "configure:5557: checking whether netdb declares h_errno" >&5
if eval "test \"`echo '$''{'emacs_cv_netdb_declares_h_errno'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5565 "configure"
+#line 5562 "configure"
#include "confdefs.h"
#include <netdb.h>
int main() {
return h_errno;
; return 0; }
EOF
-if { (eval echo configure:5572: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5569: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
emacs_cv_netdb_declares_h_errno=yes
else
# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works
# for constant arguments. Useless!
echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6
-echo "configure:5595: checking for working alloca.h" >&5
+echo "configure:5592: checking for working alloca.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_alloca_h'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5600 "configure"
+#line 5597 "configure"
#include "confdefs.h"
#include <alloca.h>
int main() {
char *p = alloca(2 * sizeof(int));
; return 0; }
EOF
-if { (eval echo configure:5607: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5604: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
ac_cv_header_alloca_h=yes
else
fi
echo $ac_n "checking for alloca""... $ac_c" 1>&6
-echo "configure:5628: checking for alloca" >&5
+echo "configure:5625: checking for alloca" >&5
if eval "test \"`echo '$''{'ac_cv_func_alloca_works'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5633 "configure"
+#line 5630 "configure"
#include "confdefs.h"
#ifdef __GNUC__
char *p = (char *) alloca(1);
; return 0; }
EOF
-if { (eval echo configure:5661: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5658: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
ac_cv_func_alloca_works=yes
else
echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6
-echo "configure:5693: checking whether alloca needs Cray hooks" >&5
+echo "configure:5690: checking whether alloca needs Cray hooks" >&5
if eval "test \"`echo '$''{'ac_cv_os_cray'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5698 "configure"
+#line 5695 "configure"
#include "confdefs.h"
#if defined(CRAY) && ! defined(CRAY2)
webecray
if test $ac_cv_os_cray = yes; then
for ac_func in _getb67 GETB67 getb67; do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:5723: checking for $ac_func" >&5
+echo "configure:5720: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 5728 "configure"
+#line 5725 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:5751: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5748: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
fi
echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6
-echo "configure:5778: checking stack direction for C alloca" >&5
+echo "configure:5775: checking stack direction for C alloca" >&5
if eval "test \"`echo '$''{'ac_cv_c_stack_direction'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
ac_cv_c_stack_direction=0
else
cat > conftest.$ac_ext <<EOF
-#line 5786 "configure"
+#line 5783 "configure"
#include "confdefs.h"
find_stack_direction ()
{
exit (find_stack_direction() < 0);
}
EOF
-if { (eval echo configure:5805: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:5802: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
ac_cv_c_stack_direction=1
else
# fmod, logb, and frexp are found in -lm on most systems.
# On HPUX 9.01, -lm does not contain logb, so check for sqrt.
echo $ac_n "checking for sqrt in -lm""... $ac_c" 1>&6
-echo "configure:5830: checking for sqrt in -lm" >&5
+echo "configure:5827: checking for sqrt in -lm" >&5
ac_lib_var=`echo m'_'sqrt | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lm $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5838 "configure"
+#line 5835 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
sqrt()
; return 0; }
EOF
-if { (eval echo configure:5849: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5846: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
# Check for mail-locking functions in a "mail" library
echo $ac_n "checking for maillock in -lmail""... $ac_c" 1>&6
-echo "configure:5879: checking for maillock in -lmail" >&5
+echo "configure:5876: checking for maillock in -lmail" >&5
ac_lib_var=`echo mail'_'maillock | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lmail $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5887 "configure"
+#line 5884 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
maillock()
; return 0; }
EOF
-if { (eval echo configure:5898: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5895: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
fi
echo $ac_n "checking for maillock in -llockfile""... $ac_c" 1>&6
-echo "configure:5926: checking for maillock in -llockfile" >&5
+echo "configure:5923: checking for maillock in -llockfile" >&5
ac_lib_var=`echo lockfile'_'maillock | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-llockfile $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 5934 "configure"
+#line 5931 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
maillock()
; return 0; }
EOF
-if { (eval echo configure:5945: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:5942: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
# Extract the first word of "liblockfile.so", so it can be a program name with args.
set dummy liblockfile.so; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:5979: checking for $ac_word" >&5
+echo "configure:5976: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_liblockfile'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
for ac_func in touchlock
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:6020: checking for $ac_func" >&5
+echo "configure:6017: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6025 "configure"
+#line 6022 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:6048: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6045: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:6076: checking for $ac_hdr" >&5
+echo "configure:6073: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6081 "configure"
+#line 6078 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6086: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6083: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
gai_strerror mkstemp
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:6122: checking for $ac_func" >&5
+echo "configure:6119: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6127 "configure"
+#line 6124 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:6150: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6147: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:6179: checking for $ac_hdr" >&5
+echo "configure:6176: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6184 "configure"
+#line 6181 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6189: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6186: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
for ac_func in alarm
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:6218: checking for $ac_func" >&5
+echo "configure:6215: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6223 "configure"
+#line 6220 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:6246: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6243: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
done
echo $ac_n "checking for working mktime""... $ac_c" 1>&6
-echo "configure:6271: checking for working mktime" >&5
+echo "configure:6268: checking for working mktime" >&5
if eval "test \"`echo '$''{'ac_cv_func_working_mktime'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
ac_cv_func_working_mktime=no
else
cat > conftest.$ac_ext <<EOF
-#line 6279 "configure"
+#line 6276 "configure"
#include "confdefs.h"
/* Test program from Paul Eggert (eggert@twinsun.com)
and Tony Leneis (tony@plaza.ds.adp.com). */
exit (0);
}
EOF
-if { (eval echo configure:6428: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:6425: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
ac_cv_func_working_mktime=yes
else
# On Solaris, -lkvm requires nlist from -lelf, so check that first
# to get the right answer into the cache.
echo $ac_n "checking for elf_begin in -lelf""... $ac_c" 1>&6
-echo "configure:6460: checking for elf_begin in -lelf" >&5
+echo "configure:6457: checking for elf_begin in -lelf" >&5
ac_lib_var=`echo elf'_'elf_begin | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lelf $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 6468 "configure"
+#line 6465 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
elf_begin()
; return 0; }
EOF
-if { (eval echo configure:6479: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6476: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
fi
echo $ac_n "checking for kvm_open in -lkvm""... $ac_c" 1>&6
-echo "configure:6500: checking for kvm_open in -lkvm" >&5
+echo "configure:6497: checking for kvm_open in -lkvm" >&5
ac_lib_var=`echo kvm'_'kvm_open | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lkvm $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 6508 "configure"
+#line 6505 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
kvm_open()
; return 0; }
EOF
-if { (eval echo configure:6519: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6516: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
# Check for the 4.4BSD definition of getloadavg.
echo $ac_n "checking for getloadavg in -lutil""... $ac_c" 1>&6
-echo "configure:6541: checking for getloadavg in -lutil" >&5
+echo "configure:6538: checking for getloadavg in -lutil" >&5
ac_lib_var=`echo util'_'getloadavg | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lutil $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 6549 "configure"
+#line 6546 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
getloadavg()
; return 0; }
EOF
-if { (eval echo configure:6560: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6557: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
# Since it is not a standard part of AIX, it might be installed locally.
ac_getloadavg_LIBS="$LIBS"; LIBS="-L/usr/local/lib $LIBS"
echo $ac_n "checking for getloadavg in -lgetloadavg""... $ac_c" 1>&6
-echo "configure:6586: checking for getloadavg in -lgetloadavg" >&5
+echo "configure:6583: checking for getloadavg in -lgetloadavg" >&5
ac_lib_var=`echo getloadavg'_'getloadavg | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lgetloadavg $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 6594 "configure"
+#line 6591 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
getloadavg()
; return 0; }
EOF
-if { (eval echo configure:6605: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6602: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
for ac_func in getloadavg
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:6632: checking for $ac_func" >&5
+echo "configure:6629: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6637 "configure"
+#line 6634 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:6660: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6657: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
ac_have_func=no
ac_safe=`echo "sys/dg_sys_info.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for sys/dg_sys_info.h""... $ac_c" 1>&6
-echo "configure:6698: checking for sys/dg_sys_info.h" >&5
+echo "configure:6695: checking for sys/dg_sys_info.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6703 "configure"
+#line 6700 "configure"
#include "confdefs.h"
#include <sys/dg_sys_info.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6708: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6705: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
EOF
echo $ac_n "checking for dg_sys_info in -ldgc""... $ac_c" 1>&6
-echo "configure:6729: checking for dg_sys_info in -ldgc" >&5
+echo "configure:6726: checking for dg_sys_info in -ldgc" >&5
ac_lib_var=`echo dgc'_'dg_sys_info | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-ldgc $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 6737 "configure"
+#line 6734 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
dg_sys_info()
; return 0; }
EOF
-if { (eval echo configure:6748: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:6745: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test $ac_have_func = no; then
ac_safe=`echo "inq_stats/cpustats.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for inq_stats/cpustats.h""... $ac_c" 1>&6
-echo "configure:6793: checking for inq_stats/cpustats.h" >&5
+echo "configure:6790: checking for inq_stats/cpustats.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6798 "configure"
+#line 6795 "configure"
#include "confdefs.h"
#include <inq_stats/cpustats.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6803: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6800: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
if test $ac_have_func = no; then
ac_safe=`echo "sys/cpustats.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for sys/cpustats.h""... $ac_c" 1>&6
-echo "configure:6836: checking for sys/cpustats.h" >&5
+echo "configure:6833: checking for sys/cpustats.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6841 "configure"
+#line 6838 "configure"
#include "confdefs.h"
#include <sys/cpustats.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6846: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6843: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:6877: checking for $ac_hdr" >&5
+echo "configure:6874: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6882 "configure"
+#line 6879 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6887: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6884: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for nlist.h""... $ac_c" 1>&6
-echo "configure:6917: checking for nlist.h" >&5
+echo "configure:6914: checking for nlist.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6922 "configure"
+#line 6919 "configure"
#include "confdefs.h"
#include <nlist.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:6927: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:6924: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
EOF
echo $ac_n "checking for n_un in struct nlist""... $ac_c" 1>&6
-echo "configure:6948: checking for n_un in struct nlist" >&5
+echo "configure:6945: checking for n_un in struct nlist" >&5
if eval "test \"`echo '$''{'ac_cv_struct_nlist_n_un'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6953 "configure"
+#line 6950 "configure"
#include "confdefs.h"
#include <nlist.h>
int main() {
struct nlist n; n.n_un.n_name = 0;
; return 0; }
EOF
-if { (eval echo configure:6960: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:6957: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_struct_nlist_n_un=yes
else
# Some definitions of getloadavg require that the program be installed setgid.
echo $ac_n "checking whether getloadavg requires setgid""... $ac_c" 1>&6
-echo "configure:6987: checking whether getloadavg requires setgid" >&5
+echo "configure:6984: checking whether getloadavg requires setgid" >&5
if eval "test \"`echo '$''{'ac_cv_func_getloadavg_setgid'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 6992 "configure"
+#line 6989 "configure"
#include "confdefs.h"
#include "$srcdir/getloadavg.c"
#ifdef LDAV_PRIVILEGED
if test $ac_cv_func_getloadavg_setgid = yes; then
echo $ac_n "checking group of /dev/kmem""... $ac_c" 1>&6
-echo "configure:7023: checking group of /dev/kmem" >&5
+echo "configure:7020: checking group of /dev/kmem" >&5
if eval "test \"`echo '$''{'ac_cv_group_kmem'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
echo $ac_n "checking for _LARGEFILE_SOURCE value needed for large files""... $ac_c" 1>&6
-echo "configure:7044: checking for _LARGEFILE_SOURCE value needed for large files" >&5
+echo "configure:7041: checking for _LARGEFILE_SOURCE value needed for large files" >&5
if eval "test \"`echo '$''{'ac_cv_sys_largefile_source'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
ac_cv_sys_largefile_source=no
cat > conftest.$ac_ext <<EOF
-#line 7050 "configure"
+#line 7047 "configure"
#include "confdefs.h"
#include <stdio.h>
int main() {
return !fseeko;
; return 0; }
EOF
-if { (eval echo configure:7057: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:7054: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
:
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -rf conftest*
cat > conftest.$ac_ext <<EOF
-#line 7064 "configure"
+#line 7061 "configure"
#include "confdefs.h"
#define _LARGEFILE_SOURCE 1
#include <stdio.h>
return !fseeko;
; return 0; }
EOF
-if { (eval echo configure:7073: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:7070: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_sys_largefile_source=1
else
# If you want fseeko and ftello with glibc, upgrade to a fixed glibc.
echo $ac_n "checking for fseeko""... $ac_c" 1>&6
-echo "configure:7097: checking for fseeko" >&5
+echo "configure:7094: checking for fseeko" >&5
if eval "test \"`echo '$''{'ac_cv_func_fseeko'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
ac_cv_func_fseeko=no
cat > conftest.$ac_ext <<EOF
-#line 7103 "configure"
+#line 7100 "configure"
#include "confdefs.h"
#include <stdio.h>
int main() {
return fseeko && fseeko (stdin, 0, 0);
; return 0; }
EOF
-if { (eval echo configure:7110: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7107: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
ac_cv_func_fseeko=yes
else
for ac_func in grantpt
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:7132: checking for $ac_func" >&5
+echo "configure:7129: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7137 "configure"
+#line 7134 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:7160: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7157: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
for ac_func in getpt
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:7189: checking for $ac_func" >&5
+echo "configure:7186: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7194 "configure"
+#line 7191 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:7217: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7214: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
# It's better to believe a function is not available
# than to expect to find it in ncurses.
echo $ac_n "checking for tparm in -lncurses""... $ac_c" 1>&6
-echo "configure:7247: checking for tparm in -lncurses" >&5
+echo "configure:7244: checking for tparm in -lncurses" >&5
ac_lib_var=`echo ncurses'_'tparm | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lncurses $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7255 "configure"
+#line 7252 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
tparm()
; return 0; }
EOF
-if { (eval echo configure:7266: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7263: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
# These tell us which Kerberos-related libraries to use.
if test "${with_kerberos+set}" = set; then
echo $ac_n "checking for com_err in -lcom_err""... $ac_c" 1>&6
-echo "configure:7297: checking for com_err in -lcom_err" >&5
+echo "configure:7294: checking for com_err in -lcom_err" >&5
ac_lib_var=`echo com_err'_'com_err | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lcom_err $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7305 "configure"
+#line 7302 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
com_err()
; return 0; }
EOF
-if { (eval echo configure:7316: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7313: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
fi
echo $ac_n "checking for mit_des_cbc_encrypt in -lk5crypto""... $ac_c" 1>&6
-echo "configure:7344: checking for mit_des_cbc_encrypt in -lk5crypto" >&5
+echo "configure:7341: checking for mit_des_cbc_encrypt in -lk5crypto" >&5
ac_lib_var=`echo k5crypto'_'mit_des_cbc_encrypt | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lk5crypto $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7352 "configure"
+#line 7349 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
mit_des_cbc_encrypt()
; return 0; }
EOF
-if { (eval echo configure:7363: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7360: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
fi
echo $ac_n "checking for mit_des_cbc_encrypt in -lcrypto""... $ac_c" 1>&6
-echo "configure:7391: checking for mit_des_cbc_encrypt in -lcrypto" >&5
+echo "configure:7388: checking for mit_des_cbc_encrypt in -lcrypto" >&5
ac_lib_var=`echo crypto'_'mit_des_cbc_encrypt | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lcrypto $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7399 "configure"
+#line 7396 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
mit_des_cbc_encrypt()
; return 0; }
EOF
-if { (eval echo configure:7410: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7407: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
fi
echo $ac_n "checking for krb5_init_context in -lkrb5""... $ac_c" 1>&6
-echo "configure:7438: checking for krb5_init_context in -lkrb5" >&5
+echo "configure:7435: checking for krb5_init_context in -lkrb5" >&5
ac_lib_var=`echo krb5'_'krb5_init_context | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lkrb5 $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7446 "configure"
+#line 7443 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
krb5_init_context()
; return 0; }
EOF
-if { (eval echo configure:7457: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7454: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
if test "${with_kerberos5+set}" != set; then
echo $ac_n "checking for des_cbc_encrypt in -ldes425""... $ac_c" 1>&6
-echo "configure:7486: checking for des_cbc_encrypt in -ldes425" >&5
+echo "configure:7483: checking for des_cbc_encrypt in -ldes425" >&5
ac_lib_var=`echo des425'_'des_cbc_encrypt | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-ldes425 $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7494 "configure"
+#line 7491 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
des_cbc_encrypt()
; return 0; }
EOF
-if { (eval echo configure:7505: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7502: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
else
echo "$ac_t""no" 1>&6
echo $ac_n "checking for des_cbc_encrypt in -ldes""... $ac_c" 1>&6
-echo "configure:7531: checking for des_cbc_encrypt in -ldes" >&5
+echo "configure:7528: checking for des_cbc_encrypt in -ldes" >&5
ac_lib_var=`echo des'_'des_cbc_encrypt | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-ldes $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7539 "configure"
+#line 7536 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
des_cbc_encrypt()
; return 0; }
EOF
-if { (eval echo configure:7550: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7547: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
fi
echo $ac_n "checking for krb_get_cred in -lkrb4""... $ac_c" 1>&6
-echo "configure:7580: checking for krb_get_cred in -lkrb4" >&5
+echo "configure:7577: checking for krb_get_cred in -lkrb4" >&5
ac_lib_var=`echo krb4'_'krb_get_cred | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lkrb4 $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7588 "configure"
+#line 7585 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
krb_get_cred()
; return 0; }
EOF
-if { (eval echo configure:7599: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7596: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
else
echo "$ac_t""no" 1>&6
echo $ac_n "checking for krb_get_cred in -lkrb""... $ac_c" 1>&6
-echo "configure:7625: checking for krb_get_cred in -lkrb" >&5
+echo "configure:7622: checking for krb_get_cred in -lkrb" >&5
ac_lib_var=`echo krb'_'krb_get_cred | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lkrb $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 7633 "configure"
+#line 7630 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
krb_get_cred()
; return 0; }
EOF
-if { (eval echo configure:7644: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:7641: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7680: checking for $ac_hdr" >&5
+echo "configure:7677: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7685 "configure"
+#line 7682 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7690: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7687: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7721: checking for $ac_hdr" >&5
+echo "configure:7718: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7726 "configure"
+#line 7723 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7731: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7728: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7758: checking for $ac_hdr" >&5
+echo "configure:7755: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7763 "configure"
+#line 7760 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7768: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7765: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7795: checking for $ac_hdr" >&5
+echo "configure:7792: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7800 "configure"
+#line 7797 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7805: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7802: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7841: checking for $ac_hdr" >&5
+echo "configure:7838: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7846 "configure"
+#line 7843 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7851: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7848: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7878: checking for $ac_hdr" >&5
+echo "configure:7875: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7883 "configure"
+#line 7880 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7888: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7885: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7915: checking for $ac_hdr" >&5
+echo "configure:7912: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7920 "configure"
+#line 7917 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7925: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7922: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:7962: checking for $ac_hdr" >&5
+echo "configure:7959: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 7967 "configure"
+#line 7964 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:7972: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:7969: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
# Solaris requires -lintl if you want strerror (which calls dgettext)
# to return localized messages.
echo $ac_n "checking for dgettext in -lintl""... $ac_c" 1>&6
-echo "configure:8003: checking for dgettext in -lintl" >&5
+echo "configure:8000: checking for dgettext in -lintl" >&5
ac_lib_var=`echo intl'_'dgettext | sed 'y%./+-%__p_%'`
if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
ac_save_LIBS="$LIBS"
LIBS="-lintl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 8011 "configure"
+#line 8008 "configure"
#include "confdefs.h"
/* Override any gcc2 internal prototype to avoid an error. */
/* We use char because int might match the return type of a gcc2
dgettext()
; return 0; }
EOF
-if { (eval echo configure:8022: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:8019: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_lib_$ac_lib_var=yes"
else
echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6
-echo "configure:8051: checking whether localtime caches TZ" >&5
+echo "configure:8048: checking whether localtime caches TZ" >&5
if eval "test \"`echo '$''{'emacs_cv_localtime_cache'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
emacs_cv_localtime_cache=yes
else
cat > conftest.$ac_ext <<EOF
-#line 8061 "configure"
+#line 8058 "configure"
#include "confdefs.h"
#include <time.h>
extern char **environ;
exit (0);
}
EOF
-if { (eval echo configure:8093: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:8090: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
emacs_cv_localtime_cache=no
else
for ac_func in gettimeofday
do
echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
-echo "configure:8123: checking for $ac_func" >&5
+echo "configure:8120: checking for $ac_func" >&5
if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8128 "configure"
+#line 8125 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $ac_func(); below. */
; return 0; }
EOF
-if { (eval echo configure:8151: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:8148: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_$ac_func=yes"
else
done
echo $ac_n "checking whether gettimeofday can accept two arguments""... $ac_c" 1>&6
-echo "configure:8176: checking whether gettimeofday can accept two arguments" >&5
+echo "configure:8173: checking whether gettimeofday can accept two arguments" >&5
if eval "test \"`echo '$''{'emacs_cv_gettimeofday_two_arguments'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8181 "configure"
+#line 8178 "configure"
#include "confdefs.h"
#ifdef TIME_WITH_SYS_TIME
gettimeofday (&time, 0);
; return 0; }
EOF
-if { (eval echo configure:8199: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:8196: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
emacs_cv_gettimeofday_two_arguments=yes
else
if test "$ac_cv_func_gettimeofday" = yes; then
echo $ac_n "checking for struct timezone""... $ac_c" 1>&6
-echo "configure:8222: checking for struct timezone" >&5
+echo "configure:8219: checking for struct timezone" >&5
if eval "test \"`echo '$''{'emacs_cv_struct_timezone'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8227 "configure"
+#line 8224 "configure"
#include "confdefs.h"
#include <sys/time.h>
int main() {
struct timezone tz;
; return 0; }
EOF
-if { (eval echo configure:8234: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:8231: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
if test "$cross_compiling" = yes; then
emacs_cv_struct_timezone=yes
else
cat > conftest.$ac_ext <<EOF
-#line 8240 "configure"
+#line 8237 "configure"
#include "confdefs.h"
#ifdef TIME_WITH_SYS_TIME
exit (gettimeofday (&time, &dummy));
}
EOF
-if { (eval echo configure:8259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:8256: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
emacs_cv_struct_timezone=yes
else
ok_so_far=yes
echo $ac_n "checking for socket""... $ac_c" 1>&6
-echo "configure:8285: checking for socket" >&5
+echo "configure:8282: checking for socket" >&5
if eval "test \"`echo '$''{'ac_cv_func_socket'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8290 "configure"
+#line 8287 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char socket(); below. */
; return 0; }
EOF
-if { (eval echo configure:8313: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:8310: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_socket=yes"
else
if test $ok_so_far = yes; then
ac_safe=`echo "netinet/in.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for netinet/in.h""... $ac_c" 1>&6
-echo "configure:8336: checking for netinet/in.h" >&5
+echo "configure:8333: checking for netinet/in.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8341 "configure"
+#line 8338 "configure"
#include "confdefs.h"
#include <netinet/in.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:8346: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:8343: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
if test $ok_so_far = yes; then
ac_safe=`echo "arpa/inet.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6
-echo "configure:8372: checking for arpa/inet.h" >&5
+echo "configure:8369: checking for arpa/inet.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8377 "configure"
+#line 8374 "configure"
#include "confdefs.h"
#include <arpa/inet.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:8382: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:8379: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
fi
echo $ac_n "checking whether system supports dynamic ptys""... $ac_c" 1>&6
-echo "configure:8420: checking whether system supports dynamic ptys" >&5
+echo "configure:8417: checking whether system supports dynamic ptys" >&5
if test -d /dev/pts && ls -d /dev/ptmx > /dev/null 2>&1 ; then
echo "$ac_t""yes" 1>&6
cat >> confdefs.h <<\EOF
fi
echo $ac_n "checking for pid_t""... $ac_c" 1>&6
-echo "configure:8432: checking for pid_t" >&5
+echo "configure:8429: checking for pid_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8437 "configure"
+#line 8434 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
ac_safe=`echo "vfork.h" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for vfork.h""... $ac_c" 1>&6
-echo "configure:8466: checking for vfork.h" >&5
+echo "configure:8463: checking for vfork.h" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8471 "configure"
+#line 8468 "configure"
#include "confdefs.h"
#include <vfork.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:8476: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:8473: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
if test -z "$ac_err"; then
rm -rf conftest*
fi
echo $ac_n "checking for working vfork""... $ac_c" 1>&6
-echo "configure:8501: checking for working vfork" >&5
+echo "configure:8498: checking for working vfork" >&5
if eval "test \"`echo '$''{'ac_cv_func_vfork_works'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
if test "$cross_compiling" = yes; then
echo $ac_n "checking for vfork""... $ac_c" 1>&6
-echo "configure:8507: checking for vfork" >&5
+echo "configure:8504: checking for vfork" >&5
if eval "test \"`echo '$''{'ac_cv_func_vfork'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8512 "configure"
+#line 8509 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char vfork(); below. */
; return 0; }
EOF
-if { (eval echo configure:8535: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:8532: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
eval "ac_cv_func_vfork=yes"
else
ac_cv_func_vfork_works=$ac_cv_func_vfork
else
cat > conftest.$ac_ext <<EOF
-#line 8557 "configure"
+#line 8554 "configure"
#include "confdefs.h"
/* Thanks to Paul Eggert for this test. */
#include <stdio.h>
}
}
EOF
-if { (eval echo configure:8652: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:8649: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
ac_cv_func_vfork_works=yes
else
# Fixme: This should be replaced when we have autoconf 2.14.
echo $ac_n "checking for size_t""... $ac_c" 1>&6
-echo "configure:8677: checking for size_t" >&5
+echo "configure:8674: checking for size_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 8682 "configure"
+#line 8679 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
dnl checks for header files
AC_CHECK_HEADERS(sys/select.h sys/timeb.h sys/time.h unistd.h utime.h \
linux/version.h sys/systeminfo.h termios.h limits.h string.h stdlib.h \
- termcap.h stdio_ext.h fcntl.h term.h strings.h)
+ termcap.h stdio_ext.h fcntl.h term.h strings.h pwd.h sys/ioctl.h ulimit.h)
AC_HEADER_STDC
AC_HEADER_TIME
AC_DECL_SYS_SIGLIST
AC_DEFINE(HAVE_XPM)
fi
fi
-
+
### Use -ljpeg if available, unless `--with-jpeg=no'.
HAVE_JPEG=no
if test "${HAVE_X11}" = "yes"; then
fi
if test "${HAVE_JPEG}" = "yes"; then
- AC_DEFINE(HAVE_JPEG)
+ AC_EGREP_CPP(
+changequote({, })dnl
+ {version=(6[2-9]|[7-9][0-9])},
+changequote([, ])dnl
+ [#include <jpeglib.h>
+ version=JPEG_LIB_VERSION
+ ],
+ AC_DEFINE(HAVE_JPEG),
+ [AC_MSG_WARN([libjpeg found, but not version 6b or later])
+ HAVE_JPEG=no])
fi
fi
-
+
### Use -lpng if available, unless `--with-png=no'.
HAVE_PNG=no
if test "${HAVE_X11}" = "yes"; then
+++ /dev/null
-This 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.
-
-\f
-Here are the configurations Emacs is intended to work with, with the
-corresponding configuration names. You can postpend version numbers
-to operating system names (i.e. sunos4.1) or architecture names (i.e.
-hppa1.1). If you leave out the version number, the `configure' script
-will configure Emacs for the latest version it knows about.
-
-Acorn RISCiX (arm-acorn-riscix1.2)
-
- Emacs 19.29 has changes that ought to support RISCiX 1.2.
-
- Due to a bug in the RISCiX C compiler (3.4.5), emacs must
- be built with gcc (versions 2.5.8 onwards).
-
- In addition, you will need GNU sed and GNU make, as the RISCiX release
- versions of these utilities cannot cope with building emacs-19!
-
- GNU sed should be configured with:
-
- env 'DEFS=-Dgetopt=gnu_getopt -Dopterr=gnu_opterr -Doptind=gnu_optind \
- -Doptarg=gnu_optarg' ./configure
-
- GNU make (3.72+) should be configured with:
-
- env 'CFLAGS=-Dgetopt=gnu_getopt -Dopterr=gnu_opterr -Doptind=gnu_optind \
- -Doptarg=gnu_optarg' ./configure
-
- Emacs may be configured to use the X toolkit, by adding --with-x-toolkit
- to the configure command. If you do this, you will need to edit the line
- in src/Makefile which defines LIBW (about line 59) to read:
-
- LIBW= -lXaw_n
-
- This ensures that the non-shared widget library is used.
-
- It is unlikely that this version of emacs will work with RISCiX 1.1.
-
-Alliant (fx80-alliant-bsd):
-
- 18.52 worked on system version 4. Previous Emacs versions were
- known to work on previous system versions.
-
- If you are using older versions of their operating system, you may
- need to edit `src/config.h' to use `m/alliant1.h' (on version 1) or
- `m/alliant.h' (on versions 2 and 3).
-
-Alliant FX/2800 (i860-alliant-bsd)
-
- Known to work with 19.26 and OS version 2.2, compiler version 1.3.
-
-Alpha (DEC) running OSF/1 or GNU/Linux (alpha-dec-osf1, alpha-dec-linux-gnu)
-
- For OSF/1 (aka Digital Unix) version 4.0, update 386,
- it is reported that you need to run configure this way:
-
- configure --x-includes=/usr/include --x-libraries=/usr/shlib
-
- For 4.0 revision 564, and 4.0A and 4.0B, Emacs 20 seems to work
- with no special configuration options. However, if you use GCC as
- your compiler, you will need version 2.8.1 or later, as older
- versions fail to build with a message "Invalid dimension for the
- charset-ID 160".
-
- Note that the X11 libraries on GNU/Linux systems for the Alpha are
- said to have bugs that prevent Emacs from working with X (as of
- November 1995). Recent releases work (July 2000).
-
-Altos 3068 (m68k-altos-sysv)
-
- 18.52 was said to work, provided you don't compile unexec.c with -O.
-
-Amdahl UTS (580-amdahl-sysv)
-
- Small changes for 18.38 were merged in 18.39. It is mostly
- working, but at last report a bug sometimes causes Emacs to
- grab very large amounts of memory. No fix or explanation
- has yet been reported. It may be possible to find this bug
- if you find which Emacs command it happens within and then
- run that command with a breakpoint set at malloc.
-
- The 5.2u370 compiler is so brain damaged that it is not
- even worth trying to use it. Success was obtained with the
- uts native C compiler on uts version 5.2.5.
-
-Apollo running X Windows (m68k-apollo-bsd)
-
- Apollo version now supports dumping. It has been tested on SR10.3 and
- SR10.4. It certainly requires at least SR10.0, and maybe SR10.2. Be sure
- to build in the BSD environment.
-
- By default, everything is compiled with the switch "-W0,-opt,2". Don't try
- to change this to full optimization (-O). The full optimizer (in Domain CC
- 6.7, 6.8 and 6.9) generates some bad code in several modules which causes
- the emacs window, under X, to be refreshed with each keystroke.
-
- The configuration stuff should work for the most part. However, some Domain
- installations may have to edit src/Makefile manually after it is created.
- There are too many versions of both cc and X to automate this easily.
-
- In `lib-src/Makefile', emacsclient and emacsserver compile and work fine
- under CC 6.9. They now probably work under other versions of the compiler,
- as well.
-
- The Apollo Domain CC compiler will issue quite a few warning messages,
- mostly complaining about incompatible pointers. In general, these are
- harmless and can be ignored. If you discover otherwise, please submit a bug
- report identifying the problem in detail.
-
- When you try to dump emacs, you may get the message ".rwdi section needs
- relocation." This means you are linking with some code that has compressed
- data sections. In some cases this comes from linking with X libraries. Try
- using shared X libraries instead. With some versions of Domain/OS this is
- as simple as removing the "-lX11" from the LIBX line in src/Makefile.
-
- When running the configure script, use the configuration name
- "m68k-apollo-bsd". You will also need to use the "-with-gcc=no" and
- "-with-x" options. Depending upon your site configuration, you may have to
- use other configure options, as well. Examine the INSTALL file for other
- configure options.
-
- Check out the file 'lisp/x-apollo.el'. To use it, add
-
- (load "x-apollo")
-
- to your .emacs file. It provides useful default Apollo function key
- bindings.
-
-AT&T 3b2, 3b5, 3b15, 3b20 (we32k-att-sysv)
-
- Emacs will probably not work with certain kernel constants too small.
-
- In param.h CDLIMIT should be at least (1L << 12) in order to allow
- processes to write up to 2 Mbyte files. This parameter is configurable
- by normal means in /etc/master.d/kernel; examine that file for the
- symbol CDLIMIT or ULIMIT, and raise it by several powers of 2. Then
- do normal kernel rebuild things via "cd /boot; mkboot -k KERNEL" and so
- forth.
-
- In seg.h NSEGP and STACKSEG should be at least 16 and 4 respectively
- to allow processes with total size of up to 2Mbytes.
- However, I'm told it is unlikely this would fail to be true.
-
- The MAXMEM may also prevent Emacs from running. The file
- 3B-MAXMEM in this directory explains how to increase MAXMEM.
-
- On some of these machines, you may need to define IN_SCCS_ID
- in config.h to make Emacs work. Supposedly you can tell whether
- this is necessary by checking something in /usr/include/sys/time.h;
- we do not know precisely what.
-
-AT&T 7300 or 3b1 (m68k-att-sysv)
-
- 18.52 worked. If you have strange troubles with dumping
- Emacs, delete the last few lines from `src/m/7300.h' and recompile.
- These lines are supposed to produce a sharable executable.
-
- `src/m/7300.h' defines SHORTNAMES because operating system versions
- older than 3.5 did not support long symbol names. Version 3.5 does
- support them, so you can remove the #define SHORTNAMES in that
- version.
-
-Bull DPX/2 models 2nn or 3nn (m68k-bull-sysv3)
-
- Minor fixes merged into 19.19, which should work with CC or GCC.
-
- You should compile with all the POSIX stuff: undef _SYSV and define
- _POSIX_SOURCE, _XOPEN_SOURCE and _BULL_SOURCE.
-
- On bos2.00.45 there is a bug that makes the F_SETOWN fcntl
- call enters in an infinite loop. F_SETOWN_BUG has been defined to avoid
- calling it.
-
-Bull DPX/20 (rs6000-bull-bosx)
-
- Version 19 works.
-
-Bull sps7 (m68k-bull-sysv2)
-
- Changes partially merged in version 19, but some fixes are probably required.
-
-CCI 5/32, 6/32
-
- See "Tahoe".
-
-Celerity (celerity-celerity-bsd4.2)
-
- Version 18.49 worked. This configuration name is a hack, because we
- don't know the processor used by Celerities. If someone
- who uses a Celerity could get in touch with us, we can teach
- config.sub a better name for the configuration.
-
-Clipper (clipper-???)
-
- Version 19 has support for some brand of clipper system. If you
- have successfully built Emacs 19 on some sort of clipper system, let
- us know so we can flesh out this entry.
-
- Note that the Orion 105 is also a clipper, but some system-related
- parameters are different.
-
-Convex (c1-convex-bsd, c2-convex-bsd, c32-convex-bsd, c34-convex-bsd,
- c38-convex-bsd)
-
- Support updated and residual bugs fixed in 19.26.
-
-Cubix QBx/386 (i386-cubix-sysv)
-
- Changes merged in 19.1. Systems before 2/A/0 may fail to compile etags.c
- due to a compiler bug.
-
-Cydra 5 (cydra-cydrome-sysv)
-
- 18.51 worked in one version of their operating system but stopped
- working in a newer version. This has not been fixed.
-
-Data General Aviion (m88k-dg-dgux)
-
- 19.23 works; however, the GCC provided with DGUX 5.4R3.00 fails to
- compile src/emacs.c. GCC 2.5.8 does work.
- The 19.26 pretest was reported to work; no word on which compiler.
- System versions other than DGUX 5.4R3.00 have not been tested.
-
- DGUX 5.4R3.10 works with 19.29 and 19.30.
-
- DGUX R4.11 contains changes to the stdio internals and it doesn't work
- with versions before 20.2 without patches. 20.2 works in interactive
- mode but usually fails in batch mode. The problem is that using
- stderr in the dumped emacs usually leads to a segmentation fault.
- Only m88k has been tested.
-
-DECstation (mips-dec-ultrix or mips-dec-osf)
-
- This machine is the older Mips-based DECstation.
- Emacs should now work on the Alpha CPU.
-
- 19.25 works on Ultrix 4.2. The 19.26 pretest was reported to work
- on Ultrix 4.2a and on 4.4.
-
- One user reported 19.25 did not work at all with --with-x-toolkit
- using X11R5 patch level 10, but worked ok with X11R5 pl26.
-
- See under Ultrix for problems using X windows on Ultrix.
- Note that this is a MIPS machine.
-
- For Ultrix versions 4.1 or earlier, you may need to define
- SYSTEM_MALLOC in `src/m/pmax.h', because XvmsAlloc.o in libX11.a seems
- to insist on defining malloc itself.
-
- For Ultrix versions prior to 4.0, you may need to delete
- the definition of START_FILES from `src/m/pmax.h'.
-
-Motorola Delta 147 (m68k-motorola-sysv)
-
- The EMacs 19.26 pretest was reported to work.
-
- Motorola Delta boxes running System V/68 release 3.
- Tested on 147 board with SVR3V7, no X and gcc.
- Tested on 167 board with SVR3V7, no X, cc, gnucc and gcc.
- Reports say it works with X too.
-
- The installation script chooses the compiler itself. gnucc is
- preferred.
-
-Motorola Delta 187 (m88k-motorola-sysv,
- m88k-motorola-sysvr4, or
- m88k-motorola-m88kbcs)
-
- The 19.26 pretest was reported to run on SVR3. However, if you
- use --with-x-toolkit on svr3, you will have problems compiling some
- files because time.h and sys/time.h get included twice.
- One fix is to edit those files to protect against multiple inclusion.
-
- As of version 19.13, Emacs was reported to run under SYSVr3 and SYSVr4.
-
-Dual running System V (m68k-dual-sysv)
-
- As of 17.46, this worked except for a few changes
- needed in unexec.c.
-
-Dual running Uniplus (m68k-dual-uniplus)
-
- Worked, as of 17.51.
-
-Elxsi 6400 (elxsi-elxsi-sysv)
-
- Changes for 12.0 release are in 19.1.
- Dumping should work now.
-
-Encore machine (ns16k-encore-bsd)
-
- This machine bizarrely uses 4.2BSD modified to use the COFF format
- for object files. Works (as of 18.40). For the APC processor you
- must enable two lines at the end of `src/s/umax.h', which are commented
- out in the file as distributed.
-
- WARNING: If you compile Emacs with the "-O" compiler switch, you
- must also use the "-q enter_exits" switch so that all functions have
- stack frames. Otherwise routines that call `alloca' all lose.
-
- A kernel bug in some system versions causes input characters to be lost
- occasionally.
-
-Fujitsu DS/90 (sparc-fujitsu-sysv4)
-
- Changes merged in 20.3.
-
-GEC 63 (local-gec63-usg5.2)
-
- Changes are partially merged in version 18, but certainly require
- more work. Let us know if you get this working, and we'll give it a
- real configuration name.
-
-Gould Power Node (pn-gould-bsd4.2 or pn-gould-bsd4.3)
-
- 18.36 worked on versions 1.2 and 2.0 of the operating system.
-
- On UTX/32 2.0, use pn-gould-bsd4.3.
-
- On UTX/32 1.2 and UTX/32S 1.0, use pn-gould-bsd4.2 and note that
- compiling `lib-src/sorted-doc' tickles a compiler bug: remove the -g
- flag to cc in the makefile.
-
- UTX/32 1.3 has a bug in the bcopy library routine. Fix it by
- #undef BSTRING in `src/m/gould.h'.
-
- Version 19 incorporates support for releases 2.1 and later of UTX/32.
- A site running a pre-release of 2.1 should #define RELEASE2_1 in config.h.
-
-Gould NP1 (np1-gould-bsd)
-
- Version 19 supposedly works.
-
-Harris Night Hawk (m68k-harris-cxux or m88k-harris-cxux)
-
- This port was added in 19.23. The configuration actually tested was
- a Night Hawk 4800 running CX/UX 7.0.
-
- If you have GCC ported and want to build with it, you probably need to
- change things (like compiler switches) defined in the s/cxux.h file.
-
- If you have X11R6 installed in /usr/lib, configure will fail to find
- it and may find X11R5 instead. To work around this problem, use
- --x-libraries=/usr/lib when you run configure.
-
- With CX/UX 7.0 and later releases, you need to build after setting the
- SDE_TARGET environment variable to COFF (a port using ELF and shared
- libraries has not yet been done).
-
-Harris Power PC (powerpc-harris-powerunix)
-
- Patches have been merged in 19.31.
-
-Honeywell XPS100 (xps100-honeywell-sysv)
-
- Config file added in version 19.
-
-Hewlett-Packard 9000 series 200 or 300 (m68k-hp-bsd or m68k-hp-hpux
- or m68k-hp-netbsd)
-
- 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".
-
- Version 19 works under BSD. The 19.26 pretest was reported
- to work on HPUX 9. 19.31 works on HPUX 10.01, but there are
- some problems on 10.10 which have not been resolved. Emacs 19.34
- works on HPUX 10.20 provided you compile with GCC; with the HP C
- compiler, subprocess commands do not work.
-
- On HPUX 9, Emacs sometimes crashes with SIGBUS or SIGSEGV after you
- delete a frame. We think this is due to a bug in the X libraries
- provided by HP. With the alternative X libraries in
- /usr/contrib/mitX11R5/lib, the problem does not happen.
-
- If you are running HP/UX release 8.0 or later, you need the optional
- "C/ANSI C" software in order to build Emacs (older releases of HP/UX
- do not require any special software). If the file "/etc/filesets/C"
- exists on your machine, you have this software, otherwise you do not.
-
- Note that HP has used two incompatible assembler syntaxes,
- and has recently changed the format of C function frames.
- `src/crt0.c' and `src/alloca.s' have been conditionalised for the new
- assembler and new function-entry sequence. You may need to define
- OLD_HP_ASSEMBLER if you are using an older hpux version. If you
- have an official (bought from HP) series 300 machine you have
- the new assembler. Kernels that are 5.+ or later have new
- assembler. A Series 200 that has been upgraded to a 68010
- processor and a 5.+ kernel has the new compiler.
-
- Define C_SWITCH_MACHINE to be +X to make a version of Emacs that
- runs on both 68010 and 68020 based HP/UX's.
-
- Define HPUX_68010 if you are using the new assembler, for
- a system that has a 68010 without a 68881. This is to say,
- a s200 (upgraded) or s310.
-
- Define the symbol HPUX_NET if you have the optional network features
- that include the `netunam' system call. This is referred to as
- Network Services (NS/9000) in HP literature.
-
-HP 9000 series 500: not supported.
-
- The series 500 has a seriously incompatible memory architecture
- which relocates data in memory during execution of a program,
- and support for it would be difficult to implement.
-
-HP 9000 series 700 or 800 (Spectrum) (hppa1.0-hp-hpux or hppa1.1-hp-hpux
- or ...hpux9shr, or ...-nextstep)
-
- Use hppa1.1 for the 700 series and hppa1.0 for the 800
- series machines. (Emacs may not actually care which one you use.)
-
- Support for NextSTEP was added in 19.31.
-
- Emacs 20 may work on HPUX 10. You need patch PHSS_6202 to install
- the Xaw and Xmu libraries. On HPUX 10.20 you may need to compile with GCC;
- when Emacs was compiled with HP's C compiler, HP92453-01 A.10.32.03,
- the subprocess features failed to work.
-
- 19.26 is believed to work on HPUX 9 provided you compile with GCC.
- As of version 19.16, Emacs was reported to build (using GCC) and run
- on HP 9000/700 series machines running HP/UX versions 8.07 and 9.01.
- The HP compiler is known to fail on some versions if you use +O3,
- but it may work with lower optimization levels.
-
- Use hppa1.1-hp-hpux9shr to use shared libraries on HPUX version 9.
- You may need to create the X libraries libXaw.a and libXmu.a from
- the MIT X distribute, and you may need to edit src/Makefile's
- definition of LIBXT to look like this:
-
- LIBXT= $(LIBW) -lXmu -lXt $(LIBXTR6) -lXext
-
- Some people report trouble using the GNU memory allocator under
- HP/UX version 9. The problems often manifest as lots of ^@'s in the
- buffer.
-
- We are told that these problems go away if you obtain the latest
- patches for the HP/UX C compiler. James J Dempsey
- <jjd@spserv.bbn.com> 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. Or you may be able to use this
- web site:
-
- HP Patch Server: http://support.mayfield.hp.com/patches/html/patches.html
- HP Support Line: http://support.mayfield.hp.com
-
- Please do not ask FSF for further support on this. If you have any
- trouble obtaining the patch, contact HP Software Support.
-
- If your buffer fills up with nulls (^@) at some point, it could well
- be that problem. That problem does not happen when people use GCC
- to compile Emacs. On the other hand, the HP compiler version 9.34
- was reported to work for the 19.26 pretest. 9.65 was also reported to work.
-
- If you turn on the DSUSP character (delayed suspend),
- Emacs 19.26 does not know how to turn it off on HPUX.
- You need to turn it off manually.
-
- If you are running HP/UX release 8.0 or later, you need the optional
- "C/ANSI C" software in order to build Emacs (older releases of HP/UX
- do not require any special software). If the file "/etc/filesets/C"
- exists on your machine, you have this software, otherwise you do not.
-
-High Level Hardware Orion (orion-highlevel-bsd)
-
- This is the original microprogrammed hardware.
- Machine description file ought to work.
-
-High Level Hardware Orion 1/05 (clipper-highlevel-bsd)
-
- Changes merged in 18.52. This is the one with the Clipper cpu.
- Note that systems which lack NFS need LOAD_AVE_TYPE changed to `double'.
-
- C compiler has a bug; it loops compiling eval.c.
- Compile it by hand without optimization.
-
-HITACHI SR2001/SR2201 series (hppa1.1-hitachi-hiuxmpp)
-
- These machines are based on PA architecture running HI-UX/MPP
- (based on OSF1. `MPP' stands for `Massively Parallel Processor').
-
- Emacs 19.34 is believed to work; its pretest was tested
- both on SR2001 (output of `uname -rv' is `00-01-BB 0') and
- SR2201 (`02-00 0').
-
- The machine description file is `src/m/sr2k.h' is based on
- `src/m/hp800.h'. The system description file is `src/s/hiuxmpp.h'
- based on `src/s/osf1.h'. Note that this system doesn't use COFF.
-
-IBM PS/2 (i386-ibm-aix1.1 or i386-ibm-aix1.2)
-
- Changes merged in version 19. You may need to copy
- /usr/lib/samples/hft/hftctl.c to the Emacs src directory.
-
- i386-ibm-aix1.1 may not work with certain new X window managers, and
- may be suboptimal.
-
-IBM RS/6000 (rs6000-ibm-aix*)
-
- Emacs 19.26 is believed to work; its pretest was tested.
-
- Compiling with the system's `cc' and CFLAGS containing `-O5' might
- fail because libXbsd isn't found. This is a compiler bug;
- re-configure Emacs so that it isn't compiled with `-O5'.
-
- At last report, Emacs didn't run well on terminals. Informed
- persons say that the tty VMIN and VTIME settings have been
- corrupted; if you have a fix, please send it to us.
-
- Compiling with -O using the IBM compiler has been known
- to make Emacs work incorrectly. It's reported that on
- AIX 3.2.5 with an IBM compiler earlier than 1.03.00.14,
- cc -O fails for some files. You need to install any
- PTF containing APAR #IX42810 to bring the compiler to
- the 1.03.00.14 level to allow optimized compiles.
-
- There are reports that IBM compiler versions earlier than 1.03.00.02
- fail even without -O. However, another report said that compiler
- version 1.02.01.00 did work, on AIX 3.2.4, with Emacs 19.31.
-
- As of 19.11, if you strip the Emacs executable, it ceases to work.
-
- If you are using AIX 3.2.3, you may get a core dump when loading
- ange-ftp. You may be able to fix the problem by defining LIBS_TERMCAP
- as -ltermcap -lcurses. Please tell us if this fails to work.
-
- If anyone can fix the above problems, or confirm that they don't happen
- with certain versions of various programs, we would appreciate it.
-
-IBM RT/PC (romp-ibm-bsd or romp-ibm-aix)
-
- Use romp-ibm-bsd for the 4.2-like system and romp-ibm-aix for AIX.
- 19.22 is reported to work under bsd. We don't know about AIX.
-
- On BSD, if you have trouble, try compiling with a different compiler.
-
- On AIX, the file /usr/lib/samples/hft/hftctl.c must be compiled into
- hftctl.o, with this result left in the src directory (hftctl.c is
- part of the standard AIX distribution).
-
- window.c must not be compiled with -O on AIX.
-
-Integrated Solutions `Optimum V' (m68k-isi-bsd4.2 or -bsd4.3)
-
- 18.52 said to work on some sort of ISI machine.
- Version 18.45 worked (running on a Optimum V (VME bus, 68020)
- BSD 4.2 (3.05e) system). 18.42 is reported to work on
- a Qbus 68010 system. Has not been tried on `WorkStation' `Cluster
- Compute Node' `Cluster WorkStation' or `Server Node' (Love the
- StudLYCaps)
-
- Compilation with -O is rumored to break something.
-
- On recent system versions, you may need to undefine the macro UMAX
- in `lib-src/loadst.c' and `src/getpagesize.h'. They stupidly defined this
- in a system header file, which confuses Emacs (which thinks that UMAX
- indicates the Umax operating system).
-
-Intel 386 (i386-*-isc, i386-*-esix, i386-*-bsdi2,
- i386-*-xenix, i386-*-freebsd, i386-*-linux-gnu,
- i386-*-sol2.4, i386-*-sysv3, i386-intsys-sysv,
- i386-*-sysv4, i386-*-sysv4.2,
- i386-*-sysv5.3, i386-*-bsd4.2,
- i386-*-sco3.2v4, i386-*-bsd386, i386-*-386bsd,
- i386-*-msdos, i386-*-windowsnt.
- i386... can be replaced with i486... or i586...)
-
- In the above configurations, * means that the manufacturer's name
- you specify does not matter, and you can use any name you like
- (but it should not contain any dashes or stars).
-
- When using the ISC configurations, be sure to specify the isc
- version number - for example, if you're running ISC 3.0, use
- i386-unknown-isc3.0 as your configuration name.
- Use i386-*-esix for Esix; Emacs runs as of version 19.6.
- Use i386-*-linux-gnu for GNU/Linux systems; Emacs runs as of version 19.26.
- Use i386-intsys-sysv for Integrated Solutions 386 machines.
- It may also be correct for Microport systems.
- Use i386-*-sco3.2v4 for SCO 3.2v4; Emacs runs as of version 19.26.
-
- On GNU/Linux systems, Emacs 19.23 was said to work properly with libc
- version 4.5.21, but not with 4.5.19. If your system uses QMAGIC
- for the executable format, you must edit config.h to define LINUX_QMAGIC.
-
- On GNU/Linux, configure may fail to put these definitions in config.h:
-
- #define HAVE_GETTIMEOFDAY
- #define HAVE_MKDIR
- #define HAVE_RMDIR
- #define HAVE_XSCREENNUMBEROFSCREEN
-
- To work around the problem, add those definitions by hand.
- It is possible that this problem happens only with X11R6.
- Newer system versions have fixed it.
-
- The 19.26 pretest was reported to work on SVR4.3 and on Freebsd.
-
- 19.29 is reported to crash when using Motif on Solaris 2.5.
- The reasons are not yet known.
-
- Use i386-*-bsdiN for BSDI BSD/OS version N; Emacs runs as of version 19.23.
- In some system versions, `make' is broken; use GNU make instead.
- Shell bugs in version 1.0 of BSD/OS cause configure
- to do the wrong thing with --with-x-toolkit; the workaround is to edit
- configure to run another shell such as bash.
-
- For System V release 3, use i386-*-sysv3.
- For System V release 4, use i386-*-sysv4.
- For System V release 4.2, use i386-*-sysv4.2.
-
- If you are using Xenix, see notes at end under Xenix.
- If you are using Esix, see notes at end under Esix.
- If you are using SCO Unix, see notes at end under SCO.
-
- On 386bsd, NetBSD and FreeBSD, at one time, it was necessary to use
- GNU make, not the system's make. Assuming it's installed as gmake,
- do `gmake install MAKE=gmake'. However, more recently it is
- reported that using the system Make on NetBSD 1.3.1 works ok.
-
- If you are using System V release 4.2, you may find that `cc -E'
- puts spurious spaces in `src/xmakefile'. If that happens,
- specify CPP=/lib/cpp as an option when you run make.
- There is no problem if you compile with GCC.
-
- Note that use of Linux with GCC 2.4 and the DLL 4.4 libraries
- requires the experimental "net 2" network patches (no relation to
- Berkeley Net 2). There is a report that (some version of) Linux
- requires including `/usr/src/linux/include/linux' in buffer.c
- but no coherent explanation of why that might be so. If it is so,
- in current versions of Linux, something else should probably be changed.
-
- Some sysV.3 systems seem to have bugs in `opendir';
- for them, alter `config.h' to define NONSYSTEM_DIR_LIBRARY
- and undefine SYSV_SYSTEM_DIR.
-
- If you use optimization on V.3, you may need the option -W2,'-y 0'
- to prevent certain faulty optimization.
-
- On 386/ix, to link with shared libraries, add #define USG_SHARED_LIBRARIES
- to config.h.
-
- On SCO, there are problems in regexp matching when Emacs is compiled
- with the system compiler. The compiler version is "Microsoft C
- version 6", SCO 4.2.0h Dev Sys Maintenance Supplement 01/06/93;
- Quick C Compiler Version 1.00.46 (Beta). The solution is to compile
- with GCC.
-
- On ISC systems (2.02 and more recent), don't try to use the versions
- of X that come with the system; use XFree86 instead.
-
- There is no consistency in the handling of certain system header files
- on V.3.
-
- Some versions have sys/sioctl.h, and require it in sysdep.c.
- But some versions do not have sys/sioctl.h.
- For a given version of the system, this may depend on whether you have
- X Windows or TCP/IP. Define or undefine NO_SIOCTL_H in config.h
- according to whether you have the file.
-
- Likewise, some versions have been known to need sys/ttold.h, sys/stream.h,
- and sys/ptem.h included in sysdep.c. If your system has these files,
- try defining NEED_PTEM_H in config.h if you have trouble without it.
-
- You may find that adding -I/usr/X/include or -I/usr/netinclude or both
- to CFLAGS avoids compilation errors on certain systems.
-
- Some versions convince sysdep.c to try to use `struct tchars'
- but define `struct tc' instead; add `#define tchars tc'
- to config.h to solve this problem.
-
-Iris 2500 and Iris 2500 Turbo (m68k-sgi-iris3.5 or m68k-sgi-iris3.6)
-
- Version 18 was said to work; use m68k-sgi-iris3.5 for system version 2.5
- and m68k-sgi-iris3.6 for system version 3.6.
- Note that the 3030 is the same as the Iris 2500 Turbo.
-
-Iris 4D (mips-sgi-irix[456].*)
-
- You can build a 64-bit executable (with larger maximum buffer size)
- on Irix 6.5 by specifying the 64-bit ABI using the `-64' compiler
- flag or otherwise (see cc(1)). This may work on earlier Irix 6
- systems if you edit src/s/irix6-0.h following irix6-5.h.
-
- If compiling with GCC on Irix 6 yields an error "conflicting types
- for `initstate'", install GCC 2.95 or a newer version, and this
- problem should go away. It is possible that this problem results
- from upgrading the operating system without reinstalling GCC; so you
- could also try reinstalling the same version of GCC, and telling us
- whether that fixes the problem.
-
- The 19.26 pretest was reported to work on IRIX 4.0.5 and 5.2.
- 19.23 was reported to work on IRIX 5.2, but you may need to install
- the "compiler_dev.hdr.internal" subsystem in order to compile unexelfsgi.c.
- 19.22 was known to work on all Silicon Graphics machines running
- IRIX 4.0.5 or IRIX 5.1.
-
- Compiling with -O using IRIX compilers prior to 3.10.1 may not work.
- Don't use -O or use GCC instead.
-
- Most IRIX 3.3 systems do not have an ANSI C compiler, but a few do.
- Compile Emacs 18 with the -cckr switch on these machines.
-
- There is a bug in IRIX 3.3 that can sometimes leave ptys owned by root
- with a permission of 622. This causes malfunctions in use of
- subprocesses of Emacs. Irix versions 4.0 and later with GNU Emacs
- versions 18.59 and later fix this bug.
-
-Masscomp (m68k-masscomp-rtu)
-
- 18.36 worked on a 5500DP running RTU v3.1a and compiler version 3.2
- with minor fixes that are included in 18.37. However, bizarre behavior
- was reported for 18.36 on a Masscomp (model and version unknown but probably
- a 68020 system). The report sounds like a compiler bug.
-
- A compiler bug affecting statements like
- unsigned char k; unsigned char *p;... x = p[k];
- has been reported for "C version 1.2 under RTU 3.1". We do not wish
- to take the time to install the numerous workarounds required to
- compensate for this bug.
-
- For RTU version 3.1, define FIRST_PTY_LETTER to be 'p' in `src/s/rtu.h'
- (or #undef and redefine it in config.h) so that ptys will be used.
-
- GNU Emacs is said to have no chance of compiling on RTU versions
- prior to v3.0.
-
-Megatest (m68k-megatest-bsd)
-
- Emacs 15 worked; do not have any reports about Emacs 16 or 17
- but any new bugs are probably not difficult.
-
-Mips (mips-mips-riscos, mips-mips-riscos4.0, or mips-mips-bsd)
-
- The C compiler on Riscos 4.51 dumps core trying to optimize
- parts of Emacs. Try without optimization or try GCC.
-
- Meanwhile, the linker on that system returns success even if
- there are undefined symbols; as a result, configure gets the
- wrong answers to various questions. No work-around is known
- except to edit src/config.h by hand to indicate which functions
- don't exist.
-
- Use mips-mips-riscos4.0 for RISCOS version 4.
- Use mips-mips-bsd with the BSD world.
-
- Note that the proper configuration names for DECstations are
- mips-dec-ultrix and mips-dec-osf.
-
- If you are compiling with GCC, then you must run fixincludes;
- the alternative of using -traditional won't work because
- the definition of SIGN_EXTEND_CHAR uses the keyword `signed'.
-
- If the SYSV world is the default, then you probably need the following
- line in etc/Makefile:
-
- CFLAGS= -g -systype bsd43
-
- Some operating systems on MIPS machines give SIGTRAP for division by
- zero instead of the usual signals. The only real solution is to fix
- the system to give a proper signal.
-
- In the meantime, you can change init_data in data.c if you wish.
- Change it to handle SIGTRAP as well as SIGFPE. But this will have a
- great disadvantage: you will not be able to run Emacs under a
- debugger. I think crashing on division by zero is a lesser problem.
-
- dsg@mitre.org reported needing to use --x-libraries=/bsd43/usr/lib
- on a riscos4bsd site. But it is not clear whether this is needed in
- general or only because of quirks on a particular site.
-
-National Semiconductor 32000 (ns32k-ns-genix)
-
- This is for a complete machine from National Semiconductor,
- running Genix. Changes merged in version 19.
-
-NCR Tower 32 (m68k-ncr-sysv2 or m68k-ncr-sysv3)
-
- If you are running System V release 2, use m68k-ncr-sysv2.
- If you are running System V release 3, use m68k-ncr-sysv3.
-
- These both worked as of 18.56. If you change `src/ymakefile' so that
- CFLAGS includes C_OPTIMIZE_SWITCH rather than C_DEBUG_SWITCH, check
- out the comments in `src/m/tower32.h' (for System V release 2) or
- `src/m/tower32v3.h' (for System V release 3) about this.
-
- There is a report that compilation with -O did not work with 18.54
- under System V release 2.
-
-NCR Intel system (i386-ncr-sysv4.2)
-
- This system works in 19.31, but if you don't link it with GNU ld,
- you may need to set LD_RUN_PATH at link time to specify where
- to find the X libraries.
-
-NEC EWS4800 (mips-nec-sysv4)
-
- This system works in 20.4, but you should use the compiler
- /usr/abiccs/bin/cc (MIPS ABI MODE).
-
-NeXT (m68k-next-nextstep)
-
- Emacs 19 has not been tested extensively yet, but it seems to work
- in a NeXTStep 3.0 terminal window, and under the X server called
- co-Xist. You may need to specify -traditional when src/Makefile
- builds xmakefile.
-
- NeXT users might want to implement direct operation with NeXTStep,
- but from the point of view of the GNU project, that is a
- distraction.
-
- Thanks to Thorsten Ohl for working on the NeXT port of Emacs 19.
-
-Nixdorf Targon 31 (m68k-nixdorf-sysv)
-
- Machine description file for version 17 is included in 18
- but whether it works is not known.
- `src/unexec.c' bombs if compiled with -O.
- Note that the "Targon 35" is really a Pyramid.
-
-Nu (TI or LMI) (m68k-nu-sysv)
-
- Version 18 is believed to work.
-
-Paragon OSF/1 (i860-intel-osf1)
-
- Changes merged in 19.29.
-
- There is a bug in OSF/1 make which claims there is a syntax error
- in the src/xmakefile. You can successfully build emacs with:
-
- pmake MAKE=pmake
-
-Plexus (m68k-plexus-sysv)
-
- Worked as of 17.56.
-
-Pmax (DEC Mips) (mips-dec-ultrix or mips-dec-osf1)
-
- See under DECstation, above.
-
-Prime EXL (i386-prime-sysv)
-
- Minor changes merged in 19.1.
-
-Pyramid (pyramid-pyramid-bsd)
-
- The 19.26 pretest was observed to work on OSx 5.0, but it is necessary
- to edit gmalloc.c. You must add #include <sys/types.h> at the top,
- and delete the #define for size_t.
-
- You need to build Emacs in the Berkeley universe with
- the `ucb' command, as in `ucb make' or `ucb build-install'.
-
- In OSx 4.0, it seems necessary to add the following two lines
- to `src/m/pyramid.h':
- #define _longjmp longjmp
- #define _setjmp setjmp
-
- In Pyramid system 2.5 there has been a compiler bug making
- Emacs crash just after screen-splitting with Qnil containing 0.
- A compiler that fixes this is Pyramid customer number 8494,
- internal number 1923.
-
- Some versions of the pyramid compiler get fatal
- errors when the -gx compiler switch is used; if this
- happens to you, change `src/m/pyramid.h' to define
- C_DEBUG_SWITCH with an empty definition.
-
- Some old system versions may require you to define PYRAMID_OLD
- in when alloca.s is preprocessed, in order to define _longjmp and _setjmp.
-
-Sequent Balance (ns32k-sequent-bsd4.2 or ns32k-sequent-bsd4.3)
-
- Emacs 18.51 worked on system version 3.0. 18.52 is said to work.
- Delete some lines at the end of `src/m/sequent.h' for earlier system
- versions.
-
-Sequent Symmetry (i386-sequent-bsd, i386-sequent-ptx, i386-sequent-ptx4)
-
- 19.33 has changes to support ptx 4 (a modified SVR4).
-
- Emacs 19 should work on Dynix (BSD). However, if you compile with
- the Sequent compiler, you may find Emacs does not restore the
- terminal settings on exit. If this happens, compile with GCC.
-
- Emacs 19.27 contains patches that should support
- DYNIX/ptx 1.4 and 2.1 with the native cc compiler.
-
- GCC can't compile src/process.c due to a non-standard Sequent asm
- keyword extension supported by cc and used for the network byte/word
- swapping functions in the PTX /usr/include/netinet/in.h file. GCC
- 2.5.8 includes the file <sys/byteorder.h> which can be included into
- netinet/in.h to perform these byte/word swapping functions in the
- same manner. Patches have been submitted to the FSF against GCC
- 2.6.0 to fix this problem and allow Emacs to be built with GCC.
-
- If your machine does not have TCP/IP installed, you will have to edit the
- src/s/ptx.h file and comment out #define TCPIP_INSTALLED.
-
-Siemens Nixdorf RM600 and RM400 (mips-siemens-sysv4)
-
- Changes merged in 19.29. This configuration should also work for
- Pyramid MIS Server running DC-OSX 1.x. The version configured with
- `--with-x' works without any modifications, but `--with-x-toolkit'
- works only if the Athena library and the Toolkit library are linked
- statically. For this, edit `src/Makefile' after the `configure' run
- and modify the lines with `-lXaw' and `-lXt' as follows:
-
- LIBW= /usr/lib/libXaw.a
- LIBXT= $(LIBW) -lXmu /usr/lib/libXt.a $(LIBXTR6) -lXext
-
- In addition, `--with-x-toolkit=motif' works only
- if the Motif library and the Toolkit library are linked statically.
- To do this, edit `src/Makefile' after the `configure' run
- and modify the lines with `-lXm' and `-lXt' as follows:
-
- LIBW= /usr/lib/libXm.a /usr/ccs/lib/libgen.a
- LIBXT= $(LIBW) -lXmu /usr/lib/libXt.a $(LIBXTR6) -lXext
-
-SONY News (m68k-sony-bsd4.2 or m68k-sony-bsd4.3)
-
- 18.52 worked. Use m68k-sony-bsd4.3 for system release 3.
-
-SONY News 3000 series (RISC NEWS) (mips-sony-bsd)
-
- The 19.26 pretest is reported to work.
-
- Some versions of the operating system give SIGTRAP for division by zero
- instead of the usual signals. This causes division by zero
- to make Emacs crash. The system should be fixed to give the proper signal.
- Changing Emacs is not a proper solution, because it would prevent
- Emacs from working under any debugger. But you can change init_data
- in data.c if you wish.
-
-Stardent i860 (i860-stardent-sysv4.0)
-
- 19.26 pretest reported to work.
-
-Stardent 1500 or 3000
-
- See Titan.
-
-Stride (m68k-stride-sysv)
-
- Works (most recent news for 18.30) on their release 2.0.
- For release 2.2, see the end of `src/m/stride.h'.
- It may be possible to run on their V.1 system but changes
- in the s- file would be needed.
-
-Sun 3, Sun 4 (sparc), Sun 386 (m68k-sun-sunos, sparc-sun-sunos, i386-sun-sunos,
- sparc-sun-sunos4.1.3noshr, sparc-sun-solaris2.*,
- i386-sun-solaris2.*, sparc*-*-linux-gnu)
-
- To build a 64-bit Emacs (with larger maximum buffer size and
- including large file support) on a Solaris system which supports
- 64-bit executables, use the Sun compiler, configuring something like
- this (see the cc documentation for information on 64-bit
- compilation): env CC="cc -xarch=v9" ./configure --without-gcc
-
- As of version 2.95, GCC doesn't support the 64-bit ABI properly, but
- later releases may.
-
- On Solaris 2.7, building Emacs with WorkShop Compilers 5.0 98/12/15
- C 5.0 failed, apparently with non-default CFLAGS, most probably due to
- compiler bugs. Using Sun Solaris 2.7 Sun WorkShop 6 update 1 C
- release was reported to work without problems. It worked OK on
- another system with Solaris 8 using apparently the same 5.0 compiler
- and the default CFLAGS.
-
- Emacs 20.5 and later work on SPARC GNU/Linux with the 32-bit ABI.
- As of release 2.95, GCC doesn't work properly with the 64-bit ABI
- (applicable on UltraSPARC), but that isn't the default mode.
-
- Emacs 20.3 fails to build on Solaris 2.5 if you use GCC 2.7.2.3.
- Installing GCC 2.8 fixes the problem.
-
- 19.32 works on Solaris 2.4 and 2.5. On Solaris 2.5
- you may need one of these patches to prevent Emacs from crashing
- when it starts up:
- 103093-03: [README] SunOS 5.5: kernel patch (2140557 bytes)
- 102832-01: [README] OpenWindows 3.5: Xview Jumbo Patch (4181613 bytes)
- 103242-04: [README] SunOS 5.5: linker patch (595363 bytes)
-
- There are reports that using SunSoft cc with -xO4 -xdepend produces
- bad code for some part of Emacs.
-
- Emacs works ok Sunos 4.1.x
- provided you completely replace your C shared library
- using one of the SunOS 4.1.x jumbo replacement patches from Sun.
- Here are the patch numbers for Sunos 4.1.3:
- 100890-10 SunOS 4.1.3: domestic libc jumbo patch
- 100891-10 SunOS 4.1.3: international libc jumbo patch
-
- Some people report that Emacs crashes immediately on startup when
- used with a non-X terminal, but we think this is due to compiling
- with GCC and failing to use GCC's "fixed" system header files.
-
- Some Sun versions of X windows use the clipboard, not the selections,
- for transferring text between clients. The Cut, Paste and Copy items
- in the menu bar Edit menu work with the clipboard.
-
- It's important to include the SunOS version number in the
- configuration name. For example, for SunOS release 4.0 on a Sun 3,
- use `m68k-sun-sunos4.0'; for SunOS release 4.1 on a Sparc, use
- `sparc-sun-sunos4.1'. For SunOS release 4.1.3 on a Sparc, use
- `sparc-sun-sunos4.1.3'. Note that shared libraries are now
- used by default on SunOS 4.1.
-
- A user reported irreproducible segmentation faults when using 19.29
- on Solaris 2.3 and 2.4 after compiling it with the Sun compiler.
- The problem went away when GCC 2.7.0 was used instead. We do not know
- whether anything in Emacs is partly to blame for this.
-
- X11R6 is set up to make shared libraries only, on Sunos 4.
- Therefore, in order to link Emacs, you need to create static X libraries.
- To do this, rebuild X11 after setting
- #define ForceNormalLib YES
- #define SeparateSharedCompile YES
- in site.def (after #ifdef AfterVendorCF).
-
- Use `m68k' for the 68000-based Sun boxes, `sparc' for Sparcstations,
- and `i386' for Sun Roadrunners. i386 calls for Sunos4.0.
-
- If you compile with Sun's ANSI compiler acc, you need additional options
- when linking temacs, such as
- /usr/lang/SC2.0.1/values-Xt.o -L/usr/lang/SC2.0.1/cg87 -L/usr/lang/SC2.0.1
- (those should be added just before the libraries) and you need to
- add -lansi just before -lc. The precise file names depend on the
- compiler version, so we cannot easily arrange to supply them.
-
- On SunOS 4.1.1, do not use /usr/5bin/cc. You can use gcc or/usr/bin/cc.
- Make sure the environment variable LD_LIBRARY_PATH is not defined.
-
- Some people report crashes on SunOS 4.1.3 if SYSTEM_MALLOC is defined.
- Others have reported that Emacs works if SYSTEM_MALLOC is defined, and not
- if it is undefined. So far we do not know why results vary in this way.
- The sources are set up so that SYSTEM_MALLOC is defined; if that crashes,
- or if you want the benefit of the relocating memory allocator, you can
- try enabling the #undef SYSTEM_MALLOC in src/s/sunos4-1-3.h.
-
- On Solaris 2, you need to install patch 100947-02 to fix a system bug.
- Presumably this patch comes from Sun. You must alter the definition of
- LD_SWITCH_SYSTEM if your X11 libraries are not in /usr/openwin/lib.
- You must make sure that /usr/ucblib is not in your LD_LIBRARY_PATH.
-
- On Solaris 2.2, with a multiprocessor SparcCenter 1000, Emacs 19.17 is
- reported to hang sometimes if it exits while it has one or more
- subprocesses (e.g. the `wakeup' subprocess used by `display-time').
- Emacs and its subprocesses become zombies, and in their zombie state
- slow down their host and disable rlogin and telnet. This is most
- likely due to a bug in Solaris 2.2's multiprocessor support,
- rather than an Emacs bug.
-
- On Solaris, do not use /usr/ucb/cc. Use /opt/SUNWspro/bin/cc. Make
- sure that /usr/ccs/bin and /opt/SUNWspro/bin are in your PATH before
- /usr/ucb. (Most free software packages have the same requirement on
- Solaris.)
-
- If you have trouble using open-network-stream, get the distribution
- of `bind' (the BSD name-server), build libresolv.a, and link Emacs
- with -lresolv, by copying the #definition of LIBS_SYSTEM in
- src/s/sunos4-1.h to src/config.h. This problem is due to obsolete
- software in the nonshared standard library.
-
- If you want to use SunWindows, define HAVE_SUN_WINDOWS
- in config.h to enable a special interface called `emacstool'.
- The definition must *precede* the #include "machine.h".
- System version 3.2 is required for this facility to work.
-
- We recommend that you instead use the X window system, which
- has technical advantages, is an industry standard, and is also
- free software. The FSF does not support the SunWindows code;
- we installed it only on the understanding we would not let it
- divert our efforts from what we think is important.
-
- If you are compiling for X windows, and the X window library was
- compiled to use the 68881, then you must edit config.h according
- the comments at the end of `src/m/sun3.h'.
-
- Note that Emacs on a Sun is not really as big as it looks.
- As dumped, it includes around 200k of zeros between the
- original text section and the original data section
- (now remapped as part of the text). These are never
- swapped in.
-
- To build a single Emacs that will run on Sun 2 and Sun 3
- HARDWARE, just build it on the Sun 2.
-
- On Sunos 4.1.3, the word is that Emacs can loop infinitely
- on startup with X due perhaps to a bug in Sunos. Installing all of
- these Sun patches fixes the problem. We don't know which of them
- are really relevant.
-
- 100075-11 100224-06 100347-03 100482-05 100557-02 100623-03 100804-03
- 101080-01 100103-12 100249-09 100496-02 100564-07 100630-02 100891-10
- 101134-01 100170-09 100296-04 100377-09 100507-04 100567-04 100650-02
- 101070-01 101145-01 100173-10 100305-15 100383-06 100513-04 100570-05
- 100689-01 101071-03 101200-02 100178-09 100338-05 100421-03 100536-02
- 100584-05 100784-01 101072-01 101207-01
-
-Tadpole 68K (m68k-tadpole-sysv)
-
- Changes merged in 19.1.
-
- You may need to edit Makefile to change the variables LIBDIR and
- BINDIR from /usr/local to /usr/contrib.
-
- To give movemail access to /usr/mail, you may need to execute
-
- chmod 2755 etc/movemail; chgrp mail etc/movemail
-
-Tahoe (tahoe-tahoe-bsd4.2 or tahoe-tahoe-bsd4.3)
-
- 18.52 was known to work on some Tahoes, but a compiler bug intervenes
- on others. Some Emacs versions have worked in Unisys 1r4
- (not in 1r3) and CCI I.21.
-
- If you have trouble compiling `lib-src/loadst.c', turn off the definition
- of DKSTAT_HEADER_FILE in `src/m/tahoe.h'.
-
-Tandem Integrity S2 (mips-tandem-sysv)
-
- Changes merged in 18.56 but subprocess support is turned off.
- You will probably want to see if you can make subprocesses work.
-
- You must edit `lib-src/Makefile' to define LOADLIBES = -mld.
-
-Tektronix XD88 (m88k-tektronix-sysv3*)
-
- The 19.26 pretest was reported to work.
- Minor changes merged in 19.19.
-
-Tektronix 16000 box (6130?) (ns16k-tektronix-bsd)
-
- Emacs 17.61 worked.
-
-Tektronix 4300 (m68k-tektronix-bsd)
-
- Emacs 19.26 pretest reported to work.
-
-Titan P2 or P3 (titan-titan-sysv)
-
- Changes probably merged in version 19.
-
-Ustation E30 (SS5E) (m68k-unisys-unipl)
-
- Changes merged in 18.52; don't know whether they work.
-
-Vaxen running Berkeley Unix (vax-dec-bsd4.1, vax-dec-bsd4.2, vax-dec-bsd4.3),
- Ultrix (vax-dec-ultrix),
- System V (vax-dec-sysv0, vax-dec-sysv2), or
- VMS (vax-dec-vms)
-
- Works.
-
- See under Ultrix for problems using X windows on Ultrix (vax-dec-ultrix).
-
- 18.27 worked on System V rel 2 (vax-dec-sysv2).
-
- 18.36 worked on System V rel 0 (vax-dec-sysv0).
-
- Richard Levitte <levitte@e.kth.se> 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.
-\f
-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.
-
-Linux (actually GNU/Linux)
-
- Most of the complete systems which use the Linux kernel are close
- enough to the GNU system to be considered variant GNU systems. We
- call them "Linux-based GNU systems," or GNU/Linux for short.
-
- It is not coincidence that many of the other components used with
- Linux--including GNU Emacs--were developed specifically for the GNU
- project. The GNU project was launched in 1984 to develop a free
- complete Unix-like operating system. To reach this goal, we had to
- develop whatever system components were not available as freely
- redistributable software from some other source.
-
- The GNU project wants users of GNU/Linux systems to be aware of how
- these systems relate to the GNU project, because that will help
- spread the GNU idea that software should be free--and thus encourage
- people to write more free software. See the file LINUX-GNU in this
- directory for more explanation.
-
-Microport
-
- See under "Intel 386".
-
-MSDOS
-
- For installation on MSDOS, see the file INSTALL (search for `MSDOG',
- near the end of the file). See the "MS-DOS" chapter of the manual
- for information about using Emacs on MSDOS.
-
-SCO Unix
- If you have TCP but not X, you need to edit src/s/sco4.h
- to define HAVE_SOCKETS.
-
- If you are using MMDF instead of sendmail, you need to remove
- /usr/lib/sendmail or modify lisp/paths.el before compiling.
- lisp/paths.el (which is loaded during the build) will attempt to use
- sendmail if it exists.
-
- If you are using SMAIL, you need to define the macro
- SMAIL in config.h.
-
-System V rel 0 (usg5.0)
-
- Works, on Vaxes and 3bxxx's.
- There are some problems in 18.37 due to shortnames/cccp problems:
- use the emacs 17 cpp if you have it.
-
-System V rel 2 (usg5.2)
-
- Works on various machines.
- On some (maybe all) machines the library -lPW exists and contains
- a version of `alloca'. On these machines, to use it, put
- #define HAVE_ALLOCA
- #define LIB_STANDARD -lPW -lc
- in the `src/m/MACHINENAME.h' file for the machine.
-
- If you find that the character Meta-DEL makes Emacs crash,
- find where function init_sys_modes in sysdep.c sets sg.c_cc[VQUIT]
- and make it store 7 there. I have as yet no evidence of whether
- this problem, known in HP/UX, exists in other system V versions.
-
-System V rel 2.2 (usg5.2.2)
-
- In 5.2.2 AT&T undid, incompatibly, their previous incompatible
- change to the way the nlist library is called. A different s- file
- is used to enable the other interface.
-
- They call themselves the right choice--can't they choose?
-
- Emacs version 18 unexec is currently not working properly
- on 5.2.2. Nobody knows why yet. A workaround is to define
- NO_REMAP. It is not yet known whether this applies to all
- machines running 5.2.2.
-
-System V rel 3 (usg5.3)
-
- Some versions of this system support ptys and BSD-style sockets.
- On such systems, you should define HAVE_PTYS and HAVE_SOCKETS in config.h.
-
- If you want to link Emacs with shared libraries, define
- USG_SHARED_LIBRARIES.
-
- You may have to add ANSI idempotence #-lines to your sys/types.h
- file to get Emacs to compile correctly. This may be necessary on
- other pre-ANSI systems as well.
-
- On an AT&T 6386WGS using System V Release 3.2 and X11R3, the X support
- cannot be made to work. Whether or not the GNU relocating malloc is
- used, the symptom is that the first call Emacs makes to sbrk(0) returns
- (char *)-1. Sorry, you're stuck with character-only mode. Try
- installing Xfree86 to fix this.
-
-System V rel 4.0.3 and 4.0.4 (usg5.4)
-
- Supported, including shared libraries for ELF, but ptys do not work
- because TIOCGPGRP fails to work on ptys (but Dell 2.2 seems to have
- fixed this). This failure is probably due to a misunderstanding of
- the consequences of the POSIX spec: many system designers mistakenly
- think that POSIX requires this feature to fail. This is untrue;
- ptys are an extension, and POSIX says that extensions *when used*
- may change the action of standard facilities in any fashion.
-
- If you get compilation errors about wrong number of
- arguments to getpgrp, define GETPGRP_NO_ARG.
-
- The standard C preprocessor may generate xmakefile incorrectly. However,
- /lib/cpp will work, so use `make CPP=/lib/cpp'. Standard cpp
- seems to work OK under Dell 2.2.
-
- Some versions 3 and earlier of V.4, on the Intel 386 and 860, had
- problems in the X11 libraries. These prevent Emacs from working
- with X. You can use Emacs with X provided your copy of X is based
- on X11 release 4 or newer, or is Dell's 2.2 (which is a 4.0.3).
- Unfortunately, the only way you can tell whether your X11 library is
- new enough is to try compiling Emacs to use X. If emacs runs, your
- X11 library is new enough.
-
- In this context, GSV4 and GSV4i are alternate names for X11R4.
- OL2.* is X11R3 based. OL3 is in between X11R3 and X11R4, and may or
- may not work, depending on who made the Unix system. If the library
- libXol is part of the X distribution, then you have X11R3 and Emacs
- won't work with X.
-
- Most versions of V.4 support sockets. If `/usr/lib/libsocket.so'
- exists, your system supports them. If yours does not, you must add
- #undef HAVE_SOCKETS in config.h, after the inclusion of s-usg5-4.h.
- (Any system that supports Internet should implement sockets.)
-
-Ultrix (bsd4.3)
-
- Recent versions of Ultrix appear to support the features of Berkeley 4.3.
- Ultrix was at the BSD 4.2 level for a long time after BSD 4.3 came out.
-
- Ultrix 3.0 has incompatibilities in its X library if you have the
- Ultrix version of X (UWS version 2.0). To solve them, you need to
- prevent XvmsAlloc.o in Xlib from being used. Israel Pinkas says:
-
- I added the following lines to config.h after the X defines:
-
- #if defined(ultrix) && defined(X11)
- #define OBJECTS_SYSTEM calloc.o
- #endif
-
- Then I ran the following:
-
- ar x /usr/lib/libc.a calloc.o
-
- The problem is said to be gone in UWS version 2.1.
-
-Uniplus 5.2 (unipl5.2)
-
- Works, on Dual machines at least.
-
-VMS (vmsM.N)
-
- Richard Levitte <levitte@e.kth.se> distributes a set of patches to
- Emacs 18.59 to make it work nicely under VMS. Emacs 19 probably
- won't work very well, or even compile. Levitte is working on a
- port, so these problems should be fixed in the near future.
-
- Note that Emacs for VMS is usually distributed in a special VMS
- distribution. See the file ../vms/VMSINSTALL for info on moving
- Unix distributions to VMS, and other VMS-related topics.
-
-Windows NT
-
- For installation on Windows NT, see the file etc/INSTALL and search for
- `Windows NT'.
-
-Xenix (xenix)
-
- Should work in 18.50, but you will need to edit the files
- `lib-src/Makefile' and `src/ymakefile'
- (see the comments that mention "Xenix" for what to change.)
- Compiling Emacs with -O is said not to work.
-
- If you want Emacs to work with Smail (installed as /usr/bin/smail)
- then add the line #define SMAIL to config.h.
-
- The file etc/XENIX suggests some useful things to do to Xenix
- to make the Emacs meta key work.
-\f
-Local variables:
-mode: indented-text
-fill-prefix: " "
-End:
((consp (sgml-entity-text entity)) ; external id?
(let* ((extid (sgml-entity-text entity))
-* Emacs 21 freezes when visiting a TeX file with AUC TeX installed.
-
-Emacs 21 needs version 10 or later of AUC TeX; upgrading should solve
-these problems.
-
-* Running TeX from AUC TeX package with Emacs 20.3 gives a Lisp error
+* Running TeX from AUXTeX package with Emacs 20.3 gives a Lisp error
about a read-only tex output buffer.
This problem appeared for AUC TeX version 9.9j and some earlier
+++ /dev/null
-Things 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.
-
+++ /dev/null
-eterm,
- lines#24,cols#80,
- colors#8,pairs#64,
- cuu1=\E[A,cud1=\n,cub1=\b,cuf1=\E[C,home=\E[H,cr=\r,
- cuu=\E[%p1%dA,cud=\E[%p1%dB,cub=\E[%p1%dD,cuf=\E[%p1%dC,
- cup=\E[%i%p1%d;%p2%dH,
- ind=\n,csr=\E[%i%p1%d;%p2%dr,
- il1=\E[L,il=\E[%p1%dL,
- clear=\E[H\E[J,ed=\E[J,el=\E[K,el1=\E[1K,
- dl1=\E[M,dl=\E[%p1%dM,dch1=\E[P,dch=\E[%p1%dP,
- smir=\E[4h,rmir=\E[4l,ich=\E[%p1%d@,mir,
- smcup=\E7\E[?47h,rmcup=\E[2J\E[?47l\E8,
- ht=\t,khome=\E[1~,kend=\E[4~,knp=\E[6~,kpp=\E[5~,
- kcub1=\EOD, kcud1=\EOB, kcuf1=\EOC, kcuu1=\EOA,
- smso=\E[7m,rmso=\E[m,
- smul=\E[4m,rmul=\E[m,
- rev=\E[7m,bold=\E[1m,sgr0=\E[m,
- invis=\E[8m,
- setab=\E[%p1%{40}%+%dm, setaf=\E[%p1%{30}%+%dm,
- bel=^G,xenl,am,
-
+++ /dev/null
-@setfilename LNEWS
-
-@section New Features in the Lisp Language
-
-@end itemize
-@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.
-
-@ignore
-@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.
-@c ??? This hasn't been written yet. ???
-@end ignore
-
-@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 a function
-definition 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 expm1
-@findex expm1
-Power of @var{e}, minus 1.
-@item log1p
-@findex log1p
-Add 1, then take the logarithm.
-@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{f}, 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, 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.
-
-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 buffer modification
-primitives to set @code{deactivate-mark}.
-
-The variables @code{activate-mark-hook} and @code{deactivate-mark-hook}
-are normal hooks run, respectively, when the mark becomes active andwhen
-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
-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
-rrgion beginning from the region end.) All three arguments are
-integers. The buffer that's about to change 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 (@pxref{Property Lists}).
-
- You can use the property @code{face-code} to control the font and
-color of text. That is the only property name which currently has a
-special meaning, but 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. @xref{Property Search}, for
-functions to examine the properties of a number of characters at once.
-
-@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 three 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 vessage 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-code} to control the font and
-color of text. That is the only property name which currently has a
-special meaning, but you can create properties of any name and examine
-them later for your own purposes.
-about face codes.
-
- 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-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{make-directory}, @code{make-symbolic-link}, @code{rename-file},
-@code{set-file-modes}, @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 (primitive &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 (supported under X Windows
-only). This is the only primitive for creating frames.
-
-@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 windows
-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}. @xref{Focus Events}.
-
-@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;
-X windows 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-scrollbar
-Non-@code{nil} gives the frame a scroll bar
-for vertical scrolling.
-
-@item horizontal-scrollbar
-Non-@code{nil} gives the frame a scroll bar
-for horizontal scrolling.
-@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 Windows 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 features for key
-bindings and input.''
-@c ???
-
-@item
-@code{x-set-selection} sets a ``selection'' in the X Windows 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 Windows 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
-X Windows 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 in X Windows, but Emacs supports
-them for the sake of X clients that still use them.
-
-@item
-You can close the connection with the X Windows server with
-the function @code{x-close-current-connection}. This takes no arguments.
-
-Then you can connect to a different X Windows 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 Windows 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-color-display-p} returns @code{t} if you are using an X Window
-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 one of the keyboard keys. This works
-only with X Windows.
-
-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-geometry} parses a string specifying window size
-and position in the usual fashion for X windows. 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
-@samp{%l} as a mode line item displays the current line number.
-
-If the buffer is longer than @code{line-number-display-limit}
-characters, or if lines are too long in the viscinity of the current
-displayed text, then line number display is inhibited to save time.
-
-The default contents of the mode line include the line number if
-@code{line-number-mode} is non-@code{nil}.
-
-@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
-
-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 not available with X Windows.
-
-@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.
-
-A face code for X windows is the combination of a font and a color.
-Emacs uses integers to identify face codes. You can define a new face
-code with @code{(x-set-face @var{face-code} @var{font} @var{foreground}
-@var{background})}. @var{face-code} is an integer from 0 to 255; it
-specifies which face to define. The other three arguments are strings:
-@var{font} is the name of the font to use, and @var{foreground} and
-@var{background} specify the colors to use.
-
-If @code{glyph-table} is @code{nil}, then all possible glyph codes are
-simple.
-
-@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 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 numbered
-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-scrollbar} or @code{horizontal-scrollbar}, and
-the pair @code{(@var{column} . @var{row})} is instead 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 (#<window 18 on NEWS> 2613 (0 . 38) -864320))
-(mouse-1 (#<window 18 on NEWS> 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 (#<window 18 on NEWS> 3440 (0 . 27) -731219))
-(C-drag-mouse-2 (#<window 18 on NEWS> 3440 (0 . 27) -731219)
- (#<window 18 on NEWS> 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 (#<window 18 on NEWS> mode-line (33 . 31) -457844))
-(M-S-drag-mouse-2 (#<window 18 on NEWS> mode-line (33 . 31) -457844)
- (#<window 20 on carlton-sanskrit.tex> 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 concern, 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}, @code{horizontal-scrollbar} and
-@code{vertical-scrollbar}.
-
-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 (#<window 6 on NEWS> 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 overal 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. Do 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-minibufer} 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} says whether to enable the use of a Meta key.
-Non-@code{nil} means yes.
-
-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 option 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}.
-It takes no arguments, and returns a list of this form:
-
-@example
-(@var{offset} @var{savings-flag} @var{standard} @var{savings})
-@end example
-
-@var{offset} is an integer specifying how many minutes east of Greenwich
-the current time zone is located. A negative value means west of
-Greenwich. Note that this describes the standard time; if daylight
-savings time is in effect, it does not affect this value.
-
-@var{savings-flag} is non-@code{nil} iff daylight savings time or some other
-sort of seasonal time adjustment is in effect.
-
-@var{standard} is a string giving the name of the time zone when no
-seasonal time adjustment is in effect.
-
-@var{savings} is a string giving the name of the time zone when there is a
-seasonal time adjustment in effect.
-
-If the user has specified a region that does not use a seasonal time
-adjustment, @var{savings-flag} is always @code{nil}, and @var{standard}
-and @var{savings} are equal.
-
-@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} has been renamed to
-@code{suspend-hooks}, because it is a list of functions but is not a
-normal hook.
-
-@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.
-@end itemize
-
-@bye
+++ /dev/null
-
-# This is termcap.dat, a copy of the /etc/termcap file included here
-# for use on VMS.
-
-# I know that many terminals are missing from this version of the file
-# because they were deleted at MIT.
-# I hope that someone will add in all the missing terminal types
-# and send me a corrected, larger file.
-
-# These are local terminals.
-
-v1|tvi912|912|920|tvi920|old televideo:\
- :ct=\E3:st=\E1:cr=^M:do=^J:nl=^J:bl=^G:\
- :al=33*\EE:le=^H:ce=\ET:cm=\E=%+ %+ :cl=^Z:co#80:dc=\EW:dl=33*\ER:ei=:\
- :kb=^h:ku=^K:kd=^J:kl=^H:kr=^L:k0=^A@\r:k1=^AA\r:k2=^AB\r:k3=^AC\r:\
- :bs:am:k4=^AD\r:k5=^AE\r:k6=^AF\r:k7=^AG\r:k8=^AH\r:k9=^AI\r:\
- :ho=^^:im=:ic=\EQ:li#24:nd=^L:ta=^I:pt:se=\Ek:so=\Ej:up=^K:us=\El:ue=\Em:\
- :ma=^K^P^L :sg#1:ug#1:
-ZV|bobcat|sbobcat|HP 9000 model 300 console:\
- :al=10*\EL:am:bs:\
- :cd=\EJ:ce=\EK:ch=6\E&a%dC:cl=\EH\EJ:\
- :co#128:da:db:dc=\EP:dl=10*\EM:do=\EB:ei=\ER:\
- :kb=^H:kd=\EB:kh=\Eh:kl=\ED:kr=\EC:ku=\EA:\
- :ke=\E&s0A:ks=\E&s1A:\
- :li#47:mi:nd=\EC:pt:\
- :se=\E&d@:so=\E&dB:\
- :up=\EA:xs:\
- :cm=6\E&a%dy%dC:cv=6\E&a%dY:\
- :im=\EQ:ml=\El:mu=\Em:\
- :ue=\E&d@:us=\E&dD:bt=\Ei:sg#0:
-ZX|gator-t|HP 9000 model 237 emulating extra-tall AAA:\
- :cr=^M:do=^J:nl=^J:bl=^G:al=\E[L:le=^H:bs:\
- :cd=\E[J:ce=\E[K:cl=\E[H\E[J:cm=\E[%i%d;%dH:co#128:li#94:\
- :dc=\E[P:dl=\E[M:ho=\E[H:ic=\E[@:\
- :AL=1*\E[%dL:DL=1*\E[%dM:IC=4\E[%d@:DC=4\E[%dP:rp=1*%.\E[%db:mr=\E[7m:me=\E[m:\
- :km:ch=\E[%i%d`:\
- :ul:ei=:im=:pt:bw:bt=\E[Z:\
- :mi:nd=\E[C:se=\E[m:so=\E[7m:ue=\E[m:us=\E[4m:up=\EM:
-ZW|gator|HP 9000 model 237 emulating AAA:\
- :cr=^M:do=^J:nl=^J:bl=^G:al=\E[L:le=^H:bs:\
- :cd=\E[J:ce=\E[K:cl=\E[H\E[J:cm=\E[%i%d;%dH:co#128:li#47:\
- :dc=\E[P:dl=\E[M:ho=\E[H:ic=\E[@:\
- :AL=1*\E[%dL:DL=1*\E[%dM:IC=4\E[%d@:DC=4\E[%dP:rp=1*%.\E[%db:mr=\E[7m:me=\E[m:\
- :km:ch=\E[%i%d`:\
- :ul:ei=:im=:pt:bw:bt=\E[Z:\
- :mi:nd=\E[C:se=\E[m:so=\E[7m:ue=\E[m:us=\E[4m:up=\EM:
-ZY|gator-52|HP 9000 model 237 emulating VT52:\
- :cr=^M:do=^J:nl=^J:bl=^G:\
- :le=^H:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#128:li#47:nd=\EC:\
- :ta=^I:pt:sr=\EI:up=\EA:ku=\EA:kd=\EB:kr=\EC:kl=\ED:kb=^H:\
- :ce=\EK:ho=\EH:
-ZZ|gator-52t|HP 9000 model 237 emulating extra-tall VT52:\
- :cr=^M:do=^J:nl=^J:bl=^G:\
- :le=^H:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#128:li#94:nd=\EC:\
- :ta=^I:pt:sr=\EI:up=\EA:ku=\EA:kd=\EB:kr=\EC:kl=\ED:kb=^H:\
- :ce=\EK:ho=\EH:
-#
-# N: ANN ARBOR
-#
-N0|aa|annarbor|4080|ann arbor 4080:\
- :cr=^M:do=^J:nl=^J:bl=^G:pt:ct=^\^P^P:st=^]^P1:\
- :cm=^O%r%\066%.%>^S^L%+@:\
- :co#80:li#40:le=^H:bs:cl=2^L:up=^N:nd=^_:ho=^K:am:\
- :kb=^^:kd=^J:ku=^N:kl=^H:kr=^_:kh=^K:ma=^_ ^N^P:
-# Needs function keys added.
-# Originally from Mike O'Brien@Rand and Howard Katseff at Bell Labs.
-# Highly modified 6/22 by Mike O'Brien.
-# split out into several for the various screen sizes by dave-yost@rand
-# Modifications made 3/82 by Mark Horton
-# Modified by Tom Quarles at UCB for greater efficiency and more diversity
-# status line moved to top of screen, vb removed 5/82
-#
-# assumes the following setup:
-# A: 0000 1010 0001 0000
-# B: 9600 0100 1000 0000 0000 1000 0000 17 19
-# C: 56 66 0 0 9600 0110 1100
-# D: 0110 1001 1 0
-#
-# Briefly, the settings are for the following modes:
-# (values are for bit set/clear with * indicating our preference
-# and the value used to test these termcaps)
-# Note that many of these settings are irrelevant to the termcap
-# and are just set to the default mode of the terminal as shipped
-# by the factory.
-#
-# A menu: 0000 1010 0001 0000
-# Block/underline cursor*
-# blinking/nonblinking cursor*
-# key click/no key click*
-# bell/no bell at column 72*
-#
-# key pad is cursor control*/key pad is numeric
-# return and line feed/return for <cr> key *
-# repeat after .5 sec*/no repeat
-# repeat at 25/15 chars per sec. *
-#
-# hold data until pause pressed/process data unless pause pressed*
-# slow scroll/no slow scroll*
-# Hold in area/don't hold in area*
-# functions keys have default*/function keys disabled on powerup
-#
-# show/don't show position of cursor during page transmit*
-# unused
-# unused
-# unused
-#
-# B menu: 9600 0100 1000 0000 0000 1000 0000 17 19
-# Baud rate (9600*)
-#
-# 2 bits of parity - 00=odd,01=even*,10=space,11=mark
-# 1 stop bit*/2 stop bits
-# parity error detection off*/on
-#
-# keyboard local/on line*
-# half/full duplex*
-# disable/do not disable keyboard after data transmission*
-#
-# transmit entire page/stop transmission at cursor*
-# transfer/do not transfer protected characters*
-# transmit all characters/transmit only selected characters*
-# transmit all selected areas/transmit only 1 selected area*
-#
-# transmit/do not transmit line separators to host*
-# transmit/do not transmit page tab stops tabs to host*
-# transmit/do not transmit column tab stop tabs to host*
-# transmit/do not transmit graphics control (underline,inverse..)*
-#
-# enable*/disable auto XON/XOFF control
-# require/do not require receipt of a DC1 from host after each LF*
-# pause key acts as a meta key/pause key is pause*
-# unused
-#
-# unused
-# unused
-# unused
-# unused
-#
-# XON character (17*)
-# XOFF character (19*)
-#
-# C menu: 56 66 0 0 9600 0110 1100
-# number of lines to print data on (printer) (56*)
-#
-# number of lines on a sheet of paper (printer) (66*)
-#
-# left margin (printer) (0*)
-#
-# number of pad chars on new line to printer (0*)
-#
-# printer baud rate (9600*)
-#
-# printer parity: 00=odd,01=even*,10=space,11=mark
-# printer stop bits: 2*/1
-# print/do not print guarded areas*
-#
-# new line is: 01=LF,10=CR,11=CRLF*
-# unused
-# unused
-#
-# D menu: 0110 1001 1 0
-# LF is newline/LF is down one line, same column*
-# wrap to preceding line if move left from col 1*/don't wrap
-# wrap to next line if move right from col 80*/don't wrap
-# backspace is/is not destructive*
-#
-# display*/ignore DEL character
-# display will not/will scroll*
-# page/column tab stops*
-# erase everything*/erase unprotected only
-#
-# editing extent: 0=display,1=line*,2=field,3=area
-#
-# unused
-#
-N1|aaa-29-np|aaa-29 with no padding (for psl):\
- :al=\E[L:ce=\E[K:cl=\E[H\E[J:\
- :dc=\E[P:dl=\E[M:ic=\E[@:
-tc=aaa-29:
-N2|aaa-unk|ann arbor ambassador (internal - don't use this directly):\
- :cr=^M:do=^J:nl=^J:bl=^G:al=1*\E[L:am:le=^H:bs:km:\
- :cd=7.2*\E[J:ce=5\E[K:cl=7.2*\E[H\E[J:cm=\E[%i%d;%dH:co#80:\
- :dc=4\E[P:dl=1*\E[M:ho=\E[H:ic=4\E[@:\
- :md=\E[1m:mr=\E[7m:mb=\E[5m:mk=\E[8m:me=\E[m:\
- :ku=\EM:kd=\ED:kl=\E[D:kr=\E[C:kh=\E[H:ce=\E[K:\
- :ks=\EP`?z~[H~[[J`>z~[[J`8xz~[M`4xz~[[D`6xz~[[C`2xz~[D\E\\:\
- :ke=\EP`?y~[H~[[J`>y~[[2J`8xy~[M`4xy~[[D`6xy~[[C`2xy~[D\E\\:\
- :ch=\E[%i%d`:\
- :ei=:im=:pt:bw:bt=\E[Z:\
- :mi:nd=\E[C:se=\E[m:so=\E[7m:ue=\E[m:us=\E[4m:up=\EM:\
- :AL=1*\E[%dL:DL=1*\E[%dM:IC=4\E[%d@:DC=4\E[%dP:\
- :cS=\E[%d;%d;%d;%dp:\
- :vs=\E[>52;54h\E[>30;37;38;39l:ve=\E[>52l\E[>37h:
-# All the ti strings used to start with \E[2J, which cleared the screen.
-# But this was so slow that it caused ^S/^Q lossage.
-# So I removed the \E[2J's. -- rms, 1/29/86
-N3|aaa-18|ann arbor ambassador/18 lines:\
- :ti=\E[18;0;0;18p:\
- :te=\E[60;0;0;18p\E[18;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;18p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#18:tc=aaa-unk:
-N4|aaa-20|ann arbor ambassador/20 lines:\
- :ti=\E[20;0;0;20p:\
- :te=\E[60;0;0;20p\E[20;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;20p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#20:tc=aaa-unk:
-N5|aaa-22|ann arbor ambassador/22 lines:\
- :ti=\E[22;0;0;22p:\
- :te=\E[60;0;0;22p\E[22;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;22p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#22:tc=aaa-unk:
-N6|aaa-24|ann arbor ambassador/24 lines:\
- :ti=\E[24;0;0;24p:\
- :te=\E[60;0;0;24p\E[24;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;24p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#24:tc=aaa-unk:
-N7|aaa-26|ann arbor ambassador/26 lines:\
- :ti=\E[26;0;0;26p:\
- :te=\E[60;0;0;26p\E[26;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;26p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#26:tc=aaa-unk:
-N8|aaa-28|ann arbor ambassador/28 lines:\
- :ti=\E[28;0;0;28p:\
- :te=\E[60;0;0;28p\E[28;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;28p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#28:tc=aaa-unk:
-N9|aaa|ambassador|aaa-30|ann arbor ambassador/30 lines:\
- :ti=\E[30;0;0;30p:\
- :te=\E[60;0;0;30p\E[30;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[30;0;0;30p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#30:tc=aaa-unk:
-NA|aaa-36|ann arbor ambassador/36 lines:\
- :ti=\E[36;0;0;36p:\
- :te=\E[60;0;0;36p\E[36;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;36p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#36:tc=aaa-unk:
-NB|aaa-40|ann arbor ambassador/40 lines:\
- :ti=\E[40;0;0;40p:\
- :te=\E[60;0;0;40p\E[40;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;40p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#40:tc=aaa-unk:
-NC|aaa-48|ann arbor ambassador/48 lines:\
- :ti=\E[48;0;0;48p:\
- :te=\E[60;0;0;48p\E[48;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;48p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#48:tc=aaa-unk:
-ND|aaa-60|ann arbor ambassador/60 lines:\
- :ti=\E[60;0;0;60p:\
- :te=\E[60;0;0;60p\E[60;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;0;0;60p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#60:tc=aaa-unk:
-NE|aaa-unk-s|ann arbor ambassador unknown with/status:\
- :hs:es:i2=\E7\E[>51h\E[H\E[2K\E[>51l\E8:\
- :ts=\E7\E[>51h\E[H\E[2K\E[%i%d`:fs=\E[>51l\E8:\
- :ds=\E7\E[>51h\E[H\E[2K\E[>51l\E8:\
- :tc=aaa-unk:
-NF|aaa-18-s|ann arbor ambassador/18 lines + status line:\
- :ti=\E[18;1;0;18p:\
- :te=\E[60;1;0;18p\E[17;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;18p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#17:tc=aaa-unk-s:
-NG|aaa-20-s|ann arbor ambassador/20 lines + status line:\
- :ti=\E[20;1;0;20p:\
- :te=\E[60;1;0;20p\E[19;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;20p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#19:tc=aaa-unk-s:
-NH|aaa-22-s|ann arbor ambassador/22 lines + status line:\
- :ti=\E[22;1;0;22p:\
- :te=\E[60;1;0;22p\E[21;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;22p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#21:tc=aaa-unk-s:
-NI|aaa-24-s|ann arbor ambassador/24 lines + status line:\
- :ti=\E[24;1;0;24p:\
- :te=\E[60;1;0;24p\E[23;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;24p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#23:tc=aaa-unk-s:
-NJ|aaa-26-s|ann arbor ambassador/26 lines + status line:\
- :ti=\E[26;1;0;26p:\
- :te=\E[60;1;0;26p\E[25;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;26p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#25:tc=aaa-unk-s:
-NK|aaa-28-s|ann arbor ambassador/28 lines + status line:\
- :ti=\E[28;1;0;28p:\
- :te=\E[60;1;0;28p\E[27;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;28p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#27:tc=aaa-unk-s:
-NL|aaa-30-s|ann arbor ambassador/30 lines + status line:\
- :ti=\E[30;1;0;30p:\
- :te=\E[60;1;0;30p\E[29;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;30p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#29:tc=aaa-unk-s:
-NM|aaa-36-s|ann arbor ambassador/36 lines + status line:\
- :ti=\E[36;1;0;36p:\
- :te=\E[60;1;0;36p\E[35;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;36p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#35:tc=aaa-unk-s:
-NN|aaa-40-s|ann arbor ambassador/40 lines + status line:\
- :ti=\E[40;1;0;40p:\
- :te=\E[60;1;0;40p\E[39;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;40p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#39:tc=aaa-unk-s:
-NO|aaa-48-s|ann arbor ambassador/48 lines+sl:\
- :ti=\E[48;1;0;48p:te=\E[60;1;0;48p\E[47;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\EP`?y~[[2J~[[H\E7\E[60;1;0;48p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#47:tc=aaa-unk-s:
-NP|aaa-60-s|ann arbor ambassador/60 lines + status line:\
- :ti=\E[60;1;0;60p:te=\E[60;1;0;60p\E[59;1H\E[J:\
- :is=\EP`+x~M\E\\\E[m\E7\E[60;1;0;60p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :li#59:tc=aaa-unk-s:
-NQ|aaa-18-rv|ambassador/18 lines+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;18p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-18:
-NR|aaa-20-rv|ambassador/20 lines+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;20p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-20:
-NS|aaa-22-rv|ambassador/22 lines+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;22p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-22:
-NT|aaa-24-rv|ambassador/24 lines+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;24p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-24:
-NU|aaa-26-rv|ambassador/26 lines+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;26p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-26:
-NV|aaa-28-rv|ambassador/28 lines+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;28p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-28:
-NW|aaa-30-rv|ann arbor ambassador/30 lines in reverse video:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;30p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-30:
-NX|aaa-36-rv|ann arbor ambassador/36 lines in reverse video:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;36p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-36:
-NY|aaa-40-rv|ann arbor ambassador/40 lines in reverse video:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;40p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-40:
-NZ|aaa-48-rv|ann arbor ambassador/48 lines in reverse video:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;48p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-48:
-Na|aaa-60-rv|ann arbor ambassador/60 lines in reverse video:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;0;0;60p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-60:
-Nb|aaa-18-rv-s|aaa-18-s-rv|ambassador/18 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;18p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-18-s:
-Nc|aaa-20-rv-s|aaa-20-s-rv|ambassador/20 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;20p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-20-s:
-Nd|aaa-22-rv-s|aaa-22-s-rv|ambassador/22 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;22p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-22-s:
-Ne|aaa-24-rv-s|aaa-24-s-rv|ambassador/24 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;24p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-24-s:
-Nf|aaa-26-rv-s|aaa-26-s-rv|ambassador/26 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;26p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-26-s:
-Ng|aaa-28-rv-s|aaa-28-s-rv|ambassador/28 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;28p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-28-s:
-Nh|aaa-30-rv-s|aaa-30-s-rv|ambassador/30 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;30p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-30-s:
-Ni|aaa-36-rv-s|aaa-36-s-rv|ambassador/36 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;36p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-36-s:
-Nj|aaa-40-rv-s|aaa-40-s-rv|ambassador/40 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;40p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-40-s:
-Nk|aaa-48-rv-s|aaa-48-s-rv|ambassador/48 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;48p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-48-s:
-Nl|aaa-60-rv-s|aaa-60-s-rv|ambassador/60 lines+sl+rv:\
- :md=\E[1;7m:mr=\E[m:mb=\E[5;7m:mk=\E[7;8m:me=\E[7m:\
- :us=\E[4;7m:ue=\E[7m:se=\E[7m:so=\E[m:\
- :is=\EP`+x~M\E\\\E[7m\E7\E[60;1;0;60p\E[3g\E[f\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E[8a\EH\E8\E[>6h\E[1Q:\
- :tc=aaa-60-s:
-Nm|aaa-24-ctxt:\
- :ti=\E[30;1H\E[K\E[24;0;0;24p:te=\E[60;1;0;24p\E[60;1H\E[K:tc=aaa-24:
-Nn|aaa-24-rv-ctxt:\
- :ti=\E[30;1H\E[K\E[24;0;0;24p:te=\E[60;1;0;24p\E[60;1H\E[K:tc=aaa-24-rv:
-No|aaa-30-s-ctxt:\
- :ti=\E[30;1H\E[K\E[30;1;0;30p:te=\E[60;1;0;30p\E[59;1H\E[K:tc=aaa-30-s:
-Np|aaa-30-s-rv-ctxt:\
- :ti=\E[30;1H\E[K\E[30;1;0;30p:\
- :te=\E[60;1;0;30p\E[59;1H\E[K:tc=aaa-30-s-rv:
-Nq|aaa-ctxt|aaa-30-ctxt:\
- :ti=\E[30;0;0;30p:te=\E[60;0;0;30p\E[60;1H\E[K:tc=aaa-30:
-Nr|aaa-rv-ctxt|aaa-30-rv-ctxt:\
- :ti=\E[30;0;0;30p:te=\E[60;0;0;30p\E[60;1H\E[K:tc=aaa-30-rv:
-Ns|aaa-db|ann arbor ambassador 30/destructive backspace:\
- :ti=\E[H\E[J\E[30;0;0;30p:te=\E7\E[60;0;0;30p\E8:li#30:\
- :is=\E[60;0;0;30p\E[H\E[J\E[1Q\E[m\E[20l\E[>30h:le=\E[D:bc=\E[D:bs@:\
- :tc=aaa-unk:
-#Kludge for supdup
-aaa-supdup|ann arbor ambassador 30/ for supdup :\
- :ns:tc=aaa-30:
-
-#
-# yet another attempt at the aaa terminal from CCA:
-#
-ZJ|aaax|ambasx|ambassadorx|ann arbor ambassador base descriptor/:\
- :al=\E[L:bs:bt=\E[Z:bw:\
- :cd=\E[J:ce=\E[K:ch=\E[%i%d`:cl=\E[H\E[2J:cm=\E[%i%d;%dH:co#80:\
- :cv=\E[%i%dd:da:db:dc=\E[P:dl=\E[M:ho=\E[H:ic=\E[@:\
- :mi:nd=\E[C:pt:sf=\E[S:sr=\E[T:se=\E[m:so=\E[7m:\
- :km:mm=\E[>52h:mo=\E[>52l:\
- :ue=\E[m:up=\E[A:us=\E[4m:
-ZK|aaa48|ambas|ambassador|ann arbor ambassador/48 lines:\
- :is=\E[48;0;0;48p\E[H\E[J\E[1Q\E[m\E[>30l\E[>26l\E[>32h\E[>33h\E[>52h:\
- :li#48:mi:tc=aaax:
-ZL|aaa24|ambas24|ambassador24|ann arbor ambassador/24 lines:\
- :is=\E[24;0;0;24p\E[H\E[J\E[1Q\E[m\E[>30l\E[>26l\E[>32h\E[>33h\E[>52h:\
- :li#24:mi:tc=aaax:
-ZM|aaa30|ambas30|ambassador30|ann arbor ambassador/30 lines:\
- :is=\E[30;0;0;30p\E[H\E[J\E[1Q\E[m\E[>30l\E[>26l\E[>32h\E[>33h\E[>52h:\
- :li#30:mi:tc=aaax:
-ZN|aaa60|ambas60|ambassador60|ann arbor ambassador/60 lines:\
- :is=\E[60;0;0;60p\E[H\E[J\E[1Q\E[m\E[>30l\E[>26l\E[>32h\E[>33h\E[>52h:\
- :li#60:mi:tc=aaax:
-# vt100 -- this has been changed to delete the "pt" ("real tabs")
-# option, which was losing. -- walter 10/84
-d0|vt100-132|vt125-132|dec vt100 with 132 columns:\
- :co#132:tc=vt100:
-d0|vt100|vt100-am|vt100-80|vt125|vt125-80|dec vt100:\
- :cr=^M:bl=^G:le=^H:do=\ED:ho=\E[H:\
- :co#80:li#24:cl=45\E[H\E[2J:bs:am:cm=5\E[%i%d;%dH:nd=\E[C:up=\E[A:\
- :ce=2\E[K:cd=2*\E[J:so=2\E[7m:se=2\E[m:us=2\E[4m:ue=2\E[m:\
- :md=2\E[1m:mr=2\E[7m:mb=2\E[5m:me=2\E[m:\
- :is=\E<\E[m\E>\E[?7h\E[?3;4;6l\200\200\200\200\200\200\200\200:\
- :rs=\E<\E[m\E>\E[?7h\E[?3;4;6l\200\200\200\200\200\200\200\200:\
- :ku=\EOA:kd=\EOB:kr=\EOC:kl=\EOD:kb=^H:\
- :cs=\E[%i%d;%dr:ks=\E[?1h\E=:ke=\E[?1l\E>:\
- :kh=\E[H:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:ta=^I:sf=5\ED:sr=5\EM:xn:\
- :dN#4:vt#3:sc=\E7:rc=\E8:
-d0|vt132-132|dec vt132 with 132 columns:\
- :al=99\E[L:dl=99\E[M:ip=7:dc=7\E[P:ei=\E[4l:im=\E[4h:xn:dN#30:\
- :co#132:tc=vt100:
-d0|vt132|vt132-80|dec vt132 with 80 columns:\
- :al=99\E[L:dl=99\E[M:ip=7:dc=7\E[P:ei=\E[4l:im=\E[4h:xn:dN#30:tc=vt100:
-
-dw|vt52|vt52-80|dec vt52:\
- :cr=^M:do=^J:nl=^J:bl=^G:\
- :le=^H:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:li#24:nd=\EC:\
- :ta=^I:pt:sr=\EI:up=\EA:ku=\EA:kd=\EB:kr=\EC:kl=\ED:kb=^H:
-
-# Sun workstation consoles
-Mu|sun|Sun Microsystems Workstation console:\
- :li#34:co#80:cl=^L:cm=\E[%i%d;%dH:nd=\E[C:up=\E[A:\
- :am:bs:km:mi:ms:pt:\
- :ce=\E[K:cd=\E[J:so=\E[7m:se=\E[m:rs=\E[s:\
- :kd=\E[B:kl=\E[D:ku=\E[A:kr=\E[C:kh=\E[H:\
- :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:\
- :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:
-# From john@ucbrenoir Tue Sep 24 13:14:44 1985
-Mu|sun-s|Sun Microsystems Workstation window with status line:\
- :hs:ts=\E]l:fs=\E\\:ds=\E]l\E\\:tc=sun
-Mu|sun-e-s|sun-s-e|Sun Microsystems Workstation with status hacked for emacs:\
- :hs:ts=\E]l:fs=\E\\:ds=\E]l\E\\:tc=sun-e:
-M0|sun-48|Sun 48-line window:\
- :li#48:co#80:tc=sun:
-M1|sun-34|Sun 34-line window:\
- :li#34:co#80:tc=sun:
-M2|sun-24|Sun 24-line window:\
- :li#24:co#80:tc=sun:
-M3|sun-17|Sun 17-line window:\
- :li#17:co#80:tc=sun:
-M4|sun-12|Sun 12-line window:\
- :li#12:co#80:tc=sun:
-M5|sun-1|Sun 1-line window for sysline:\
- :li#1:co#80:es:hs:ts=\r:fs=\E[K:ds=^L:tc=sun:
-M6|sun-e|sun-nic|sune|Sun Microsystems Workstation without insert character:\
- :ic@:im@:ei@:tc=sun:
-
-# Nu machine parameters taken from mit-vax.
-# smc - 5/21/85
-#
-dg|nuterminal:\
- :al=1*\EL:am:bs:cd=60\EJ:ce=10\EK:cl=60\EE:cm=10\EY%+ %+ :\
- co#80:dc=2.5*\EN:\
- :dl=1*\EM:do=\EB:ei=\EO:ho=\EH:im=\E@:ip=2.5*:li#24:mi:nd=\EC:\
- :as=\EF:ae=\EG:\
- :ms:pt:sr=\EI:se=\Eq:so=\Ep:up=\EA:vs=\Ex4:ve=\Ey4:\
- :kb=^h:ku=\EA:kd=\EB:kl=\ED:kr=\EC:kh=\EH:kn#8:\
- :k1=\ES:k2=\ET:k3=\EU:k4=\EV:k5=\EW:\
- :l6=blue:l7=red:l8=white:k6=\EP:k7=\EQ:k8=\ER:
-nu|nu24|nuwindow:\
- :al=1*\EL:bs:cd=\EJ:ce=\EK:cl=\EE:cm=\EY%+ %+ :co#86:\
- :dl=1*\EM:do=\EB:ei=\EO:ho=\EH:im=\E@:ip=2.5*:li#24:mi:nd=\EC:\
- :as=\EF:ae=\EG:\
- :ms:pt:sr=\EI:se=\Eq:so=\Ep:up=\EA:vs=\Ex4:ve=\Ey4:\
- :kb=^h:ku=\EA:kd=\EB:kl=\ED:kr=\EC:kh=\EH:
-bnu|nu51|bnuwindow:\
- :co#86:li#51:tc=nu:
-fnu|nu61|fnuwindow:\
- :co#86:li#61:tc=nu:
-nunix-30|nu-telnet-30|nu-half: Half nu screen thru telnet:\
- :am:al=\EL:bs:cd=\EJ:ce=\EK:cl=\EE:cm=\EY%+ %+ :co#78:\
- :dl=\EM:do=\EB:ip=2.5*:ho=\EH:li#30:nd=\EC:\
- :pt:sr=\EI:se=\Eq:so=\Ep:up=\EA:
-nunix-61|nu-telnet-61|nu-full| Full nu screen thru telnet:\
- :co#78:li#61:tc=nunix-30:
-
-## VT200 entry for VMS. Also for VT300.
-# Make sure not to use \n for nl or anything else.
-# It is bad form to use ^J,^L,^K to scroll the screen.
-# If the VT2xx doesn't have newline mode set those characters
-# donot move the cursor down a line. Use \ED instead.
-d0|vt200-80|vt200|vt300-80|VT 200 with 80 columns, on VMS:\
- :AL=\E[%dL:DC=\E[%dP:DL=\E[%dM:DO=\E[%dB:IC=\E[%d@:\
- :LE=\E[%dD:RI=\E[%dC:SR=1*\E[%dM:UP=\E[%dA:al=\E[L:\
- :am:bl=^G:bs:cd=2*\E[J:ce=2*\E[K:cl=45\E[H\E[2J:\
- :cm=%i\E[%d;%dH:co#80:cr=\r:cs=\E[%i%d;%dr:ct=\E[3g:\
- :dc=\E[P:dl=\E[M:dm=:do=\ED:ec=\E[%dX:ed=:ei=\E[4l:\
- :ho=\E[H:ic:im=\E[4h:it#8:k1=\EOP:k2=\EOQ:k3=\EOR:\
- :k4=\EOS:kd=\E[B:ke=\E[?1l\E>:kl=\E[D:kn#4:kr=\E[C:ks=\E[?1h\E=:\
- :ku=\E[A:le=^H:li#24:mb=\E[5m:md=\E[1m:me=\E[0m:mi:\
- :mr=\E[7m:ms:nd=\E[C:nl=\ED:nw=\EE:pf=\E[?4i:po=\E[?5i:\
- :ps=\E[i:rc=\E8:sc=\E7:se=\E[27m:sf=1*\ED:so=\E[7m:\
- :sr=1*\EM:st=\EH:ue=\E[24m:up=\EM:us=\E[4m:xn:
-d0|vt200-132|vt300-132|VT 200 with 132 columns, on VMS:\
- :co#132:tc=vt200-80:
-
-aP|apollo_15P|apollo 15 inch display:\
- :dN@:tc=vt132:
-aQ|apollo_19L|apollo 19 inch display:\
- :dN@:tc=vt132:
-aR|apollo_color|apollo color display:\
- :dN@:tc=vt132:
-aS|apollo_800_color|apollo 800 line color display:\
- :dN@:tc=vt132:
-d3|vt132|vt-132:\
- :al=99\E[L:dl=99\E[M:ip=7:dc=7\E[P:ei=\E[4l:im=\E[4h:xn:dN#30:tc=vt100:
-d0|vt100|vt100n|vt100 with no init:\
- :co#80:li#24:am:bs:pt:xn:cl=45\E[H\E[2J:\
- :cm=%i\E[%d;%dH:nd=\E[C:up=\EM:ho=\E[H:ce=2\E[K:cd=2*\E[J:\
- :nl=\EE:cr=\r:sr=5\EM:sf=30\E7\E[200H\ED\E8:\
- :sc=\E7:rc=\E8:cs=\E[%i%d;%dr:so=\E[7m:se=\E[m:us=\E[4m:ue=\E[m:LC:\
- :kl=\E[D:kr=\E[C:ku=\E[A:kd=\E[B:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:
-# *************************************************************************
-# Added for del to use a 132 char width terminal
-#
-d0|vt100l|vt100n|vt100 with no init:\
- :co#132:li#24:am:bs:pt:xn:cl=45\E[H\E[2J:\
- :cm=%i\E[%d;%dH:nd=\E[C:up=\EM:ho=\E[H:ce=2\E[K:cd=2*\E[J:\
- :nl=\EE:cr=\r:sr=5\EM:sf=30\E7\E[200H\ED\E8:\
- :sc=\E7:rc=\E8:cs=\E[%i%d;%dr:so=\E[7m:se=\E[m:us=\E[4m:ue=\E[m:LC:\
- :kl=\E[D:kr=\E[C:ku=\E[A:kd=\E[B:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:
-#
-# End of "Add for del"
-# **************************************************************************
-df|vt100|vt-100|vt100f|pt100|pt-100|dec vt100 (fast scroll, reverse video):\
- :is=\E>\E[?4l\E[?5h\E[?7h\E[?8h:\
- :if=/usr/lib/tabset/vt100:tc=vt100n:
-d1|vt100|vt100fnv|dec vt100 (fast scroll, normal video):\
- :is=\E>\E[?4l\E[?5l\E[?7h\E[?8h:\
- :if=/usr/lib/tabset/vt100:tc=vt100n:
-ds|vt100|vt100s|dec vt100 (smooth scroll, reverse video):\
- :is=\E>\E[?4h\E[?5h\E[?7h\E[?8h:\
- :if=/usr/lib/tabset/vt100:tc=vt100n:
-dn|vt100|vt100snv|dec vt100 (smooth scroll, normal video):\
- :is=\E>\E[?4h\E[?5l\E[?7h\E[?8h:\
- :if=/usr/lib/tabset/vt100:tc=vt100n:
-# This was designed for a VT320 emulator, but it is probably a good start
-# at support for the VT320 itself.
-# Please send changes with explanations to bug-gnu-emacs@prep.ai.mit.edu.
-k3|vt320|vt320-k3|kermit|MS-Kermit 3.00's vt320 emulation:\
- :AL=\E[%dL:CC=\E:DL=\E[%dM:IC=\E[%d@:DC=\E[%dP:DO=\E[%dB:LE=\E[%dD:\
- :RI=\E[%dC:SR=\E[%dL:UP=\E[%dA:ae=\E(B:al=\E[L:am:as=\E(0:bl=^G:\
- :cd=\E[J:ce=\E[K:ch=\E[%i%dG:cl=\E[H\E[J:cm=\E[%i%d;%dH:co#80:cr=^M:\
- :cs=\E[%i%d;%dr:ct=\E[3g:cv=\E[%i%dd:dc=\E[P:do=^J:dl=\E[M:ds=\E[0$~:\
- :ec=\E[%dX:ei=\E[4l:es:fs=\E[0$}:ho=\E[H:hs:im=\E[4h:\
- :is=\E>\E F\E[?1l\E[?7h\E[r\E[2$~:k1=\EOP:k2=\EOQ:\
- :k3=\EOR:k4=\EOS:k6=\E[17~:k7=\E[18~:k8=\E[19~:k9=\E[20~:k0=\E[21~:\
- :kI=\E[2~:kL=\E[3~:kN=\E[6~:kP=\E[5~:kb=^H:kd=\EOB:ke=\E[?1l\E>:\
- :kl=\EOD:km:kn#20:kr=\EOC:ks=\E[?1h\E=:ku=\EOA:\
- :le=^H:li#49:mb=\E[5m:md=\E[1m:me=\E[m:mi:mr=\E[7m:ms:nd=\E[C:\
- :nl=^J:pb#9600:po=\E[5i:pf=\E[4i:ps=\E[0i:pt:rc=\E8:\
- :rs=\E(B\E)B\E>\E F\E[4;20l\E[12h\E[?1;5;6;38;42l\E[?7;25h\E4i\E?4i\E[m\E[r\E[2$~:\
- :sc=\E7:se=\E[27m:sf=^J:so=\E[7m:sr=\EM:st=\EH:ta=^I:\
- :ts=\E[1$}^M\E[K:ue=\E[24m:\
- :up=\E[A:us=\E[4m:vb=\E[?5h\E[?5l\E[?5h\E[?5l\E[?5h\E[?5l:ve=\E[?25h:\
- :vi=\E[?25l:vt#3:xn:
-sw|switch|intelligent switch:co#80:os:am:
-su|dumb|un|unknown:co#80:os:am:
-sp|plugboard:co#80:os:am:
-sa|arpanet|network:co#80:os:am:
-sd|du|dialup:co#80:os:am:
-sb|bussiplexer:co#80:os:am:
-# Note that all of these claim to be "c100" in order to please the
-# pen and emacs editors. If the user does a "tset c100" he will get co.
-co|c100|concept|concept100|concept 100:\
- :is=\EU\Ef\E7\E5\E8\El\ENH\EK\E\200\Eo&\200\Eo\47\E:\
- :al=3*\E^R:am:bs:cd=16*\E^C:ce=16\E^S:cl=2*^L:cm=\Ea%+ %+ :co#80:\
- :dc=16\E^A:dl=3*\E^B:ei=\E\200:eo:im=\E^P:in:ip=16*:li#24:mi:nd=\E=:\
- :pt:kb=^h:so=\ENh:se=\ENH:ta=8\t:ul:up=\E;:db:xn:vs=\EW:ve=\Ew:\
- :vb=\Ek\200\200\200\200\200\200\200\200\200\200\200\200\200\200\EK:\
- :us=\EG:ue=\Eg:ks=\EX\ES:ke=\Ex\Es:ku=\E;:kd=\E<:kl=\E>:kr=\E=:kh=\E?:\
- :k1=\E5:k2=\E6:k3=\E7:.dN#9:dC#9:
-c4|c100|c1004p|c100 w/4 pages:\
- :ti=\EU\Ev 8p\Ep\r:te=\Ev ~p\Ep\r\n:vs@:ve@:tc=concept:
-cP|c100|c100rv4ppp|c100 with printer port:\
- :is=\EU\Ef\E7\E5\E8\El\ENH\Ek\E\200\Eo&\200\Eo!\200\EQ"\EY(^W\Eo\47\E:\
- :tc=c100rv4p:
-cR|c100|c100rv4p|c100 w/4 pages:\
- :ti=\EU\Ev 8p\Ep\r:te=\Ev ~p\Ep\r\n:tc=c100rv:
-# Some tty drivers use cr3 for concept, others use nl3, hence dN/dC below.
-cd|c100|c100rvs|slow reverse concept 100:\
- :vb=\EK\200\Ek:pt:dC@:dN@:tc=c100rv:
-cn|c100|c100rv4pna|c100 with no arrows:ks@:ke@:tc=c100rv4p:
-cr|c100|c100rv|c100 rev video:\
- :is=\EU\Ef\E7\E5\E8\El\ENH\Ek\E\200\Eo&\200\Eo\47\E:vs@:ve@:\
- :vb=\EK\200\200\200\200\200\200\200\200\200\200\200\200\200\200\Ek:\
- :tc=concept:
-cs|c100|c100s|slowconcept|slowconcept100|slow concept 100:\
- :vb=\Ek\200\EK:pt:dC@:dN@:tc=concept:
-# vt100 and vt132 are still untested
-# Note that all of these claim to be "vt100", so the first one wins.
-dG|gigi|GIGI|dec gigi (naively treated as a straight vt100):\
- :tc=vt100n:
-dR|vt125|dec vt125 (naively treated as a straight vt100; R for ReGIS):\
- :tc=vt100n:
-kA|h19A|heathA|h19A|heathkitA|heathkit h19 ansi mode:\
- :al=1*\E[1L:am:bs:cd=\E[J:ce=\E[K:cl=\E[2J:cm=\E[%i%2;%2H:co#80:\
- :dc=\E[1P:dl=1*\E[1M:dn=\E[1B:ei=\E[4l:ho=\E[H:im=\E[4h:li#24:mi:\
- :nd=\E[1C:as=\E[10m:ae=\E[11m:ms:pt:se=\E[0m:so=\E[7m:up=\E[1A:\
- :vs=\E[>4h:ve=\E[>4l:kb=^h:ku=\E[1A:kd=\E[1B:kl=\E[1D:kr=\E[1C:\
- :kh=\E[H:kn#8:k1=\EOS:k2=\EOT:k3=\EOU:k4=\EOV:k5=\EOW:l6=blue:\
- :l7=red:l8=white:k6=\EOP:k7=\EOQ:k8=\EOR:\
- :sr=\EM:is=\E<\E[>1;2;3;4;5;6;7;8;9l\E[0m\E[11m\E[?7h:
-kB|h19bs|heathkit w/keypad shifted:ks=\Et:ke=\Eu:tc=h19b:
-kU|h19us|heathkit w/keypad shifted/underscore cursor:ks=\Et:ke=\Eu:tc=h19u:
-kb|h19|heath|h19b|heathkit|heath-19|z19|zenith|heathkit h19:\
- :al=1*\EL:am:bs:cd=\EJ:ce=\EK:cl=\EE:cm=\EY%+ %+ :co#80:dc=\EN:\
- :dl=1*\EM:do=\EB:ei=\EO:ho=\EH:im=\E@:li#24:mi:nd=\EC:as=\EF:ae=\EG:\
- :ms:pt:sr=\EI:se=\Eq:so=\Ep:up=\EA:vs=\Ex4:ve=\Ey4:\
- :kb=^h:ku=\EA:kd=\EB:kl=\ED:kr=\EC:kh=\EH:kn#8:\
- :k1=\ES:k2=\ET:k3=\EU:k4=\EV:k5=\EW:\
- :l6=blue:l7=red:l8=white:k6=\EP:k7=\EQ:k8=\ER:
-ke|e19|winston edmond special:vb=\Eg\Eh:tc=h19:
-ku|h19u|heathkit with underscore cursor:vs@:ve@:tc=h19b:
-Ma|aa|annarbor|ann arbor:\
- :cm=^O%r%B%.%>^S^L%+@:co#80:li#40:bs:cl=2^L:up=^N:nd=^_:ho=^K:am:\
- :kb=^^:kd=^J:ku=^N:kl=^H:kr=^_:kh=^K:ma=^_ ^N^P:
-# The A manufacturer represents Diablo, DTC, Xerox, Qume, and other Daisy
-# wheel terminals until such time as termcap distinguishes between them
-# enough to justify separate codes.
-# 1620 uses all 132 columns, 1640 sets left margin to 8 and uses snazzy
-# binary tabset file. Both should work on both terminals.
-A6|1620|450|diablo 1620:\
- :if=/usr/lib/tabset/std:\
- :kb=^H:bs:co#132:ff=^L:hc:hu=\EU:hd=\ED:os:pt:up=\E\n:
-A7|1640|diablo 1640:\
- :co#124:if=/usr/lib/tabset/diablo:tc=1620:
-Ad|dtc300s|300|300s|gsi|dtc|dtc 300s:\
- :if=/usr/lib/tabset/std:\
- :kb=^h:bs:co#132:ff=^L:hc:hu=\EH:hd=\Eh:os:pt:up=^Z:
-Ag|gsi:bs:co#132:hc:hd=\Eh:hu=\EH:os:pt:up=^Z:
-Aj|aj830|aj832|aj|anderson jacobson:\
- :bs:hc:hd=\E9:hu=\E8:os:pl:up=\E7:
-Aq|qume5|qume|Qume Sprint 5:\
- :if=/usr/lib/tabset/std:\
- :kb=^h:bs:co#80:ff=^L:hc:hu=\EH:hd=\Eh:os:pt:up=^Z:
-Ax|x1720|xerox 1720:co#132:bs:ff=^L:hc:os:pt:if=/usr/lib/tabset/xerox1720
-Ca|cdc456|cdc:\
- :li#24:co#80:cl=^Y^X:nd=^L:up=^Z:bs:\
- :cm=\E1%+ %+ :ho=^Y:al=\E\114:dl=\E\112:ce=^V:cd=^X:am:
-Cc|cdc456tst:\
- :li#24:co#80:cl=^y^x:bs:cm=\E1%+ %+ :am:
-D0|dm1520|1520|datamedia 1520:\
- :am:bs:cd=^K:ce=^]:cl=^L:cm=^^%r%+ %.:co#80:ho=^Y:\
- :ku=^_:kd=^J:kl=^H:kr=^\:kh=^Y:\
- :li#24:nd=^\:up=^_:xn:ma=^\ ^_^P^YH:pt:
-D1|dm1521|1521|datamedia 1521:\
- :am:bs:cd=^K:ce=^]:cl=^L:cm=^^%r%+ %.:co#80:ho=^Y:\
- :ku=^_:kd=^J:kl=^H:kr=^\:kh=^Y:\
- :li#24:nd=^\:up=^_:xn:ma=^\ ^_^P^YH:pt:
-D2|dm2500|datamedia2500|2500|datamedia 2500:\
- :al=15^P\n^X^]^X^]:bs:ce=^W:cl=^^^^\177:cm=^L%r%n%.%.:co#80:\
- :dc=10*\b:dl=10*^P^Z^X^]:dm=^P:ed=^X^]:ei=10\377\377^X^]:ho=^B:ic10*^\:\
- :im=^P:li#24:nc:nd=^\:pc=\377:so=^N:se=^X^]:up=^Z:
-D3|dm3025|datamedia 3025a:is=\EQ\EU\EV:\
- :al=130\EP\n\EQ:bs:cd=2\EJ:ce=\EK:cl=2\EM:cm=\EY%r%+ %+ :\
- :co#80:dc=6\b:dl=130\EP\EA\EQ:dm=\EP:ed=\EQ:ei=\EQ:ho=\EH:\
- :im=\EP:ip=6:li#24:nd=\EC:pt:so=\EOA:se=\EO@:up=\EA:
-D4|3045|dm3045|datamedia 3045a:is=\EU\EV:\
- :am:bs:cd=2\EJ:ce=\EK:cl=2\EM:cm=\EY%r%+ %+ :co#80:\
- :dc=6\EB:dm=:ed=:ei=\EP:ho=\EH:ic=:im=\EP:ip=6:\
- :k0=\Ey\r:k1=\Ep\r:k2=\Eq\r:k3=\Er\r:k4=\Es\r:\
- :k5=\Et\r:k6=\Eu\r:k7=\Ev\r:k8=\Ew\r:k9=\Ex\r:\
- :kh=\EH:ku=\EA:kr=\EC:li#24:nd=\EC:pc=\177:pt:eo:ul:up=\EA:xn:
-D5|dt80|dmdt80|dm80|datamedia dt80/1:\
- :is=\E<\E[2J\E[H\E[?1;3;5;6;9l\E[?7;8h:\
- :am:bs:cd=\E[J:co#80:li#24:ce=\E[K:cl=\E[2J\E[H:\
- :cm=%i\E[%d;%dH:ho=\E[H:nd=\E[C:\
- :so=\E[7m:se=\E[m:\
- :up=\E[A:us=\E[4m:ue=\E[m:\
- :vb=\E[?5h\E[?5l:\
- :vs=\E[1;2;3;4q\E[?4l:ve=\E[0q\E?4h:\
- :kd=\E[B:kl=\E[D:kr=\E[C:ku=\E[A:\
- :sr=\EM:\
- :k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:
-D6|dt80132|dmdt80132|datamedia dt80/1 in 132 char mode:\
- :bs:cd=20^[[0J:co#132:ce=20^[[0K:kd=^[[B:kl=^[[D:kr=^[[C:ku=^[[A:\
- :li#24:cm=5^[[%i%d;%dH:cl=50^[[H^[[2J:nd=^[[C:up=5^[[A:
-ED|delta|dd5000|delta data 5000:\
- :am:bs:cl=^NR:cm=^O%D%+9%D%+9:co#80:li#27:ho=^NQ:nc:nd=^Y:\
- :up=^Z:ce=^NU:dc=^NV:ma=^K^J^Z^P^Y :xr:
-# Note: the h1552 appears to be the first Hazeltine terminal which
-# is not braindamaged. It has tildes and backprimes and everything!
-# Be sure the auto lf/cr switch is set to cr.
-H2|h1552|hazeltine 1552:\
- :al=\EE:dl=\EO:f1=\EP:l1=blue:f2=\EQ:l2=red:f3=\ER:l3=green:tc=vt52:
-H3|h1552rv|hazeltine 1552 reverse video:\
- :so=\ES:se=\ET:tc=h1552:
-H5|h1500|hazeltine 1500:\
- :al=40~^Z:am:bs:cd=10~^X:ce=~^O:cl=~^\:cm=~^Q%r%.%.:co#80:\
- :dl=40~^S:do=~^K:hz:li#24:nd=^P:.se=~^_:.so=~^Y:up=~^L:
-H6|h1510|hazeltine 1510:\
- :al=\E^Z:am:bs:cd=\E^X:ce=\E^O:cl=\E^\:cm=\E^Q%r%.%.:co#80:\
- :dl=\E^S:do=\E^K:hz:li#24:nd=^P:.se=\E^_:.so=\E^Y:up=\E^L:
-H8|h1520|hazeltine 1520:\
- :al=~^Z:am:bs:cd=~^X:ce=~^O:cl=~\034:cm=~^Q%r%.%.\200:co#80:\
- :dl=~^S:do=~^K:hz:li#24:nd=^P:se=~^Y:so=~\037:up=~^L:ho=~^R:
-# Note: h2000 won't work because of a clash between upper case and ~'s.
-H7|h2000|hazeltine 2000:\
- :al=6~^z:am:bs:cl=6~^\:cm=~^q%r%.%.:co#74:\
- :dl=6~^s:ho=~^r:li#27:nc:pc=\177:
-# One of these should go in the misc category, IBM and ISC can't
-# both have I. I will wait to see who comes out with more terminals.
-I8|8001|ISC8001:al=\EU:am:bc=^Z:cl=3*^L:cm=^C%r%.%.:co#80:\
- :cd=\EQ:dm=\EQ:ed=\EF:\
- :dc=\177:dl=\EV:ei=\EF:im=\EQ:li#40:nd=1^Y:ta=8\t:\
- :up=^\:ho=1^H:pc=^@:
-It|intext|ISC modified owl 1200:\
- :al=5.5*\020:am:bc=\037:bs:cd=5.5*\026J:cl=132\014:\
- :cm=\017%+ %+ :co#80:dc=5.5*\022:dl=5.5*\021:\
- :ei=\026\074:im=\026\073:ip=5.5*:in:li#24:nd=\036:up=\034:\
- :ma=^K^P^R^L^L :kl=^H:kd=^J:kr=^L:ku=^K:
-I9|ibm|ibm3101|3101|i3101|IBM 3101-10:\
- :if=/usr/lib/tabset/3101:\
- :am:bs:cl=^[K:li#24:co#80:nd=^[C:up=^[A:cd=^[J:ce=^[I:\
- :kd=\EB:kl=\ED:kr=\EC:ku=\EA:ho=^[H:cm=\EY%+\40%+\40:
-L3|digilog|333|digilog 333:bs:co#80:ce=\030:ho=^n:li#16:nd=^i:up=^o:
-MA|ampex|d80|dialogue|dialogue80|ampex dialogue 80:\
- :am:bs:pt:if=/usr/lib/tabset/stdcrt:cl=\E*:cm=\E=%+ %+ :\
- :al=\EE:bt=\EI:ic=\EQ:im=:ei=:dl=\ER:dc=\EW:\
- :ce=\Et:cd=\Ey:so=\Ej:se=\Ek:li#24:co#80:nd=^L:up=^K:
-MB|aaadb|ann arbor ambassador 48/destructive backspace:\
- :is=\E[48;0;0;48p\E[H\E[J\E[>30h\E[1Q\E[m:bs@:\
- :vs=\E[>30l:ve=\E[>30h:tc=aaa:
-MC|compucolor|compucolorII:\
- :pt:am:cm=%r^C%.%.:bc=^Z:li#32:co#64:\
- :cl=^L:ho=^H:nd=^Y:up=^\:
-MD|d132|datagraphix|datagraphix 132a:\
- :co#80:li#30:cl=^l:ho=\Et:da:db:sf=\Ev:sr=\Ew:\
- :up=\Ek:nd=\El:vs=\ex:ve=\Em\En:\
- :al=\E3:ic=\E5:dc=\E6:in:ic=\E5:
-MS|soroc|Soroc 120:\
- :cd=\EY:ce=\ET:cl=2\E*:ma=^K^P^R^L^L :\
- :kl=^H:ku=^K:kr=^L:kd=^J:tc=adm3a:
-# Needs function keys added. Also can't use 60 line mode because it needs
-# too much nl delay - can fix for nl but not out of vi.
-# The cl delay is sufficient, but a smaller one could do.
-# This entry is merged from Mike O'Brien@Rand and Howard Katseff at
-# Bell Labs, and is untested.
-Mb|aaa|ambas|ambassador|ann arbor ambassador/48 lines:\
- :al=\E[L:am:bs:\
- :cd=\E[0J:ce=\E[0K:cl=400\E[;H\E[0J:cm=\E[%i%d;%dH:co#80:\
- :da:db:dc=\E[4h\E[1Q\E[P\E[4l\E[0Q:dc=\E[P:dl=\E[M:dm=\E[1Q:\
- :ed=\E[0Q:ei=\E[0Q:ho=\E[;H:ic=\E[@:if=/usr/lib/tabset/aa:im=\E[1Q:\
- :is=\E[48;0;0;48p\E[H\E[J\E[1Q\E[m:li#48:mi:\
- :nd=\E[C:nl=\ED:pt:sf=\E[S:sr=\E[T:se=\E[m:so=\E[7m:up=\E[A:
-Md|datapoint|dp3|dp3360|datapoint 3360:\
- :am:bs:cd^_:ce=^^:cl=^]^_:co#82:ho=^]:li#25:nd=^x:up=^z:
-Mg|dg|dg6053|data general 6053:\
- ca:am:bs:cm=^P%r%.%.:cl=^L:ho=^H:nd=^S\
- up=^W:ce=^K:co#80:li#24:
-Mi|cdi|cdi1203:am:bs:hc:os:co#80:cD#200:
-Mk|teletec|tec|Teletec Datascreen:\
- :am:bs:co#80:cl=^l:ho=^^:li#24:nd=^_:up=^k:
-# ^S is an arrow key! Boy is this guy in for a surprise on v7!
-Ml|sol:\
- :am:bs:cm=\E^1%.\E^2%.:cl=^K:ho=^N:co#64:li#16:nd=^S:up=^W:\
- :kl=^A:kr=^S:ku=^W:kd=^Z:ma=^A^H^S ^W^P^Z^N:
-Mo|omron|Omron 8025AG:\
- :al=\EL:am:bs:cd=\ER:co#80:ce=\EK:cl=\EJ:da:db:dc=\EP:dl=\EM:\
- :ho=\EH:li#24:nd=\EC:se=\E4:sf=\ES:so=\Ef:sr=\ET:up=\EA:ve=:vs=\EN:
-Mp|plasma|plasma panel:am:bs:cl=^L:co#85:ho=^^:li#45:nd=\030:up=\026:
-Ms|swtp|ct82|southwest technical products ct82:\
- :am:bs:bc=^d:al=^\^y:cd=^v:ce=^F:cl=^L:cm=%r^k%.%.:co#82:li#20:\
- :dl=^z:nd=^s:up=^a:so=^^^v:se=^^^F:dc=^\^h:ic=^\^x:ho=^p:\
- :ei=:sf=^n:sr=^o:ll=^c:im=:\
- :is=^\^r^^^s^^^d^]^w^i^s^^^]^^^o^]^w^r^i:
-Mt|terak|Terak emulating Datamedia 1520:tc=dm1520:
-My|mdl110|cybernex mdl-110:cm=^P%+ %+ :co#80:li#24:am:cl=70^X:bs:\
- :nd=^U:up=^Z:ho=^Y:ce=145^N@^V:cd=145^NA^W:al=65^NA^N^]:\
- :dl=40^NA^N^^:im=:\
- :ei=:ic=3.5^NA^]:dm:ed:dc=3.5^NA^^:so=^NF:se=^NG:ta=43\t:\
- :ma=^Z^P:cd=6^N@^V
-Mz|zen30|z30|zentec 30:\
- :mi:co#80:li#24:ma=^L ^R^L^K^P:ul:\
- :al=1.5*\EE:bs:ce=1.0*\ET:cm=\E=%+ %+ :cl=\E*:\
- :ho=^^:nd=^L:se=\EG0;so=\EG6:up=^K:im=\Eq:ei=\Er:\
- :am:dc=\EW:dl=1.5*\ER:cd=\EY:
-T3|33|tty33|tty|model 33 teletype:\
- :co#72:hc:os:
-T4|43|tty43|model 43 teletype:\
- :kb=^h:am:bs:hc:os:co#132:
-T7|37|tty37|model 37 teletype:\
- :bs:hc:hu=\E8:hd=\E9:up=\E7:os:
-# The Visual 200 beeps when you type a character in insert mode.
-# This is a horribly obnoxious misfeature, and some of the entries
-# below try to get around the problem by ignoring the feature or
-# turning it off when inputting a character. They are said not to
-# work well at 300 baud. (You could always cut the wire to the bell!)
-V2|vi200|v200|visual 200 with function keys:\
- :al=\EL:am:bs:cd=\Ey:ce=4*\Ex:cl=\Ev:\
- :cm=\EY%+ %+ :co#80:dc=4*\EO:dl=4*\EM:ho=\EH:\
- :im=:ei=:ic=\Ei \b\Ej:\
- :is=\E3\Eb\Ej\E\\\El\EG\Ed\Ek:\
- :k0=\EP:k1=\EQ:k2=\ER:k3=\E :k4=\E!:k5=\E":k6=\E#:\
- :k7=\E$:k8=\E%:k9=\E&:kl=\ED:kr=\EC:ku=\EA:kd=\EB:kh=\EH:\
- :li#24:nd=\EC:pt:sr=\EI:up=\EA:vs=\Ed:ve=\Ec:
-VR|vi200rvic|visual 200 reverse video using insert char:\
- :ei=\Ej:im=\Ei:ic@:tc=vi200rv:
-# The older Visuals didn't come with function keys. This entry uses
-# ks and ke so that the keypad keys can be used as function keys.
-# If your version of vi doesn't support function keys you may want
-# to use V2.
-Vf|vi200f|visual|visual 200 no function keys:\
- :al=\EL:am:bs:cd=\Ey:ce=4*\Ex:cl=\Ev:\
- :cm=\EY%+ %+ :co#80:dc=4*\EO:dl=4*\EM:ho=\EH:\
- :im=:ei=:ic=\Ei \b\Ej:\
- :is=\E3\Eb\Ej\E\\\El\EG\Ed\Ek:ks=\E=:ke=\E>:\
- :k0=\E?p:k1=\E?q:k2=\E?r:k3=\E?s:k4=\E?t:k5=\E?u:k6=\E?v:\
- :k7=\E?w:k8=\E?x:k9=\E?y:kl=\ED:kr=\EC:ku=\EA:kd=\EB:kh=\EH:\
- :li#24:nd=\EC:pt:sr=\EI:up=\EA:vs=\Ed:ve=\Ec:
-Vr|vi200rv|visual 200 reverse video:\
- :so=\E4:se=\E3:sr@:vs@:ve@:tc=vi200:
-Vt|vi200ic|visual 200 using insert char:\
- :ei=\Ej:im=\Ei:ic@:tc=vi200:
-Xa|tek4012|4012|tektronix 4012:\
- :is=\E^O:bs:cl=1000\E^L:co#75:ns:li#35:os:
-Xb|tek4013|4013|tektronix 4013:\
- :as=\E^N:ae=\E^O:tc=4012:
-Xc|tek4014|4014|tektronix 4014:\
- :is=\E^O\E9:co#81:li#38:dF#1000:tc=tek4012:
-Xd|tek4015|4015|tektronix 4015:\
- :as=\E^N:ae=\E^O:tc=4014:
-Xe|tek4014sm|4014sm|tektronix 4014 in small font:\
- :is=\E^O\E\072:co#121:li#58:tc=tek4014:
-Xf|tek4015sm|4015sm|tektronix 4015 in small font:\
- :as=\E^N:ae=\E^O:tc=4014sm:
-# I think the 1000UP is supposed to be so expensive it never happens.
-X4|tek4023|4023|tektronix 4023:\
- :so=^_P:se=^_@:cm=\034%r%+ %+ :nd=\t:bs:cl=4\E^L:co#80:li#24:am:\
- :up=1000UP:
-# Can't use cursor motion because it's memory relative, and because
-# it only works in the workspace, not the monitor. Same for home.
-# Likewise, standout only works in the workspace.
-X5|tek|4025|4027|4024|tek4025|tek4027|tek4024|4025cu|4027cu|tektronix 4024/4025/4027:\
- :is=\41com 31\r\n^_sto 9,17,25,33,41,49,57,65,73\r:\
- :ks=^_lea p4 /h/\r^_lea p8 /k/\r^_lea p6 / /\r^_lea p2 /j/\r^_lea f5 /H/\r:\
- :ke=^_lea p2\r^_lea p4\r^_lea p6\r^_lea p8\r^_lea f5\r:\
- :am:bs:da:db:pt:li#34:co#80:cl=^_era\r\n\n:up=^K:nd=^_rig\r:\
- :al=145^_up\r^_ili\r:dl=^_dli\r:\
- :dc=^_dch\r:im=^_ich\r:ei=^F\n^K:nl=^F\n:\
- :ce=^_dch 80\r:cd=^_dli 50\r:CC=^_:
-X7|4025-17|4027-17|tek 4025 17 line window:li#17:tc=4025:
-X8|4025-17ws|4027-17ws|tek 4025 17 line window in workspace:\
- :is=\41com 31\r\n^_sto 9,17,25,33,41,49,57,65,73\r^_wor 17\r^_mon 17\r:\
- :ti=^_wor h\r:te=^_mon h\r:so=^_att e\r:se=^_att s\r:tc=4025-17:
-Xe|4025ex|4027ex|tek 4025 w/!:ti=\41com 31\r:te=^_com 33\r:\
- :is=^_com 33\r\n\41sto 9,17,25,33,41,49,57,65,73\r:tc=4025:
-# Regent: lowest common denominator, works on all regents.
-a0|regent|adds regent series:\
- :am:bs:cl=^L:cm=^K%+ ^P%B%.:co#80:ho=^A:li#24:ll=^A^Z:nd=^F:up=^Z:
-# Regent 100 has a bug where if computer sends escape when user is holding
-# down shift key it gets confused, so we avoid escape.
-a1|regent100|adds regent 100:\
- :cm=^K%+ ^P%B%.:k1=^B1\r:k2=^B2\r:k3=^B3\r:k4=^B4\r:\
- :k5=^B5\r:k6=^B6\r:k7=^B7\r:k8=^B8\r:\
- :kh=^A:kl=^U:kr=^F:ku=^Z:kd=^J:tc=regent:
-# Regent 20, untested
-a2|regent20|adds regent 20:\
- :cd=\Ek:ce=\EK:cm=\EY%+ %+ :tc=regent:
-a3|regent25|adds regent 25:\
- :k0=^B0\r:k1=^B1\r:k2=^B2\r:k3=^B3\r:k4=^B4\r:\
- :k5=^B5\r:k6=^B6\r:k7=^B7\r:k8=^B8\r:k9=^B9\r:\
- :kh=^A:kl=^U:kr=^F:ku=^Z:kd=^J:tc=regent20:
-# Regent 40: untested
-a4|regent40|adds regent 40:\
- :al=\EM:dl=\El:is=\EB:se=\E0@:so=\EOP:ue=\EO@:us=\E0`:vb=\ED\Ed:\
- :tc=regent25:
-# If you have standout problem with regent 200, try so=\ER\EOP:se=\E0@\EV:
-a6|regent60|regent200|adds Regent 60:\
- :dc=\EE:ei=\EF:im=\EF:is=\EV\EB:ko=dc,im,ei:tc=regent40:
-a7|regent60na|regent 60 w/no arrow keys:\
- kl@:kr@:ku@:kd@:tc=regent60:
-# Note: if return acts weird on a980, check internal switch #2
-# on the top chip on the CONTROL pc board.
-ac|a980|adds consul 980:\
- :al=13\E^N:am:bs:cl=^L\200^K@:cm=^K%+@\E^E%2:co#80:dl=13\E^O:\
- :k0=\E0:k1=\E1:k2=\E2:k3=\E3:k4=\E4:k5=\E5:k6=\E6:k7=\E7:k8=\E8:k9=\E9:\
- :li#24:nd=\E^E01:so=^Y^^^N:se=^O:up=9:
-b2|sb2|sb3|fixed superbee:xb@:tc=superbee:
-bh|bh3m|beehiveIIIm:if=/usr/lib/tabset/beehive:\
- :al=160^S:am:bs:cd=^R:ce=^P:cl=^E^R:co#80:dl=300^Q:ho=^E:li#20:ll=^E^K:\
- :nd=^L:pt:se= ^_:so=^] :up=^K:
-# This loses on lines > 80 chars long, use at your own risk
-bi|superbeeic|super bee with insert char:\
- :ic=:im=\EQ:ei=\ER:tc=superbee:
-bm|microb|microbee|micro bee series:\
- :am:bs:cd=\EJ:ce=\EK:cl=\EE:co#80:cm=\EF%+ %+ :\
- :k1=\Ep:k2=\Eq:k3=\Er:k4=\Es:k5=\Et:k6=\Eu:k7=\Ev:k8=\Ew:k9=\Ex:\
- :kd=\EB:kh=\EH:kl=\ED:kr=\EC:ku=\EA:\
- :li#24:nd=\EC:pt:se=\Ed@ :so= \EdP:ue=\Ed@:up=\EA:us=\Ed`:
-# Superbee - f1=escape, f2=^C.
-# Note: there are at least 3 kinds of superbees in the world. The sb1
-# holds onto escapes and botches ^C's. The sb2 is the best of the 3.
-# The sb3 puts garbage on the bottom of the screen when you scroll with
-# the switch in the back set to CRLF instead of AEP. This description
-# is tested on the sb2 but should work on all with either switch setting.
-# The f1/f2 business is for the sb1 and the :xb: can be taken out for
-# the other two if you want to try to hit that tiny escape key.
-# This description is tricky: being able to use cm depends on there being
-# 2048 bytes of memory and the hairy nl string.
-bs|sb1|superbee|superb|beehive super bee:if=/usr/lib/tabset/stdcrt:is=\EE:\
- :am:bs:cd=3\EJ:ce=3\EK:cl=3\EH\EJ:co#80:cm=\EF%r%3%3:cr=1000\r:\
- :dC#10:da:db:xb:dc=3\EP:dl=100\EM:so=\E_1:se=\E_0:\
- :li#25:nl=\n\200\200\200\n\200\200\200\EA\EK\200\200\200\ET\ET:\
- :nd=\EC:pt:up=\EA:ho=\EH:ve=\n:\
- :k1=\Ep:k2=\Eq:k3=\Er:k4=\Es:k5=\Et:k6=\Eu:k7=\Ev:k8=\Ew:\
- :kd=\EB:kh=\EH:kl=\ED:kr=\EC:ku=\EA:
-d2|gt42|dec gt42:\
- :bs:co#72:ns:li#40:os:
-d4|gt40|dec gt40:\
- :bs:co#72:ns:li#30:os:
-d5|vt50|dec vt50:\
- :bs:cd=\EJ:ce=\EK:cl=\EH\EJ:co#80:li#12:nd=\EC:pt:up=\EA:
-dI|dw1|decwriter I:\
- :bs:co#72:hc:os:
-dh|vt50h|dec vt50h:\
- :bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:li#12:nd=\EC:\
- :pt:sr=\EI:up=\EA:
-#
-# ds|vt100s|vt-100s|pt100s|pt-100s|dec vt100 132 cols 14 lines:\
-# :li#14:tc=vt100w:
-#
-dt|vt100w|vt-100w|pt100w|pt-100w|dec vt100 132 cols:\
- :co#128:li#24:is=\E>\E[?3h\E[?4l\E[?5l\E[?7h\E[?8h:tc=vt100:
-dv|vt52|dec vt52:\
- :bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:li#24:nd=\EC:\
- :pt:sr=\EI:up=\EA:ku=\EA:kd=\EB:kr=\EC:kl=\ED:
-dw|dw2|dw3|dw4|decwriter II:\
- :kb=^h:bs:co#132:hc:os:
-e1|ep48|ep4080|execuport 4080:am:bs:os:co#80:hu=\036:hd=\034:
-e2|ep40|ep4000|execuport 4000:am:bs:os:co#136:hu=\036:hd=\034:
-g2|1200|tn1200|terminet 1200:\
- :co#120:hc:os:
-g3|300|tn300|terminet 300:\
- :co#120:hc:os:
-# Note: no "ho" on HP's since that homes to top of memory, not screen.
-# Due to severe braindamage, the only way to get the arrow keys to
-# transmit anything at all is to turn on the function key labels
-# (f1-f8) with ks, and even then the poor user has to hold down shift!
-# The default 2621 turns off the labels except when it has to to enable
-# the function keys. If your installation prefers labels on all the time,
-# or off all the time (at the "expense" of the function keys) move the
-# 2621nl or 2621wl labels to the front using reorder.
-# 2621k45: untested
-h2|2621|hp2621|hp2621a|hp2621p|2621|2621a|2621p|hp 2621:\
- :is=\E&j@\r\E3\r:bt=\Ei:cm=\E&a%r%dc%dY:dc=2\EP:ip=2:\
- :kh=\Ep\r:ku=\Et\r:kl=\Eu\r:kr=\Ev\r:kd=\Ew\r:\
- :kn#8:k1=\Ep\r:k2=\Eq\r:k3=\Er\r:k4=\Es\r:k5=\Et\r:k6=\Eu\r:k7=\Ev\r:\
- :k8=\Ew\r:ks=\E&jB:ke=\E&j@:ta=2^I:tc=hp:
-h3|2621k45|hp2621k45|k45|hp 2621 with 45 keyboard:\
- :kb=^H:ku=\EA:kd=\EB:kl=\ED:kr=\EC:kh=\Eh:ks=\E&s1A:ke=\E&s0A:tc=2621:
-h4|hp|hp2645|2645|hp 264x series:\
- :if=/usr/lib/tabset/stdcrt:\
- :al=\EL:am:bs:cd=\EJ:ce=\EK:ch=\E&a%dC:cl=\EH\EJ:cm=6\E&a%r%dc%dY:\
- :co#80:cv=\E&a%dY:da:db:dc=\EP:dl=\EM:ei=\ER:im=\EQ:\
- :kb=^H:ku=\EA:kd=\EB:kl=\ED:kr=\EC:kh=\Eh:ks=\E&s1A:ke=\E&s0A:\
- :li#24:mi:ml=\El:mu=\Em:nd=\EC:pt:se=\E&d@:so=\E&dJ:\
- :us=\E&dD:ue=\E&d@:up=\EA:xs:
-h6|hp2626|hp2626a|hp2626p|2626|2626a|2626p|hp 2626:\
- :is=\E&j@\r\E3\r:if=/usr/lib/tabset/stdcrt:\
- :al=\EL:am:bs:bt=\Ei:cd=\EJ:ce=\EK:cl=\EH\EJ:\
- :cm=\E&a%r%dc%dY:co#80:da:db:dc=2\EP:dl=\EM:ei=\ER:\
- :im=\EQ:ip=2:li#24:mi:nd=\EC:pt:se=\E&d@:so=\E&dB:up=\EA:\
- :kh=\Eh:ku=\EA:kl=\ED:kr=\EC:kd=\EB:\
- :ma=j^Jk^P^K^Pl :sf=\ES:\
- :ta=2^I:xs:
-# cD a pain - only screw up at 9600 baud.
-h8|hp2648|hp2648a|2648a|2648|HP 2648a graphics terminal:\
- :cl=50\EH\EJ:cm=20\E&a%r%dc%dY:dc=7\EP:ip#5:is=130\Eg:tc=2645:
-# 2640a doesn't have the Y cursor addressing feature, and C is memory relative
-# instead of screen relative, as we need .
-ha|2640|hp2640a|2640a|hp 2640a:cm@:ks@:ke@:tc=2645:
-hb|2640b|hp2640b|2644a|hp2644a|hp 264x series:ks@:ke@:tc=2645:
-# 2621 using all 48 lines of memory, only 24 visible at any time. Untested.
-hb|big2621|48 line 2621:li#48:ho=\EH:cm=\E&a%r%dc%dR:tc=2621:
-hn|2621nl|hp2621nl|2621|hp 2621 with no labels:ks@:ke@:kh@:ku@:kl@:kr@:kd@:tc=hp2621:
-hw|2621wl|hp2621wl|2621|hp 2621 with labels:is=\E&jA\r\E3\r:ke=\E&jA:tc=hp2621:
-# Infoton is now called General Terminal Corp. or some such thing.
-# gt100 sounds like something DEC would come out with. Lets hope they don't.
-i1|i100|gt100|gt100a|General Terminal 100A (formerly Infoton 100):\
- :cl=^L:cd=\EJ:ce=\EK:li#24:co#80:\
- :al=\EL:dl=\EM:up=\EA:nd=\EC:ho=\EH:cm=\Ef%r%+ %+ :vb=\Eb\Ea:am:bs:\
- :so=\Eb:se=\Ea:
-i4|i400|400|infoton 400:\
- :if=/usr/lib/tabset/infoton_tabs:\
- :al=\E[L:am:bs:ce=\E[N:cl=\E[2J:cm=%i\E[%3;%3H:co#80:dl=\E[M:li#25:\
- :nd=\E[C:up=\E[A:im=\E[4h\E[2Q:ei=\E[4l\E[0Q:\
- :dc=\E[4h\E[2Q\E[P\E[4l\E[0Q:
-ia|addrinfo:\
- :li#24:co#80:cl=^L:ho=^H:nd=^Y:cd=^K:\
- :up=^\:am:bc=^Z:cm=\037%+\377%+\377:ll=^H^\:
-ik|infotonKAS:\
- :am:bc=^Z:cd=^K:cl=^L:co#80:li#24:nd=^Y:up=^\:ll=^H^\:
-l1|adm31|31|lsi adm31:is=\Eu\E0:\
- :al=\EE:am:bs:ce=\ET:cm=\E=%+ %+ :cl=\E*:co#80:dc=\EW:dl=\ER:\
- :ei=\Er:ho=^^:im=\Eq:li#24:mi:nd=^L:se=\EG0:so=\EG4:up=^K:\
- :kl=^H:kd=^J:ku=^K:kr=^L:ma=^K^P^L :
-l2|adm2|lsi adm2:\
- :al=\EE:am:bs:cd=\EY:ce=\ET:cl=\E;:cm=\E=%+ %+ :co#80:dc=\EW:dl=\ER:\
- :ei=:ho=^^:ic=\EQ:im=:kd=^J:kh=^^:kl=^H:kr=^L:ku=^K:li#24:nd=^L:up=^K:
-l3|adm3|3|lsi adm3:\
- :am:bs:cl=^Z:li#24:ma=^K^P:co#80:
-l4|adm42|42|lsi adm42:vs=\EC\E3 \E3(:\
- :al=270\EE:am:bs:cd=\EY:ce=\ET:cl=\E;:cm=\E=%+ %+ :co#80:\
- :dc=\EW:dl=\ER:ei=\Er:im=\Eq:ip=6*:li#24:\
- :bt=\EI:nd=^L:se=\EG0:so=\EG4:ta=\t:up=^k:\
- :ma=^K^P:pc=\177:
-la|adm3a|3a|lsi adm3a:\
- :am:bs:cm=\E=%+ %+ :cl=1^Z:co#80:ho=^^:li#24:ma=^K^P:nd=^L:up=^K:
-lb|adm3a+|3a+:kl=^H:kd=^J:ku=^K:kr=^L:tc=adm3a:
-# These mime1 entries refer to the Microterm Mime I or Mime II.
-# The default mime is assumed to be in enhanced act iv mode.
-m3|mime3a|mime1 emulating 3a:\
- :am@:ma=^X ^K^J^Z^P:ku=^Z:kd=^K:kl=^H:kr=^X:tc=adm3a:
-m4|microterm|act4|microterm act iv:\
- :am:bs:cd=^_:ce=^^:cl=^L:cm=^T%.%.:co#80:li#24:nd=^X:up=^Z:ho=^]:
-# The padding on sr and ta for act5 and mime is a guess and not final.
-m5|microterm5|act5|microterm act v:\
- :uc=\EA:pt:ta=2^I:sr=3\EH:ku=^Z:kd=^K:kl=^H:kr=^X:ma=^Z^P^Xl^Kj:tc=act4:
-# act5s is not tested and said not to work.
-mS|act5s|skinny act5:ti=\EP:te=\EQ:li#48:co#39:tc=act5:
-# Mimes using brightness for standout. Half bright is really dim unless
-# you turn up the brightness so far that lines show up on the screen.
-# uc is disabled to get around a curses bug, and should be put back in someday.
-mf|mimefb|full bright mime1:so=^Y:se=^S:uc@:is=^S\E:tc=mime:
-mh|mimehb|half bright mime1:so=^S:se=^Y:uc@:is=^Y\E:tc=mime:
-mm|mime|mime1|mime2|mimei|mimeii|microterm mime1:\
- :al=80^A:am:bs:cd=^_:ce=^^:cl=\035^C:cm=^T%+^X%> 0%+P:co#80:\
- :dl=80^W:ta=2^I:li#24:nd=^X:pt:uc=^U:up=^z:ho=\035:do=^K:is=^S\E:\
- :ma=^X ^K^J^Z^P:ku=^Z:kd=^K:kl=^H:kr=^X:sr=3^R:
-# These termcaps (for mime 2a) put the terminal in low intensity mode
-# since high intensity mode is so obnoxious.
-ms|mime2as|microterm mime2a (emulating an enhanced soroc iq120):\
- :al=20*^A:am:bs:cd=20*\EJ:ce=\EK:cl=\EL:cm=\E=%+ %+ :co#80:dc=\ED:\
- :dl=20*^W:kl=^H:kr=^L:ku=^K:kd=^J:ho=^^:is=\E):sr=\EI\
- :im=\EE:ei=^Z:ip=2:li#24:nd=^L:so=\E\072:se=\E;:up=\EI:\
- :us=\E6:ue=\E7:
-# This is the preferred mode (but ^X can't be used as a kill character)
-mv|mime2a|mime2av|microterm mime2a (emulating an enhanced vt52):\
- :al=20*^A:bs:cd=20*\EQ:co#80:ce=\EP:cl=\EL:cm=\EY%+ %+ :is=^Y\
- :dc=^N:dl=20*^W:ip=2:ei=^Z:ho=\EH:im=^O:kd=\EB:kl=\ED:kr=\EC:ku=\EA:\
- :li#24:nd=\EC:pt:se=\E9:so=\E8:up=\EA:sr=\EA:us=\E4:ue=\E5:
-mx|mime3ax|mime1 emulating enhanced 3a:\
- :al=80^A:dl=80^W:pt:ce=^X:cd=^_:tc=mime3a:
-n2|spin|nec spinwriter 5525|spinwriter:\
- :bs:co#136:hc:hd=\EU:hu=\ED:os:pt:so=\EA:se=\EB:\
- :if=/usr/lib/tabset/spinwriter:
-pf|fox|perkin elmer 1100:if=/usr/lib/tabset/stdcrt:\
- :am:bs:cd=5.5*\EJ:ce=\EI:cl=132\EH\EJ:co#80:ho=\EH:li#24:\
- :ll=\EH\EA:nd=\EC:cm=\EX%+ \EY%+ :up=\EA:vb=^P^B^P^C:
-po|owl|perkin elmer 1200:if=/usr/lib/tabset/stdcrt:\
- :al=5.5*\EL:am:bs:cd=5.5*\EJ:ce=5.5\EI:cl=132\EH\EJ:ho=\EH:ll=\EH\EA:\
- :cm=\EX%+ \EY%+ :co#80:dc=5.5*\EO:dl=5.5*\EM:ei=:ic=\EN:im=:ip=5.5*:\
- :kb=^h:in:li#24:nd=\EC:up=\EA:se?=\E!\200:so?=\E!^H:vb=^P^B^P^C:\
- :k1=\ERA:k2=\ERB:k3=\ERC:k4=\ERD:k5=\ERE:k6=\ERF:\
- :k7=\ERG:k8=\ERH:k9=\ERI:k0=\ERJ:
-#
-# qB|bc|bill croft homebrew:\
-# :am:bs:cm=\E=%+ %+ :cl=^Z:co#96:ho=^^:li#72:\
-# :nd=^L:up=^K:vb=:
-#
-#NOTE: bg can scroll, it just would rather not (ns) - rwells 3/13/81.
-qB|bg|bg2.0|bgn|BBN BitGraph Terminal (no init):\
- :al=2*\E[L:bs:cd=150\E[J:ce=2\E[K:cl=150\E[H\E[J:cm=%i\E[%d;%dH:\
- :co#85:cs=\E[%i%d;%dr:dl=2*\E[M:\
- :k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:\
- :kd=\E[B:ke=\E>:kl=\E[D:kr=\E[C:ks=\E=:ku=\E[A:\
- :l1=PF1:l2=PF2:l3=PF3:l4=PF4:\
- :li#64:nd=\E[C:ns:pt:se=\E[0m:so=\E[7m:up=\E[A:\
- :sc=\E7:rc=\E8:xn:
-qB|bg|bg2.0nv|bgnv:BBN BitGraph Terminal (normal video):\
- :is=\E>\E[?5l\E[?7h:\
- :if=/usr/lib/tabset/vt100:tc=bgn:
-qB|bg|bg2.0rv|bgrv:BBN BitGraph Terminal (reverse video):\
- :is=\E>\E[?5h\E[?7h:\
- :if=/usr/lib/tabset/vt100:tc=bgn:
-qB|bg|bg1.25|BBN BitGraph terminal:\
- :al=2*\E[L:bs:cd=150\E[J:ce=2\E[K:cl=150\E[H\E[J:cm=%i\E[%d;%dH:\
- :co#85:dl=2*\E[M:\
- :is=\E<:\
- :k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:\
- :kd=\E[B:ke=\E>:kl=\E[D:kr=\E[C:ks=\E=:ku=\E[A:\
- :l1=PF1:l2=PF2:l3=PF3:l4=PF4:\
- :li#64:nd=\E[C:ns:pt:se=\E[0m:so=\E[7m:up=\E[A:
-qB|bg|bg1.25nv|:BBN BitGraph Terminal (normal video):\
- :is=\E<\E>\E[?5l\E[?7h:tc=bg1.25:
-qB|bg|bg1.25rv|:BBN BitGraph Terminal (reverse video):\
- :is=\E<\E>\E[?5h\E[?7h:tc=bg1.25:
-qN|nucterm|rayterm|NUC homebrew:\
- :am:bs:cl=1^L:li#24:co#80:nd=^C:up=^N:ho=^B:ll=^K:ce=^A:cd=^E:
-qb|ex3000:\
- :li#24:co#80:ho=^Q:
-qc|carlock|klc:\
- :al=^E:am:bs:ce=^U:cl=100^Z:cm=\E=%+ %+ :co#80:dc=\177:dl=^D:dm=:\
- :ed=:ei=^T:ho=^^:im=^T:li#24:nd=^L:se=^V:so=^V:up=^K:vb=\EV\EV:
-qe|exidy|exidy2500|exidy sorcerer as dm2500:\
- :al=^P^J^X:am:bs:ce=^W:cl=^^:cm=^L%r%n%.%.:co#64:\
- :dc=\b:dl=^P^Z^X:dm=^P:ed=^X:ei=^X:ho=^B:ic=^\:\
- :im=^P:li#30:nd=^\:pt:so=^N:se=^X:up=^Z:
-qn|netx|netronics:\
- :bs:cd=2000^F^E:ce=1600^E:cl=466^L:cm=\E=%+@%+@:co#64:ho=^D:\
- :li#16:ma=j^Jk^Pl :nd=\E+@A:pc=\200:sr=\E=@@^K:up=^K:
-# This came from the comp ctr who got it from some user. Smart indeed!
-qs|sexidy|exidy smart:\
- :li#24:co#64:cl=^l:ho=^q:nd=^s:up=^w:bs:bc=^a:ma=^x^J:kd=^S:
-qu|ubell|ubellchar:if=/usr/staff/michael/term/startup:\
- :am:bs:pt:ce=\Ed:cl=^Z:cm=\E=%+ %+ :co#80:li#24:nd=^L:up=^K:\
- :ma=j^Jk^P^K^Pl :ho=^^:
-qw|ttyWilliams:\
- :co#80:li#12:bc=^Y:do=^K:up=^Z:cl=^^:ce=^_:am:ho=^]:nd=^X:
-qx|xitex|xitex sct-100:\
- :bs:cd=2000^F^E:ce=1600^E:cl=400^L:cm=\E=%+@%+@:co#64:ho=^D:\
- :li#16:ma=j^Jk^Pl :nd=\E+@A:pc=\200:sr=\E=@@^K:up=^K:
-t3|ti|ti700|ti733|735|ti735|ti silent 700:\
- :bs:co#80:hc:os:dC#162:
-t4|ti745|745|743|ti silent 745:\
- :bs:co#80:hc:os:
-# There are some tvi's that require incredible amounts of padding and
-# some that don't. I'm assuming 912 and 920 are the old slow ones,
-# and 912b, 912c, 920b, 920c are the new ones that don't need padding.
-v1|tvi912|912|920|tvi920|old televideo:if=/usr/lib/tabset/stdcrt:\
- :al=33*\EE:am:bs:ce=\ET:cm=\E=%+ %+ :cl=^Z:co#80:dc=\EW:dl=33*\ER:ei=:\
- :kb=^h:ku=^K:kd=^J:kl=^H:kr=^L:k0=^A@\r:k1=^AA\r:k2=^AB\r:k3=^AC\r:\
- :k4=^AD\r:k5=^AE\r:k6=^AF\r:k7=^AG\r:k8=^AH\r:k9=^AI\r:\
- :ho=^^:im=:ic=\EQ:li#24:nd=^L:pt:se=\Ek:so=\Ej:up=^K:us=\El:ue=\Em:\
- :ma=^K^P^L :sg=1:ug=1:
-v2|912b|912c|920b|920c|tvi|new televideo:\
- :al=5*\EE:dl=5*\ER:tc=912:
-# Note two things called "teleray". Reorder should move the common one
-# to the front if you have either. A dumb teleray with the cursor stuck
-# on the bottom and no obvious model number is probably a 3700.
-y1|t3700|teleray|dumb teleray 3700:\
- :bs:cl=^L:co#80:li#24:
-y3|t3800|teleray 3800 series: \
- :bs:cd=\EJ:ce=\EK:cl=^L:cm=\EY%+ %+ :co#80: \
- :do=\n:ho=\EH:li#24:ll=\EY7 :nd=\EC:pt:up=^K:
-y6|t1061|t10|teleray|teleray 1061:if=/usr/lib/tabset/teleray:\
- :al=2*\EL:am:bs:cd=1\EJ:ce=\EK:cl=1^L:cm=\EY%+ %+ :co#80:\
- :dc=\EQ:dl=2*\EM:ei=:ho=\EH:ic=\EP:im=:ip=0.4*:\
- :k1=^Z1:k2=^Z2:k3=^Z3:k4=^Z4:k5=^Z5:k6=^Z6:k7=^Z7:k8=^Z8:\
- :li#24:nd=\EC:pt:se=\ER@:so= \ERD:\
- :is=\Ee\EU01^Z1\EV\EU02^Z2\EV\EU03^Z3\EV\EU04^Z4\EV\EU05^Z5\EV\EU06^Z6\EV\EU07^Z7\EV\EU08^Z8\EV\Ef:\
- :up=\EA:us=\ERH:ue=\ER@:xs:xt:sg=2:ug=1:
-yf|t1061f|teleray 1061 with fast PROMs:\
- al=\EL:ip@:dl=\EM:tc=t1061:
-rv|vidtx|Radio Shack VIDEOTEX:\
- :cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#32:li#16:nd=\EC:up=\EA:
-ae|apple2e|Apple ][e with 80 column card:\
- :am:bs:cd=^K:ce=^]:cl=^L:cm=^^%r%+ %.:co#80:ho=^Y:\
- :ku=^_:kd=^J:kl=^H:kr=^\:kh=^Y:\
- :li#24:nd=^\:up=^_:xn:ma=^\ ^_^P^YH:pt:
-#
-# ----
-# Convention: First entry is two chars, first char is manufacturer,
-# second char is canonical abbreviation for model or mode.
-# Second entry is canonical abbreviation.
-# Third entry is the one the editor will print with "set" command.
-# Last entry is verbose description.
-# Others are mnemonic synonyms for the terminal.
-#
-# If you absolutely MUST check for a specific terminal (this is discouraged)
-# check for the 2nd entry (the canonical form) since all other codes are
-# subject to change. The two letter codes are there for version 6 and are
-# EXTREMELY subject to change, or even to go away if version 6 becomes for
-# all practical purposes obsolete.
-#
-# Special manufacturer codes:
-# M: Misc. (with only a few terminals)
-# q: Homemade
-# s: special (dialup, etc.)
-#
-# This file is to be installed with an editor script that moves the most
-# common terminals to the front of the file. If the source is not available,
-# it can be constructed by sorting
-# the above entries by the 2 char initial code.
emacs-33
emacs-34
emacs-35
-emacs-36
emacs-mime
ccmode
ccmode-1
pcl-cvs
woman
speedbar
-elisp
-elisp-1
-elisp-2
-elisp-3
-elisp-4
-elisp-5
-elisp-6
-elisp-7
-elisp-8
-elisp-9
-elisp-10
-elisp-11
-elisp-12
-elisp-13
-elisp-14
-elisp-15
-elisp-16
-elisp-17
-elisp-18
-elisp-19
-elisp-20
-elisp-21
-elisp-22
-elisp-23
-elisp-24
-elisp-25
-elisp-26
-elisp-27
-elisp-28
-elisp-29
-elisp-30
-elisp-31
-elisp-32
-elisp-33
-elisp-34
-elisp-35
-elisp-36
-elisp-37
-elisp-38
-elisp-39
-elisp-40
-elisp-41
-elisp-42
-elisp-43
-elisp-44
-elisp-45
-elisp-46
-elisp-47
-2001-02-05 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (BUILT_EMACS): Use $(THISDIR) to make emacs.exe
- path absolute.
-
-2001-02-03 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (LATIN): Fix last change to use () not {}.
-
-2001-02-02 Kenichi Handa <handa@etl.go.jp>
-
- * Makefile.in (LATIN): Include ${srcdir}/quail/latin-alt.elc.
-
- * makefile.w32-in (LATIN): Likewise.
-
- * quail/latin-ltx.el: New file -- LaTeX-like Latin input method.
-
-2001-02-01 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in (LATIN): Include $(srcdir)/quail/latin-alt.elc.
-
-2001-02-01 Kenichi Handa <handa@etl.go.jp>
-
- * Makefile.in (LATIN): Include ${srcdir}/quail/latin-alt.elc.
-
- * quail/greek.el ("greek-mizuochi"): New input method for
- classical Greek.
-
-2001-01-28 Gerd Moellmann <gerd@gnu.org>
-
- * Makefile.in (extraclean): Added target so make doesn't die if
- one runs "make extraclean" at the top level.
-
2001-01-06 Andrew Innes <andrewi@gnu.org>
* makefile.nt ($(TIT)): Map .elc to .el.
TIBETAN=${srcdir}/quail/tibetan.elc
-LATIN= ${srcdir}/quail/latin-pre.elc \
- ${srcdir}/quail/latin-post.elc \
- ${srcdir}/quail/latin-alt.elc \
- ${srcdir}/quail/latin-ltx.elc
+LATIN=${srcdir}/quail/latin-pre.elc ${srcdir}/quail/latin-post.elc
SLAVIC= \
${srcdir}/quail/czech.elc \
distclean maintainer-clean:
if test -f stamp-subdir; then rm -rf ${SUBDIRS} stamp-subdir; fi
rm -f Makefile
-
-extraclean: distclean
- -rm -f *~ \#* m/?*~ s/?*~
\r
# Which Emacs to use to convert TIT files to Emacs Lisp files,\r
# byte-compile Emacs Lisp files, and generate the file leim-list.el.\r
-BUILT_EMACS = $(THISDIR)/$(dot)$(dot)/src/$(BLD)/emacs.exe\r
+BUILT_EMACS = $(dot)$(dot)/src/$(BLD)/emacs.exe\r
\r
buildlisppath=$(CURDIR)/$(dot)$(dot)/lisp\r
\r
\r
TIBETAN=$(srcdir)/quail/tibetan.elc\r
\r
-LATIN= $(srcdir)/quail/latin-pre.elc \\r
- $(srcdir)/quail/latin-post.elc \\r
- $(srcdir)/quail/latin-alt.elc \\r
- $(srcdir)/quail/latin-ltx.elc\r
+LATIN=$(srcdir)/quail/latin-pre.elc $(srcdir)/quail/latin-post.elc\r
\r
SLAVIC= \\r
$(srcdir)/quail/czech.elc \\r
;;; quail/greek.el -- Quail package for inputting Greek
-;; Copyright (C) 1997, 2001 Electrotechnical Laboratory, JAPAN.
+;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Keywords: multilingual, input method, Greek
;;
-(quail-define-package "greek-mizuochi" "Greek" "CG" t "
-The Mizuochi input method for Classical Greek using mule-unicode-0100-24ff.
-
--------------------------------------
-character capital small
--------------------------------------
-alpha A a
-beta B b
-gamma G g
-delta D d
-epsilon E e
-zeta Z z
-eta H h
-theta Q q
-iota I i
-kappa K k
-lamda L l
-mu M m
-nu H n
-xi X x
-omicron O o
-pi P p
-rho R r
-sigma S s
-final sigma j
-tau T t
-upsilon U u
-phi F f
-chi C c
-psi Y y
-omega W w
--------------------------------------
-sampi !
-digamma #
-stigma $
-koppa & %
--------------------------------------
-
-------------------------
-mark key
-------------------------
-ypogegrammeni J
-psili ' or v
-dasia ` or V
-oxia /
-varia ?
-perispomeni \\ or ^
-dialytika \"
-ano teleia :
-erotimatiko ;
-----------------------
-"
-nil t t nil nil nil nil nil nil nil t)
-
-(quail-define-rules
-
- ("!" ?\e$,1'a\e(B) ; sampi
- ("#" ?\e$,1'\\e(B) ; DIGAMMA
- ("$" ?\e$,1'[\e(B) ; stigma
- ("%" ?\e$,1'_\e(B) ; koppa
- ("&" ?\e$,1'^\e(B) ; KOPPA
- ("'" ?\e$,1q\7f\e(B) ("v" ?\e$,1q\7f\e(B) ; psili
- ("/" ?\e$,1r]\e(B) ; oxia
- (":" ?\e$,1&g\e(B) ; ano teleia
- (";" ?\e$,1&^\e(B) ; erotimatiko
- ("\"" ?\e,A(\e(B) ; dialytika
-
- ("A" ?\e$,1&q\e(B)
- ("B" ?\e$,1&r\e(B)
- ("C" ?\e$,1''\e(B)
- ("D" ?\e$,1&t\e(B)
- ("E" ?\e$,1&u\e(B)
- ("F" ?\e$,1'&\e(B)
- ("G" ?\e$,1&s\e(B)
- ("H" ?\e$,1&w\e(B)
- ("I" ?\e$,1&y\e(B)
- ("wJ" ?\e$,1rS\e(B)
- ("K" ?\e$,1&z\e(B)
- ("L" ?\e$,1&{\e(B)
- ("M" ?\e$,1&|\e(B)
- ("N" ?\e$,1&}\e(B)
- ("O" ?\e$,1&\7f\e(B)
-
- ("P" ?\e$,1' \e(B)
- ("Q" ?\e$,1&x\e(B)
- ("R" ?\e$,1'!\e(B)
- ("S" ?\e$,1'#\e(B)
- ("T" ?\e$,1'$\e(B)
- ("U" ?\e$,1'%\e(B)
- ("hJ" ?\e$,1r#\e(B)
- ("W" ?\e$,1')\e(B)
- ("X" ?\e$,1&~\e(B)
- ("Y" ?\e$,1'(\e(B)
- ("Z" ?\e$,1&v\e(B)
- ("?" ?\e$,1rO\e(B) ; varia
- ("\\" ?\e$,1r \e(B) ("^" ?\e$,1r \e(B) ; perispomeni
-
- ("`" ?\e$,1r^\e(B) ("V" ?\e$,1r^\e(B) ; dasia
- ("a" ?\e$,1'1\e(B)
- ("b" ?\e$,1'2\e(B)
- ("c" ?\e$,1'G\e(B)
- ("d" ?\e$,1'4\e(B)
- ("e" ?\e$,1'5\e(B)
- ("f" ?\e$,1'F\e(B)
- ("g" ?\e$,1'3\e(B)
- ("h" ?\e$,1'7\e(B)
- ("i" ?\e$,1'9\e(B)
- ("j" ?\e$,1'B\e(B)
- ("k" ?\e$,1':\e(B)
- ("l" ?\e$,1';\e(B)
- ("m" ?\e$,1'<\e(B)
- ("n" ?\e$,1'=\e(B)
- ("o" ?\e$,1'?\e(B)
-
- ("p" ?\e$,1'@\e(B)
- ("q" ?\e$,1'8\e(B)
- ("r" ?\e$,1'A\e(B)
- ("s" ?\e$,1'C\e(B)
- ("t" ?\e$,1'D\e(B)
- ("u" ?\e$,1'E\e(B)
- ("aJ" ?\e$,1qs\e(B)
- ("w" ?\e$,1'I\e(B)
- ("x" ?\e$,1'>\e(B)
- ("y" ?\e$,1'H\e(B)
- ("z" ?\e$,1'6\e(B)
-
- ("i`" ?\e$,1pQ\e(B) ("iV" ?\e$,1pQ\e(B)
- ("i'" ?\e$,1pP\e(B) ("iv" ?\e$,1pP\e(B)
- ("i/" ?\e$,1q7\e(B)
- ("i`/" ?\e$,1pU\e(B) ("iV/" ?\e$,1pU\e(B) ("i/`" ?\e$,1pU\e(B) ("i/V" ?\e$,1pU\e(B)
- ("i'/" ?\e$,1pT\e(B) ("iv/" ?\e$,1pT\e(B) ("i/'" ?\e$,1pT\e(B) ("i/v" ?\e$,1pT\e(B)
- ("i?" ?\e$,1q6\e(B)
- ("i`?" ?\e$,1pS\e(B) ("iV?" ?\e$,1pS\e(B) ("i?`" ?\e$,1pS\e(B) ("i?V" ?\e$,1pS\e(B)
- ("i'?" ?\e$,1pR\e(B) ("iv?" ?\e$,1pR\e(B) ("i?'" ?\e$,1pR\e(B) ("i?v" ?\e$,1pR\e(B)
- ("i^" ?\e$,1r6\e(B) ("i\\" ?\e$,1r6\e(B)
- ("i`^" ?\e$,1pW\e(B) ("i`\\" ?\e$,1pW\e(B) ("iV^" ?\e$,1pW\e(B) ("iV\\" ?\e$,1pW\e(B)
- ("i^`" ?\e$,1pW\e(B) ("i\\`" ?\e$,1pW\e(B) ("i^V" ?\e$,1pW\e(B) ("i\\V" ?\e$,1pW\e(B)
- ("i'^" ?\e$,1pV\e(B) ("i'\\" ?\e$,1pV\e(B) ("iv^" ?\e$,1pV\e(B) ("iv\\" ?\e$,1pV\e(B)
- ("i^'" ?\e$,1pV\e(B) ("i\\'" ?\e$,1pV\e(B) ("i^v" ?\e$,1pV\e(B) ("i\\v" ?\e$,1pV\e(B)
- ("i\"" ?\e$,1'J\e(B)
- ("i/\"" ?\e$,1r3\e(B) ("i\"/" ?\e$,1r3\e(B)
- ("i?\"" ?\e$,1r2\e(B) ("i\"?" ?\e$,1r2\e(B)
-
- ("^`" ?\e$,1r?\e(B) ("^V" ?\e$,1r?\e(B) ("\\`" ?\e$,1r?\e(B) ("\\V" ?\e$,1r?\e(B)
- ("`^" ?\e$,1r?\e(B) ("V^" ?\e$,1r?\e(B) ("`\\" ?\e$,1r?\e(B) ("V\\" ?\e$,1r?\e(B)
- ("^'" ?\e$,1r/\e(B) ("^v" ?\e$,1r/\e(B) ("\\'" ?\e$,1r/\e(B) ("\\v" ?\e$,1r/\e(B)
- ("'^" ?\e$,1r/\e(B) ("v^" ?\e$,1r/\e(B) ("'\\" ?\e$,1r/\e(B) ("v\\" ?\e$,1r/\e(B)
- ("/`" ?\e$,1r>\e(B) ("/V" ?\e$,1r>\e(B) ("`/" ?\e$,1r>\e(B) ("V/" ?\e$,1r>\e(B)
- ("/'" ?\e$,1r.\e(B) ("/v" ?\e$,1r.\e(B) ("'/" ?\e$,1r.\e(B) ("v/" ?\e$,1r.\e(B)
- ("?`" ?\e$,1r=\e(B) ("?V" ?\e$,1r=\e(B) ("`?" ?\e$,1r=\e(B) ("V?" ?\e$,1r=\e(B)
- ("?'" ?\e$,1r-\e(B) ("?v" ?\e$,1r-\e(B) ("'?" ?\e$,1r-\e(B) ("v?" ?\e$,1r-\e(B)
- ("\"/" ?\e$,1rN\e(B) ("/\"" ?\e$,1rN\e(B)
- ("\"?" ?\e$,1rM\e(B) ("?\"" ?\e$,1rM\e(B)
-
- ("e`" ?\e$,1p1\e(B) ("eV" ?\e$,1p1\e(B)
- ("e'" ?\e$,1p0\e(B) ("ev" ?\e$,1p0\e(B)
- ("e/" ?\e$,1q3\e(B)
- ("e/`" ?\e$,1p5\e(B) ("e/V" ?\e$,1p5\e(B) ("e`/" ?\e$,1p5\e(B) ("eV/" ?\e$,1p5\e(B)
- ("e/'" ?\e$,1p4\e(B) ("e/v" ?\e$,1p4\e(B) ("e'/" ?\e$,1p4\e(B) ("ev/" ?\e$,1p4\e(B)
- ("e?" ?\e$,1q2\e(B)
- ("e?`" ?\e$,1p3\e(B) ("e?V" ?\e$,1p3\e(B) ("e`?" ?\e$,1p3\e(B) ("eV?" ?\e$,1p3\e(B)
- ("e?'" ?\e$,1p2\e(B) ("e?v" ?\e$,1p2\e(B) ("e'?" ?\e$,1p2\e(B) ("ev?" ?\e$,1p2\e(B)
-
- ("a`" ?\e$,1p!\e(B) ("aV" ?\e$,1p!\e(B)
- ("a'" ?\e$,1p \e(B) ("av" ?\e$,1p \e(B)
- ("a/" ?\e$,1q1\e(B)
- ("a/`" ?\e$,1p%\e(B) ("a/V" ?\e$,1p%\e(B) ("a`/" ?\e$,1p%\e(B) ("aV/" ?\e$,1p%\e(B)
- ("a/'" ?\e$,1p$\e(B) ("a/v" ?\e$,1p$\e(B) ("a'/" ?\e$,1p$\e(B) ("av/" ?\e$,1p$\e(B)
- ("a?" ?\e$,1q0\e(B)
- ("a?`" ?\e$,1p#\e(B) ("a?V" ?\e$,1p#\e(B) ("a`?" ?\e$,1p#\e(B) ("aV?" ?\e$,1p#\e(B)
- ("a?'" ?\e$,1p"\e(B) ("a?v" ?\e$,1p"\e(B) ("a'?" ?\e$,1p"\e(B) ("av?" ?\e$,1p"\e(B)
- ("a^" ?\e$,1qv\e(B) ("a\\" ?\e$,1qv\e(B)
- ("a^`" ?\e$,1p'\e(B) ("a^V" ?\e$,1p'\e(B) ("a\\`" ?\e$,1p'\e(B) ("a\\V" ?\e$,1p'\e(B)
- ("a`^" ?\e$,1p'\e(B) ("aV^" ?\e$,1p'\e(B) ("a`\\" ?\e$,1p'\e(B) ("aV\\" ?\e$,1p'\e(B)
- ("a^'" ?\e$,1p&\e(B) ("a^v" ?\e$,1p&\e(B) ("a\\'" ?\e$,1p&\e(B) ("a\\v" ?\e$,1p&\e(B)
- ("a'^" ?\e$,1p&\e(B) ("av^" ?\e$,1p&\e(B) ("a'\\" ?\e$,1p&\e(B) ("av\\" ?\e$,1p&\e(B)
-
- ("aJ`" ?\e$,1qA\e(B) ("aJV" ?\e$,1qA\e(B)
- ("aJ'" ?\e$,1q@\e(B) ("aJv" ?\e$,1q@\e(B)
- ("aJ/" ?\e$,1qt\e(B)
- ("aJ/`" ?\e$,1qE\e(B) ("aJ/V" ?\e$,1qE\e(B) ("aJ`/" ?\e$,1qE\e(B) ("aJV/" ?\e$,1qE\e(B)
- ("aJ/'" ?\e$,1qD\e(B) ("aJ/v" ?\e$,1qD\e(B) ("aJ'/" ?\e$,1qD\e(B) ("aJv/" ?\e$,1qD\e(B)
- ("aJ?" ?\e$,1qr\e(B)
- ("aJ?`" ?\e$,1qC\e(B) ("aJ?V" ?\e$,1qC\e(B) ("aJ`?" ?\e$,1qC\e(B) ("aJV?" ?\e$,1qC\e(B)
- ("aJ?'" ?\e$,1qB\e(B) ("aJ?v" ?\e$,1qB\e(B) ("aJ'?" ?\e$,1qB\e(B) ("aJv?" ?\e$,1qB\e(B)
- ("aJ^" ?\e$,1qw\e(B) ("aJ\\" ?\e$,1qw\e(B)
- ("aJ^`" ?\e$,1qG\e(B) ("aJ^V" ?\e$,1qG\e(B) ("aJ\\`" ?\e$,1qG\e(B) ("aJ\\V" ?\e$,1qG\e(B)
- ("aJ`^" ?\e$,1qG\e(B) ("aJV^" ?\e$,1qG\e(B) ("aJ`\\" ?\e$,1qG\e(B) ("aJV\\" ?\e$,1qG\e(B)
- ("aJ^'" ?\e$,1qF\e(B) ("aJ^v" ?\e$,1qF\e(B) ("aJ\\'" ?\e$,1qF\e(B) ("aJ\\v" ?\e$,1qF\e(B)
- ("aJ'^" ?\e$,1qF\e(B) ("aJv^" ?\e$,1qF\e(B) ("aJ'\\" ?\e$,1qF\e(B) ("aJv\\" ?\e$,1qF\e(B)
-
- ("r`" ?\e$,1rE\e(B) ("rV" ?\e$,1rE\e(B)
- ("r'" ?\e$,1rD\e(B) ("rv" ?\e$,1rD\e(B)
-
- ("h`" ?\e$,1pA\e(B) ("hV" ?\e$,1pA\e(B)
- ("h'" ?\e$,1p@\e(B) ("hv" ?\e$,1p@\e(B)
- ("h/" ?\e$,1q5\e(B)
- ("h/`" ?\e$,1pE\e(B) ("h/V" ?\e$,1pE\e(B) ("h`/" ?\e$,1pE\e(B) ("hV/" ?\e$,1pE\e(B)
- ("h/'" ?\e$,1pD\e(B) ("h/v" ?\e$,1pD\e(B) ("h'/" ?\e$,1pD\e(B) ("hv/" ?\e$,1pD\e(B)
- ("h?" ?\e$,1q4\e(B)
- ("h?`" ?\e$,1pC\e(B) ("h?V" ?\e$,1pC\e(B) ("h`?" ?\e$,1pC\e(B) ("hV?" ?\e$,1pC\e(B)
- ("h?'" ?\e$,1pB\e(B) ("h?v" ?\e$,1pB\e(B) ("h'?" ?\e$,1pB\e(B) ("hv?" ?\e$,1pB\e(B)
- ("h^" ?\e$,1r&\e(B) ("h\\" ?\e$,1r&\e(B)
- ("h^`" ?\e$,1pG\e(B) ("h^V" ?\e$,1pG\e(B) ("h\\`" ?\e$,1pG\e(B) ("h\\V" ?\e$,1pG\e(B)
- ("h`^" ?\e$,1pG\e(B) ("h`\\" ?\e$,1pG\e(B) ("hV^" ?\e$,1pG\e(B) ("hV\\" ?\e$,1pG\e(B)
- ("h^'" ?\e$,1pF\e(B) ("h^v" ?\e$,1pF\e(B) ("h\\'" ?\e$,1pF\e(B) ("h\\v" ?\e$,1pF\e(B)
- ("h'^" ?\e$,1pF\e(B) ("h'\\" ?\e$,1pF\e(B) ("hv^" ?\e$,1pF\e(B) ("hv\\" ?\e$,1pF\e(B)
-
- ("J" ?\e$,1&Z\e(B) ; ypogegrammeni
-
- ("hJ`" ?\e$,1qQ\e(B) ("hJV" ?\e$,1qQ\e(B)
- ("hJ'" ?\e$,1qP\e(B) ("hJv" ?\e$,1qP\e(B)
- ("hJ/" ?\e$,1r$\e(B)
- ("hJ`/" ?\e$,1qU\e(B) ("hJV/" ?\e$,1qU\e(B) ("hJ/`" ?\e$,1qU\e(B) ("hJ/V" ?\e$,1qU\e(B)
- ("hJ'/" ?\e$,1qT\e(B) ("hJv/" ?\e$,1qT\e(B) ("hJ/'" ?\e$,1qT\e(B) ("hJ/v" ?\e$,1qT\e(B)
- ("hJ?" ?\e$,1r"\e(B)
- ("hJ`?" ?\e$,1qS\e(B) ("hJV?" ?\e$,1qS\e(B) ("hJ?`" ?\e$,1qS\e(B) ("hJ?V" ?\e$,1qS\e(B)
- ("hJ'?" ?\e$,1qR\e(B) ("hJv?" ?\e$,1qR\e(B) ("hJ?'" ?\e$,1qR\e(B) ("hJ?v" ?\e$,1qR\e(B)
- ("hJ^" ?\e$,1r'\e(B) ("hJ\\" ?\e$,1r'\e(B)
- ("hJ`^" ?\e$,1qW\e(B) ("hJ`\\" ?\e$,1qW\e(B) ("hJV^" ?\e$,1qW\e(B) ("hJV\\" ?\e$,1qW\e(B)
- ("hJ^`" ?\e$,1qW\e(B) ("hJ\\`" ?\e$,1qW\e(B) ("hJ^V" ?\e$,1qW\e(B) ("hJ\\V" ?\e$,1qW\e(B)
- ("hJ'^" ?\e$,1qV\e(B) ("hJ'\\" ?\e$,1qV\e(B) ("hJv^" ?\e$,1qV\e(B) ("hJv\\" ?\e$,1qV\e(B)
- ("hJ^'" ?\e$,1qV\e(B) ("hJ\\'" ?\e$,1qV\e(B) ("hJ^v" ?\e$,1qV\e(B) ("hJ\\v" ?\e$,1qV\e(B)
-
- ("o`" ?\e$,1pa\e(B) ("oV" ?\e$,1pa\e(B)
- ("o'" ?\e$,1p`\e(B) ("ov" ?\e$,1p`\e(B)
- ("o/" ?\e$,1q9\e(B)
- ("o/`" ?\e$,1pe\e(B) ("o/V" ?\e$,1pe\e(B) ("o`/" ?\e$,1pe\e(B) ("oV/" ?\e$,1pe\e(B)
- ("o/'" ?\e$,1pd\e(B) ("o/v" ?\e$,1pd\e(B) ("o'/" ?\e$,1pd\e(B) ("ov/" ?\e$,1pd\e(B)
- ("o?" ?\e$,1q8\e(B)
- ("o?`" ?\e$,1pc\e(B) ("o?V" ?\e$,1pc\e(B) ("o`?" ?\e$,1pc\e(B) ("oV?" ?\e$,1pc\e(B)
- ("o?'" ?\e$,1pb\e(B) ("o?v" ?\e$,1pb\e(B) ("o'?" ?\e$,1pb\e(B) ("ov?" ?\e$,1pb\e(B)
-
- ("u`" ?\e$,1pq\e(B) ("uV" ?\e$,1pq\e(B)
- ("u'" ?\e$,1pp\e(B) ("uv" ?\e$,1pp\e(B)
- ("u/" ?\e$,1q;\e(B)
- ("u/`" ?\e$,1pu\e(B) ("u/V" ?\e$,1pu\e(B) ("u`/" ?\e$,1pu\e(B) ("uV/" ?\e$,1pu\e(B)
- ("u/'" ?\e$,1pt\e(B) ("u/v" ?\e$,1pt\e(B) ("u'/" ?\e$,1pt\e(B) ("uv/" ?\e$,1pt\e(B)
- ("u?" ?\e$,1q:\e(B)
- ("u?`" ?\e$,1ps\e(B) ("u?V" ?\e$,1ps\e(B) ("u`?" ?\e$,1ps\e(B) ("uV?" ?\e$,1ps\e(B)
- ("u?'" ?\e$,1pr\e(B) ("u?v" ?\e$,1pr\e(B) ("u'?" ?\e$,1pr\e(B) ("uv?" ?\e$,1pr\e(B)
- ("u^" ?\e$,1rF\e(B) ("u\\" ?\e$,1rF\e(B)
- ("u^`" ?\e$,1pw\e(B) ("u^V" ?\e$,1pw\e(B) ("u\\`" ?\e$,1pw\e(B) ("u\\V" ?\e$,1pw\e(B)
- ("u`^" ?\e$,1pw\e(B) ("uV^" ?\e$,1pw\e(B) ("u`\\" ?\e$,1pw\e(B) ("uV\\" ?\e$,1pw\e(B)
- ("u^'" ?\e$,1pv\e(B) ("u^v" ?\e$,1pv\e(B) ("u\\'" ?\e$,1pv\e(B) ("u\\v" ?\e$,1pv\e(B)
- ("u'^" ?\e$,1pv\e(B) ("uv^" ?\e$,1pv\e(B) ("u'\\" ?\e$,1pv\e(B) ("uv\\" ?\e$,1pv\e(B)
- ("u\"" ?\e$,1'K\e(B)
- ("u\"/" ?\e$,1rC\e(B) ("u/\"" ?\e$,1rC\e(B)
- ("u\"?" ?\e$,1rB\e(B) ("u?\"" ?\e$,1rB\e(B)
-
- ("w`" ?\e$,1q!\e(B) ("wV" ?\e$,1q!\e(B)
- ("w'" ?\e$,1q \e(B) ("wv" ?\e$,1q \e(B)
- ("w/" ?\e$,1q=\e(B)
- ("w/`" ?\e$,1q%\e(B) ("w/V" ?\e$,1q%\e(B) ("w`/" ?\e$,1q%\e(B) ("wV/" ?\e$,1q%\e(B)
- ("w/'" ?\e$,1q$\e(B) ("w/v" ?\e$,1q$\e(B) ("w'/" ?\e$,1q$\e(B) ("wv/" ?\e$,1q$\e(B)
- ("w?" ?\e$,1q<\e(B)
- ("w?`" ?\e$,1q#\e(B) ("w?V" ?\e$,1q#\e(B) ("w`?" ?\e$,1q#\e(B) ("wV?" ?\e$,1q#\e(B)
- ("w?'" ?\e$,1q"\e(B) ("w?v" ?\e$,1q"\e(B) ("w'?" ?\e$,1q"\e(B) ("wv?" ?\e$,1q"\e(B)
- ("w^" ?\e$,1rV\e(B) ("w\\" ?\e$,1rV\e(B)
- ("w^`" ?\e$,1q'\e(B) ("w^V" ?\e$,1q'\e(B) ("w\\`" ?\e$,1q'\e(B) ("w\\V" ?\e$,1q'\e(B)
- ("w`^" ?\e$,1q'\e(B) ("wV^" ?\e$,1q'\e(B) ("w`\\" ?\e$,1q'\e(B) ("wV\\" ?\e$,1q'\e(B)
- ("w^'" ?\e$,1q&\e(B) ("w^v" ?\e$,1q&\e(B) ("w\\'" ?\e$,1q&\e(B) ("w\\v" ?\e$,1q&\e(B)
- ("w'^" ?\e$,1q&\e(B) ("wv^" ?\e$,1q&\e(B) ("w'\\" ?\e$,1q&\e(B) ("wv\\" ?\e$,1q&\e(B)
-
- ("wJ`" ?\e$,1qa\e(B) ("wJV" ?\e$,1qa\e(B)
- ("wJ'" ?\e$,1q`\e(B) ("wJv" ?\e$,1q`\e(B)
- ("wJ/" ?\e$,1rT\e(B)
- ("wJ/`" ?\e$,1qe\e(B) ("wJ/V" ?\e$,1qe\e(B) ("wJ`/" ?\e$,1qe\e(B) ("wJV/" ?\e$,1qe\e(B)
- ("wJ/'" ?\e$,1qd\e(B) ("wJ/v" ?\e$,1qd\e(B) ("wJ'/" ?\e$,1qd\e(B) ("wJv/" ?\e$,1qd\e(B)
- ("wJ?" ?\e$,1rR\e(B)
- ("wJ?`" ?\e$,1qc\e(B) ("wJ?V" ?\e$,1qc\e(B) ("wJ`?" ?\e$,1qc\e(B) ("wJV?" ?\e$,1qc\e(B)
- ("wJ?'" ?\e$,1qb\e(B) ("wJ?v" ?\e$,1qb\e(B) ("wJ'?" ?\e$,1qb\e(B) ("wJv?" ?\e$,1qb\e(B)
- ("wJ^" ?\e$,1rW\e(B) ("wJ\\" ?\e$,1rW\e(B)
- ("wJ^`" ?\e$,1qg\e(B) ("wJ^V" ?\e$,1qg\e(B) ("wJ\\`" ?\e$,1qg\e(B) ("wJ\\V" ?\e$,1qg\e(B)
- ("wJ`^" ?\e$,1qg\e(B) ("wJV^" ?\e$,1qg\e(B) ("wJ`\\" ?\e$,1qg\e(B) ("wJV\\" ?\e$,1qg\e(B)
- ("wJ^'" ?\e$,1qf\e(B) ("wJ^v" ?\e$,1qf\e(B) ("wJ\\'" ?\e$,1qf\e(B) ("wJ\\v" ?\e$,1qf\e(B)
- ("wJ'^" ?\e$,1qf\e(B) ("wJv^" ?\e$,1qf\e(B) ("wJ'\\" ?\e$,1qf\e(B) ("wJv\\" ?\e$,1qf\e(B)
- )
-
-;;
-
-(quail-define-package "greek-ibycus4" "Greek" "IB" t
-"The Ibycus4 input method for Classical Greek using mule-unicode-0100-24ff."
-nil t t nil nil nil nil nil nil nil t)
-
-(quail-define-rules
-
- ("{((}" ?\() ("((" ?\() ; #x0028
- ("{))}" ?\)) ("))" ?\)) ; #x0029
- ("<<" ?\e,A+\e(B) ; #x00ab
- (">>" ?\e,A;\e(B) ; #x00bb
-
- ("-" ?\e$,1rp\e(B) ; #x2010
- ("---" ?\e$,1rt\e(B) ; #x2014
- ("||" ?\e$,1rv\e(B) ; #x2016
- ("{`}" ?\e$,1rx\e(B) ("`" ?\e$,1rx\e(B) ; #x2018
- ("{'}" ?\e$,1ry\e(B) ("'" ?\e$,1ry\e(B) ; #x2019
- ("{``}" ?\e$,1r|\e(B) ("``" ?\e$,1r|\e(B) ; #x201c
- ("{''}" ?\e$,1r}\e(B) ("''" ?\e$,1r}\e(B) ; #x201d
- ("{\\dag}" ?\e$,1s \e(B) ("\\dag" ?\e$,1s \e(B) ; #x2020
- ("{\\ddag}" ?\e$,1s!\e(B) ("\\ddag" ?\e$,1s!\e(B) ; #x2021
- ("<" ?\e$,1s9\e(B) ; #x2039
- (">" ?\e$,1s:\e(B) ; #x203a
- ("$\\leftarrow$" ?\e$,1vp\e(B) ; #x2190
- ("$\\rightarrow$" ?\e$,1vr\e(B) ; #x2192
-
- ("?" ?\e$,1&^\e(B) ; #x037e ; erotimatiko
- (";" ?\e$,1&g\e(B) ; #x0387 ; ano teleia
- ("|" ?\e$,1&Z\e(B) ; #x037a ; ypogegrammeni
-
- ("A" ?\e$,1&q\e(B)
- ("B" ?\e$,1&r\e(B)
- ("G" ?\e$,1&s\e(B)
- ("D" ?\e$,1&t\e(B)
- ("E" ?\e$,1&u\e(B)
- ("Z" ?\e$,1&v\e(B)
- ("H" ?\e$,1&w\e(B)
- ("Q" ?\e$,1&x\e(B)
- ("I" ?\e$,1&y\e(B)
- ("K" ?\e$,1&z\e(B)
- ("L" ?\e$,1&{\e(B)
- ("M" ?\e$,1&|\e(B)
- ("N" ?\e$,1&}\e(B)
- ("C" ?\e$,1&~\e(B)
- ("O" ?\e$,1&\7f\e(B)
- ("P" ?\e$,1' \e(B)
- ("R" ?\e$,1'!\e(B)
- ("S" ?\e$,1'#\e(B)
- ("T" ?\e$,1'$\e(B)
- ("U" ?\e$,1'%\e(B)
- ("F" ?\e$,1'&\e(B)
- ("X" ?\e$,1''\e(B)
- ("Y" ?\e$,1'(\e(B)
- ("W" ?\e$,1')\e(B)
-
- ("a" ?\e$,1'1\e(B)
- ("b" ?\e$,1'2\e(B)
- ("g" ?\e$,1'3\e(B)
- ("d" ?\e$,1'4\e(B)
- ("e" ?\e$,1'5\e(B)
- ("z" ?\e$,1'6\e(B)
- ("h" ?\e$,1'7\e(B)
- ("q" ?\e$,1'8\e(B)
- ("i" ?\e$,1'9\e(B)
- ("k" ?\e$,1':\e(B)
- ("l" ?\e$,1';\e(B)
- ("m" ?\e$,1'<\e(B)
- ("n" ?\e$,1'=\e(B)
- ("c" ?\e$,1'>\e(B)
- ("o" ?\e$,1'?\e(B)
- ("p" ?\e$,1'@\e(B)
- ("r" ?\e$,1'A\e(B)
- ("j" ?\e$,1'B\e(B) ("s " ["\e$,1'B\e(B "]) ("s," ["\e$,1'B\e(B,"]) ("s." ["\e$,1'B\e(B."]) ("s?" ["\e$,1'B&^\e(B"]) ("s;" ["\e$,1'B&g\e(B"])
- ("s|" ?\e$,1'C\e(B) ("s" ?\e$,1'C\e(B)
- ("t" ?\e$,1'D\e(B)
- ("u" ?\e$,1'E\e(B)
- ("f" ?\e$,1'F\e(B)
- ("x" ?\e$,1'G\e(B)
- ("y" ?\e$,1'H\e(B)
- ("w" ?\e$,1'I\e(B)
-
- ("i+" ?\e$,1'J\e(B)
- ("u+" ?\e$,1'K\e(B)
- ("V" ?\e$,1'\\e(B) ; DIGAMMA
- ("v" ?\e$,1']\e(B) ; digamma
- ("K+" ?\e$,1'^\e(B) ; KOPPA
- ("k+" ?\e$,1'_\e(B) ; koppa
- ("S+" ?\e$,1'`\e(B) ; SAMPI
- ("s+" ?\e$,1'a\e(B) ; sampi
- ("c+" ?\e$,1'r\e(B) ; lunate sigma
-
- ("a)" ?\e$,1p \e(B)
- ("a(" ?\e$,1p!\e(B)
- ("a)`" ?\e$,1p"\e(B)
- ("a(`" ?\e$,1p#\e(B)
- ("a)'" ?\e$,1p$\e(B)
- ("a('" ?\e$,1p%\e(B)
- ("a)=" ?\e$,1p&\e(B)
- ("a(=" ?\e$,1p'\e(B)
-
- (")A" ?\e$,1p(\e(B)
- ("(A" ?\e$,1p)\e(B)
- (")`A" ?\e$,1p*\e(B)
- ("(`A" ?\e$,1p+\e(B)
- (")'A" ?\e$,1p,\e(B)
- ("('A" ?\e$,1p-\e(B)
- (")=A" ?\e$,1p.\e(B)
- ("(=A" ?\e$,1p/\e(B)
-
- ("e)" ?\e$,1p0\e(B)
- ("e(" ?\e$,1p1\e(B)
- ("e)`" ?\e$,1p2\e(B)
- ("e(`" ?\e$,1p3\e(B)
- ("e)'" ?\e$,1p4\e(B)
- ("e('" ?\e$,1p5\e(B)
-
- (")E" ?\e$,1p8\e(B)
- ("(E" ?\e$,1p9\e(B)
- (")`E" ?\e$,1p:\e(B)
- ("(`E" ?\e$,1p;\e(B)
- (")'E" ?\e$,1p<\e(B)
- ("('E" ?\e$,1p=\e(B)
-
- ("h)" ?\e$,1p@\e(B)
- ("h(" ?\e$,1pA\e(B)
- ("h)`" ?\e$,1pB\e(B)
- ("h(`" ?\e$,1pC\e(B)
- ("h)'" ?\e$,1pD\e(B)
- ("h('" ?\e$,1pE\e(B)
- ("h)=" ?\e$,1pF\e(B)
- ("h(=" ?\e$,1pG\e(B)
-
- (")H" ?\e$,1pH\e(B)
- ("(H" ?\e$,1pI\e(B)
- (")`H" ?\e$,1pJ\e(B)
- ("(`H" ?\e$,1pK\e(B)
- (")'H" ?\e$,1pL\e(B)
- ("('H" ?\e$,1pM\e(B)
- (")=H" ?\e$,1pN\e(B)
- ("(=H" ?\e$,1pO\e(B)
-
- ("i)" ?\e$,1pP\e(B)
- ("i(" ?\e$,1pQ\e(B)
- ("i)`" ?\e$,1pR\e(B)
- ("i(`" ?\e$,1pS\e(B)
- ("i)'" ?\e$,1pT\e(B)
- ("i('" ?\e$,1pU\e(B)
- ("i)=" ?\e$,1pV\e(B)
- ("i(=" ?\e$,1pW\e(B)
-
- (")I" ?\e$,1pX\e(B)
- ("(I" ?\e$,1pY\e(B)
- (")`I" ?\e$,1pZ\e(B)
- ("(`I" ?\e$,1p[\e(B)
- (")'I" ?\e$,1p\\e(B)
- ("('I" ?\e$,1p]\e(B)
- (")=I" ?\e$,1p^\e(B)
- ("(=I" ?\e$,1p_\e(B)
-
- ("o)" ?\e$,1p`\e(B)
- ("o(" ?\e$,1pa\e(B)
- ("o)`" ?\e$,1pb\e(B)
- ("o(`" ?\e$,1pc\e(B)
- ("o)'" ?\e$,1pd\e(B)
- ("o('" ?\e$,1pe\e(B)
-
- (")O" ?\e$,1ph\e(B)
- ("(O" ?\e$,1pi\e(B)
- (")`O" ?\e$,1pj\e(B)
- ("(`O" ?\e$,1pk\e(B)
- (")'O" ?\e$,1pl\e(B)
- ("('O" ?\e$,1pm\e(B)
-
- ("u)" ?\e$,1pp\e(B)
- ("u(" ?\e$,1pq\e(B)
- ("u)`" ?\e$,1pr\e(B)
- ("u(`" ?\e$,1ps\e(B)
- ("u)'" ?\e$,1pt\e(B)
- ("u('" ?\e$,1pu\e(B)
- ("u)=" ?\e$,1pv\e(B)
- ("u(=" ?\e$,1pw\e(B)
-
- ("(U" ?\e$,1py\e(B)
- ("(`U" ?\e$,1p{\e(B)
- ("('U" ?\e$,1p}\e(B)
- ("(=U" ?\e$,1p\7f\e(B)
-
- ("w)" ?\e$,1q \e(B)
- ("w(" ?\e$,1q!\e(B)
- ("w)`" ?\e$,1q"\e(B)
- ("w(`" ?\e$,1q#\e(B)
- ("w)'" ?\e$,1q$\e(B)
- ("w('" ?\e$,1q%\e(B)
- ("w)=" ?\e$,1q&\e(B)
- ("w(=" ?\e$,1q'\e(B)
-
- (")W" ?\e$,1q(\e(B)
- ("(W" ?\e$,1q)\e(B)
- (")`W" ?\e$,1q*\e(B)
- ("(`W" ?\e$,1q+\e(B)
- (")'W" ?\e$,1q,\e(B)
- ("('W" ?\e$,1q-\e(B)
- (")=W" ?\e$,1q.\e(B)
- ("(=W" ?\e$,1q/\e(B)
-
- ("a`" ?\e$,1q0\e(B)
- ("a'" ?\e$,1q1\e(B)
- ("e`" ?\e$,1q2\e(B)
- ("e'" ?\e$,1q3\e(B)
- ("h`" ?\e$,1q4\e(B)
- ("h'" ?\e$,1q5\e(B)
- ("i`" ?\e$,1q6\e(B)
- ("i'" ?\e$,1q7\e(B)
- ("o`" ?\e$,1q8\e(B)
- ("o'" ?\e$,1q9\e(B)
- ("u`" ?\e$,1q:\e(B)
- ("u'" ?\e$,1q;\e(B)
- ("w`" ?\e$,1q<\e(B)
- ("w'" ?\e$,1q=\e(B)
-
- ("a)|" ?\e$,1q@\e(B)
- ("a(|" ?\e$,1qA\e(B)
- ("a)`|" ?\e$,1qB\e(B)
- ("a(`|" ?\e$,1qC\e(B)
- ("a)'|" ?\e$,1qD\e(B)
- ("a('|" ?\e$,1qE\e(B)
- ("a)=|" ?\e$,1qF\e(B)
- ("a(=|" ?\e$,1qG\e(B)
-
- (")Ai" ?\e$,1qH\e(B)
- ("(Ai" ?\e$,1qI\e(B)
- (")`Ai" ?\e$,1qJ\e(B)
- ("(`Ai" ?\e$,1qK\e(B)
- (")'Ai" ?\e$,1qL\e(B)
- ("('Ai" ?\e$,1qM\e(B)
- (")=Ai" ?\e$,1qN\e(B)
- ("(=Ai" ?\e$,1qO\e(B)
-
- ("h)|" ?\e$,1qP\e(B)
- ("h(|" ?\e$,1qQ\e(B)
- ("h)`|" ?\e$,1qR\e(B)
- ("h(`|" ?\e$,1qS\e(B)
- ("h)'|" ?\e$,1qT\e(B)
- ("h('|" ?\e$,1qU\e(B)
- ("h)=|" ?\e$,1qV\e(B)
- ("h(=|" ?\e$,1qW\e(B)
-
- (")Hi" ?\e$,1qX\e(B)
- ("(Hi" ?\e$,1qY\e(B)
- (")`Hi" ?\e$,1qZ\e(B)
- ("(`Hi" ?\e$,1q[\e(B)
- (")'Hi" ?\e$,1q\\e(B)
- ("('Hi" ?\e$,1q]\e(B)
- (")=Hi" ?\e$,1q^\e(B)
- ("(=Hi" ?\e$,1q_\e(B)
-
- ("w)|" ?\e$,1q`\e(B)
- ("w(|" ?\e$,1qa\e(B)
- ("w)`|" ?\e$,1qb\e(B)
- ("w(`|" ?\e$,1qc\e(B)
- ("w)'|" ?\e$,1qd\e(B)
- ("w('|" ?\e$,1qe\e(B)
- ("w)=|" ?\e$,1qf\e(B)
- ("w(=|" ?\e$,1qg\e(B)
-
- (")Wi" ?\e$,1qh\e(B)
- ("(Wi" ?\e$,1qi\e(B)
- (")`Wi" ?\e$,1qj\e(B)
- ("(`Wi" ?\e$,1qk\e(B)
- (")'Wi" ?\e$,1ql\e(B)
- ("('Wi" ?\e$,1qm\e(B)
- (")=Wi" ?\e$,1qn\e(B)
- ("(=Wi" ?\e$,1qo\e(B)
-
- ("a`|" ?\e$,1qr\e(B)
- ("a|" ?\e$,1qs\e(B)
- ("a'|" ?\e$,1qt\e(B)
- ("a=" ?\e$,1qv\e(B)
- ("a=|" ?\e$,1qw\e(B)
-
- ("`A" ?\e$,1qz\e(B)
- ("'A" ?\e$,1q{\e(B)
- ("Ai" ?\e$,1q|\e(B)
-
- (")" ?\e$,1q\7f\e(B) ; #x1fbf ; psili
- ("=" ?\e$,1r \e(B) ; #x1fc0 ; perispomeni
- ("+=" ?\e$,1r!\e(B) ; #x1fc1
-
- ("h`|" ?\e$,1r"\e(B)
- ("h|" ?\e$,1r#\e(B)
- ("h'|" ?\e$,1r$\e(B)
- ("h=" ?\e$,1r&\e(B)
- ("h=|" ?\e$,1r'\e(B)
-
- ("`E" ?\e$,1r(\e(B)
- ("'E" ?\e$,1r)\e(B)
-
- ("`H" ?\e$,1r*\e(B)
- ("'H" ?\e$,1r+\e(B)
- ("Hi" ?\e$,1r,\e(B)
-
- (")`" ?\e$,1r-\e(B) ; #x1fcd
- (")'" ?\e$,1r.\e(B) ; #x1fce
- (")=" ?\e$,1r/\e(B) ; #x1fcf
-
- ("i+`" ?\e$,1r2\e(B)
- ("i+'" ?\e$,1r3\e(B)
- ("i=" ?\e$,1r6\e(B)
- ("i+=" ?\e$,1r7\e(B)
-
- ("`I" ?\e$,1r:\e(B)
- ("'I" ?\e$,1r;\e(B)
-
- ("(`" ?\e$,1r=\e(B) ; #x1fdd
- ("('" ?\e$,1r>\e(B) ; #x1fde
- ("(=" ?\e$,1r?\e(B) ; #x1fdf
-
- ("u+`" ?\e$,1rB\e(B)
- ("u+'" ?\e$,1rC\e(B)
-
- ("r)" ?\e$,1rD\e(B)
- ("r(" ?\e$,1rE\e(B)
-
- ("u=" ?\e$,1rF\e(B)
- ("u+=" ?\e$,1rG\e(B)
-
- ("`U" ?\e$,1rJ\e(B)
- ("'U" ?\e$,1rK\e(B)
-
- ("`R" ?\e$,1rL\e(B)
-
- ("+`" ?\e$,1rM\e(B) ; #x1fed
- ("+'" ?\e$,1rN\e(B) ; #x1fee
- ("`" ?\e$,1rO\e(B) ; #x1fef ; varia
-
- ("w`|" ?\e$,1rR\e(B)
- ("w|" ?\e$,1rS\e(B)
- ("w'|" ?\e$,1rT\e(B)
- ("w=" ?\e$,1rV\e(B)
- ("w=|" ?\e$,1rW\e(B)
-
- ("`O" ?\e$,1rX\e(B)
- ("'O" ?\e$,1rY\e(B)
-
- ("`W" ?\e$,1rZ\e(B)
- ("'W" ?\e$,1r[\e(B)
- ("Wi" ?\e$,1r\\e(B)
-
- ("'" ?\e$,1r]\e(B) ; #x1ffd ; oxia
- ("(" ?\e$,1r^\e(B) ; #x1ffe ; dasia
-)
-
-;;
-
(quail-define-package
"greek" "Greek" "\e,FY\e(B" nil
"\e,FEkkgmij\\e(B: Greek keyboard layout (ISO 8859-7)
+++ /dev/null
-;;; quail/latin-ltx.el -- Quail package for Latin scripts
-
-;; Copyright (C) 2001 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-
-;; Keywords: multilingual, input method, Greek
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(require 'quail)
-
-(quail-define-package
- "latin-latex2e" "Latin" "LL" t
- "The LaTeX-like input method for Latin characters.
-The characters in latin-iso8859-1 and mule-unicode-0100-24ff are supported."
- nil t t nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("!`" ?\e,A!\e(B)
- ("{\\pounds}" ?\e,A#\e(B) ("\\pounds" ?\e,A#\e(B)
- ("{\\S}" ?\e,A'\e(B) ("\\S" ?\e,A'\e(B)
- ("\\\"{}" ?\e,A(\e(B)
- ("{\\copyright}" ?\e,A)\e(B) ("\\copyright" ?\e,A)\e(B)
- ("$^a$" ?\e,A*\e(B)
- ("\\={}" ?\e,A/\e(B)
- ("$\\pm$" ?\e,A1\e(B)
- ("$^2$" ?\e,A2\e(B)
- ("$^3$" ?\e,A3\e(B)
- ("\\'{}" ?\e,A4\e(B)
- ("{\\P}" ?\e,A6\e(B) ("\\P" ?\e,A6\e(B)
- ("$\\cdot$" ?\e,A7\e(B)
- ("\\c{}" ?\e,A8\e(B)
- ("$^1$" ?\e,A9\e(B)
- ("$^o$" ?\e,A:\e(B)
- ("?`" ?\e,A?\e(B)
-
- ("\\`{A}" ?\e,A@\e(B) ("\\`A" ?\e,A@\e(B)
- ("\\'{A}" ?\e,AA\e(B) ("\\'A" ?\e,AA\e(B)
- ("\\^{A}" ?\e,AB\e(B) ("\\^A" ?\e,AB\e(B)
- ("\\~{A}" ?\e,AC\e(B) ("\\~A" ?\e,AC\e(B)
- ("\\\"{A}" ?\e,AD\e(B) ("\\\"A" ?\e,AD\e(B)
- ("{\\AA}" ?\e,AE\e(B) ("\\AA" ?\e,AE\e(B)
- ("{\\AE}" ?\e,AF\e(B) ("\\AE" ?\e,AF\e(B)
- ("\\c{C}" ?\e,AG\e(B) ("\\cC" ?\e,AG\e(B)
- ("\\`{E}" ?\e,AH\e(B) ("\\`E" ?\e,AH\e(B)
- ("\\'{E}" ?\e,AI\e(B) ("\\'E" ?\e,AI\e(B)
- ("\\^{E}" ?\e,AJ\e(B) ("\\^E" ?\e,AJ\e(B)
- ("\\\"{E}" ?\e,AK\e(B) ("\\\"E" ?\e,AK\e(B)
- ("\\`{I}" ?\e,AL\e(B) ("\\`I" ?\e,AL\e(B)
- ("\\'{I}" ?\e,AM\e(B) ("\\'I" ?\e,AM\e(B)
- ("\\^{I}" ?\e,AN\e(B) ("\\^I" ?\e,AN\e(B)
- ("\\\"{I}" ?\e,AO\e(B) ("\\\"I" ?\e,AO\e(B)
-
- ("\\~{N}" ?\e,AQ\e(B) ("\\~N" ?\e,AQ\e(B)
- ("\\`{O}" ?\e,AR\e(B) ("\\`O" ?\e,AR\e(B)
- ("\\'{O}" ?\e,AS\e(B) ("\\'O" ?\e,AS\e(B)
- ("\\^{O}" ?\e,AT\e(B) ("\\^O" ?\e,AT\e(B)
- ("\\~{O}" ?\e,AU\e(B) ("\\~O" ?\e,AU\e(B)
- ("\\\"{O}" ?\e,AV\e(B) ("\\\"O" ?\e,AV\e(B)
- ("$\\times$" ?\e,AW\e(B)
- ("{\\O}" ?\e,AX\e(B) ("\\O" ?\e,AX\e(B)
- ("\\`{U}" ?\e,AY\e(B) ("\\`U" ?\e,AY\e(B)
- ("\\'{U}" ?\e,AZ\e(B) ("\\'U" ?\e,AZ\e(B)
- ("\\^{U}" ?\e,A[\e(B) ("\\^U" ?\e,A[\e(B)
- ("\\\"{U}" ?\e,A\\e(B) ("\\\"U" ?\e,A\\e(B)
- ("\\'{Y}" ?\e,A]\e(B) ("\\'Y" ?\e,A]\e(B)
- ("{\\ss}" ?\e,A_\e(B) ("\\ss" ?\e,A_\e(B)
-
- ("\\`{a}" ?\e,A`\e(B) ("\\`a" ?\e,A`\e(B)
- ("\\'{a}" ?\e,Aa\e(B) ("\\'a" ?\e,Aa\e(B)
- ("\\^{a}" ?\e,Ab\e(B) ("\\^a" ?\e,Ab\e(B)
- ("\\~{a}" ?\e,Ac\e(B) ("\\~a" ?\e,Ac\e(B)
- ("\\\"{a}" ?\e,Ad\e(B) ("\\\"a" ?\e,Ad\e(B)
- ("{\\aa}" ?\e,Ae\e(B) ("\\aa" ?\e,Ae\e(B)
- ("{\\ae}" ?\e,Af\e(B) ("\\ae" ?\e,Af\e(B)
- ("\\c{c}" ?\e,Ag\e(B) ("\\cc" ?\e,Ag\e(B)
- ("\\`{e}" ?\e,Ah\e(B) ("\\`e" ?\e,Ah\e(B)
- ("\\'{e}" ?\e,Ai\e(B) ("\\'e" ?\e,Ai\e(B)
- ("\\^{e}" ?\e,Aj\e(B) ("\\^e" ?\e,Aj\e(B)
- ("\\\"{e}" ?\e,Ak\e(B) ("\\\"e" ?\e,Ak\e(B)
- ("\\`{\\i}" ?\e,Al\e(B) ("\\`i" ?\e,Al\e(B)
- ("\\'{\\i}" ?\e,Am\e(B) ("\\'i" ?\e,Am\e(B)
- ("\\^{\\i}" ?\e,An\e(B) ("\\^i" ?\e,An\e(B)
- ("\\\"{\\i}" ?\e,Ao\e(B) ("\\\"i" ?\e,Ao\e(B)
-
- ("\\~{n}" ?\e,Aq\e(B) ("\\~n" ?\e,Aq\e(B)
- ("\\`{o}" ?\e,Ar\e(B) ("\\`o" ?\e,Ar\e(B)
- ("\\'{o}" ?\e,As\e(B) ("\\'o" ?\e,As\e(B)
- ("\\^{o}" ?\e,At\e(B) ("\\^o" ?\e,At\e(B)
- ("\\~{o}" ?\e,Au\e(B) ("\\~o" ?\e,Au\e(B)
- ("\\\"{o}" ?\e,Av\e(B) ("\\\"o" ?\e,Av\e(B)
- ("$\\div$" ?\e,Aw\e(B)
- ("{\\o}" ?\e,Ax\e(B) ("\\o" ?\e,Ax\e(B)
- ("\\`{u}" ?\e,Ay\e(B) ("\\`u" ?\e,Ay\e(B)
- ("\\'{u}" ?\e,Az\e(B) ("\\'u" ?\e,Az\e(B)
- ("\\^{u}" ?\e,A{\e(B) ("\\^u" ?\e,A{\e(B)
- ("\\\"{u}" ?\e,A|\e(B) ("\\\"u" ?\e,A|\e(B)
- ("\\'{y}" ?\e,A}\e(B) ("\\'y" ?\e,A}\e(B)
- ("\\\"{y}" ?\e,A\7f\e(B) ("\\\"y" ?\e,A\7f\e(B)
-
- ("\\={A}" ?\e$,1 \e(B) ("\\=A" ?\e$,1 \e(B)
- ("\\={a}" ?\e$,1 !\e(B) ("\\=a" ?\e$,1 !\e(B)
- ("\\u{A}" ?\e$,1 "\e(B) ("\\uA" ?\e$,1 "\e(B)
- ("\\u{a}" ?\e$,1 #\e(B) ("\\ua" ?\e$,1 #\e(B)
- ("\\'{C}" ?\e$,1 &\e(B) ("\\'C" ?\e$,1 &\e(B)
- ("\\'{c}" ?\e$,1 '\e(B) ("\\'c" ?\e$,1 '\e(B)
- ("\\^{C}" ?\e$,1 (\e(B) ("\\^C" ?\e$,1 (\e(B)
- ("\\^{c}" ?\e$,1 )\e(B) ("\\^c" ?\e$,1 )\e(B)
- ("\\.{C}" ?\e$,1 *\e(B) ("\\.C" ?\e$,1 *\e(B)
- ("\\.{c}" ?\e$,1 +\e(B) ("\\.c" ?\e$,1 +\e(B)
- ("\\v{C}" ?\e$,1 ,\e(B) ("\\vC" ?\e$,1 ,\e(B)
- ("\\v{c}" ?\e$,1 -\e(B) ("\\vc" ?\e$,1 -\e(B)
- ("\\v{D}" ?\e$,1 .\e(B) ("\\vD" ?\e$,1 .\e(B)
- ("\\v{d}" ?\e$,1 /\e(B) ("\\vd" ?\e$,1 /\e(B)
-
- ("\\={E}" ?\e$,1 2\e(B) ("\\=E" ?\e$,1 2\e(B)
- ("\\={e}" ?\e$,1 3\e(B) ("\\=e" ?\e$,1 3\e(B)
- ("\\u{E}" ?\e$,1 4\e(B) ("\\uE" ?\e$,1 4\e(B)
- ("\\u{e}" ?\e$,1 5\e(B) ("\\ue" ?\e$,1 5\e(B)
- ("\\.{E}" ?\e$,1 6\e(B) ("\\.E" ?\e$,1 6\e(B)
- ("\\e{e}" ?\e$,1 7\e(B) ("\\ee" ?\e$,1 7\e(B)
- ("\\v{E}" ?\e$,1 :\e(B) ("\\vE" ?\e$,1 :\e(B)
- ("\\v{e}" ?\e$,1 ;\e(B) ("\\ve" ?\e$,1 ;\e(B)
- ("\\^{G}" ?\e$,1 <\e(B) ("\\^G" ?\e$,1 <\e(B)
- ("\\^{g}" ?\e$,1 =\e(B) ("\\^g" ?\e$,1 =\e(B)
- ("\\u{G}" ?\e$,1 >\e(B) ("\\uG" ?\e$,1 >\e(B)
- ("\\u{g}" ?\e$,1 ?\e(B) ("\\ug" ?\e$,1 ?\e(B)
-
- ("\\.{G}" ?\e$,1 @\e(B) ("\\.G" ?\e$,1 @\e(B)
- ("\\.{g}" ?\e$,1 A\e(B) ("\\.g" ?\e$,1 A\e(B)
- ("\\c{G}" ?\e$,1 B\e(B) ("\\cG" ?\e$,1 B\e(B)
- ("\\c{g}" ?\e$,1 C\e(B) ("\\cg" ?\e$,1 C\e(B)
- ("\\^{H}" ?\e$,1 D\e(B) ("\\^H" ?\e$,1 D\e(B)
- ("\\^{h}" ?\e$,1 E\e(B) ("\\^h" ?\e$,1 E\e(B)
- ("\\~{I}" ?\e$,1 H\e(B) ("\\~I" ?\e$,1 H\e(B)
- ("\\~{\\i}" ?\e$,1 I\e(B) ("\\~i" ?\e$,1 I\e(B)
- ("\\={I}" ?\e$,1 J\e(B) ("\\=I" ?\e$,1 J\e(B)
- ("\\={\\i}" ?\e$,1 K\e(B) ("\\=i" ?\e$,1 K\e(B)
- ("\\u{I}" ?\e$,1 L\e(B) ("\\uI" ?\e$,1 L\e(B)
- ("\\u{\\i}" ?\e$,1 M\e(B) ("\\ui" ?\e$,1 M\e(B)
-
- ("\\.{I}" ?\e$,1 P\e(B) ("\\.I" ?\e$,1 P\e(B)
- ("{\\i}" ?\e$,1 Q\e(B) ("\\i" ?\e$,1 Q\e(B)
- ("\\^{J}" ?\e$,1 T\e(B) ("\\^J" ?\e$,1 T\e(B)
- ("\\^{\\j}" ?\e$,1 U\e(B) ("\\^j" ?\e$,1 U\e(B)
- ("\\c{K}" ?\e$,1 V\e(B) ("\\cK" ?\e$,1 V\e(B)
- ("\\c{k}" ?\e$,1 W\e(B) ("\\ck" ?\e$,1 W\e(B)
- ("\\'{L}" ?\e$,1 Y\e(B) ("\\'L" ?\e$,1 Y\e(B)
- ("\\'{l}" ?\e$,1 Z\e(B) ("\\'l" ?\e$,1 Z\e(B)
- ("\\c{L}" ?\e$,1 [\e(B) ("\\cL" ?\e$,1 [\e(B)
- ("\\c{l}" ?\e$,1 \\e(B) ("\\cl" ?\e$,1 \\e(B)
-
- ("{\\L}" ?\e$,1 a\e(B) ("\\L" ?\e$,1 a\e(B)
- ("{\\l}" ?\e$,1 b\e(B) ("\\l" ?\e$,1 b\e(B)
- ("\\'{N}" ?\e$,1 c\e(B) ("\\'N" ?\e$,1 c\e(B)
- ("\\'{n}" ?\e$,1 d\e(B) ("\\'n" ?\e$,1 d\e(B)
- ("\\c{N}" ?\e$,1 e\e(B) ("\\cN" ?\e$,1 e\e(B)
- ("\\c{n}" ?\e$,1 f\e(B) ("\\cn" ?\e$,1 f\e(B)
- ("\\v{N}" ?\e$,1 g\e(B) ("\\vN" ?\e$,1 g\e(B)
- ("\\v{n}" ?\e$,1 h\e(B) ("\\vn" ?\e$,1 h\e(B)
- ("\\={O}" ?\e$,1 l\e(B) ("\\=O" ?\e$,1 l\e(B)
- ("\\={o}" ?\e$,1 m\e(B) ("\\=o" ?\e$,1 m\e(B)
- ("\\u{O}" ?\e$,1 n\e(B) ("\\uO" ?\e$,1 n\e(B)
- ("\\u{o}" ?\e$,1 o\e(B) ("\\uo" ?\e$,1 o\e(B)
-
- ("\\H{O}" ?\e$,1 p\e(B) ("\\HO" ?\e$,1 p\e(B)
- ("\\U{o}" ?\e$,1 q\e(B) ("\\Uo" ?\e$,1 q\e(B)
- ("{\\OE}" ?\e$,1 r\e(B) ("\\OE" ?\e$,1 r\e(B)
- ("{\\oe}" ?\e$,1 s\e(B) ("\\oe" ?\e$,1 s\e(B)
- ("\\'{R}" ?\e$,1 t\e(B) ("\\'R" ?\e$,1 t\e(B)
- ("\\'{r}" ?\e$,1 u\e(B) ("\\'r" ?\e$,1 u\e(B)
- ("\\c{R}" ?\e$,1 v\e(B) ("\\cR" ?\e$,1 v\e(B)
- ("\\c{r}" ?\e$,1 w\e(B) ("\\cr" ?\e$,1 w\e(B)
- ("\\v{R}" ?\e$,1 x\e(B) ("\\vR" ?\e$,1 x\e(B)
- ("\\v{r}" ?\e$,1 y\e(B) ("\\vr" ?\e$,1 y\e(B)
- ("\\'{S}" ?\e$,1 z\e(B) ("\\'S" ?\e$,1 z\e(B)
- ("\\'{s}" ?\e$,1 {\e(B) ("\\'s" ?\e$,1 {\e(B)
- ("\\^{S}" ?\e$,1 |\e(B) ("\\^S" ?\e$,1 |\e(B)
- ("\\^{s}" ?\e$,1 }\e(B) ("\\^s" ?\e$,1 }\e(B)
- ("\\c{S}" ?\e$,1 ~\e(B) ("\\cS" ?\e$,1 ~\e(B)
- ("\\c{s}" ?\e$,1 \7f\e(B) ("\\cs" ?\e$,1 \7f\e(B)
-
- ("\\v{S}" ?\e$,1! \e(B) ("\\vS" ?\e$,1! \e(B)
- ("\\v{s}" ?\e$,1!!\e(B) ("\\vs" ?\e$,1!!\e(B)
- ("\\c{T}" ?\e$,1!"\e(B) ("\\cT" ?\e$,1!"\e(B)
- ("\\c{t}" ?\e$,1!#\e(B) ("\\ct" ?\e$,1!#\e(B)
- ("\\v{T}" ?\e$,1!$\e(B) ("\\vT" ?\e$,1!$\e(B)
- ("\\v{t}" ?\e$,1!%\e(B) ("\\vt" ?\e$,1!%\e(B)
- ("\\~{U}" ?\e$,1!(\e(B) ("\\~U" ?\e$,1!(\e(B)
- ("\\~{u}" ?\e$,1!)\e(B) ("\\~u" ?\e$,1!)\e(B)
- ("\\={U}" ?\e$,1!*\e(B) ("\\=U" ?\e$,1!*\e(B)
- ("\\={u}" ?\e$,1!+\e(B) ("\\=u" ?\e$,1!+\e(B)
- ("\\u{U}" ?\e$,1!,\e(B) ("\\uU" ?\e$,1!,\e(B)
- ("\\u{u}" ?\e$,1!-\e(B) ("\\uu" ?\e$,1!-\e(B)
-
- ("\\H{U}" ?\e$,1!0\e(B) ("\\HU" ?\e$,1!0\e(B)
- ("\\H{u}" ?\e$,1!1\e(B) ("\\Hu" ?\e$,1!1\e(B)
- ("\\^{W}" ?\e$,1!4\e(B) ("\\^W" ?\e$,1!4\e(B)
- ("\\^{w}" ?\e$,1!5\e(B) ("\\^w" ?\e$,1!5\e(B)
- ("\\^{Y}" ?\e$,1!6\e(B) ("\\^Y" ?\e$,1!6\e(B)
- ("\\^{y}" ?\e$,1!7\e(B) ("\\^y" ?\e$,1!7\e(B)
- ("\\\"{Y}" ?\e$,1!8\e(B) ("\\\"Y" ?\e$,1!8\e(B)
- ("\\'{Z}" ?\e$,1!9\e(B) ("\\'Z" ?\e$,1!9\e(B)
- ("\\'{z}" ?\e$,1!:\e(B) ("\\'z" ?\e$,1!:\e(B)
- ("\\.{Z}" ?\e$,1!;\e(B) ("\\.Z" ?\e$,1!;\e(B)
- ("\\.{z}" ?\e$,1!<\e(B) ("\\.z" ?\e$,1!<\e(B)
- ("\\v{Z}" ?\e$,1!=\e(B) ("\\vZ" ?\e$,1!=\e(B)
- ("\\v{z}" ?\e$,1!>\e(B) ("\\vz" ?\e$,1!>\e(B)
-
- ("\\v{A}" ?\e$,1"-\e(B) ("\\vA" ?\e$,1"-\e(B)
- ("\\v{a}" ?\e$,1".\e(B) ("\\va" ?\e$,1".\e(B)
- ("\\v{I}" ?\e$,1"/\e(B) ("\\vI" ?\e$,1"/\e(B)
- ("\\v{\\i}" ?\e$,1"0\e(B) ("\\vi" ?\e$,1"0\e(B)
- ("\\v{O}" ?\e$,1"1\e(B) ("\\vO" ?\e$,1"1\e(B)
- ("\\v{o}" ?\e$,1"2\e(B) ("\\vo" ?\e$,1"2\e(B)
- ("\\v{U}" ?\e$,1"3\e(B) ("\\vU" ?\e$,1"3\e(B)
- ("\\v{u}" ?\e$,1"4\e(B) ("\\vu" ?\e$,1"4\e(B)
-
- ("\\={\\AE}" ?\e$,1"B\e(B) ("\\=\\AE" ?\e$,1"B\e(B)
- ("\\={\\ae}" ?\e$,1"C\e(B) ("\\=\\ae" ?\e$,1"C\e(B)
- ("\\v{G}" ?\e$,1"F\e(B) ("\\vG" ?\e$,1"F\e(B)
- ("\\v{g}" ?\e$,1"G\e(B) ("\\vg" ?\e$,1"G\e(B)
- ("\\v{K}" ?\e$,1"H\e(B) ("\\vK" ?\e$,1"H\e(B)
- ("\\v{k}" ?k) ("\\vk" ?k)
-
- ("\\v{\\j}" ?\e$,1"P\e(B) ("\\vj" ?\e$,1"P\e(B)
- ("\\'{G}" ?\e$,1"T\e(B) ("\\'G" ?\e$,1"T\e(B)
- ("\\'{g}" ?\e$,1"U\e(B) ("\\'g" ?\e$,1"U\e(B)
- ("\\`{N}" ?\e$,1"X\e(B) ("\\`N" ?\e$,1"X\e(B)
- ("\\`{n}" ?\e$,1"Y\e(B) ("\\`n" ?\e$,1"Y\e(B)
- ("\\'{\\AE}" ?\e$,1"\\e(B) ("\\'\\AE")
- ("\\'{\\ae}" ?\e$,1"]\e(B) ("\\'\\ae" ?\e$,1"]\e(B)
- ("\\'{\\O}" ?\e$,1"^\e(B) ("\\'\\O")
- ("\\'{\\o}" ?\e$,1"_\e(B) ("\\'\\o" ?\e$,1"_\e(B)
-
- ("\\v{H}" ?\e$,1"~\e(B) ("\\vH" ?\e$,1"~\e(B)
- ("\\v{h}" ?\e$,1"\7f\e(B) ("\\vh" ?\e$,1"\7f\e(B)
- ("\\.{A}" ?\e$,1#&\e(B) ("\\.A" ?\e$,1#&\e(B)
- ("\\.{a}" ?\e$,1#'\e(B) ("\\.a" ?\e$,1#'\e(B)
- ("\\c{E}" ?\e$,1#(\e(B) ("\\cE" ?\e$,1#(\e(B)
- ("\\c{e}" ?\e$,1#)\e(B) ("\\ce" ?\e$,1#)\e(B)
- ("\\.{O}" ?\e$,1#.\e(B) ("\\.O" ?\e$,1#.\e(B)
- ("\\.{o}" ?\e$,1#/\e(B) ("\\.o" ?\e$,1#/\e(B)
- ("\\={Y}" ?\e$,1#2\e(B) ("\\=Y" ?\e$,1#2\e(B)
- ("\\={y}" ?\e$,1#3\e(B) ("\\=y" ?\e$,1#3\e(B)
-
- ("\\v{}" ?\e$,1$g\e(B)
- ("\\u{}" ?\e$,1$x\e(B)
- ("\\.{}" ?\e$,1$y\e(B)
- ("\\~{}" ?\e$,1$|\e(B)
- ("\\H{}" ?\e$,1$}\e(B)
-)
-2001-02-05 Andrew Innes <andrewi@gnu.org>
-
- * makefile.w32-in ($(DOC)): Use $(THISDIR) instead of . in
- invocation of make-docfile, to work with Windows 2000.
-
2001-01-31 Dave Love <fx@gnu.org>
* etags.c (in_word_set): Use `static' in definition (for pcc).
+++ /dev/null
-/* env - manipulate environment and execute a program in that environment
- Copyright (C) 1986, 1994 Free Software Foundation, Inc.
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, 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 <stdio.h>
-
-extern int execvp ();
-
-char *xmalloc (), *xrealloc ();
-char *concat ();
-
-extern char **environ;
-
-char **nenv;
-int nenv_size;
-
-char *progname;
-void setenv ();
-void fatal ();
-char *myindex ();
-
-extern char *strerror ();
-
-
-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;
- extern char *strerror ();
-
- environ = nenv;
- (void) execvp (*argv, argv);
-
- fprintf (stderr, "%s: cannot execute `%s': %s\n",
- progname, *argv, strerror (errno));
- 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);
-}
-\f
-
-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;
-}
-\f
-#ifndef HAVE_STRERROR
-char *
-strerror (errnum)
- int errnum;
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-
-#endif /* ! HAVE_STRERROR */
+++ /dev/null
-/* File name wild card expansion for VMS.
- This file is part of the etags program.
- Copyright (C) 1987 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. */
-
-#include <stdio.h>
-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
-
-/* 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;
- }
-
-}
-
-/* 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 <rmsdef.h>
-#include <descrip.h>
-#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);
-}
+++ /dev/null
-/* 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 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public 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 <sys/types.h>
-#include <sys/stat.h>
-#include <stdio.h>
-#include <errno.h>
-
-extern int errno;
-
-char *prog_name;
-
-/* Create directory DIRNAME if it does not exist already.
- Then give permission for everyone to read and search it.
- Return 0 if successful, 1 if not. */
-
-int
-touchy_mkdir (dirname)
- char *dirname;
-{
- struct stat buf;
-
- /* If DIRNAME already exists and is a directory, don't create. */
- if (! (stat (dirname, &buf) >= 0
- && (buf.st_mode & S_IFMT) == S_IFDIR))
- {
- /* Otherwise, try to make it. If DIRNAME exists but isn't a directory,
- this will signal an error. */
- if (mkdir (dirname, 0777) < 0)
- {
- fprintf (stderr, "%s: ", prog_name);
- perror (dirname);
- return 1;
- }
- }
-
- /* Make sure everyone can look at this directory. */
- if (stat (dirname, &buf) < 0)
- {
- fprintf (stderr, "%s: ", prog_name);
- perror (dirname);
- return 1;
- }
- if (chmod (dirname, 0555 | (buf.st_mode & 0777)) < 0)
- {
- fprintf (stderr, "%s: ", prog_name);
- perror (dirname);
- }
-
- return 0;
-}
-
-int
-main (argc, argv)
- int argc;
- char **argv;
-{
- prog_name = *argv;
-
- for (argc--, argv++; argc > 0; argc--, argv++)
- {
- char *dirname = *argv;
- int i;
-
- /* Stop at each slash in dirname and try to create the directory.
- Skip any initial slash. */
- for (i = (dirname[0] == '/') ? 1 : 0; dirname[i]; i++)
- if (dirname[i] == '/')
- {
- dirname[i] = '\0';
- if (touchy_mkdir (dirname) < 0)
- goto next_dirname;
- dirname[i] = '/';
- }
-
- touchy_mkdir (dirname);
-
- next_dirname:
- ;
- }
-
- return 0;
-}
DOC = DOC
$(DOC): $(BLD)/make-docfile.exe
- $(DEL) $(DOC)
- "$(THISDIR)/$(BLD)/make-docfile" -d ../src $(obj) > $(DOC)
- "$(THISDIR)/$(BLD)/make-docfile" -d ../src $(lisp) >> $(DOC)
+ "./$(BLD)/make-docfile" -d ../src $(obj) > $(DOC)
+ "./$(BLD)/make-docfile" -d ../src $(lisp) >> $(DOC)
$(CP) $(DOC) ../etc/DOC-X
- mkdir "../src/$(OBJDIR)"
- mkdir "../src/$(OBJDIR)/etc"
+++ /dev/null
-#! /bin/sh
-
-# RCS to ChangeLog generator
-
-# Generate a change log prefix from RCS files (perhaps in the CVS repository)
-# 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 `}'.
-
-Help='The default FILEs are the files registered under the working directory.
-Options:
-
- -c CHANGELOG Output a change log prefix to CHANGELOG (default ChangeLog).
- -h HOSTNAME Use HOSTNAME in change log entries (default current host).
- -i INDENT Indent change log lines by INDENT spaces (default 8).
- -l LENGTH Try to limit log lines to LENGTH characters (default 79).
- -R If no FILEs are given and RCS is used, recurse through working directory.
- -r OPTION Pass OPTION to subsidiary log command.
- -t TABWIDTH Tab stops are every TABWIDTH characters (default 8).
- -u "LOGIN<tab>FULLNAME<tab>MAILADDR" Assume LOGIN has FULLNAME and MAILADDR.
- -v Append RCS revision to file names in log lines.
- --help Output help.
- --version Output version number.
-
-Report bugs to <bug-gnu-emacs@gnu.org>.'
-
-Id='$Id: rcs2log,v 1.46 2001/01/02 18:50:14 eggert Exp $'
-
-# Copyright 1992, 93, 94, 95, 96, 97, 1998 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, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-Copyright='Copyright 1998 Free Software Foundation, Inc.
-This program comes with NO WARRANTY, to the extent permitted by law.
-You may redistribute copies of this program
-under the terms of the GNU General Public License.
-For more information about these matters, see the files named COPYING.
-Author: Paul Eggert <eggert@twinsun.com>'
-
-tab=' '
-nl='
-'
-
-# Parse options.
-
-# defaults
-: ${AWK=awk}
-: ${TMPDIR=/tmp}
-changelog=ChangeLog # change log file name
-datearg= # rlog date option
-hostname= # name of local host (if empty, will deduce it later)
-indent=8 # indent of log line
-length=79 # suggested max width of log line
-logins= # login names for people we know fullnames and mailaddrs of
-loginFullnameMailaddrs= # login<tab>fullname<tab>mailaddr triplets
-logTZ= # time zone for log dates (if empty, use local time)
-recursive= # t if we want recursive rlog
-revision= # t if we want revision numbers
-rlog_options= # options to pass to rlog
-tabwidth=8 # width of horizontal tab
-
-while :
-do
- case $1 in
- -c) changelog=${2?}; shift;;
- -i) indent=${2?}; shift;;
- -h) hostname=${2?}; shift;;
- -l) length=${2?}; shift;;
- -[nu]) # -n is obsolescent; it is replaced by -u.
- case $1 in
- -n) case ${2?}${3?}${4?} in
- *"$tab"* | *"$nl"*)
- echo >&2 "$0: -n '$2' '$3' '$4': tabs, newlines not allowed"
- exit 1
- esac
- case $loginFullnameMailaddrs in
- '') loginFullnameMailaddrs=$2$tab$3$tab$4;;
- ?*) loginFullnameMailaddrs=$loginFullnameMailaddrs$nl$2$tab$3$tab$4
- esac
- shift; shift; shift;;
- -u)
- # If $2 is not tab-separated, use colon for separator.
- case ${2?} in
- *"$nl"*)
- echo >&2 "$0: -u '$2': newlines not allowed"
- exit 1;;
- *"$tab"*)
- t=$tab;;
- *)
- t=:
- esac
- case $2 in
- *"$t"*"$t"*"$t"*)
- echo >&2 "$0: -u '$2': too many fields"
- exit 1;;
- *"$t"*"$t"*)
- ;;
- *)
- echo >&2 "$0: -u '$2': not enough fields"
- exit 1
- esac
- case $loginFullnameMailaddrs in
- '') loginFullnameMailaddrs=$2;;
- ?*) loginFullnameMailaddrs=$loginFullnameMailaddrs$nl$2
- esac
- shift
- esac
- case $logins in
- '') logins=$login;;
- ?*) logins=$logins$nl$login
- esac
- ;;
- -r)
- case $rlog_options in
- '') rlog_options=${2?};;
- ?*) rlog_options=$rlog_options$nl${2?}
- esac
- shift;;
- -R) recursive=t;;
- -t) tabwidth=${2?}; shift;;
- -v) revision=t;;
- --version)
- set $Id
- rcs2logVersion=$3
- echo >&2 "rcs2log (GNU Emacs) $rcs2logVersion$nl$Copyright"
- exit 0;;
- -*) echo >&2 "Usage: $0 [OPTION]... [FILE ...]$nl$Help"
- case $1 in
- --help) exit 0;;
- *) exit 1
- esac;;
- *) break
- esac
- shift
-done
-
-month_data='
- m[0]="Jan"; m[1]="Feb"; m[2]="Mar"
- m[3]="Apr"; m[4]="May"; m[5]="Jun"
- m[6]="Jul"; m[7]="Aug"; m[8]="Sep"
- m[9]="Oct"; m[10]="Nov"; m[11]="Dec"
-'
-
-
-# Put rlog output into $rlogout.
-
-# If no rlog options are given,
-# log the revisions checked in since the first ChangeLog entry.
-# Since ChangeLog is only by date, some of these revisions may be duplicates of
-# what's already in ChangeLog; it's the user's responsibility to remove them.
-case $rlog_options in
-'')
- if test -s "$changelog"
- then
- e='
- /^[0-9]+-[0-9][0-9]-[0-9][0-9]/{
- # ISO 8601 date
- print $1
- exit
- }
- /^... ... [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]:[0-9][0-9] [0-9]+ /{
- # old-fashioned date and time (Emacs 19.31 and earlier)
- '"$month_data"'
- year = $5
- for (i=0; i<=11; i++) if (m[i] == $2) break
- dd = $3
- printf "%d-%02d-%02d\n", year, i+1, dd
- exit
- }
- '
- d=`$AWK "$e" <"$changelog"` || exit
- case $d in
- ?*) datearg="-d>$d"
- esac
- fi
-esac
-
-# Use TZ specified by ChangeLog local variable, if any.
-if test -s "$changelog"
-then
- extractTZ='
- /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*"\([^"]*\)".*/{
- s//\1/; p; q
- }
- /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*t.*/{
- s//UTC0/; p; q
- }
- '
- logTZ=`tail "$changelog" | sed -n "$extractTZ"`
- case $logTZ in
- ?*) TZ=$logTZ; export TZ
- esac
-fi
-
-# If CVS is in use, examine its repository, not the normal RCS files.
-if test ! -f CVS/Repository
-then
- rlog=rlog
- repository=
-else
- rlog='cvs -q log'
- repository=`sed 1q <CVS/Repository` || exit
- test ! -f CVS/Root || CVSROOT=`cat <CVS/Root` || exit
- case $CVSROOT in
- *:/*)
- # remote repository
- ;;
- *)
- # local repository
- case $repository in
- /*) ;;
- *) repository=${CVSROOT?}/$repository
- esac
- if test ! -d "$repository"
- then
- echo >&2 "$0: $repository: bad repository (see CVS/Repository)"
- exit 1
- fi
- esac
-fi
-
-# Use $rlog's -zLT option, if $rlog supports it.
-case `$rlog -zLT 2>&1` in
-*' option'*) ;;
-*)
- case $rlog_options in
- '') rlog_options=-zLT;;
- ?*) rlog_options=-zLT$nl$rlog_options
- esac
-esac
-
-# With no arguments, examine all files under the RCS directory.
-case $# in
-0)
- case $repository in
- '')
- oldIFS=$IFS
- IFS=$nl
- case $recursive in
- t)
- RCSdirs=`find . -name RCS -type d -print`
- filesFromRCSfiles='s|,v$||; s|/RCS/|/|; s|^\./||'
- files=`
- {
- case $RCSdirs in
- ?*) find $RCSdirs \
- -type f \
- ! -name '*_' \
- ! -name ',*,' \
- ! -name '.*_' \
- ! -name .rcsfreeze.log \
- ! -name .rcsfreeze.ver \
- -print
- esac
- find . -name '*,v' -print
- } |
- sort -u |
- sed "$filesFromRCSfiles"
- `;;
- *)
- files=
- for file in RCS/.* RCS/* .*,v *,v
- do
- case $file in
- RCS/. | RCS/.. | RCS/,*, | RCS/*_) continue;;
- RCS/.rcsfreeze.log | RCS/.rcsfreeze.ver) continue;;
- RCS/.\* | RCS/\* | .\*,v | \*,v) test -f "$file" || continue;;
- RCS/*,v | RCS/.*,v) ;;
- RCS/* | RCS/.*) test -f "$file" || continue
- esac
- case $files in
- '') files=$file;;
- ?*) files=$files$nl$file
- esac
- done
- case $files in
- '') exit 0
- esac
- esac
- set x $files
- shift
- IFS=$oldIFS
- esac
-esac
-
-logdir=$TMPDIR/rcs2log$$
-llogout=$logdir/l
-rlogout=$logdir/r
-trap exit 1 2 13 15
-trap "rm -fr $logdir 2>/dev/null" 0
-(umask 077 && exec mkdir $logdir) || exit
-
-case $datearg in
-?*) $rlog $rlog_options "$datearg" ${1+"$@"} >$rlogout;;
-'') $rlog $rlog_options ${1+"$@"} >$rlogout
-esac || exit
-
-
-# Get the full name of each author the logs mention, and set initialize_fullname
-# to awk code that initializes the `fullname' awk associative array.
-# Warning: foreign authors (i.e. not known in the passwd file) are mishandled;
-# you have to fix the resulting output by hand.
-
-initialize_fullname=
-initialize_mailaddr=
-
-case $loginFullnameMailaddrs in
-?*)
- case $loginFullnameMailaddrs in
- *\"* | *\\*)
- sed 's/["\\]/\\&/g' >$llogout <<EOF || exit
-$loginFullnameMailaddrs
-EOF
- loginFullnameMailaddrs=`cat $llogout`
- esac
-
- oldIFS=$IFS
- IFS=$nl
- for loginFullnameMailaddr in $loginFullnameMailaddrs
- do
- case $loginFullnameMailaddr in
- *"$tab"*) IFS=$tab;;
- *) IFS=:
- esac
- set x $loginFullnameMailaddr
- login=$2
- fullname=$3
- mailaddr=$4
- initialize_fullname="$initialize_fullname
- fullname[\"$login\"] = \"$fullname\""
- initialize_mailaddr="$initialize_mailaddr
- mailaddr[\"$login\"] = \"$mailaddr\""
- done
- IFS=$oldIFS
-esac
-
-case $llogout in
-?*) sort -u -o $llogout <<EOF || exit
-$logins
-EOF
-esac
-output_authors='/^date: / {
- if ($2 ~ /^[0-9]*[-\/][0-9][0-9][-\/][0-9][0-9]$/ && $3 ~ /^[0-9][0-9]:[0-9][0-9]:[0-9][0-9][-+0-9:]*;$/ && $4 == "author:" && $5 ~ /^[^;]*;$/) {
- print substr($5, 1, length($5)-1)
- }
-}'
-authors=`
- $AWK "$output_authors" <$rlogout |
- case $llogout in
- '') sort -u;;
- ?*) sort -u | comm -23 - $llogout
- esac
-`
-case $authors in
-?*)
- cat >$llogout <<EOF || exit
-$authors
-EOF
- initialize_author_script='s/["\\]/\\&/g; s/.*/author[\"&\"] = 1/'
- initialize_author=`sed -e "$initialize_author_script" <$llogout`
- awkscript='
- BEGIN {
- alphabet = "abcdefghijklmnopqrstuvwxyz"
- ALPHABET = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- '"$initialize_author"'
- }
- {
- if (author[$1]) {
- fullname = $5
- if (fullname ~ /[0-9]+-[^(]*\([0-9]+\)$/) {
- # Remove the junk from fullnames like "0000-Admin(0000)".
- fullname = substr(fullname, index(fullname, "-") + 1)
- fullname = substr(fullname, 1, index(fullname, "(") - 1)
- }
- if (fullname ~ /,[^ ]/) {
- # Some sites put comma-separated junk after the fullname.
- # Remove it, but leave "Bill Gates, Jr" alone.
- fullname = substr(fullname, 1, index(fullname, ",") - 1)
- }
- abbr = index(fullname, "&")
- if (abbr) {
- a = substr($1, 1, 1)
- A = a
- i = index(alphabet, a)
- if (i) A = substr(ALPHABET, i, 1)
- fullname = substr(fullname, 1, abbr-1) A substr($1, 2) substr(fullname, abbr+1)
- }
-
- # Quote quotes and backslashes properly in full names.
- # Do not use gsub; traditional awk lacks it.
- quoted = ""
- rest = fullname
- for (;;) {
- p = index(rest, "\\")
- q = index(rest, "\"")
- if (p) {
- if (q && q<p) p = q
- } else {
- if (!q) break
- p = q
- }
- quoted = quoted substr(rest, 1, p-1) "\\" substr(rest, p, 1)
- rest = substr(rest, p+1)
- }
-
- printf "fullname[\"%s\"] = \"%s%s\"\n", $1, quoted, rest
- author[$1] = 0
- }
- }
- '
-
- initialize_fullname=`
- {
- (getent passwd $authors) ||
- (
- cat /etc/passwd
- for author in $authors
- do NIS_PATH= nismatch $author passwd.org_dir
- done
- ypmatch $authors passwd
- )
- } 2>/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 \001).
-# `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, SOH)) sep = "\n" indent_string
-
- # Print the label.
- printf "%s*%s:", indent_string, files
-
- # Print each line of the log, transliterating \001 to \n.
- while ((i = index(Log, SOH)) != 0) {
- logline = substr(Log, 1, i-1)
- if (logline ~ /[^'"$tab"' ]/) {
- printf "%s%s\n", sep, logline
- } else {
- print ""
- }
- sep = indent_string
- Log = substr(Log, i+1)
- }
-}'
-
-# Pattern to match the `revision' line of rlog output.
-rlog_revision_pattern='^revision [0-9]+\.[0-9]+(\.[0-9]+\.[0-9]+)*(['"$tab"' ]+locked by: [^'"$tab"' $,.0-9:;@]*[^'"$tab"' $,:;@][^'"$tab"' $,.0-9:;@]*;)?['"$tab"' ]*$'
-
-case $hostname in
-'')
- hostname=`(
- hostname || uname -n || uuname -l || cat /etc/whoami
- ) 2>/dev/null` || {
- echo >&2 "$0: cannot deduce hostname"
- exit 1
- }
-
- case $hostname in
- *.*) ;;
- *)
- domainname=`(domainname) 2>/dev/null` &&
- case $domainname in
- *.*) hostname=$hostname.$domainname
- esac
- esac
-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 \001 so that multiline entries fit on a single line.
-# Discard irrelevant rlog output.
-$AWK <$rlogout '
- BEGIN { repository = "'"$repository"'" }
- /^RCS file:/ {
- if (repository != "") {
- filename = $3
- if (substr(filename, 1, length(repository) + 1) == repository "/") {
- filename = substr(filename, length(repository) + 2)
- }
- if (filename ~ /,v$/) {
- filename = substr(filename, 1, length(filename) - 2)
- }
- if (filename ~ /(^|\/)Attic\/[^\/]*$/) {
- i = length(filename)
- while (substr(filename, i, 1) != "/") i--
- filename = substr(filename, 1, i - 6) substr(filename, i + 1)
- }
- }
- rev = "?"
- }
- /^Working file:/ { if (repository == "") filename = $3 }
- /'"$rlog_revision_pattern"'/, /^(-----------*|===========*)$/ {
- line = $0
- if (line ~ /'"$rlog_revision_pattern"'/) {
- rev = $2
- next
- }
- if (line ~ /^date: [0-9][- +\/0-9:]*;/) {
- date = $2
- if (date ~ /\//) {
- # This is a traditional RCS format date YYYY/MM/DD.
- # Replace "/"s with "-"s to get ISO format.
- newdate = ""
- while ((i = index(date, "/")) != 0) {
- newdate = newdate substr(date, 1, i-1) "-"
- date = substr(date, i+1)
- }
- date = newdate date
- }
- time = substr($3, 1, length($3) - 1)
- author = substr($5, 1, length($5)-1)
- printf "%s %s %s %s %s %c", filename, rev, date, time, author, 1
- rev = "?"
- next
- }
- if (line ~ /^branches: /) { next }
- if (line ~ /^(-----------*|===========*)$/) { print ""; next }
- if (line == "Initial revision" || line ~ /^file .+ was initially added on branch .+\.$/) {
- line = "New file."
- }
- printf "%s%c", line, 1
- }
-' |
-
-# Now each line is of the form
-# FILENAME REVISION YYYY-MM-DD HH:MM:SS[+-TIMEZONE] AUTHOR \001LOG
-# where \001 stands for a carriage return,
-# and each line of the log is terminated by \001 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 and revision
-# (just in case).
-sort +2 -4r +4 +0 |
-
-# Finally, reformat the sorted log entries.
-$AWK '
- BEGIN {
- logTZ = "'"$logTZ"'"
- revision = "'"$revision"'"
-
- # Some awk variants do not understand "\001", so we have to
- # put the char directly in the file.
- SOH="\ 1" # <-- There is a single SOH (octal code 001) 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 " "
- }
-
- {
- newlog = substr($0, 1 + index($0, SOH))
-
- # Ignore log entries prefixed by "#".
- if (newlog ~ /^#/) { next }
-
- if (Log != newlog || date != $3 || author != $5) {
-
- # The previous log and this log differ.
-
- # Print the old log.
- if (date != "") '"$printlogline"'
-
- # Logs that begin with "{clumpname} " should be grouped together,
- # and the clumpname should be removed.
- # Extract the new clumpname from the log header,
- # and use it to decide whether to output a blank line.
- newclumpname = ""
- sep = "\n"
- if (date == "") sep = ""
- if (newlog ~ /^\{[^'"$tab"' }]*}['"$tab"' ]/) {
- i = index(newlog, "}")
- newclumpname = substr(newlog, 1, i)
- while (substr(newlog, i+1) ~ /^['"$tab"' ]/) i++
- newlog = substr(newlog, i+1)
- if (clumpname == newclumpname) sep = ""
- }
- printf sep
- clumpname = newclumpname
-
- # Get ready for the next log.
- Log = newlog
- if (files != "")
- for (i in filesknown)
- filesknown[i] = 0
- files = ""
- }
- if (date != $3 || author != $5) {
- # The previous date+author and this date+author differ.
- # Print the new one.
- date = $3
- time = $4
- author = $5
-
- zone = ""
- if (logTZ && ((i = index(time, "-")) || (i = index(time, "+"))))
- zone = " " substr(time, i)
-
- # Print "date[ timezone] 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 %s ", date, zone, 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
- if (revision && $2 != "?") files = files " " $2
- }
- }
- END {
- # Print the last log.
- if (date != "") {
- '"$printlogline"'
- printf "\n"
- }
- }
-' &&
-
-
-# Exit successfully.
-
-exec rm -fr $logdir
-
-# Local Variables:
-# tab-width:4
-# End:
+++ /dev/null
-/* timer.c --- daemon to provide a tagged interval timer service
-
- This little daemon runs forever waiting for commands to schedule events.
- SIGALRM causes
- it to check its queue for events attached to the current second; if
- one is found, its label is written to stdout. SIGTERM causes it to
- terminate, printing a list of pending events.
-
- This program is intended to be used with the lisp package called
- timer.el. The first such program was written anonymously in 1990.
- This version was documented and rewritten for portability by
- esr@snark.thyrsus.com, Aug 7 1992. */
-
-#include <stdio.h>
-#include <signal.h>
-#include <errno.h>
-#include <sys/types.h> /* time_t */
-
-#include <../src/config.h>
-#undef read
-
-#ifdef LINUX
-/* Perhaps this is correct unconditionally. */
-#undef signal
-#endif
-#ifdef _CX_UX
-/* I agree with the comment above, this probably should be unconditional (it
- * is already unconditional in a couple of other files in this directory),
- * but in the spirit of minimizing the effects of my port, I am making it
- * conditional on _CX_UX.
- */
-#undef signal
-#endif
-
-
-extern int errno;
-extern char *strerror ();
-extern time_t time ();
-
-/*
- * The field separator for input. This character shouldn't occur in dates,
- * and should be printable so event strings are readable by people.
- */
-#define FS '@'
-
-struct event
- {
- char *token;
- time_t reply_at;
- };
-int events_size; /* How many slots have we allocated? */
-int num_events; /* How many are actually scheduled? */
-struct event *events; /* events[0 .. num_events-1] are the
- valid events. */
-
-char *pname; /* program name for error messages */
-
-/* This buffer is used for reading commands.
- We make it longer when necessary, but we never free it. */
-char *buf;
-/* This is the allocated size of buf. */
-int buf_size;
-
-/* Non-zero means don't handle an alarm now;
- instead, just set alarm_deferred if an alarm happens.
- We set this around parts of the program that call malloc and free. */
-int defer_alarms;
-
-/* Non-zero if an alarm came in during the reading of a command. */
-int alarm_deferred;
-\f
-/* Schedule one event, and arrange an alarm for it.
- STR is a string of two fields separated by FS.
- First field is string for get_date, saying when to wake-up.
- Second field is a token to identify the request. */
-
-void
-schedule (str)
- char *str;
-{
- extern time_t get_date ();
- extern char *strcpy ();
- time_t now;
- register char *p;
- static struct event *ep;
-
- /* check entry format */
- for (p = str; *p && *p != FS; p++)
- continue;
- if (!*p)
- {
- fprintf (stderr, "%s: bad input format: %s\n", pname, str);
- return;
- }
- *p++ = 0;
-
- /* allocate an event slot */
- ep = events + num_events;
-
- /* If the event array is full, stretch it. After stretching, we know
- that ep will be pointing to an available event spot. */
- if (ep == events + events_size)
- {
- int old_size = events_size;
-
- events_size *= 2;
- events = ((struct event *)
- realloc (events, events_size * sizeof (struct event)));
- if (! events)
- {
- fprintf (stderr, "%s: virtual memory exhausted.\n", pname);
- /* Since there is so much virtual memory, and running out
- almost surely means something is very very wrong,
- it is best to exit rather than continue. */
- exit (1);
- }
-
- while (old_size < events_size)
- events[old_size++].token = NULL;
- }
-
- /* Don't allow users to schedule events in past time. */
- ep->reply_at = get_date (str, NULL);
- if (ep->reply_at - time (&now) < 0)
- {
- fprintf (stderr, "%s: bad time spec: %s%c%s\n", pname, str, FS, p);
- return;
- }
-
- /* save the event description */
- ep->token = (char *) malloc ((unsigned) strlen (p) + 1);
- if (! ep->token)
- {
- fprintf (stderr, "%s: malloc %s: %s%c%s\n",
- pname, strerror (errno), str, FS, p);
- return;
- }
-
- strcpy (ep->token, p);
- num_events++;
-}
-\f
-/* Print the notification for the alarmed event just arrived if any,
- and schedule an alarm for the next event if any. */
-
-void
-notify ()
-{
- time_t now, tdiff, waitfor = -1;
- register struct event *ep;
-
- /* Inhibit interference with alarms while changing global vars. */
- defer_alarms = 1;
- alarm_deferred = 0;
-
- now = time ((time_t *) NULL);
-
- for (ep = events; ep < events + num_events; ep++)
- /* Are any events ready to fire? */
- if (ep->reply_at <= now)
- {
- fputs (ep->token, stdout);
- putc ('\n', stdout);
- fflush (stdout);
- free (ep->token);
-
- /* We now have a hole in the event array; fill it with the last
- event. */
- ep->token = events[num_events - 1].token;
- ep->reply_at = events[num_events - 1].reply_at;
- num_events--;
-
- /* We ought to scan this event again. */
- ep--;
- }
- else
- {
- /* next timeout should be the soonest of any remaining */
- if ((tdiff = ep->reply_at - now) < waitfor || waitfor < 0)
- waitfor = (long)tdiff;
- }
-
- /* If there are no more events, we needn't bother setting an alarm. */
- if (num_events > 0)
- alarm (waitfor);
-
- /* Now check if there was another alarm
- while we were handling an explicit request. */
- defer_alarms = 0;
- if (alarm_deferred)
- notify ();
- alarm_deferred = 0;
-}
-\f
-/* Read one command from command from standard input
- and schedule the event for it. */
-
-void
-getevent ()
-{
- int i;
-
- /* In principle the itimer should be disabled on entry to this
- function, but it really doesn't make any important difference
- if it isn't. */
-
- if (buf == 0)
- {
- buf_size = 80;
- buf = (char *) malloc (buf_size);
- }
-
- /* Read a line from standard input, expanding buf if it is too short
- to hold the line. */
- for (i = 0; ; i++)
- {
- char c;
- int nread;
-
- if (i >= buf_size)
- {
- buf_size *= 2;
- alarm_deferred = 0;
- defer_alarms = 1;
- buf = (char *) realloc (buf, buf_size);
- defer_alarms = 0;
- if (alarm_deferred)
- notify ();
- alarm_deferred = 0;
- }
-
- /* Read one character into c. */
- while (1)
- {
- nread = read (fileno (stdin), &c, 1);
-
- /* Retry after transient error. */
- if (nread < 0
- && (1
-#ifdef EINTR
- || errno == EINTR
-#endif
-#ifdef EAGAIN
- || errno == EAGAIN
-#endif
- ))
- continue;
-
- /* Report serious errors. */
- if (nread < 0)
- {
- perror ("read");
- exit (1);
- }
-
- /* On eof, exit. */
- if (nread == 0)
- exit (0);
-
- break;
- }
-
- if (c == '\n')
- {
- buf[i] = '\0';
- break;
- }
-
- buf[i] = c;
- }
-
- /* Register the event. */
- alarm_deferred = 0;
- defer_alarms = 1;
- schedule (buf);
- defer_alarms = 0;
- notify ();
- alarm_deferred = 0;
-}
-
-/* Handle incoming signal SIG. */
-
-SIGTYPE
-sigcatch (sig)
- int sig;
-{
- struct event *ep;
-
- /* required on older UNIXes; harmless on newer ones */
- signal (sig, sigcatch);
-
- switch (sig)
- {
- case SIGALRM:
- if (defer_alarms)
- alarm_deferred = 1;
- else
- notify ();
- break;
- case SIGTERM:
- fprintf (stderr, "Events still queued:\n");
- for (ep = events; ep < events + num_events; ep++)
- fprintf (stderr, "%d = %ld @ %s\n",
- ep - events, ep->reply_at, ep->token);
- exit (0);
- break;
- }
-}
-
-/*ARGSUSED*/
-int
-main (argc, argv)
- int argc;
- char **argv;
-{
- for (pname = argv[0] + strlen (argv[0]);
- *pname != '/' && pname != argv[0];
- pname--);
- if (*pname == '/')
- pname++;
-
- events_size = 16;
- events = ((struct event *) malloc (events_size * sizeof (*events)));
- num_events = 0;
-
- signal (SIGALRM, sigcatch);
- signal (SIGTERM, sigcatch);
-
- /* Loop reading commands from standard input
- and scheduling alarms accordingly.
- The alarms are handled asynchronously, while we wait for commands. */
- while (1)
- getevent ();
-}
-\f
-#ifndef HAVE_STRERROR
-char *
-strerror (errnum)
- int errnum;
-{
- extern char *sys_errlist[];
- extern int sys_nerr;
-
- if (errnum >= 0 && errnum < sys_nerr)
- return sys_errlist[errnum];
- return (char *) "Unknown error";
-}
-
-#endif /* ! HAVE_STRERROR */
-
-long *
-xmalloc (size)
- int size;
-{
- register long *val;
-
- val = (long *) malloc (size);
-
- if (!val && size)
- {
- fprintf (stderr, "timer: virtual memory exceeded\n");
- exit (1);
- }
-
- return val;
-}
-
-/* timer.c ends here */
+++ /dev/null
-/* Program to produce output at regular intervals. */
-
-#ifdef HAVE_CONFIG_H
-#include <config.h>
-#endif
-
-#include <stdio.h>
-#include <sys/types.h>
-
-#ifdef TIME_WITH_SYS_TIME
-#include <sys/time.h>
-#include <time.h>
-#else
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#else
-#include <time.h>
-#endif
-#endif
-
-struct tm *localtime ();
-
-void
-main (argc, argv)
- int argc;
- char **argv;
-{
- int period = 60;
- time_t when;
- struct tm *tp;
-
- if (argc > 1)
- period = atoi (argv[1]);
-
- while (1)
- {
- /* Make sure wakeup stops when Emacs goes away. */
- if (getppid () == 1)
- exit (0);
- printf ("Wake up!\n");
- fflush (stdout);
- /* If using a period of 60, produce the output when the minute
- changes. */
- if (period == 60)
- {
- time (&when);
- tp = localtime (&when);
- sleep (60 - tp->tm_sec);
- }
- else
- sleep (period);
- }
-}
+++ /dev/null
-;;; ada.el --- Ada editing support package in GNUlisp. v1.0
-
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
-
-;; Author: Vincent Broman <broman@bugs.nosc.mil>
-;; 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:
-
-(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 ?- ". 12" 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 ?\n ">" table)
- (setq ada-mode-syntax-table table))
-
-;; Strings are a real pain in Ada because both ' and " can appear in a
-;; non-string quote context (the former as an operator, the latter as a
-;; character string). We follow the least losing solution, in which only " is
-;; a string quote. Therefore a character string of the form '"' will throw
-;; fontification off on the wrong track.
-
-(defconst ada-font-lock-keywords-1
- (list
- ;;
- ;; Function, package (body), pragma, procedure, task (body) plus name.
- (list (concat "\\<\\("
- "function\\|"
- "p\\(ackage\\(\\|[ \t]+body\\)\\|r\\(agma\\|ocedure\\)\\)\\|"
- "task\\(\\|[ \t]+body\\)"
- "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
- '(1 font-lock-keyword-face) '(6 font-lock-function-name-face nil t)))
- "For consideration as a value of `ada-font-lock-keywords'.
-This does fairly subdued highlighting.")
-
-(defconst ada-font-lock-keywords-2
- (append ada-font-lock-keywords-1
- (list
- ;;
- ;; Main keywords, except those treated specially below.
- (concat "\\<\\("
-; ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
-; "and" "array" "at" "begin" "case" "declare" "delay" "delta"
-; "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
-; "generic" "if" "in" "is" "limited" "loop" "mod" "not"
-; "null" "or" "others" "private" "protected"
-; "range" "record" "rem" "renames" "requeue" "return" "reverse"
-; "select" "separate" "tagged" "task" "terminate" "then" "until"
-; "while" "xor")
- "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
- "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
- "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
- "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
- "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
- "o\\(r\\|thers\\)\\|pr\\(ivate\\|otected\\)\\|"
- "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
- "se\\(lect\\|parate\\)\\|"
- "t\\(a\\(gged\\|sk\\)\\|erminate\\|hen\\)\\|until\\|while\\|xor"
- "\\)\\>")
- ;;
- ;; Anything following end and not already fontified is a body name.
- '("\\<\\(end\\)\\>[ \t]*\\(\\sw+\\)?"
- (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-; ;;
-; ;; Variable name plus optional keywords followed by a type name. Slow.
-; (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:"
-; "[ \t]*\\(constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
-; "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-; '(1 font-lock-variable-name-face)
-; '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
- ;;
- ;; Optional keywords followed by a type name.
- (list (concat ":[ \t]*\\<\\(constant\\|in\\|in[ \t]+out\\|out\\)\\>?[ \t]*"
- "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
- '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
- ;;
- ;; Keywords followed by a type or function name.
- (list (concat "\\<\\("
- "new\\|of\\|subtype\\|type"
- "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
- '(1 font-lock-keyword-face)
- '(2 (if (match-beginning 4)
- font-lock-function-name-face
- font-lock-type-face) nil t))
- ;;
- ;; Keywords followed by a reference.
- (list (concat "\\<\\(goto\\|raise\\|use\\|when\\|with\\)\\>"
- "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
- '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
- ;;
- ;; Goto tags.
- '("<<\\(\\sw+\\(\\.\\sw*\\)*\\)>>" 1 font-lock-reference-face)
- ))
- "For consideration as a value of `ada-font-lock-keywords'.
-This does a lot more highlighting.")
-
-(defvar ada-font-lock-keywords (if font-lock-maximum-decoration
- ada-font-lock-keywords-2
- ada-font-lock-keywords-1)
- "Additional expressions to highlight in Ada mode.")
-
-(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.")
-
-(defvar ada-comment-end-column)
-
-(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-mode-map>\\[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 'ada-comment-end-column)
- (setq ada-comment-end-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)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(ada-font-lock-keywords nil t ((?\_ . "w"))))
- (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) ada-comment-end-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
+++ /dev/null
-;;; batmode.el --- Simple mode for Windows BAT files
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Peter Breton <pbreton@i-kinetics.com>
-;; Created: Thu Jul 25 1996
-;; Keywords: BAT, DOS, Windows
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-;; USAGE: Byte-compile this file, and add the following lines to your
-;; emacs initialization file (.emacs/_emacs):
-;;
-;; (setq auto-mode-alist
-;; (append
-;; (list (cons "\\.[bB][aA][tT]$" 'bat-mode))
-;; ;; For DOS init files
-;; (list (cons "CONFIG\\." 'bat-mode))
-;; (list (cons "AUTOEXEC\\." 'bat-mode))
-;; auto-mode-alist))
-;;
-;; (autoload 'bat-mode "batmode"
-;; "DOS and WIndows BAT files" t)
-
-;; TODO:
-;;
-;; Support "compiles" ?
-;; Imenu? Don't have real functions.....
-
-;;; Change log:
-;; $Log: batmode.el,v $
-;; Revision 1.3 1996/08/22 02:31:47 peter
-;; Added Usage message, credit to folks from NTEmacs mailing list,
-;; Syntax table, New font-lock keywords
-;;
-;; Revision 1.2 1996/08/18 16:27:13 peter
-;; Added preliminary global-font-lock support
-;;
-;; Revision 1.1 1996/08/18 16:14:18 peter
-;; Initial revision
-;;
-
-;; Credit for suggestions, patches and bug-fixes:
-;; Robert Brodersen <rbrodersen@siebel.com>
-;; ACorreir@pervasive-sw.com (Alfred Correira)
-
-;;; Code:
-
-(defvar bat-mode-map nil "Local keymap for bat-mode buffers.")
-
-;; Make this lowercase if you like
-(defvar bat-mode-comment-start "REM "
- "Comment string to use in BAT mode")
-
-(defvar bat-mode-syntax-table nil
- "Syntax table in use in Bat-mode buffers.")
-
-(if bat-mode-map
- nil
- (setq bat-mode-map (copy-keymap global-map))
-)
-
-;; Make underscores count as words
-(if bat-mode-syntax-table
- ()
- (setq bat-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?_ "w" bat-mode-syntax-table)
-)
-
-(defun bat-mode ()
- "Mode for DOS and Windows BAT files"
- (interactive)
- (kill-all-local-variables)
- (use-local-map bat-mode-map)
- (set-syntax-table bat-mode-syntax-table)
-
- (make-local-variable 'parse-sexp-ignore-comments)
- (make-local-variable 'comment-start)
- (make-local-variable 'comment-start-skip)
- (make-local-variable 'comment-end)
- (make-local-variable 'executable-command)
- (make-local-variable 'font-lock-defaults)
-
- (setq major-mode 'bat-mode
- mode-name "bat"
-
- comment-end ""
-
- comment-start bat-mode-comment-start
- comment-start-skip "[Rr][Ee][Mm] *"
-
- parse-sexp-ignore-comments t
-
- )
-
- ;; Global font-lock support
- ;; (setq font-lock-defaults (list 'bat-font-lock-keywords nil t nil nil))
- (setq font-lock-defaults (list 'bat-font-lock-keywords nil))
-
- (run-hooks 'bat-mode-hook))
-
-(defvar bat-font-lock-keywords
- (list
- ;; Make this one first in the list, otherwise comments will
- ;; be over-written by other variables
- (list "^[@ \t]*\\([rR][eE][mM].*\\)" 1 'font-lock-comment-face t)
- (list "^[ \t]*\\(::-.*\\)" 1 'font-lock-comment-face t)
- (list
- (concat "\\(\\<"
- (mapconcat 'identity
- '(
- "call"
- "echo"
- "exist"
- "errorlevel"
- "for"
- "goto"
- "if"
- "not"
- "path"
- "pause"
- "prompt"
- "set"
- "start"
- )
- "\\>\\|\\<")
- "\\>\\)") 1 'font-lock-keyword-face)
- (list "^[ \t]*\\(:\\sw+\\)" 1 'font-lock-function-name-face t)
- (list "\\(%\\sw+%\\)" 1 'font-lock-reference-face)
- (list "\\(%[0-9]\\)" 1 'font-lock-reference-face)
- (list "\\(/[^/ \t\n]+\\)" 1 'font-lock-type-face)
- (list "\\<\\(goto\\)\\>[ \t]*\\(\\sw+\\)?"
- '(1 font-lock-keyword-face)
- '(2 font-lock-function-name-face nil t))
-
- )
- "Keywords to hilight in BAT mode")
-
-;;; don't do it in Win-Emacs
-(if (boundp 'font-lock-defaults-alist)
- (add-to-list
- 'font-lock-defaults-alist
- (cons 'bat-mode
- (list 'bat-font-lock-keywords nil t nil nil))))
-
-(provide 'bat-mode)
-
-;;; batmode.el ends here
+++ /dev/null
-;;; bytecpat.el --- do recompilation for Emacs patch files.
-;;; This function is used by the patch files to update Emacs releases.
-
-(defun batch-byte-recompile-emacs ()
- "Recompile the Emacs `lisp' directory.
-This is used after installing the patches for a new version."
- (let ((load-path (list (expand-file-name "lisp"))))
- (byte-recompile-directory "lisp")))
-
-(defun batch-byte-compile-emacs ()
- "Compile new files installed in the Emacs `lisp' directory.
-This is used after installing the patches for a new version.
-It uses the command line arguments to specify the files to compile."
- (let ((load-path (list (expand-file-name "lisp"))))
- (batch-byte-compile)))
+++ /dev/null
-;;; cl.el --- Common-Lisp extensions for GNU Emacs Lisp.
-
-;; Copyright (C) 1987, 1988, 1989, 1992 Free Software Foundation, Inc.
-
-;; Author: Cesar Quiroz <quiroz@cs.rochester.edu>
-;; Keywords: extensions
-
-(defvar cl-version "3.0 07-February-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:
-
-;;; Notes from Rob Austein on his mods
-;; yaya:/usr/u/sra/cl/cl.el, 5-May-1991 16:01:34, sra
-;;
-;; Slightly hacked copy of cl.el 2.0 beta 27.
-;;
-;; Various minor performance improvements:
-;; a) Don't use MAPCAR when we're going to discard its results.
-;; b) Make various macros a little more clever about optimizing
-;; generated code in common cases.
-;; c) Fix DEFSETF to expand to the right code at compile-time.
-;; d) Make various macros cleverer about generating reasonable
-;; code when compiled, particularly forms like DEFSTRUCT which
-;; are usually used at top-level and thus are only compiled if
-;; you use Hallvard Furuseth's hacked bytecomp.el.
-;;
-;; New features: GETF, REMF, and REMPROP.
-;;
-;; Notes:
-;; 1) I'm sceptical about the FBOUNDP checks in SETF. Why should
-;; the SETF expansion fail because the SETF method isn't defined
-;; at compile time? Lisp is going to check for a binding at run-time
-;; anyway, so maybe we should just assume the user's right here.
-
-;;;; These are extensions to Emacs Lisp that provide some form of
-;;;; Common Lisp compatibility, beyond what is already built-in
-;;;; in Emacs Lisp.
-;;;;
-;;;; When developing them, I had the code spread among several files.
-;;;; This file 'cl.el' is a concatenation of those original files,
-;;;; minus some declarations that became redundant. The marks between
-;;;; the original files can be found easily, as they are lines that
-;;;; begin with four semicolons (as this does). The names of the
-;;;; original parts follow the four semicolons in uppercase, those
-;;;; names are GLOBAL, SYMBOLS, LISTS, SEQUENCES, CONDITIONALS,
-;;;; ITERATIONS, MULTIPLE VALUES, ARITH, SETF and DEFSTRUCT. If you
-;;;; add functions to this file, you might want to put them in a place
-;;;; that is compatible with the division above (or invent your own
-;;;; categories).
-;;;;
-;;;; To compile this file, make sure you load it first. This is
-;;;; because many things are implemented as macros and now that all
-;;;; the files are concatenated together one cannot ensure that
-;;;; declaration always precedes use.
-;;;;
-;;;; Bug reports, suggestions and comments,
-;;;; to quiroz@cs.rochester.edu
-
-\f
-;;;; GLOBAL
-;;;; This file provides utilities and declarations that are global
-;;;; to Common Lisp and so might be used by more than one of the
-;;;; other libraries. Especially, I intend to keep here some
-;;;; utilities that help parsing/destructuring some difficult calls.
-;;;;
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-;;; Too many pieces of the rest of this package use psetq. So it is unwise to
-;;; use here anything but plain Emacs Lisp! There is a neater recursive form
-;;; for the algorithm that deals with the bodies.
-
-;;; Code:
-
-;;; This version is due to Hallvard Furuseth (hallvard@ifi.uio.no, 6 Jul 91)
-(defmacro psetq (&rest args)
- "(psetq {VARIABLE VALUE}...): In parallel, set each VARIABLE to its VALUE.
-All the VALUEs are evaluated, and then all the VARIABLEs are set.
-Aside from order of evaluation, this is the same as `setq'."
- ;; check there is a reasonable number of forms
- (if (/= (% (length args) 2) 0)
- (error "Odd number of arguments to `psetq'"))
- (setq args (copy-sequence args)) ;for safety below
- (prog1 (cons 'setq args)
- (while (progn (if (not (symbolp (car args)))
- (error "`psetq' expected a symbol, found '%s'."
- (prin1-to-string (car args))))
- (cdr (cdr args)))
- (setcdr args (list (list 'prog1 (nth 1 args)
- (cons 'setq
- (setq args (cdr (cdr args))))))))))
-\f
-;;; utilities
-;;;
-;;; pair-with-newsyms takes a list and returns a list of lists of the
-;;; form (newsym form), such that a let* can then bind the evaluation
-;;; of the forms to the newsyms. The idea is to guarantee correct
-;;; order of evaluation of the subforms of a setf. It also returns a
-;;; list of the newsyms generated, in the corresponding order.
-
-(defun pair-with-newsyms (oldforms)
- "PAIR-WITH-NEWSYMS OLDFORMS
-The top-level components of the list oldforms are paired with fresh
-symbols, the pairings list and the newsyms list are returned."
- (do ((ptr oldforms (cdr ptr))
- (bindings '())
- (newsyms '()))
- ((endp ptr) (values (nreverse bindings) (nreverse newsyms)))
- (let ((newsym (gentemp)))
- (setq bindings (cons (list newsym (car ptr)) bindings))
- (setq newsyms (cons newsym newsyms)))))
-
-(defun zip-lists (evens odds)
- "Merge two lists EVENS and ODDS, taking elts from each list alternatingly.
-EVENS and ODDS are two lists. ZIP-LISTS constructs a new list, whose
-even numbered elements (0,2,...) come from EVENS and whose odd
-numbered elements (1,3,...) come from ODDS.
-The construction stops when the shorter list is exhausted."
- (do* ((p0 evens (cdr p0))
- (p1 odds (cdr p1))
- (even (car p0) (car p0))
- (odd (car p1) (car p1))
- (result '()))
- ((or (endp p0) (endp p1))
- (nreverse result))
- (setq result
- (cons odd (cons even result)))))
-
-(defun unzip-list (list)
- "Extract even and odd elements of LIST into two separate lists.
-The argument LIST is separated in two strands, the even and the odd
-numbered elements. Numbering starts with 0, so the first element
-belongs in EVENS. No check is made that there is an even number of
-elements to start with."
- (do* ((ptr list (cddr ptr))
- (this (car ptr) (car ptr))
- (next (cadr ptr) (cadr ptr))
- (evens '())
- (odds '()))
- ((endp ptr)
- (values (nreverse evens) (nreverse odds)))
- (setq evens (cons this evens))
- (setq odds (cons next odds))))
-\f
-(defun reassemble-argslists (argslists)
- "(reassemble-argslists ARGSLISTS) => a list of lists
-ARGSLISTS is a list of sequences. Return a list of lists, the first
-sublist being all the entries coming from ELT 0 of the original
-sublists, the next those coming from ELT 1 and so on, until the
-shortest list is exhausted."
- (let* ((minlen (apply 'min (mapcar 'length argslists)))
- (result '()))
- (dotimes (i minlen (nreverse result))
- ;; capture all the elements at index i
- (setq result
- (cons (mapcar (function (lambda (sublist) (elt sublist i)))
- argslists)
- result)))))
-
-\f
-;;; Checking that a list of symbols contains no duplicates is a common
-;;; task when checking the legality of some macros. The check for 'eq
-;;; pairs can be too expensive, as it is quadratic on the length of
-;;; the list. I use a 4-pass, linear, counting approach. It surely
-;;; loses on small lists (less than 5 elements?), but should win for
-;;; larger lists. The fourth pass could be eliminated.
-;;; 10 dec 1986. Emacs Lisp has no REMPROP, so I just eliminated the
-;;; 4th pass.
-;;;
-;;; [22 April 1991, sra] REMPROP now in library, so restored 4th pass.
-(defun duplicate-symbols-p (list)
- "Find all symbols appearing more than once in LIST.
-Return a list of all such duplicates; `nil' if there are no duplicates."
- (let ((duplicates '()) ;result built here
- (propname (gensym)) ;we use a fresh property
- )
- ;; check validity
- (unless (and (listp list)
- (every 'symbolp list))
- (error "a list of symbols is needed"))
- ;; pass 1: mark
- (dolist (x list)
- (put x propname 0))
- ;; pass 2: count
- (dolist (x list)
- (put x propname (1+ (get x propname))))
- ;; pass 3: collect
- (dolist (x list)
- (if (> (get x propname) 1)
- (setq duplicates (cons x duplicates))))
- ;; pass 4: unmark.
- (dolist (x list)
- (remprop x propname))
- ;; return result
- duplicates))
-
-;;;; end of cl-global.el
-\f
-;;;; SYMBOLS
-;;;; This file provides the gentemp function, which generates fresh
-;;;; symbols, plus some other minor Common Lisp symbol tools.
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-;;; Keywords. There are no packages in Emacs Lisp, so this is only a
-;;; kludge around to let things be "as if" a keyword package was around.
-
-(defmacro defkeyword (x &optional docstring)
- "Make symbol X a keyword (symbol whose value is itself).
-Optional second argument is a documentation string for it."
- (cond ((symbolp x)
- (list 'defconst x (list 'quote x) docstring))
- (t
- (error "`%s' is not a symbol" (prin1-to-string x)))))
-
-(defun keywordp (sym)
- "t if SYM is a keyword."
- (if (and (symbolp sym) (char-equal (aref (symbol-name sym) 0) ?\:))
- ;; looks like one, make sure value is right
- (set sym sym)
- nil))
-
-(defun keyword-of (sym)
- "Return a keyword that is naturally associated with symbol SYM.
-If SYM is keyword, the value is SYM.
-Otherwise it is a keyword whose name is `:' followed by SYM's name."
- (cond ((keywordp sym)
- sym)
- ((symbolp sym)
- (let ((newsym (intern (concat ":" (symbol-name sym)))))
- (set newsym newsym)))
- (t
- (error "expected a symbol, not `%s'" (prin1-to-string sym)))))
-\f
-;;; Temporary symbols.
-;;;
-
-(defvar *gentemp-index* 0
- "Integer used by gentemp to produce new names.")
-
-(defvar *gentemp-prefix* "T$$_"
- "Names generated by gentemp begin with this string by default.")
-
-(defun gentemp (&optional prefix oblist)
- "Generate a fresh interned symbol.
-There are 2 optional arguments, PREFIX and OBLIST. PREFIX is the
-string that begins the new name, OBLIST is the obarray used to search for
-old names. The defaults are just right, YOU SHOULD NEVER NEED THESE
-ARGUMENTS IN YOUR OWN CODE."
- (if (null prefix)
- (setq prefix *gentemp-prefix*))
- (if (null oblist)
- (setq oblist obarray)) ;default for the intern functions
- (let ((newsymbol nil)
- (newname))
- (while (not newsymbol)
- (setq newname (concat prefix *gentemp-index*))
- (setq *gentemp-index* (+ *gentemp-index* 1))
- (if (not (intern-soft newname oblist))
- (setq newsymbol (intern newname oblist))))
- newsymbol))
-\f
-(defvar *gensym-index* 0
- "Integer used by gensym to produce new names.")
-
-(defvar *gensym-prefix* "G$$_"
- "Names generated by gensym begin with this string by default.")
-
-(defun gensym (&optional prefix)
- "Generate a fresh uninterned symbol.
-There is an optional argument, PREFIX. PREFIX is the
-string that begins the new name. Most people take just the default,
-except when debugging needs suggest otherwise."
- (if (null prefix)
- (setq prefix *gensym-prefix*))
- (let ((newsymbol nil)
- (newname ""))
- (while (not newsymbol)
- (setq newname (concat prefix *gensym-index*))
- (setq *gensym-index* (+ *gensym-index* 1))
- (if (not (intern-soft newname))
- (setq newsymbol (make-symbol newname))))
- newsymbol))
-
-;;;; end of cl-symbols.el
-\f
-;;;; CONDITIONALS
-;;;; This file provides some of the conditional constructs of
-;;;; Common Lisp. Total compatibility is again impossible, as the
-;;;; 'if' form is different in both languages, so only a good
-;;;; approximation is desired.
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-;;; indentation info
-(put 'case 'lisp-indent-hook 1)
-(put 'ecase 'lisp-indent-hook 1)
-(put 'when 'lisp-indent-hook 1)
-(put 'unless 'lisp-indent-hook 1)
-
-;;; WHEN and UNLESS
-;;; These two forms are simplified ifs, with a single branch.
-
-(defmacro when (condition &rest body)
- "(when CONDITION . BODY) => evaluate BODY if CONDITION is true."
- (list* 'if (list 'not condition) '() body))
-
-(defmacro unless (condition &rest body)
- "(unless CONDITION . BODY) => evaluate BODY if CONDITION is false."
- (list* 'if condition '() body))
-\f
-;;; CASE and ECASE
-;;; CASE selects among several clauses, based on the value (evaluated)
-;;; of a expression and a list of (unevaluated) key values. ECASE is
-;;; the same, but signals an error if no clause is activated.
-
-(defmacro case (expr &rest cases)
- "(case EXPR . CASES) => evals EXPR, chooses from CASES on that value.
-EXPR -> any form
-CASES -> list of clauses, non empty
-CLAUSE -> HEAD . BODY
-HEAD -> t = catch all, must be last clause
- -> otherwise = same as t
- -> nil = illegal
- -> atom = activated if (eql EXPR HEAD)
- -> list of atoms = activated if (memq EXPR HEAD)
-BODY -> list of forms, implicit PROGN is built around it.
-EXPR is evaluated only once."
- (let* ((newsym (gentemp))
- (clauses (case-clausify cases newsym)))
- ;; convert case into a cond inside a let
- (list 'let
- (list (list newsym expr))
- (list* 'cond (nreverse clauses)))))
-
-(defmacro ecase (expr &rest cases)
- "(ecase EXPR . CASES) => like `case', but error if no case fits.
-`t'-clauses are not allowed."
- (let* ((newsym (gentemp))
- (clauses (case-clausify cases newsym)))
- ;; check that no 't clause is present.
- ;; case-clausify would put one such at the beginning of clauses
- (if (eq (caar clauses) t)
- (error "no clause-head should be `t' or `otherwise' for `ecase'"))
- ;; insert error-catching clause
- (setq clauses
- (cons
- (list 't (list 'error
- "ecase on %s = %s failed to take any branch"
- (list 'quote expr)
- (list 'prin1-to-string newsym)))
- clauses))
- ;; generate code as usual
- (list 'let
- (list (list newsym expr))
- (list* 'cond (nreverse clauses)))))
-
-\f
-(defun case-clausify (cases newsym)
- "CASE-CLAUSIFY CASES NEWSYM => clauses for a 'cond'
-Converts the CASES of a [e]case macro into cond clauses to be
-evaluated inside a let that binds NEWSYM. Returns the clauses in
-reverse order."
- (do* ((currentpos cases (cdr currentpos))
- (nextpos (cdr cases) (cdr nextpos))
- (curclause (car cases) (car currentpos))
- (result '()))
- ((endp currentpos) result)
- (let ((head (car curclause))
- (body (cdr curclause)))
- ;; construct a cond-clause according to the head
- (cond ((null head)
- (error "case clauses cannot have null heads: `%s'"
- (prin1-to-string curclause)))
- ((or (eq head 't)
- (eq head 'otherwise))
- ;; check it is the last clause
- (if (not (endp nextpos))
- (error "clause with `t' or `otherwise' head must be last"))
- ;; accept this clause as a 't' for cond
- (setq result (cons (cons 't body) result)))
- ((atom head)
- (setq result
- (cons (cons (list 'eql newsym (list 'quote head)) body)
- result)))
- ((listp head)
- (setq result
- (cons (cons (list 'memq newsym (list 'quote head)) body)
- result)))
- (t
- ;; catch-all for this parser
- (error "don't know how to parse case clause `%s'"
- (prin1-to-string head)))))))
-
-;;;; end of cl-conditionals.el
-\f
-;;;; ITERATIONS
-;;;; This file provides simple iterative macros (a la Common Lisp)
-;;;; constructed on the basis of let, let* and while, which are the
-;;;; primitive binding/iteration constructs of Emacs Lisp
-;;;;
-;;;; The Common Lisp iterations use to have a block named nil
-;;;; wrapped around them, and allow declarations at the beginning
-;;;; of their bodies and you can return a value using (return ...).
-;;;; Nothing of the sort exists in Emacs Lisp, so I haven't tried
-;;;; to imitate these behaviors.
-;;;;
-;;;; Other than the above, the semantics of Common Lisp are
-;;;; correctly reproduced to the extent this was reasonable.
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-;;; some lisp-indentation information
-(put 'do 'lisp-indent-hook 2)
-(put 'do* 'lisp-indent-hook 2)
-(put 'dolist 'lisp-indent-hook 1)
-(put 'dotimes 'lisp-indent-hook 1)
-(put 'do-symbols 'lisp-indent-hook 1)
-(put 'do-all-symbols 'lisp-indent-hook 1)
-
-\f
-(defmacro do (stepforms endforms &rest body)
- "(do STEPFORMS ENDFORMS . BODY): Iterate BODY, stepping some local variables.
-STEPFORMS must be a list of symbols or lists. In the second case, the
-lists must start with a symbol and contain up to two more forms. In
-the STEPFORMS, a symbol is the same as a (symbol). The other 2 forms
-are the initial value (def. NIL) and the form to step (def. itself).
-The values used by initialization and stepping are computed in parallel.
-The ENDFORMS are a list (CONDITION . ENDBODY). If the CONDITION
-evaluates to true in any iteration, ENDBODY is evaluated and the last
-form in it is returned.
-The BODY (which may be empty) is evaluated at every iteration, with
-the symbols of the STEPFORMS bound to the initial or stepped values."
- ;; check the syntax of the macro
- (and (check-do-stepforms stepforms)
- (check-do-endforms endforms))
- ;; construct emacs-lisp equivalent
- (let ((initlist (extract-do-inits stepforms))
- (steplist (extract-do-steps stepforms))
- (endcond (car endforms))
- (endbody (cdr endforms)))
- (cons 'let (cons initlist
- (cons (cons 'while (cons (list 'not endcond)
- (append body steplist)))
- (append endbody))))))
-
-\f
-(defmacro do* (stepforms endforms &rest body)
- "`do*' is to `do' as `let*' is to `let'.
-STEPFORMS must be a list of symbols or lists. In the second case, the
-lists must start with a symbol and contain up to two more forms. In
-the STEPFORMS, a symbol is the same as a (symbol). The other 2 forms
-are the initial value (def. NIL) and the form to step (def. itself).
-Initializations and steppings are done in the sequence they are written.
-The ENDFORMS are a list (CONDITION . ENDBODY). If the CONDITION
-evaluates to true in any iteration, ENDBODY is evaluated and the last
-form in it is returned.
-The BODY (which may be empty) is evaluated at every iteration, with
-the symbols of the STEPFORMS bound to the initial or stepped values."
- ;; check the syntax of the macro
- (and (check-do-stepforms stepforms)
- (check-do-endforms endforms))
- ;; construct emacs-lisp equivalent
- (let ((initlist (extract-do-inits stepforms))
- (steplist (extract-do*-steps stepforms))
- (endcond (car endforms))
- (endbody (cdr endforms)))
- (cons 'let* (cons initlist
- (cons (cons 'while (cons (list 'not endcond)
- (append body steplist)))
- (append endbody))))))
-
-\f
-;;; DO and DO* share the syntax checking functions that follow.
-
-(defun check-do-stepforms (forms)
- "True if FORMS is a valid stepforms for the do[*] macro (q.v.)"
- (if (nlistp forms)
- (error "init/step form for do[*] should be a list, not `%s'"
- (prin1-to-string forms))
- (mapcar
- (function
- (lambda (entry)
- (if (not (or (symbolp entry)
- (and (listp entry)
- (symbolp (car entry))
- (< (length entry) 4))))
- (error "init/step must be %s, not `%s'"
- "symbol or (symbol [init [step]])"
- (prin1-to-string entry)))))
- forms)))
-
-(defun check-do-endforms (forms)
- "True if FORMS is a valid endforms for the do[*] macro (q.v.)"
- (if (nlistp forms)
- (error "termination form for do macro should be a list, not `%s'"
- (prin1-to-string forms))))
-
-(defun extract-do-inits (forms)
- "Returns a list of the initializations (for do) in FORMS
---a stepforms, see the do macro--. FORMS is assumed syntactically valid."
- (mapcar
- (function
- (lambda (entry)
- (cond ((symbolp entry)
- (list entry nil))
- ((listp entry)
- (list (car entry) (cadr entry))))))
- forms))
-
-;;; There used to be a reason to deal with DO differently than with
-;;; DO*. The writing of PSETQ has made it largely unnecessary.
-
-(defun extract-do-steps (forms)
- "EXTRACT-DO-STEPS FORMS => an s-expr
-FORMS is the stepforms part of a DO macro (q.v.). This function
-constructs an s-expression that does the stepping at the end of an
-iteration."
- (list (cons 'psetq (select-stepping-forms forms))))
-
-(defun extract-do*-steps (forms)
- "EXTRACT-DO*-STEPS FORMS => an s-expr
-FORMS is the stepforms part of a DO* macro (q.v.). This function
-constructs an s-expression that does the stepping at the end of an
-iteration."
- (list (cons 'setq (select-stepping-forms forms))))
-
-(defun select-stepping-forms (forms)
- "Separate only the forms that cause stepping."
- (let ((result '()) ;ends up being (... var form ...)
- (ptr forms) ;to traverse the forms
- entry ;to explore each form in turn
- )
- (while ptr ;(not (endp entry)) might be safer
- (setq entry (car ptr))
- (cond ((and (listp entry) (= (length entry) 3))
- (setq result (append ;append in reverse order!
- (list (caddr entry) (car entry))
- result))))
- (setq ptr (cdr ptr))) ;step in the list of forms
- (nreverse result)))
-\f
-;;; Other iterative constructs
-
-(defmacro dolist (stepform &rest body)
- "(dolist (VAR LIST [RESULTFORM]) . BODY): do BODY for each elt of LIST.
-The RESULTFORM defaults to nil. The VAR is bound to successive
-elements of the value of LIST and remains bound (to the nil value) when the
-RESULTFORM is evaluated."
- ;; check sanity
- (cond
- ((nlistp stepform)
- (error "stepform for `dolist' should be (VAR LIST [RESULT]), not `%s'"
- (prin1-to-string stepform)))
- ((not (symbolp (car stepform)))
- (error "first component of stepform should be a symbol, not `%s'"
- (prin1-to-string (car stepform))))
- ((> (length stepform) 3)
- (error "too many components in stepform `%s'"
- (prin1-to-string stepform))))
- ;; generate code
- (let* ((var (car stepform))
- (listform (cadr stepform))
- (resultform (caddr stepform))
- (listsym (gentemp)))
- (nconc
- (list 'let (list var (list listsym listform))
- (nconc
- (list 'while listsym
- (list 'setq
- var (list 'car listsym)
- listsym (list 'cdr listsym)))
- body))
- (and resultform
- (cons (list 'setq var nil)
- (list resultform))))))
-
-(defmacro dotimes (stepform &rest body)
- "(dotimes (VAR COUNTFORM [RESULTFORM]) . BODY): Repeat BODY, counting in VAR.
-The COUNTFORM should return a positive integer. The VAR is bound to
-successive integers from 0 to COUNTFORM-1 and the BODY is repeated for
-each of them. At the end, the RESULTFORM is evaluated and its value
-returned. During this last evaluation, the VAR is still bound, and its
-value is the number of times the iteration occurred. An omitted RESULTFORM
-defaults to nil."
- ;; check sanity
- (cond
- ((nlistp stepform)
- (error "stepform for `dotimes' should be (VAR COUNT [RESULT]), not `%s'"
- (prin1-to-string stepform)))
- ((not (symbolp (car stepform)))
- (error "first component of stepform should be a symbol, not `%s'"
- (prin1-to-string (car stepform))))
- ((> (length stepform) 3)
- (error "too many components in stepform `%s'"
- (prin1-to-string stepform))))
- ;; generate code
- (let* ((var (car stepform))
- (countform (cadr stepform))
- (resultform (caddr stepform))
- (testsym (if (consp countform) (gentemp) countform)))
- (nconc
- (list
- 'let (cons (list var -1)
- (and (not (eq countform testsym))
- (list (list testsym countform))))
- (nconc
- (list 'while (list '< (list 'setq var (list '1+ var)) testsym))
- body))
- (and resultform (list resultform)))))
-\f
-(defmacro do-symbols (stepform &rest body)
- "(do_symbols (VAR [OBARRAY [RESULTFORM]]) . BODY)
-The VAR is bound to each of the symbols in OBARRAY (def. obarray) and
-the BODY is repeatedly performed for each of those bindings. At the
-end, RESULTFORM (def. nil) is evaluated and its value returned.
-During this last evaluation, the VAR is still bound and its value is nil.
-See also the function `mapatoms'."
- ;; check sanity
- (cond
- ((nlistp stepform)
- (error "stepform for `do-symbols' should be (VAR OBARRAY [RESULT]), not `%s'"
- (prin1-to-string stepform)))
- ((not (symbolp (car stepform)))
- (error "first component of stepform should be a symbol, not `%s'"
- (prin1-to-string (car stepform))))
- ((> (length stepform) 3)
- (error "too many components in stepform `%s'"
- (prin1-to-string stepform))))
- ;; generate code
- (let* ((var (car stepform))
- (oblist (cadr stepform))
- (resultform (caddr stepform)))
- (list 'progn
- (list 'mapatoms
- (list 'function
- (cons 'lambda (cons (list var) body)))
- oblist)
- (list 'let
- (list (list var nil))
- resultform))))
-
-
-(defmacro do-all-symbols (stepform &rest body)
- "(do-all-symbols (VAR [RESULTFORM]) . BODY)
-Is the same as (do-symbols (VAR obarray RESULTFORM) . BODY)."
- (list*
- 'do-symbols
- (list (car stepform) 'obarray (cadr stepform))
- body))
-\f
-(defmacro loop (&rest body)
- "(loop . BODY) repeats BODY indefinitely and does not return.
-Normally BODY uses `throw' or `signal' to cause an exit.
-The forms in BODY should be lists, as non-lists are reserved for new features."
- ;; check that the body doesn't have atomic forms
- (if (nlistp body)
- (error "body of `loop' should be a list of lists or nil")
- ;; ok, it is a list, check for atomic components
- (mapcar
- (function (lambda (component)
- (if (nlistp component)
- (error "components of `loop' should be lists"))))
- body)
- ;; build the infinite loop
- (cons 'while (cons 't body))))
-
-;;;; end of cl-iterations.el
-\f
-;;;; LISTS
-;;;; This file provides some of the lists machinery of Common-Lisp
-;;;; in a way compatible with Emacs Lisp. Especially, see the the
-;;;; typical c[ad]*r functions.
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-;;; Synonyms for list functions
-(defsubst first (x)
- "Synonym for `car'"
- (car x))
-
-(defsubst second (x)
- "Return the second element of the list LIST."
- (nth 1 x))
-
-(defsubst third (x)
- "Return the third element of the list LIST."
- (nth 2 x))
-
-(defsubst fourth (x)
- "Return the fourth element of the list LIST."
- (nth 3 x))
-
-(defsubst fifth (x)
- "Return the fifth element of the list LIST."
- (nth 4 x))
-
-(defsubst sixth (x)
- "Return the sixth element of the list LIST."
- (nth 5 x))
-
-(defsubst seventh (x)
- "Return the seventh element of the list LIST."
- (nth 6 x))
-
-(defsubst eighth (x)
- "Return the eighth element of the list LIST."
- (nth 7 x))
-
-(defsubst ninth (x)
- "Return the ninth element of the list LIST."
- (nth 8 x))
-
-(defsubst tenth (x)
- "Return the tenth element of the list LIST."
- (nth 9 x))
-
-(defsubst rest (x)
- "Synonym for `cdr'"
- (cdr x))
-\f
-(defsubst endp (x)
- "t if X is nil, nil if X is a cons; error otherwise."
- (if (listp x)
- (null x)
- (error "endp received a non-cons, non-null argument `%s'"
- (prin1-to-string x))))
-
-(defun last (x)
- "Returns the last link in the list LIST."
- (if (nlistp x)
- (error "arg to `last' must be a list"))
- (do ((current-cons x (cdr current-cons))
- (next-cons (cdr x) (cdr next-cons)))
- ((endp next-cons) current-cons)))
-
-(defun list-length (x) ;taken from CLtL sect. 15.2
- "Returns the length of a non-circular list, or `nil' for a circular one."
- (do ((n 0) ;counter
- (fast x (cddr fast)) ;fast pointer, leaps by 2
- (slow x (cdr slow)) ;slow pointer, leaps by 1
- (ready nil)) ;indicates termination
- (ready n)
- (cond ((endp fast)
- (setq ready t)) ;return n
- ((endp (cdr fast))
- (setq n (+ n 1))
- (setq ready t)) ;return n+1
- ((and (eq fast slow) (> n 0))
- (setq n nil)
- (setq ready t)) ;return nil
- (t
- (setq n (+ n 2)))))) ;just advance counter
-\f
-(defun butlast (list &optional n)
- "Return a new list like LIST but sans the last N elements.
-N defaults to 1. If the list doesn't have N elements, nil is returned."
- (if (null n) (setq n 1))
- (nreverse (nthcdr n (reverse list)))) ;optim. due to macrakis@osf.org
-
-;;; This version due to Aaron Larson (alarson@src.honeywell.com, 26 Jul 91)
-(defun list* (arg &rest others)
- "Return a new list containing the first arguments consed onto the last arg.
-Thus, (list* 1 2 3 '(a b)) returns (1 2 3 a b)."
- (if (null others)
- arg
- (let* ((others (cons arg (copy-sequence others)))
- (a others))
- (while (cdr (cdr a))
- (setq a (cdr a)))
- (setcdr a (car (cdr a)))
- others)))
-
-(defun adjoin (item list)
- "Return a list which contains ITEM but is otherwise like LIST.
-If ITEM occurs in LIST, the value is LIST. Otherwise it is (cons ITEM LIST).
-When comparing ITEM against elements, `eql' is used."
- (if (memq item list)
- list
- (cons item list)))
-
-(defun ldiff (list sublist)
- "Return a new list like LIST but sans SUBLIST.
-SUBLIST must be one of the links in LIST; otherwise the value is LIST itself."
- (do ((result '())
- (curcons list (cdr curcons)))
- ((or (endp curcons) (eq curcons sublist))
- (reverse result))
- (setq result (cons (car curcons) result))))
-\f
-;;; The popular c[ad]*r functions and other list accessors.
-
-;;; To implement this efficiently, a new byte compile handler is used to
-;;; generate the minimal code, saving one function call.
-
-(defsubst caar (X)
- "Return the car of the car of X."
- (car (car X)))
-
-(defsubst cadr (X)
- "Return the car of the cdr of X."
- (car (cdr X)))
-
-(defsubst cdar (X)
- "Return the cdr of the car of X."
- (cdr (car X)))
-
-(defsubst cddr (X)
- "Return the cdr of the cdr of X."
- (cdr (cdr X)))
-
-(defsubst caaar (X)
- "Return the car of the car of the car of X."
- (car (car (car X))))
-
-(defsubst caadr (X)
- "Return the car of the car of the cdr of X."
- (car (car (cdr X))))
-
-(defsubst cadar (X)
- "Return the car of the cdr of the car of X."
- (car (cdr (car X))))
-
-(defsubst cdaar (X)
- "Return the cdr of the car of the car of X."
- (cdr (car (car X))))
-
-(defsubst caddr (X)
- "Return the car of the cdr of the cdr of X."
- (car (cdr (cdr X))))
-
-(defsubst cdadr (X)
- "Return the cdr of the car of the cdr of X."
- (cdr (car (cdr X))))
-
-(defsubst cddar (X)
- "Return the cdr of the cdr of the car of X."
- (cdr (cdr (car X))))
-
-(defsubst cdddr (X)
- "Return the cdr of the cdr of the cdr of X."
- (cdr (cdr (cdr X))))
-
-(defsubst caaaar (X)
- "Return the car of the car of the car of the car of X."
- (car (car (car (car X)))))
-
-(defsubst caaadr (X)
- "Return the car of the car of the car of the cdr of X."
- (car (car (car (cdr X)))))
-
-(defsubst caadar (X)
- "Return the car of the car of the cdr of the car of X."
- (car (car (cdr (car X)))))
-
-(defsubst cadaar (X)
- "Return the car of the cdr of the car of the car of X."
- (car (cdr (car (car X)))))
-
-(defsubst cdaaar (X)
- "Return the cdr of the car of the car of the car of X."
- (cdr (car (car (car X)))))
-
-(defsubst caaddr (X)
- "Return the car of the car of the cdr of the cdr of X."
- (car (car (cdr (cdr X)))))
-
-(defsubst cadadr (X)
- "Return the car of the cdr of the car of the cdr of X."
- (car (cdr (car (cdr X)))))
-
-(defsubst cdaadr (X)
- "Return the cdr of the car of the car of the cdr of X."
- (cdr (car (car (cdr X)))))
-
-(defsubst caddar (X)
- "Return the car of the cdr of the cdr of the car of X."
- (car (cdr (cdr (car X)))))
-
-(defsubst cdadar (X)
- "Return the cdr of the car of the cdr of the car of X."
- (cdr (car (cdr (car X)))))
-
-(defsubst cddaar (X)
- "Return the cdr of the cdr of the car of the car of X."
- (cdr (cdr (car (car X)))))
-
-(defsubst cadddr (X)
- "Return the car of the cdr of the cdr of the cdr of X."
- (car (cdr (cdr (cdr X)))))
-
-(defsubst cddadr (X)
- "Return the cdr of the cdr of the car of the cdr of X."
- (cdr (cdr (car (cdr X)))))
-
-(defsubst cdaddr (X)
- "Return the cdr of the car of the cdr of the cdr of X."
- (cdr (car (cdr (cdr X)))))
-
-(defsubst cdddar (X)
- "Return the cdr of the cdr of the cdr of the car of X."
- (cdr (cdr (cdr (car X)))))
-
-(defsubst cddddr (X)
- "Return the cdr of the cdr of the cdr of the cdr of X."
- (cdr (cdr (cdr (cdr X)))))
-\f
-;;; some inverses of the accessors are needed for setf purposes
-
-(defsubst setnth (n list newval)
- "Set (nth N LIST) to NEWVAL. Returns NEWVAL."
- (rplaca (nthcdr n list) newval))
-
-(defun setnthcdr (n list newval)
- "(setnthcdr N LIST NEWVAL) => NEWVAL
-As a side effect, sets the Nth cdr of LIST to NEWVAL."
- (when (< n 0)
- (error "N must be 0 or greater, not %d" n))
- (while (> n 0)
- (setq list (cdr list)
- n (- n 1)))
- ;; here only if (zerop n)
- (rplaca list (car newval))
- (rplacd list (cdr newval))
- newval)
-\f
-;;; A-lists machinery
-
-(defsubst acons (key item alist)
- "Return a new alist with KEY paired with ITEM; otherwise like ALIST.
-Does not copy ALIST."
- (cons (cons key item) alist))
-
-(defun pairlis (keys data &optional alist)
- "Return a new alist with each elt of KEYS paired with an elt of DATA;
-optional 3rd arg ALIST is nconc'd at the end. KEYS and DATA must
-have the same length."
- (unless (= (length keys) (length data))
- (error "keys and data should be the same length"))
- (do* ;;collect keys and data in front of alist
- ((kptr keys (cdr kptr)) ;traverses the keys
- (dptr data (cdr dptr)) ;traverses the data
- (key (car kptr) (car kptr)) ;current key
- (item (car dptr) (car dptr)) ;current data item
- (result alist))
- ((endp kptr) result)
- (setq result (acons key item result))))
-
-;;;; end of cl-lists.el
-\f
-;;;; SEQUENCES
-;;;; Emacs Lisp provides many of the 'sequences' functionality of
-;;;; Common Lisp. This file provides a few things that were left out.
-;;;;
-
-
-(defkeyword :test "Used to designate positive (selection) tests.")
-(defkeyword :test-not "Used to designate negative (rejection) tests.")
-(defkeyword :key "Used to designate component extractions.")
-(defkeyword :predicate "Used to define matching of sequence components.")
-(defkeyword :start "Inclusive low index in sequence")
-(defkeyword :end "Exclusive high index in sequence")
-(defkeyword :start1 "Inclusive low index in first of two sequences.")
-(defkeyword :start2 "Inclusive low index in second of two sequences.")
-(defkeyword :end1 "Exclusive high index in first of two sequences.")
-(defkeyword :end2 "Exclusive high index in second of two sequences.")
-(defkeyword :count "Number of elements to affect.")
-(defkeyword :from-end "T when counting backwards.")
-(defkeyword :initial-value "For the syntax of #'reduce")
-\f
-(defun some (pred seq &rest moreseqs)
- "Test PREDICATE on each element of SEQUENCE; is it ever non-nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
- (let ((args (reassemble-argslists (list* seq moreseqs))))
- (do* ((ready nil) ;flag: return when t
- (result nil) ;resulting value
- (applyval nil) ;result of applying pred once
- (remaining args
- (cdr remaining)) ;remaining argument sets
- (current (car remaining) ;current argument set
- (car remaining)))
- ((or ready (endp remaining)) result)
- (setq applyval (apply pred current))
- (when applyval
- (setq ready t)
- (setq result applyval)))))
-
-(defun every (pred seq &rest moreseqs)
- "Test PREDICATE on each element of SEQUENCE; is it always non-nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
- (let ((args (reassemble-argslists (list* seq moreseqs))))
- (do* ((ready nil) ;flag: return when t
- (result t) ;resulting value
- (applyval nil) ;result of applying pred once
- (remaining args
- (cdr remaining)) ;remaining argument sets
- (current (car remaining) ;current argument set
- (car remaining)))
- ((or ready (endp remaining)) result)
- (setq applyval (apply pred current))
- (unless applyval
- (setq ready t)
- (setq result nil)))))
-\f
-(defun notany (pred seq &rest moreseqs)
- "Test PREDICATE on each element of SEQUENCE; is it always nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
- (let ((args (reassemble-argslists (list* seq moreseqs))))
- (do* ((ready nil) ;flag: return when t
- (result t) ;resulting value
- (applyval nil) ;result of applying pred once
- (remaining args
- (cdr remaining)) ;remaining argument sets
- (current (car remaining) ;current argument set
- (car remaining)))
- ((or ready (endp remaining)) result)
- (setq applyval (apply pred current))
- (when applyval
- (setq ready t)
- (setq result nil)))))
-
-(defun notevery (pred seq &rest moreseqs)
- "Test PREDICATE on each element of SEQUENCE; is it sometimes nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
- (let ((args (reassemble-argslists (list* seq moreseqs))))
- (do* ((ready nil) ;flag: return when t
- (result nil) ;resulting value
- (applyval nil) ;result of applying pred once
- (remaining args
- (cdr remaining)) ;remaining argument sets
- (current (car remaining) ;current argument set
- (car remaining)))
- ((or ready (endp remaining)) result)
- (setq applyval (apply pred current))
- (unless applyval
- (setq ready t)
- (setq result t)))))
-\f
-;;; More sequence functions that don't need keyword arguments
-
-(defun concatenate (type &rest sequences)
- "(concatenate TYPE &rest SEQUENCES) => a sequence
-The sequence returned is of type TYPE (must be 'list, 'string, or 'vector) and
-contains the concatenation of the elements of all the arguments, in the order
-given."
- (let ((sequences (append sequences '(()))))
- (case type
- (list
- (apply (function append) sequences))
- (string
- (apply (function concat) sequences))
- (vector
- (apply (function vector) (apply (function append) sequences)))
- (t
- (error "type for concatenate `%s' not 'list, 'string or 'vector"
- (prin1-to-string type))))))
-
-(defun map (type function &rest sequences)
- "(map TYPE FUNCTION &rest SEQUENCES) => a sequence
-The FUNCTION is called on each set of elements from the SEQUENCES \(stopping
-when the shortest sequence is terminated\) and the results are possibly
-returned in a sequence of type TYPE \(one of 'list, 'vector, 'string, or nil\)
-giving NIL for TYPE gets rid of the values."
- (if (not (memq type (list 'list 'string 'vector nil)))
- (error "type for map `%s' not 'list, 'string, 'vector or nil"
- (prin1-to-string type)))
- (let ((argslists (reassemble-argslists sequences))
- results)
- (if (null type)
- (while argslists ;don't bother accumulating
- (apply function (car argslists))
- (setq argslists (cdr argslists)))
- (setq results (mapcar (function (lambda (args) (apply function args)))
- argslists))
- (case type
- (list
- results)
- (string
- (funcall (function concat) results))
- (vector
- (apply (function vector) results))))))
-\f
-;;; an inverse of elt is needed for setf purposes
-
-(defun setelt (seq n newval)
- "In SEQUENCE, set the Nth element to NEWVAL. Returns NEWVAL.
-A sequence means either a list or a vector."
- (let ((l (length seq)))
- (if (or (< n 0) (>= n l))
- (error "N(%d) should be between 0 and %d" n l)
- ;; only two cases need be considered valid, as strings are arrays
- (cond ((listp seq)
- (setnth n seq newval))
- ((arrayp seq)
- (aset seq n newval))
- (t
- (error "SEQ should be a sequence, not `%s'"
- (prin1-to-string seq)))))))
-\f
-;;; Testing with keyword arguments.
-;;;
-;;; Many of the sequence functions use keywords to denote some stylized
-;;; form of selecting entries in a sequence. The involved arguments
-;;; are collected with a &rest marker (as Emacs Lisp doesn't have a &key
-;;; marker), then they are passed to build-klist, who
-;;; constructs an association list. That association list is used to
-;;; test for satisfaction and matching.
-
-;;; DON'T USE MEMBER, NOR ANY FUNCTION THAT COULD TAKE KEYWORDS HERE!!!
-
-(defun build-klist (argslist acceptable &optional allow-other-keys)
- "Decode a keyword argument list ARGSLIST for keywords in ACCEPTABLE.
-ARGSLIST is a list, presumably the &rest argument of a call, whose
-even numbered elements must be keywords.
-ACCEPTABLE is a list of keywords, the only ones that are truly acceptable.
-The result is an alist containing the arguments named by the keywords
-in ACCEPTABLE, or an error is signalled, if something failed.
-If the third argument (an optional) is non-nil, other keys are acceptable."
- ;; check legality of the arguments, then destructure them
- (unless (and (listp argslist)
- (evenp (length argslist)))
- (error "build-klist: odd number of keyword-args"))
- (unless (and (listp acceptable)
- (every 'keywordp acceptable))
- (error "build-klist: second arg should be a list of keywords"))
- (multiple-value-bind
- (keywords forms)
- (unzip-list argslist)
- (unless (every 'keywordp keywords)
- (error "build-klist: expected keywords, found `%s'"
- (prin1-to-string keywords)))
- (unless (or allow-other-keys
- (every (function (lambda (keyword)
- (memq keyword acceptable)))
- keywords))
- (error "bad keyword[s]: %s not in %s"
- (prin1-to-string (mapcan (function (lambda (keyword)
- (if (memq keyword acceptable)
- nil
- (list keyword))))
- keywords))
- (prin1-to-string acceptable)))
- (do* ;;pick up the pieces
- ((auxlist ;auxiliary a-list, may
- (pairlis keywords forms)) ;contain repetitions and junk
- (ptr acceptable (cdr ptr)) ;pointer in acceptable
- (this (car ptr) (car ptr)) ;current acceptable keyword
- (auxval nil) ;used to move values around
- (alist '())) ;used to build the result
- ((endp ptr) alist)
- ;; if THIS appears in auxlist, use its value
- (when (setq auxval (assq this auxlist))
- (setq alist (cons auxval alist))))))
-
-
-(defun extract-from-klist (klist key &optional default)
- "(extract-from-klist KLIST KEY [DEFAULT]) => value of KEY or DEFAULT
-Extract value associated with KEY in KLIST (return DEFAULT if nil)."
- (let ((retrieved (cdr (assq key klist))))
- (or retrieved default)))
-
-(defun keyword-argument-supplied-p (klist key)
- "(keyword-argument-supplied-p KLIST KEY) => nil or something
-NIL if KEY (a keyword) does not appear in the KLIST."
- (assq key klist))
-
-(defun add-to-klist (key item klist)
- "(ADD-TO-KLIST KEY ITEM KLIST) => new KLIST
-Add association (KEY . ITEM) to KLIST."
- (setq klist (acons key item klist)))
-
-(defun elt-satisfies-test-p (item elt klist)
- "(elt-satisfies-test-p ITEM ELT KLIST) => t or nil
-KLIST encodes a keyword-arguments test, as in CH. 14 of CLtL.
-True if the given ITEM and ELT satisfy the test."
- (let ((test (extract-from-klist klist :test))
- (test-not (extract-from-klist klist :test-not))
- (keyfn (extract-from-klist klist :key 'identity)))
- (cond (test
- (funcall test item (funcall keyfn elt)))
- (test-not
- (not (funcall test-not item (funcall keyfn elt))))
- (t ;should never happen
- (error "neither :test nor :test-not in `%s'"
- (prin1-to-string klist))))))
-
-(defun elt-satisfies-if-p (item klist)
- "(elt-satisfies-if-p ITEM KLIST) => t or nil
-True if an -if style function was called and ITEM satisfies the
-predicate under :predicate in KLIST."
- (let ((predicate (extract-from-klist klist :predicate))
- (keyfn (extract-from-klist klist :key 'identity)))
- (funcall predicate (funcall keyfn item))))
-
-(defun elt-satisfies-if-not-p (item klist)
- "(elt-satisfies-if-not-p ITEM KLIST) => t or nil
-KLIST encodes a keyword-arguments test, as in CH. 14 of CLtL.
-True if an -if-not style function was called and ITEM does not satisfy
-the predicate under :predicate in KLIST."
- (let ((predicate (extract-from-klist klist :predicate))
- (keyfn (extract-from-klist klist :key 'identity)))
- (not (funcall predicate (funcall keyfn item)))))
-
-(defun elts-match-under-klist-p (e1 e2 klist)
- "(elts-match-under-klist-p E1 E2 KLIST) => t or nil
-KLIST encodes a keyword-arguments test, as in CH. 14 of CLtL.
-True if elements E1 and E2 match under the tests encoded in KLIST."
- (let ((test (extract-from-klist klist :test))
- (test-not (extract-from-klist klist :test-not))
- (keyfn (extract-from-klist klist :key 'identity)))
- (if (and test test-not)
- (error "both :test and :test-not in `%s'"
- (prin1-to-string klist)))
- (cond (test
- (funcall test (funcall keyfn e1) (funcall keyfn e2)))
- (test-not
- (not (funcall test-not (funcall keyfn e1) (funcall keyfn e2))))
- (t ;should never happen
- (error "neither :test nor :test-not in `%s'"
- (prin1-to-string klist))))))
-\f
-;;; This macro simplifies using keyword args. It is less clumsy than using
-;;; the primitives build-klist, etc... For instance, member could be written
-;;; this way:
-
-;;; (defun member (item list &rest kargs)
-;;; (with-keyword-args kargs (test test-not (key 'identity))
-;;; ...))
-
-;;; Suggested by Robert Potter (potter@cs.rochester.edu, 15 Nov 1989)
-
-(defmacro with-keyword-args (keyargslist vardefs &rest body)
- "(WITH-KEYWORD-ARGS KEYARGSLIST VARDEFS . BODY)
-KEYARGSLIST can be either a symbol or a list of one or two symbols.
-In the second case, the second symbol is either T or NIL, indicating whether
-keywords other than the mentioned ones are tolerable.
-
-VARDEFS is a list. Each entry is either a VAR (symbol) or matches
-\(VAR [DEFAULT [KEYWORD]]). Just giving VAR is the same as giving
-\(VAR nil :VAR).
-
-The BODY is executed in an environment where each VAR (a symbol) is bound to
-the value present in the KEYARGSLIST provided, or to the DEFAULT. The value
-is searched by using the keyword form of VAR (i.e., :VAR) or the optional
-keyword if provided.
-
-Notice that this macro doesn't distinguish between a default value given
-explicitly by the user and one provided by default. See also the more
-primitive functions build-klist, add-to-klist, extract-from-klist,
-keyword-argument-supplied-p, elt-satisfies-test-p, elt-satisfies-if-p,
-elt-satisfies-if-not-p, elts-match-under-klist-p. They provide more complete,
-if clumsier, control over this feature."
- (let (allow-other-keys)
- (if (listp keyargslist)
- (if (> (length keyargslist) 2)
- (error
- "`%s' should be SYMBOL, (SYMBOL), or (SYMBOL t-OR-nil)"
- (prin1-to-string keyargslist))
- (setq allow-other-keys (cadr keyargslist)
- keyargslist (car keyargslist))
- (if (not (and
- (symbolp keyargslist)
- (memq allow-other-keys '(t nil))))
- (error
- "first subform should be SYMBOL, (SYMBOL), or (SYMBOL t-OR-nil)"
- )))
- (if (symbolp keyargslist)
- (setq allow-other-keys nil)
- (error
- "first subform should be SYMBOL, (SYMBOL), or (SYMBOL t-OR-nil)")))
- (let (vars defaults keywords forms
- (klistname (gensym "KLIST_")))
- (mapcar (function (lambda (entry)
- (if (symbolp entry) ;defaulty case
- (setq entry (list entry nil (keyword-of entry))))
- (let* ((l (length entry))
- (v (car entry))
- (d (cadr entry))
- (k (caddr entry)))
- (if (or (< l 1) (> l 3))
- (error
- "`%s' must match (VAR [DEFAULT [KEYWORD]])"
- (prin1-to-string entry)))
- (if (or (null v) (not (symbolp v)))
- (error
- "bad variable `%s': must be non-null symbol"
- (prin1-to-string v)))
- (setq vars (cons v vars))
- (setq defaults (cons d defaults))
- (if (< l 3)
- (setq k (keyword-of v)))
- (if (and (= l 3)
- (or (null k)
- (not (keywordp k))))
- (error
- "bad keyword `%s'" (prin1-to-string k)))
- (setq keywords (cons k keywords))
- (setq forms (cons (list v (list 'extract-from-klist
- klistname
- k
- d))
- forms)))))
- vardefs)
- (append
- (list 'let* (nconc (list (list klistname
- (list 'build-klist keyargslist
- (list 'quote keywords)
- allow-other-keys)))
- (nreverse forms)))
- body))))
-(put 'with-keyword-args 'lisp-indent-hook 1)
-
-\f
-;;; REDUCE
-;;; It is here mostly as an example of how to use KLISTs.
-;;;
-;;; First of all, you need to declare the keywords (done elsewhere in this
-;;; file):
-;;; (defkeyword :from-end "syntax of sequence functions")
-;;; (defkeyword :start "syntax of sequence functions")
-;;; etc...
-;;;
-;;; Then, you capture all the possible keyword arguments with a &rest
-;;; argument. You can pass that list downward again, of course, but
-;;; internally you need to parse it into a KLIST (an alist, really). One uses
-;;; (build-klist REST-ARGS ACCEPTABLE-KEYWORDS [ALLOW-OTHER]). You can then
-;;; test for presence by using (keyword-argument-supplied-p KLIST KEY) and
-;;; extract a value with (extract-from-klist KLIST KEY [DEFAULT]).
-
-(defun reduce (function sequence &rest kargs)
- "Apply FUNCTION (a function of two arguments) to successive pairs of elements
-from SEQUENCE. Some keyword arguments are valid after FUNCTION and SEQUENCE:
-:from-end If non-nil, process the values backwards
-:initial-value If given, prefix it to the SEQUENCE. Suffix, if :from-end
-:start Restrict reduction to the subsequence from this index
-:end Restrict reduction to the subsequence BEFORE this index.
-If the sequence is empty and no :initial-value is given, the FUNCTION is
-called on zero (not two) arguments. Otherwise, if there is exactly one
-element in the combination of SEQUENCE and the initial value, that element is
-returned."
- (let* ((klist (build-klist kargs '(:from-end :start :end :initial-value)))
- (length (length sequence))
- (from-end (extract-from-klist klist :from-end))
- (initial-value-given (keyword-argument-supplied-p
- klist :initial-value))
- (start (extract-from-klist kargs :start 0))
- (end (extract-from-klist kargs :end length)))
- (setq sequence (cl$subseq-as-list sequence start end))
- (if from-end
- (setq sequence (reverse sequence)))
- (if initial-value-given
- (setq sequence (cons (extract-from-klist klist :initial-value)
- sequence)))
- (if (null sequence)
- (funcall function) ;only use of 0 arguments
- (let* ((result (car sequence))
- (sequence (cdr sequence)))
- (while sequence
- (setq result (if from-end
- (funcall function (car sequence) result)
- (funcall function result (car sequence)))
- sequence (cdr sequence)))
- result))))
-
-(defun cl$subseq-as-list (sequence start end)
- "(cl$subseq-as-list SEQUENCE START END) => a list"
- (let ((list (append sequence nil))
- (length (length sequence))
- result)
- (if (< start 0)
- (error "start should be >= 0, not %d" start))
- (if (> end length)
- (error "end should be <= %d, not %d" length end))
- (if (and (zerop start) (= end length))
- list
- (let ((i start)
- (vector (apply 'vector list)))
- (while (/= i end)
- (setq result (cons (elt vector i) result))
- (setq i (+ i 1)))
- (nreverse result)))))
-
-;;;; end of cl-sequences.el
-\f
-;;;; Some functions with keyword arguments
-;;;;
-;;;; Both list and sequence functions are considered here together. This
-;;;; doesn't fit any more with the original split of functions in files.
-
-(defun cl-member (item list &rest kargs)
- "Look for ITEM in LIST; return first tail of LIST the car of whose first
-cons cell tests the same as ITEM. Admits arguments :key, :test, and
-:test-not."
- (if (null kargs) ;treat this fast for efficiency
- (memq item list)
- (let* ((klist (build-klist kargs '(:test :test-not :key)))
- (test (extract-from-klist klist :test))
- (testnot (extract-from-klist klist :test-not))
- (key (extract-from-klist klist :key 'identity)))
- ;; another workaround allegedly for speed, BLAH
- (if (and (or (eq test 'eq) (eq test 'eql)
- (eq test (symbol-function 'eq))
- (eq test (symbol-function 'eql)))
- (null testnot)
- (or (eq key 'identity) ;either by default or so given
- (eq key (function identity)) ;could this happen?
- (eq key (symbol-function 'identity)) ;sheer paranoia
- ))
- (memq item list)
- (if (and test testnot)
- (error ":test and :test-not both specified for member"))
- (if (not (or test testnot))
- (setq test 'eql))
- ;; final hack: remove the indirection through the function names
- (if testnot
- (if (symbolp testnot)
- (setq testnot (symbol-function testnot)))
- (if (symbolp test)
- (setq test (symbol-function test))))
- (if (symbolp key)
- (setq key (symbol-function key)))
- ;; ok, go for it
- (let ((ptr list)
- (done nil)
- (result '()))
- (if testnot
- (while (not (or done (endp ptr)))
- (cond ((not (funcall testnot item (funcall key (car ptr))))
- (setq done t)
- (setq result ptr)))
- (setq ptr (cdr ptr)))
- (while (not (or done (endp ptr)))
- (cond ((funcall test item (funcall key (car ptr)))
- (setq done t)
- (setq result ptr)))
- (setq ptr (cdr ptr))))
- result)))))
-\f
-;;;; MULTIPLE VALUES
-;;;; This package approximates the behavior of the multiple-values
-;;;; forms of Common Lisp.
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-;;; Lisp indentation information
-(put 'multiple-value-bind 'lisp-indent-hook 2)
-(put 'multiple-value-setq 'lisp-indent-hook 2)
-(put 'multiple-value-list 'lisp-indent-hook nil)
-(put 'multiple-value-call 'lisp-indent-hook 1)
-(put 'multiple-value-prog1 'lisp-indent-hook 1)
-
-;;; Global state of the package is kept here
-(defvar *mvalues-values* nil
- "Most recently returned multiple-values")
-(defvar *mvalues-count* nil
- "Count of multiple-values returned, or nil if the mechanism was not used")
-\f
-;;; values is the standard multiple-value-return form. Must be the
-;;; last thing evaluated inside a function. If the caller is not
-;;; expecting multiple values, only the first one is passed. (values)
-;;; is the same as no-values returned (unaware callers see nil). The
-;;; alternative (values-list <list>) is just a convenient shorthand
-;;; and complements multiple-value-list.
-
-(defun values (&rest val-forms)
- "Produce multiple values (zero or more). Each arg is one value.
-See also `multiple-value-bind', which is one way to examine the
-multiple values produced by a form. If the containing form or caller
-does not check specially to see multiple values, it will see only
-the first value."
- (setq *mvalues-values* val-forms)
- (setq *mvalues-count* (length *mvalues-values*))
- (car *mvalues-values*))
-
-(defun values-list (&optional val-forms)
- "Produce multiple values (zero or more). Each element of LIST is one value.
-This is equivalent to (apply 'values LIST)."
- (cond ((nlistp val-forms)
- (error "Argument to values-list must be a list, not `%s'"
- (prin1-to-string val-forms))))
- (setq *mvalues-values* val-forms)
- (setq *mvalues-count* (length *mvalues-values*))
- (car *mvalues-values*))
-\f
-;;; Callers that want to see the multiple values use these macros.
-
-(defmacro multiple-value-list (form)
- "Execute FORM and return a list of all the (multiple) values FORM produces.
-See `values' and `multiple-value-bind'."
- (list 'progn
- (list 'setq '*mvalues-count* nil)
- (list 'let (list (list 'it '(gensym)))
- (list 'set 'it form)
- (list 'if '*mvalues-count*
- (list 'copy-sequence '*mvalues-values*)
- (list 'progn
- (list 'setq '*mvalues-count* 1)
- (list 'setq '*mvalues-values*
- (list 'list (list 'symbol-value 'it)))
- (list 'copy-sequence '*mvalues-values*))))))
-
-(defmacro multiple-value-call (function &rest args)
- "Call FUNCTION on all the values produced by the remaining arguments.
-(multiple-value-call '+ (values 1 2) (values 3 4)) is 10."
- (let* ((result (gentemp))
- (arg (gentemp)))
- (list 'apply (list 'function (eval function))
- (list 'let* (list (list result '()))
- (list 'dolist (list arg (list 'quote args) result)
- (list 'setq result
- (list 'append
- result
- (list 'multiple-value-list
- (list 'eval arg)))))))))
-
-(defmacro multiple-value-bind (vars form &rest body)
- "Bind VARS to the (multiple) values produced by FORM, then do BODY.
-VARS is a list of variables; each is bound to one of FORM's values.
-If FORM doesn't make enough values, the extra variables are bound to nil.
-(Ordinary forms produce only one value; to produce more, use `values'.)
-Extra values are ignored.
-BODY (zero or more forms) is executed with the variables bound,
-then the bindings are unwound."
- (let* ((vals (gentemp)) ;name for intermediate values
- (clauses (mv-bind-clausify ;convert into clauses usable
- vars vals))) ; in a let form
- (list* 'let*
- (cons (list vals (list 'multiple-value-list form))
- clauses)
- body)))
-\f
-(defmacro multiple-value-setq (vars form)
- "Set VARS to the (multiple) values produced by FORM.
-VARS is a list of variables; each is set to one of FORM's values.
-If FORM doesn't make enough values, the extra variables are set to nil.
-(Ordinary forms produce only one value; to produce more, use `values'.)
-Extra values are ignored."
- (let* ((vals (gentemp)) ;name for intermediate values
- (clauses (mv-bind-clausify ;convert into clauses usable
- vars vals))) ; in a setq (after append).
- (list 'let*
- (list (list vals (list 'multiple-value-list form)))
- (cons 'setq (apply (function append) clauses)))))
-
-(defmacro multiple-value-prog1 (form &rest body)
- "Evaluate FORM, then BODY, then produce the same values FORM produced.
-Thus, (multiple-value-prog1 (values 1 2) (foobar)) produces values 1 and 2.
-This is like `prog1' except that `prog1' would produce only one value,
-which would be the first of FORM's values."
- (let* ((heldvalues (gentemp)))
- (cons 'let*
- (cons (list (list heldvalues (list 'multiple-value-list form)))
- (append body (list (list 'values-list heldvalues)))))))
-
-;;; utility functions
-;;;
-;;; mv-bind-clausify makes the pairs needed to have the variables in
-;;; the variable list correspond with the values returned by the form.
-;;; vals is a fresh symbol that intervenes in all the bindings.
-
-(defun mv-bind-clausify (vars vals)
- "MV-BIND-CLAUSIFY VARS VALS => Auxiliary list
-Forms a list of pairs `(,(nth i vars) (nth i vals)) for i from 0 to
-the length of VARS (a list of symbols). VALS is just a fresh symbol."
- (if (or (nlistp vars)
- (notevery 'symbolp vars))
- (error "expected a list of symbols, not `%s'"
- (prin1-to-string vars)))
- (let* ((nvars (length vars))
- (clauses '()))
- (dotimes (n nvars clauses)
- (setq clauses (cons (list (nth n vars)
- (list 'nth n vals)) clauses)))))
-
-;;;; end of cl-multiple-values.el
-\f
-;;;; ARITH
-;;;; This file provides integer arithmetic extensions. Although
-;;;; Emacs Lisp doesn't really support anything but integers, that
-;;;; has still to be made to look more or less standard.
-;;;;
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-
-(defsubst plusp (number)
- "True if NUMBER is strictly greater than zero."
- (> number 0))
-
-(defsubst minusp (number)
- "True if NUMBER is strictly less than zero."
- (< number 0))
-
-(defsubst oddp (number)
- "True if INTEGER is not divisible by 2."
- (/= (% number 2) 0))
-
-(defsubst evenp (number)
- "True if INTEGER is divisible by 2."
- (= (% number 2) 0))
-
-(defsubst abs (number)
- "Return the absolute value of NUMBER."
- (if (< number 0)
- (- number)
- number))
-
-(defsubst signum (number)
- "Return -1, 0 or 1 according to the sign of NUMBER."
- (cond ((< number 0)
- -1)
- ((> number 0)
- 1)
- (t ;exactly zero
- 0)))
-\f
-(defun gcd (&rest integers)
- "Return the greatest common divisor of all the arguments.
-The arguments must be integers. With no arguments, value is zero."
- (let ((howmany (length integers)))
- (cond ((= howmany 0)
- 0)
- ((= howmany 1)
- (abs (car integers)))
- ((> howmany 2)
- (apply (function gcd)
- (cons (gcd (nth 0 integers) (nth 1 integers))
- (nthcdr 2 integers))))
- (t ;howmany=2
- ;; essentially the euclidean algorithm
- (when (zerop (* (nth 0 integers) (nth 1 integers)))
- (error "a zero argument is invalid for `gcd'"))
- (do* ((absa (abs (nth 0 integers))) ; better to operate only
- (absb (abs (nth 1 integers))) ;on positives.
- (dd (max absa absb)) ; setup correct order for the
- (ds (min absa absb)) ;successive divisions.
- ;; intermediate results
- (q 0)
- (r 0)
- ;; final results
- (done nil) ; flag: end of iterations
- (result 0)) ; final value
- (done result)
- (setq q (/ dd ds))
- (setq r (% dd ds))
- (cond ((zerop r) (setq done t) (setq result ds))
- (t (setq dd ds) (setq ds r))))))))
-
-(defun lcm (integer &rest more)
- "Return the least common multiple of all the arguments.
-The arguments must be integers and there must be at least one of them."
- (let ((howmany (length more))
- (a integer)
- (b (nth 0 more))
- prod ; intermediate product
- (yetmore (nthcdr 1 more)))
- (cond ((zerop howmany)
- (abs a))
- ((> howmany 1) ; recursive case
- (apply (function lcm)
- (cons (lcm a b) yetmore)))
- (t ; base case, just 2 args
- (setq prod (* a b))
- (cond
- ((zerop prod)
- 0)
- (t
- (/ (abs prod) (gcd a b))))))))
-\f
-(defun isqrt (number)
- "Return the integer square root of NUMBER.
-NUMBER must not be negative. Result is largest integer less than or
-equal to the real square root of the argument."
- ;; The method used here is essentially the Newtonian iteration
- ;; x[n+1] <- (x[n] + Number/x[n]) / 2
- ;; suitably adapted to integer arithmetic.
- ;; Thanks to Philippe Schnoebelen <phs@lifia.imag.fr> for suggesting the
- ;; termination condition.
- (cond ((minusp number)
- (error "argument to `isqrt' (%d) must not be negative"
- number))
- ((zerop number)
- 0)
- (t ;so (>= number 0)
- (do* ((approx 1) ;any positive integer will do
- (new 0) ;init value irrelevant
- (done nil))
- (done (if (> (* approx approx) number)
- (- approx 1)
- approx))
- (setq new (/ (+ approx (/ number approx)) 2)
- done (or (= new approx) (= new (+ approx 1)))
- approx new)))))
-\f
-(defun cl-floor (number &optional divisor)
- "Divide DIVIDEND by DIVISOR, rounding toward minus infinity.
-DIVISOR defaults to 1. The remainder is produced as a second value."
- (cond ((and (null divisor) ; trivial case
- (numberp number))
- (values number 0))
- (t ; do the division
- (multiple-value-bind
- (q r s)
- (safe-idiv number divisor)
- (cond ((zerop s)
- (values 0 0))
- ((plusp s)
- (values q r))
- (t ;opposite-signs case
- (if (zerop r)
- (values (- q) 0)
- (let ((q (- (+ q 1))))
- (values q (- number (* q divisor)))))))))))
-
-(defun cl-ceiling (number &optional divisor)
- "Divide DIVIDEND by DIVISOR, rounding toward plus infinity.
-DIVISOR defaults to 1. The remainder is produced as a second value."
- (cond ((and (null divisor) ; trivial case
- (numberp number))
- (values number 0))
- (t ; do the division
- (multiple-value-bind
- (q r s)
- (safe-idiv number divisor)
- (cond ((zerop s)
- (values 0 0))
- ((plusp s)
- (values (+ q 1) (- r divisor)))
- (t
- (values (- q) (+ number (* q divisor)))))))))
-\f
-(defun cl-truncate (number &optional divisor)
- "Divide DIVIDEND by DIVISOR, rounding toward zero.
-DIVISOR defaults to 1. The remainder is produced as a second value."
- (cond ((and (null divisor) ; trivial case
- (numberp number))
- (values number 0))
- (t ; do the division
- (multiple-value-bind
- (q r s)
- (safe-idiv number divisor)
- (cond ((zerop s)
- (values 0 0))
- ((plusp s) ;same as floor
- (values q r))
- (t ;same as ceiling
- (values (- q) (+ number (* q divisor)))))))))
-
-(defun cl-round (number &optional divisor)
- "Divide DIVIDEND by DIVISOR, rounding to nearest integer.
-DIVISOR defaults to 1. The remainder is produced as a second value."
- (cond ((and (null divisor) ; trivial case
- (numberp number))
- (values number 0))
- (t ; do the division
- (multiple-value-bind
- (q r s)
- (safe-idiv number divisor)
- (setq r (abs r))
- ;; adjust magnitudes first, and then signs
- (let ((other-r (- (abs divisor) r)))
- (cond ((> r other-r)
- (setq q (+ q 1)))
- ((and (= r other-r)
- (oddp q))
- ;; round to even is mandatory
- (setq q (+ q 1))))
- (setq q (* s q))
- (setq r (- number (* q divisor)))
- (values q r))))))
-\f
-;;; These two functions access the implementation-dependent representation of
-;;; the multiple value returns.
-
-(defun cl-mod (number divisor)
- "Return remainder of X by Y (rounding quotient toward minus infinity).
-That is, the remainder goes with the quotient produced by `cl-floor'.
-Emacs Lisp hint:
-If you know that both arguments are positive, use `%' instead for speed."
- (cl-floor number divisor)
- (cadr *mvalues-values*))
-
-(defun rem (number divisor)
- "Return remainder of X by Y (rounding quotient toward zero).
-That is, the remainder goes with the quotient produced by `cl-truncate'.
-Emacs Lisp hint:
-If you know that both arguments are positive, use `%' instead for speed."
- (cl-truncate number divisor)
- (cadr *mvalues-values*))
-\f
-;;; internal utilities
-;;;
-;;; safe-idiv performs an integer division with positive numbers only.
-;;; It is known that some machines/compilers implement weird remainder
-;;; computations when working with negatives, so the idea here is to
-;;; make sure we know what is coming back to the caller in all cases.
-
-;;; Signum computation fixed by mad@math.keio.JUNET (MAEDA Atusi)
-
-(defun safe-idiv (a b)
- "SAFE-IDIV A B => Q R S
-Q=|A|/|B|, S is the sign of A/B, R is the rest A - S*Q*B."
- ;; (unless (and (numberp a) (numberp b))
- ;; (error "arguments to `safe-idiv' must be numbers"))
- ;; (when (zerop b)
- ;; (error "cannot divide %d by zero" a))
- (let* ((q (/ (abs a) (abs b)))
- (s (* (signum a) (signum b)))
- (r (- a (* s q b))))
- (values q r s)))
-
-;;;; end of cl-arith.el
-\f
-;;;; SETF
-;;;; This file provides the setf macro and friends. The purpose has
-;;;; been modest, only the simplest defsetf forms are accepted.
-;;;; Use it and enjoy.
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-
-(defkeyword :setf-update-fn
- "Property, its value is the function setf must invoke to update a
-generalized variable whose access form is a function call of the
-symbol that has this property.")
-
-(defkeyword :setf-update-doc
- "Property of symbols that have a `defsetf' update function on them,
-installed by the `defsetf' from its optional third argument.")
-\f
-(defmacro setf (&rest pairs)
- "Generalized `setq' that can set things other than variable values.
-A use of `setf' looks like (setf {PLACE VALUE}...).
-The behavior of (setf PLACE VALUE) is to access the generalized variable
-at PLACE and store VALUE there. It returns VALUE. If there is more
-than one PLACE and VALUE, each PLACE is set from its VALUE before
-the next PLACE is evaluated."
- (let ((nforms (length pairs)))
- ;; check the number of subforms
- (cond ((/= (% nforms 2) 0)
- (error "odd number of arguments to `setf'"))
- ((= nforms 0)
- nil)
- ((> nforms 2)
- ;; this is the recursive case
- (cons 'progn
- (do* ;collect the place-value pairs
- ((args pairs (cddr args))
- (place (car args) (car args))
- (value (cadr args) (cadr args))
- (result '()))
- ((endp args) (nreverse result))
- (setq result
- (cons (list 'setf place value)
- result)))))
- (t ;i.e., nforms=2
- ;; this is the base case (SETF PLACE VALUE)
- (let* ((place (car pairs))
- (value (cadr pairs))
- (head nil)
- (updatefn nil))
- ;; dispatch on the type of the PLACE
- (cond ((symbolp place)
- (list 'setq place value))
- ((and (listp place)
- (setq head (car place))
- (symbolp head)
- (setq updatefn (get head :setf-update-fn)))
- ;; dispatch on the type of update function
- (cond ((and (consp updatefn) (eq (car updatefn) 'lambda))
- (cons 'funcall
- (cons (list 'function updatefn)
- (append (cdr place) (list value)))))
- ((and (symbolp updatefn)
- (fboundp updatefn)
- (let ((defn (symbol-function updatefn)))
- (or (subrp defn)
- (and (consp defn)
- (or (eq (car defn) 'lambda)
- (eq (car defn) 'macro))))))
- (cons updatefn (append (cdr place) (list value))))
- (t
- (multiple-value-bind
- (bindings newsyms)
- (pair-with-newsyms
- (append (cdr place) (list value)))
- ;; this let gets new symbols to ensure adequate
- ;; order of evaluation of the subforms.
- (list 'let
- bindings
- (cons updatefn newsyms))))))
- (t
- (error "no `setf' update-function for `%s'"
- (prin1-to-string place)))))))))
-\f
-(defmacro defsetf (accessfn updatefn &optional docstring)
- "Define how `setf' works on a certain kind of generalized variable.
-A use of `defsetf' looks like (defsetf ACCESSFN UPDATEFN [DOCSTRING]).
-ACCESSFN is a symbol. UPDATEFN is a function or macro which takes
-one more argument than ACCESSFN does. DEFSETF defines the translation
-of (SETF (ACCESFN . ARGS) NEWVAL) to be a form like (UPDATEFN ARGS... NEWVAL).
-The function UPDATEFN must return its last arg, after performing the
-updating called for."
- ;; reject ill-formed requests. too bad one can't test for functionp
- ;; or macrop.
- (when (not (symbolp accessfn))
- (error "first argument of `defsetf' must be a symbol, not `%s'"
- (prin1-to-string accessfn)))
- ;; update properties
- (list 'progn
- (list 'eval-and-compile
- (list 'put (list 'quote accessfn)
- :setf-update-fn (list 'function updatefn)))
- (list 'put (list 'quote accessfn) :setf-update-doc docstring)
- ;; any better thing to return?
- (list 'quote accessfn)))
-\f
-;;; This section provides the "default" setfs for Common-Emacs-Lisp
-;;; The user will not normally add anything to this, although
-;;; defstruct will introduce new ones as a matter of fact.
-;;;
-;;; Apply is a special case. The Common Lisp
-;;; standard makes the case of apply be useful when the user writes
-;;; something like (apply #'name ...), Emacs Lisp doesn't have the #
-;;; stuff, but it has (function ...). Notice that V18 includes a new
-;;; apply: this file is compatible with V18 and pre-V18 Emacses.
-
-;;; INCOMPATIBILITY: the SETF macro evaluates its arguments in the
-;;; (correct) left to right sequence *before* checking for apply
-;;; methods (which should really be an special case inside setf). Due
-;;; to this, the lambda expression defsetf'd to apply will succeed in
-;;; applying the right function even if the name was not quoted, but
-;;; computed! That extension is not Common Lisp (nor is particularly
-;;; useful, I think).
-
-(defsetf apply
- (lambda (&rest args)
- ;; disassemble the calling form
- ;; "(((quote fn) x1 x2 ... xn) val)" (function instead of quote, too)
- (let* ((fnform (car args)) ;functional form
- (applyargs (append ;arguments "to apply fnform"
- (apply 'list* (butlast (cdr args)))
- (last args)))
- (newupdater nil)) ; its update-fn, if any
- (if (and (symbolp fnform)
- (setq newupdater (get fnform :setf-update-fn)))
- (apply newupdater applyargs)
- (error "can't `setf' to `%s'"
- (prin1-to-string fnform)))))
- "`apply' is a special case for `setf'")
-
-\f
-(defsetf aref
- aset
- "`setf' inversion for `aref'")
-
-(defsetf nth
- setnth
- "`setf' inversion for `nth'")
-
-(defsetf nthcdr
- setnthcdr
- "`setf' inversion for `nthcdr'")
-
-(defsetf elt
- setelt
- "`setf' inversion for `elt'")
-
-(defsetf first
- (lambda (list val) (setnth 0 list val))
- "`setf' inversion for `first'")
-
-(defsetf second
- (lambda (list val) (setnth 1 list val))
- "`setf' inversion for `second'")
-
-(defsetf third
- (lambda (list val) (setnth 2 list val))
- "`setf' inversion for `third'")
-
-(defsetf fourth
- (lambda (list val) (setnth 3 list val))
- "`setf' inversion for `fourth'")
-
-(defsetf fifth
- (lambda (list val) (setnth 4 list val))
- "`setf' inversion for `fifth'")
-
-(defsetf sixth
- (lambda (list val) (setnth 5 list val))
- "`setf' inversion for `sixth'")
-
-(defsetf seventh
- (lambda (list val) (setnth 6 list val))
- "`setf' inversion for `seventh'")
-\f
-(defsetf eighth
- (lambda (list val) (setnth 7 list val))
- "`setf' inversion for `eighth'")
-
-(defsetf ninth
- (lambda (list val) (setnth 8 list val))
- "`setf' inversion for `ninth'")
-
-(defsetf tenth
- (lambda (list val) (setnth 9 list val))
- "`setf' inversion for `tenth'")
-
-(defsetf rest
- (lambda (list val) (setcdr list val))
- "`setf' inversion for `rest'")
-
-(defsetf car setcar "Replace the car of a cons")
-
-(defsetf cdr setcdr "Replace the cdr of a cons")
-
-(defsetf caar
- (lambda (list val) (setcar (nth 0 list) val))
- "`setf' inversion for `caar'")
-
-(defsetf cadr
- (lambda (list val) (setcar (cdr list) val))
- "`setf' inversion for `cadr'")
-
-(defsetf cdar
- (lambda (list val) (setcdr (car list) val))
- "`setf' inversion for `cdar'")
-
-(defsetf cddr
- (lambda (list val) (setcdr (cdr list) val))
- "`setf' inversion for `cddr'")
-
-(defsetf caaar
- (lambda (list val) (setcar (caar list) val))
- "`setf' inversion for `caaar'")
-
-(defsetf caadr
- (lambda (list val) (setcar (cadr list) val))
- "`setf' inversion for `caadr'")
-
-(defsetf cadar
- (lambda (list val) (setcar (cdar list) val))
- "`setf' inversion for `cadar'")
-\f
-(defsetf cdaar
- (lambda (list val) (setcdr (caar list) val))
- "`setf' inversion for `cdaar'")
-
-(defsetf caddr
- (lambda (list val) (setcar (cddr list) val))
- "`setf' inversion for `caddr'")
-
-(defsetf cdadr
- (lambda (list val) (setcdr (cadr list) val))
- "`setf' inversion for `cdadr'")
-
-(defsetf cddar
- (lambda (list val) (setcdr (cdar list) val))
- "`setf' inversion for `cddar'")
-
-(defsetf cdddr
- (lambda (list val) (setcdr (cddr list) val))
- "`setf' inversion for `cdddr'")
-
-(defsetf caaaar
- (lambda (list val) (setcar (caaar list) val))
- "`setf' inversion for `caaaar'")
-
-(defsetf caaadr
- (lambda (list val) (setcar (caadr list) val))
- "`setf' inversion for `caaadr'")
-
-(defsetf caadar
- (lambda (list val) (setcar (cadar list) val))
- "`setf' inversion for `caadar'")
-
-(defsetf cadaar
- (lambda (list val) (setcar (cdaar list) val))
- "`setf' inversion for `cadaar'")
-
-(defsetf cdaaar
- (lambda (list val) (setcdr (caar list) val))
- "`setf' inversion for `cdaaar'")
-
-(defsetf caaddr
- (lambda (list val) (setcar (caddr list) val))
- "`setf' inversion for `caaddr'")
-\f
-(defsetf cadadr
- (lambda (list val) (setcar (cdadr list) val))
- "`setf' inversion for `cadadr'")
-
-(defsetf cdaadr
- (lambda (list val) (setcdr (caadr list) val))
- "`setf' inversion for `cdaadr'")
-
-(defsetf caddar
- (lambda (list val) (setcar (cddar list) val))
- "`setf' inversion for `caddar'")
-
-(defsetf cdadar
- (lambda (list val) (setcdr (cadar list) val))
- "`setf' inversion for `cdadar'")
-
-(defsetf cddaar
- (lambda (list val) (setcdr (cdaar list) val))
- "`setf' inversion for `cddaar'")
-
-(defsetf cadddr
- (lambda (list val) (setcar (cdddr list) val))
- "`setf' inversion for `cadddr'")
-
-(defsetf cddadr
- (lambda (list val) (setcdr (cdadr list) val))
- "`setf' inversion for `cddadr'")
-
-(defsetf cdaddr
- (lambda (list val) (setcdr (caddr list) val))
- "`setf' inversion for `cdaddr'")
-
-(defsetf cdddar
- (lambda (list val) (setcdr (cddar list) val))
- "`setf' inversion for `cdddar'")
-
-(defsetf cddddr
- (lambda (list val) (setcdr (cddr list) val))
- "`setf' inversion for `cddddr'")
-
-(defsetf get put "`setf' inversion for `get' is `put'")
-
-(defsetf symbol-function fset
- "`setf' inversion for `symbol-function' is `fset'")
-
-(defsetf symbol-plist setplist
- "`setf' inversion for `symbol-plist' is `setplist'")
-
-(defsetf symbol-value set
- "`setf' inversion for `symbol-value' is `set'")
-
-(defsetf point goto-char
- "To set (point) to N, use (goto-char N)")
-
-;; how about defsetfing other Emacs forms?
-\f
-;;; Modify macros
-;;;
-;;; It could be nice to implement define-modify-macro, but I don't
-;;; think it really pays.
-
-(defmacro incf (ref &optional delta)
- "(incf REF [DELTA]) -> increment the g.v. REF by DELTA (default 1)"
- (if (null delta)
- (setq delta 1))
- (list 'setf ref (list '+ ref delta)))
-
-(defmacro decf (ref &optional delta)
- "(decf REF [DELTA]) -> decrement the g.v. REF by DELTA (default 1)"
- (if (null delta)
- (setq delta 1))
- (list 'setf ref (list '- ref delta)))
-
-(defmacro push (item ref)
- "(push ITEM REF) -> cons ITEM at the head of the g.v. REF (a list)"
- (list 'setf ref (list 'cons item ref)))
-
-(defmacro pushnew (item ref)
- "(pushnew ITEM REF): adjoin ITEM at the head of the g.v. REF (a list)"
- (list 'setf ref (list 'adjoin item ref)))
-
-(defmacro pop (ref)
- "(pop REF) -> (prog1 (car REF) (setf REF (cdr REF)))"
- (let ((listname (gensym)))
- (list 'let (list (list listname ref))
- (list 'prog1
- (list 'car listname)
- (list 'setf ref (list 'cdr listname))))))
-\f
-;;; PSETF
-;;;
-;;; Psetf is the generalized variable equivalent of psetq. The right
-;;; hand sides are evaluated and assigned (via setf) to the left hand
-;;; sides. The evaluations are done in an environment where they
-;;; appear to occur in parallel.
-
-(defmacro psetf (&rest body)
- "(psetf {var value }...) => nil
-Like setf, but all the values are computed before any assignment is made."
- (let ((length (length body)))
- (cond ((/= (% length 2) 0)
- (error "psetf needs an even number of arguments, %d given"
- length))
- ((null body)
- '())
- (t
- (list 'prog1 nil
- (let ((setfs '())
- (bodyforms (reverse body)))
- (while bodyforms
- (let* ((value (car bodyforms))
- (place (cadr bodyforms)))
- (setq bodyforms (cddr bodyforms))
- (if (null setfs)
- (setq setfs (list 'setf place value))
- (setq setfs (list 'setf place
- (list 'prog1 value
- setfs))))))
- setfs))))))
-\f
-;;; SHIFTF and ROTATEF
-;;;
-
-(defmacro shiftf (&rest forms)
- "(shiftf PLACE1 PLACE2... NEWVALUE)
-Set PLACE1 to PLACE2, PLACE2 to PLACE3...
-Each PLACE is set to the old value of the following PLACE,
-and the last PLACE is set to the value NEWVALUE.
-Returns the old value of PLACE1."
- (unless (> (length forms) 1)
- (error "`shiftf' needs more than one argument"))
- (let ((places (butlast forms))
- (newvalue (car (last forms))))
- ;; the places are accessed to fresh symbols
- (multiple-value-bind
- (bindings newsyms)
- (pair-with-newsyms places)
- (list 'let bindings
- (cons 'setf
- (zip-lists places
- (append (cdr newsyms) (list newvalue))))
- (car newsyms)))))
-
-(defmacro rotatef (&rest places)
- "(rotatef PLACE...) sets each PLACE to the old value of the following PLACE.
-The last PLACE is set to the old value of the first PLACE.
-Thus, the values rotate through the PLACEs. Returns nil."
- (if (null places)
- nil
- (multiple-value-bind
- (bindings newsyms)
- (pair-with-newsyms places)
- (list
- 'let bindings
- (cons 'setf
- (zip-lists places
- (append (cdr newsyms) (list (car newsyms)))))
- nil))))
-\f
-;;; GETF, REMF, and REMPROP
-;;;
-
-(defun getf (place indicator &optional default)
- "Return PLACE's PROPNAME property, or DEFAULT if not present."
- (while (and place (not (eq (car place) indicator)))
- (setq place (cdr (cdr place))))
- (if place
- (car (cdr place))
- default))
-
-(defmacro getf$setf$method (place indicator default &rest newval)
- "SETF method for GETF. Not for public use."
- (case (length newval)
- (0 (setq newval default default nil))
- (1 (setq newval (car newval)))
- (t (error "Wrong number of arguments to (setf (getf ...)) form")))
- (let ((psym (gentemp)) (isym (gentemp)) (vsym (gentemp)))
- (list 'let (list (list psym place)
- (list isym indicator)
- (list vsym newval))
- (list 'while
- (list 'and psym
- (list 'not
- (list 'eq (list 'car psym) isym)))
- (list 'setq psym (list 'cdr (list 'cdr psym))))
- (list 'if psym
- (list 'setcar (list 'cdr psym) vsym)
- (list 'setf place
- (list 'nconc place (list 'list isym newval))))
- vsym)))
-
-(defsetf getf
- getf$setf$method)
-
-(defmacro remf (place indicator)
- "Remove from the property list at PLACE its PROPNAME property.
-Returns non-nil if and only if the property existed."
- (let ((psym (gentemp)) (isym (gentemp)))
- (list 'let (list (list psym place) (list isym indicator))
- (list 'cond
- (list (list 'eq isym (list 'car psym))
- (list 'setf place (list 'cdr (list 'cdr psym)))
- t)
- (list t
- (list 'setq psym (list 'cdr psym))
- (list 'while
- (list 'and (list 'cdr psym)
- (list 'not
- (list 'eq (list 'car (list 'cdr psym))
- isym)))
- (list 'setq psym (list 'cdr (list 'cdr psym))))
- (list 'cond
- (list (list 'cdr psym)
- (list 'setcdr psym
- (list 'cdr
- (list 'cdr (list 'cdr psym))))
- t)))))))
-
-(defun remprop (symbol indicator)
- "Remove SYMBOL's PROPNAME property, returning non-nil if it was present."
- (remf (symbol-plist symbol) indicator))
-
-\f
-;;;; STRUCTS
-;;;; This file provides the structures mechanism. See the
-;;;; documentation for Common-Lisp's defstruct. Mine doesn't
-;;;; implement all the functionality of the standard, although some
-;;;; more could be grafted if so desired. More details along with
-;;;; the code.
-;;;;
-;;;;
-;;;; Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;; (quiroz@cs.rochester.edu)
-
-
-(defkeyword :include "Syntax of `defstruct'")
-(defkeyword :named "Syntax of `defstruct'")
-(defkeyword :conc-name "Syntax of `defstruct'")
-(defkeyword :copier "Syntax of `defstruct'")
-(defkeyword :predicate "Syntax of `defstruct'")
-(defkeyword :print-function "Syntax of `defstruct'")
-(defkeyword :type "Syntax of `defstruct'")
-(defkeyword :initial-offset "Syntax of `defstruct'")
-
-(defkeyword :structure-doc "Documentation string for a structure.")
-(defkeyword :structure-slotsn "Number of slots in structure")
-(defkeyword :structure-slots "List of the slot's names")
-(defkeyword :structure-indices "List of (KEYWORD-NAME . INDEX)")
-(defkeyword :structure-initforms "List of (KEYWORD-NAME . INITFORM)")
-(defkeyword :structure-includes
- "() or list of a symbol, that this struct includes")
-(defkeyword :structure-included-in
- "List of the structs that include this")
-
-\f
-(defmacro defstruct (&rest args)
- "(defstruct NAME [DOC-STRING] . SLOTS) define NAME as structure type.
-NAME must be a symbol, the name of the new structure. It could also
-be a list (NAME . OPTIONS).
-
-Each option is either a symbol, or a list of a keyword symbol taken from the
-list \{:conc-name, :copier, :constructor, :predicate, :include,
-:print-function, :type, :initial-offset\}. The meanings of these are as in
-CLtL, except that no BOA-constructors are provided, and the options
-\{:print-function, :type, :initial-offset\} are ignored quietly. All these
-structs are named, in the sense that their names can be used for type
-discrimination.
-
-The DOC-STRING is established as the `structure-doc' property of NAME.
-
-The SLOTS are one or more of the following:
-SYMBOL -- meaning the SYMBOL is the name of a SLOT of NAME
-list of SYMBOL and VALUE -- meaning that VALUE is the initial value of
-the slot.
-`defstruct' defines functions `make-NAME', `NAME-p', `copy-NAME' for the
-structure, and functions with the same name as the slots to access
-them. `setf' of the accessors sets their values."
- (multiple-value-bind
- (name options docstring slotsn slots initlist)
- (parse$defstruct$args args)
- ;; Names for the member functions come from the options. The
- ;; slots* stuff collects info about the slots declared explicitly.
- (multiple-value-bind
- (conc-name constructor copier predicate
- moreslotsn moreslots moreinits included)
- (parse$defstruct$options name options slots)
- ;; The moreslots* stuff refers to slots gained as a consequence
- ;; of (:include clauses). -- Oct 89: Only one :include tolerated
- (when (and (numberp moreslotsn)
- (> moreslotsn 0))
- (setf slotsn (+ slotsn moreslotsn))
- (setf slots (append moreslots slots))
- (setf initlist (append moreinits initlist)))
- (unless (> slotsn 0)
- (error "%s needs at least one slot"
- (prin1-to-string name)))
- (let ((dups (duplicate-symbols-p slots)))
- (when dups
- (error "`%s' are duplicates"
- (prin1-to-string dups))))
- (setq initlist (simplify$inits slots initlist))
- (let (properties functions keywords accessors alterators returned)
- ;; compute properties of NAME
- (setq properties
- (append
- (list
- (list 'put (list 'quote name) :structure-doc
- docstring)
- (list 'put (list 'quote name) :structure-slotsn
- slotsn)
- (list 'put (list 'quote name) :structure-slots
- (list 'quote slots))
- (list 'put (list 'quote name) :structure-initforms
- (list 'quote initlist))
- (list 'put (list 'quote name) :structure-indices
- (list 'quote (extract$indices initlist))))
- ;; If this definition :includes another defstruct,
- ;; modify both property lists.
- (cond (included
- (list
- (list 'put
- (list 'quote name)
- :structure-includes
- (list 'quote included))
- (list 'pushnew
- (list 'quote name)
- (list 'get (list 'quote (car included))
- :structure-included-in))))
- (t
- (list
- (let ((old (gensym)))
- (list 'let
- (list (list old
- (list 'car
- (list 'get
- (list 'quote name)
- :structure-includes))))
- (list 'when old
- (list 'put
- old
- :structure-included-in
- (list 'delq
- (list 'quote name)
- ;; careful with destructive
- ;;manipulation!
- (list
- 'append
- (list
- 'get
- old
- :structure-included-in)
- '())
- )))))
- (list 'put
- (list 'quote name)
- :structure-includes
- '()))))
- ;; If this definition used to be :included in another, warn
- ;; that things make break. On the other hand, the redefinition
- ;; may be trivial, so don't call it an error.
- (let ((old (gensym)))
- (list
- (list 'let
- (list (list old (list 'get
- (list 'quote name)
- :structure-included-in)))
- (list 'when old
- (list 'message
- "`%s' redefined. Should redefine `%s'?"
- (list 'quote name)
- (list 'prin1-to-string old))))))))
-
- ;; Compute functions associated with NAME. This is not
- ;; handling BOA constructors yet, but here would be the place.
- (setq functions
- (list
- (list 'fset (list 'quote constructor)
- (list 'function
- (list 'lambda (list '&rest 'args)
- (list 'make$structure$instance
- (list 'quote name)
- 'args))))
- (list 'fset (list 'quote copier)
- (list 'function 'copy-sequence))
- (let ((typetag (gensym)))
- (list 'fset (list 'quote predicate)
- (list
- 'function
- (list
- 'lambda (list 'thing)
- (list 'and
- (list 'vectorp 'thing)
- (list 'let
- (list (list typetag
- (list 'elt 'thing 0)))
- (list 'or
- (list
- 'and
- (list 'eq
- typetag
- (list 'quote name))
- (list '=
- (list 'length 'thing)
- (1+ slotsn)))
- (list
- 'memq
- typetag
- (list 'get
- (list 'quote name)
- :structure-included-in))))))
- )))))
- ;; compute accessors for NAME's slots
- (multiple-value-setq
- (accessors alterators keywords)
- (build$accessors$for name conc-name predicate slots slotsn))
- ;; generate returned value -- not defined by the standard
- (setq returned
- (list
- (cons 'vector
- (mapcar
- (function (lambda (x) (list 'quote x)))
- (cons name slots)))))
- ;; generate code
- (cons 'progn
- (nconc properties functions keywords
- accessors alterators returned))))))
-\f
-(defun parse$defstruct$args (args)
- "(parse$defstruct$args ARGS) => NAME OPTIONS DOCSTRING SLOTSN SLOTS INITLIST
-NAME=symbol, OPTIONS=list of, DOCSTRING=string, SLOTSN=count of slots,
-SLOTS=list of their names, INITLIST=alist (keyword . initform)."
- (let (name ;args=(symbol...) or ((symbol...)...)
- options ;args=((symbol . options) ...)
- (docstring "") ;args=(head docstring . slotargs)
- slotargs ;second or third cdr of args
- (slotsn 0) ;number of slots
- (slots '()) ;list of slot names
- (initlist '())) ;list of (slot keyword . initform)
- ;; extract name and options
- (cond ((symbolp (car args)) ;simple name
- (setq name (car args)
- options '()))
- ((and (listp (car args)) ;(name . options)
- (symbolp (caar args)))
- (setq name (caar args)
- options (cdar args)))
- (t
- (error "first arg to `defstruct' must be symbol or (symbol ...)")))
- (setq slotargs (cdr args))
- ;; is there a docstring?
- (when (stringp (car slotargs))
- (setq docstring (car slotargs)
- slotargs (cdr slotargs)))
- ;; now for the slots
- (multiple-value-bind
- (slotsn slots initlist)
- (process$slots slotargs)
- (values name options docstring slotsn slots initlist))))
-\f
-(defun process$slots (slots)
- "(process$slots SLOTS) => SLOTSN SLOTSLIST INITLIST
-Converts a list of symbols or lists of symbol and form into the last 3
-values returned by PARSE$DEFSTRUCT$ARGS."
- (let ((slotsn (length slots)) ;number of slots
- slotslist ;(slot1 slot2 ...)
- initlist) ;((:slot1 . init1) ...)
- (do*
- ((ptr slots (cdr ptr))
- (this (car ptr) (car ptr)))
- ((endp ptr))
- (cond ((symbolp this)
- (setq slotslist (cons this slotslist))
- (setq initlist (acons (keyword-of this) nil initlist)))
- ((and (listp this)
- (symbolp (car this)))
- (let ((name (car this))
- (form (cadr this)))
- ;; this silently ignores any slot options. bad...
- (setq slotslist (cons name slotslist))
- (setq initlist (acons (keyword-of name) form initlist))))
- (t
- (error "slot should be symbol or (symbol ...), not `%s'"
- (prin1-to-string this)))))
- (values slotsn (nreverse slotslist) (nreverse initlist))))
-\f
-(defun parse$defstruct$options (name options slots)
- "(parse$defstruct$options name OPTIONS SLOTS) => many values
-A defstruct named NAME, with options list OPTIONS, has already slots SLOTS.
-Parse the OPTIONS and return the updated form of the struct's slots and other
-information. The values returned are:
-
- CONC-NAME is the string to use as prefix/suffix in the methods,
- CONST is the name of the official constructor,
- COPIER is the name of the structure copier,
- PRED is the name of the type predicate,
- MORESLOTSN is the number of slots added by :include,
- MORESLOTS is the list of slots added by :include,
- MOREINITS is the list of initialization forms added by :include,
- INCLUDED is nil, or the list of the symbol added by :include"
- (let* ((namestring (symbol-name name))
- ;; to build the return values
- (conc-name (concat namestring "-"))
- (const (intern (concat "make-" namestring)))
- (copier (intern (concat "copy-" namestring)))
- (pred (intern (concat namestring "-p")))
- (moreslotsn 0)
- (moreslots '())
- (moreinits '())
- ;; auxiliaries
- option-head ;When an option is not a plain
- option-second ; keyword, it must be a list of
- option-rest ; the form (head second . rest)
- these-slotsn ;When :include is found, the
- these-slots ; info about the included
- these-inits ; structure is added here.
- included ;NIL or (list INCLUDED)
- )
- ;; Values above are the defaults. Now we read the options themselves
- (dolist (option options)
- ;; 2 cases arise, as options must be a keyword or a list
- (cond
- ((keywordp option)
- (case option
- (:named
- ) ;ignore silently
- (t
- (error "can't recognize option `%s'"
- (prin1-to-string option)))))
- ((and (listp option)
- (keywordp (setq option-head (car option))))
- (setq option-second (second option))
- (setq option-rest (nthcdr 2 option))
- (case option-head
- (:conc-name
- (setq conc-name
- (cond
- ((stringp option-second)
- option-second)
- ((null option-second)
- "")
- (t
- (error "`%s' is invalid as `conc-name'"
- (prin1-to-string option-second))))))
- (:copier
- (setq copier
- (cond
- ((and (symbolp option-second)
- (null option-rest))
- option-second)
- (t
- (error "can't recognize option `%s'"
- (prin1-to-string option))))))
-\f
- (:constructor ;no BOA-constructors allowed
- (setq const
- (cond
- ((and (symbolp option-second)
- (null option-rest))
- option-second)
- (t
- (error "can't recognize option `%s'"
- (prin1-to-string option))))))
- (:predicate
- (setq pred
- (cond
- ((and (symbolp option-second)
- (null option-rest))
- option-second)
- (t
- (error "can't recognize option `%s'"
- (prin1-to-string option))))))
- (:include
- (unless (symbolp option-second)
- (error "arg to `:include' should be a symbol, not `%s'"
- (prin1-to-string option-second)))
- (setq these-slotsn (get option-second :structure-slotsn)
- these-slots (get option-second :structure-slots)
- these-inits (get option-second :structure-initforms))
- (unless (and (numberp these-slotsn)
- (> these-slotsn 0))
- (error "`%s' is not a valid structure"
- (prin1-to-string option-second)))
- (if included
- (error "`%s' already includes `%s', can't include `%s' too"
- name (car included) option-second)
- (push option-second included))
- (multiple-value-bind
- (xtra-slotsn xtra-slots xtra-inits)
- (process$slots option-rest)
- (when (> xtra-slotsn 0)
- (dolist (xslot xtra-slots)
- (unless (memq xslot these-slots)
- (error "`%s' is not a slot of `%s'"
- (prin1-to-string xslot)
- (prin1-to-string option-second))))
- (setq these-inits (append xtra-inits these-inits)))
- (setq moreslotsn (+ moreslotsn these-slotsn))
- (setq moreslots (append these-slots moreslots))
- (setq moreinits (append these-inits moreinits))))
- ((:print-function :type :initial-offset)
- ) ;ignore silently
- (t
- (error "can't recognize option `%s'"
- (prin1-to-string option)))))
- (t
- (error "can't recognize option `%s'"
- (prin1-to-string option)))))
- ;; Return values found
- (values conc-name const copier pred
- moreslotsn moreslots moreinits
- included)))
-\f
-(defun simplify$inits (slots initlist)
- "(simplify$inits SLOTS INITLIST) => new INITLIST
-Removes from INITLIST - an ALIST - any shadowed bindings."
- (let ((result '()) ;built here
- key ;from the slot
- )
- (dolist (slot slots)
- (setq key (keyword-of slot))
- (setq result (acons key (cdr (assoc key initlist)) result)))
- (nreverse result)))
-
-(defun extract$indices (initlist)
- "(extract$indices INITLIST) => indices list
-Kludge. From a list of pairs (keyword . form) build a list of pairs
-of the form (keyword . position in list from 0). Useful to precompute
-some of the work of MAKE$STRUCTURE$INSTANCE."
- (let ((result '())
- (index 0))
- (dolist (entry initlist (nreverse result))
- (setq result (acons (car entry) index result)
- index (+ index 1)))))
-\f
-(defun build$accessors$for (name conc-name predicate slots slotsn)
- "(build$accessors$for NAME PREDICATE SLOTS SLOTSN) => FSETS DEFSETFS KWDS
-Generate the code for accesors and defsetfs of a structure called
-NAME, whose slots are SLOTS. Also, establishes the keywords for the
-slots names."
- (do ((i 0 (1+ i))
- (accessors '())
- (alterators '())
- (keywords '())
- (canonic "")) ;slot name with conc-name prepended
- ((>= i slotsn)
- (values
- (nreverse accessors) (nreverse alterators) (nreverse keywords)))
- (setq canonic (intern (concat conc-name (symbol-name (nth i slots)))))
- (setq accessors
- (cons
- (list 'fset (list 'quote canonic)
- (list 'function
- (list 'lambda (list 'object)
- (list 'cond
- (list (list predicate 'object)
- (list 'aref 'object (1+ i)))
- (list 't
- (list 'error
- "`%s' is not a struct %s"
- (list 'prin1-to-string
- 'object)
- (list 'prin1-to-string
- (list 'quote
- name))))))))
- accessors))
- (setq alterators
- (cons
- (list 'defsetf canonic
- (list 'lambda (list 'object 'newval)
- (list 'cond
- (list (list predicate 'object)
- (list 'aset 'object (1+ i) 'newval))
- (list 't
- (list 'error
- "`%s' not a `%s'"
- (list 'prin1-to-string
- 'object)
- (list 'prin1-to-string
- (list 'quote
- name)))))))
- alterators))
- (setq keywords
- (cons (list 'defkeyword (keyword-of (nth i slots)))
- keywords))))
-\f
-(defun make$structure$instance (name args)
- "(make$structure$instance NAME ARGS) => new struct NAME
-A struct of type NAME is created, some slots might be initialized
-according to ARGS (the &rest argument of MAKE-name)."
- (unless (symbolp name)
- (error "`%s' is not a possible name for a structure"
- (prin1-to-string name)))
- (let ((initforms (get name :structure-initforms))
- (slotsn (get name :structure-slotsn))
- (indices (get name :structure-indices))
- initalist ;pairlis'd on initforms
- initializers ;definitive initializers
- )
- ;; check sanity of the request
- (unless (and (numberp slotsn)
- (> slotsn 0))
- (error "`%s' is not a defined structure"
- (prin1-to-string name)))
- (unless (evenp (length args))
- (error "slot initializers `%s' not of even length"
- (prin1-to-string args)))
- ;; analyze the initializers provided by the call
- (multiple-value-bind
- (speckwds specvals) ;keywords and values given
- (unzip-list args) ; by the user
- ;; check that all the arguments are introduced by keywords
- (unless (every (function keywordp) speckwds)
- (error "all of the names in `%s' should be keywords"
- (prin1-to-string speckwds)))
- ;; check that all the keywords are known
- (dolist (kwd speckwds)
- (unless (numberp (cdr (assoc kwd indices)))
- (error "`%s' is not a valid slot name for %s"
- (prin1-to-string kwd) (prin1-to-string name))))
- ;; update initforms
- (setq initalist
- (pairlis speckwds
- (do* ;;protect values from further evaluation
- ((ptr specvals (cdr ptr))
- (val (car ptr) (car ptr))
- (result '()))
- ((endp ptr) (nreverse result))
- (setq result
- (cons (list 'quote val)
- result)))
- (copy-sequence initforms)))
- ;; compute definitive initializers
- (setq initializers
- (do* ;;gather the values of the most definitive forms
- ((ptr indices (cdr ptr))
- (key (caar ptr) (caar ptr))
- (result '()))
- ((endp ptr) (nreverse result))
- (setq result
- (cons (eval (cdr (assoc key initalist))) result))))
- ;; do real initialization
- (apply (function vector)
- (cons name initializers)))))
-
-;;;; end of cl-structs.el
-\f
-;;; For lisp-interaction mode, so that multiple values can be seen when passed
-;;; back. Lies every now and then...
-
-(defvar - nil "form currently under evaluation")
-(defvar + nil "previous -")
-(defvar ++ nil "previous +")
-(defvar +++ nil "previous ++")
-(defvar / nil "list of values returned by +")
-(defvar // nil "list of values returned by ++")
-(defvar /// nil "list of values returned by +++")
-(defvar * nil "(first) value of +")
-(defvar ** nil "(first) value of ++")
-(defvar *** nil "(first) value of +++")
-
-(defun cl-eval-print-last-sexp ()
- "Evaluate sexp before point; print value\(s\) into current buffer.
-If the evaled form returns multiple values, they are shown one to a line.
-The variables -, +, ++, +++, *, **, ***, /, //, /// have their usual meaning.
-
-It clears the multiple-value passing mechanism, and does not pass back
-multiple values. Use this only if you are debugging cl.el and understand well
-how the multiple-value stuff works, because it can be fooled into believing
-that multiple values have been returned when they actually haven't, for
-instance
- \(identity \(values nil 1\)\)
-However, even when this fails, you can trust the first printed value to be
-\(one of\) the returned value\(s\)."
- (interactive)
- ;; top level call, can reset mvalues
- (setq *mvalues-count* nil
- *mvalues-values* nil)
- (setq - (car (read-from-string
- (buffer-substring
- (let ((stab (syntax-table)))
- (unwind-protect
- (save-excursion
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (forward-sexp -1)
- (point))
- (set-syntax-table stab)))
- (point)))))
- (setq *** **
- ** *
- * (eval -))
- (setq /// //
- // /
- / *mvalues-values*)
- (setq +++ ++
- ++ +
- + -)
- (cond ((or (null *mvalues-count*) ;mvalues mechanism not used
- (not (eq * (car *mvalues-values*))))
- (print * (current-buffer)))
- ((null /) ;no values returned
- (terpri (current-buffer)))
- (t ;more than zero mvalues
- (terpri (current-buffer))
- (mapcar (function (lambda (value)
- (prin1 value (current-buffer))
- (terpri (current-buffer))))
- /)))
- (setq *mvalues-count* nil ;make sure
- *mvalues-values* nil))
-\f
-;;;; More LISTS functions
-;;;;
-
-;;; Some mapping functions on lists, commonly useful.
-;;; They take no extra sequences, to go along with Emacs Lisp's MAPCAR.
-
-(defun mapc (function list)
- "(MAPC FUNCTION LIST) => LIST
-Apply FUNCTION to each element of LIST, return LIST.
-Like mapcar, but called only for effect."
- (let ((args list))
- (while args
- (funcall function (car args))
- (setq args (cdr args))))
- list)
-
-(defun maplist (function list)
- "(MAPLIST FUNCTION LIST) => list'ed results of FUNCTION on cdrs of LIST
-Apply FUNCTION to successive sublists of LIST, return the list of the results"
- (let ((args list)
- results '())
- (while args
- (setq results (cons (funcall function args) results)
- args (cdr args)))
- (nreverse results)))
-
-(defun mapl (function list)
- "(MAPL FUNCTION LIST) => LIST
-Apply FUNCTION to successive cdrs of LIST, return LIST.
-Like maplist, but called only for effect."
- (let ((args list))
- (while args
- (funcall function args)
- (setq args (cdr args)))
- list))
-
-(defun mapcan (function list)
- "(MAPCAN FUNCTION LIST) => nconc'd results of FUNCTION on LIST
-Apply FUNCTION to each element of LIST, nconc the results.
-Beware: nconc destroys its first argument! See copy-list."
- (let ((args list)
- (results '()))
- (while args
- (setq results (nconc (funcall function (car args)) results)
- args (cdr args)))
- (nreverse results)))
-
-(defun mapcon (function list)
- "(MAPCON FUNCTION LIST) => nconc'd results of FUNCTION on cdrs of LIST
-Apply FUNCTION to successive sublists of LIST, nconc the results.
-Beware: nconc destroys its first argument! See copy-list."
- (let ((args list)
- (results '()))
- (while args
- (setq results (nconc (funcall function args) results)
- args (cdr args)))
- (nreverse results)))
-
-;;; Copiers
-
-(defsubst copy-list (list)
- "Build a copy of LIST"
- (append list '()))
-
-(defun copy-tree (tree)
- "Build a copy of the tree of conses TREE
-The argument is a tree of conses, it is recursively copied down to
-non conses. Circularity and sharing of substructure are not
-necessarily preserved."
- (if (consp tree)
- (cons (copy-tree (car tree))
- (copy-tree (cdr tree)))
- tree))
-
-;;; reversals, and destructive manipulations of a list's spine
-
-(defun revappend (x y)
- "does what (append (reverse X) Y) would, only faster"
- (if (endp x)
- y
- (revappend (cdr x) (cons (car x) y))))
-
-(defun nreconc (x y)
- "does (nconc (nreverse X) Y) would, only faster
-Destructive on X, be careful."
- (if (endp x)
- y
- ;; reuse the first cons of x, making it point to y
- (nreconc (cdr x) (prog1 x (rplacd x y)))))
-
-(defun nbutlast (list &optional n)
- "Side-effected LIST truncated N+1 conses from the end.
-This is the destructive version of BUTLAST. Returns () and does not
-modify the LIST argument if the length of the list is not at least N."
- (when (null n) (setf n 1))
- (let ((length (list-length list)))
- (cond ((null length)
- list)
- ((< length n)
- '())
- (t
- (setnthcdr (- length n) list nil)
- list))))
-\f
-;;; Substitutions
-
-(defun subst (new old tree)
- "NEW replaces OLD in a copy of TREE
-Uses eql for the test."
- (subst-if new (function (lambda (x) (eql x old))) tree))
-
-(defun subst-if-not (new test tree)
- "NEW replaces any subtree or leaf that fails TEST in a copy of TREE"
- ;; (subst-if new (function (lambda (x) (not (funcall test x)))) tree)
- (cond ((not (funcall test tree))
- new)
- ((atom tree)
- tree)
- (t ;no match so far
- (let ((head (subst-if-not new test (car tree)))
- (tail (subst-if-not new test (cdr tree))))
- ;; If nothing changed, return originals. Else use the new
- ;; components to assemble a new tree.
- (if (and (eql head (car tree))
- (eql tail (cdr tree)))
- tree
- (cons head tail))))))
-
-(defun subst-if (new test tree)
- "NEW replaces any subtree or leaf that satisfies TEST in a copy of TREE"
- (cond ((funcall test tree)
- new)
- ((atom tree)
- tree)
- (t ;no match so far
- (let ((head (subst-if new test (car tree)))
- (tail (subst-if new test (cdr tree))))
- ;; If nothing changed, return originals. Else use the new
- ;; components to assemble a new tree.
- (if (and (eql head (car tree))
- (eql tail (cdr tree)))
- tree
- (cons head tail))))))
-
-(defun sublis (alist tree)
- "Use association list ALIST to modify a copy of TREE
-If a subtree or leaf of TREE is a key in ALIST, it is replaced by the
-associated value. Not exactly Common Lisp, but close in spirit and
-compatible with the native Emacs Lisp ASSOC, which uses EQUAL."
- (let ((toplevel (assoc tree alist)))
- (cond (toplevel ;Bingo at top
- (cdr toplevel))
- ((atom tree) ;Give up on this
- tree)
- (t
- (let ((head (sublis alist (car tree)))
- (tail (sublis alist (cdr tree))))
- (if (and (eql head (car tree))
- (eql tail (cdr tree)))
- tree
- (cons head tail)))))))
-
-(defun member-if (predicate list)
- "PREDICATE is applied to the members of LIST. As soon as one of them
-returns true, that tail of the list if returned. Else NIL."
- (catch 'found-member-if
- (while (not (endp list))
- (if (funcall predicate (car list))
- (throw 'found-member-if list)
- (setq list (cdr list))))
- nil))
-
-(defun member-if-not (predicate list)
- "PREDICATE is applied to the members of LIST. As soon as one of them
-returns false, that tail of the list if returned. Else NIL."
- (catch 'found-member-if-not
- (while (not (endp list))
- (if (funcall predicate (car list))
- (setq list (cdr list))
- (throw 'found-member-if-not list)))
- nil))
-
-(defun tailp (sublist list)
- "(tailp SUBLIST LIST) => True if SUBLIST is a sublist of LIST."
- (catch 'tailp-found
- (while (not (endp list))
- (if (eq sublist list)
- (throw 'tailp-found t)
- (setq list (cdr list))))
- nil))
-\f
-;;; Suggestion of phr%widow.Berkeley.EDU@lilac.berkeley.edu
-
-(defmacro declare (&rest decls)
- "Ignore a Common-Lisp declaration."
- "declarations are ignored in this implementation")
-
-(defun proclaim (&rest decls)
- "Ignore a Common-Lisp proclamation."
- "declarations are ignored in this implementation")
-
-(defmacro the (type form)
- "(the TYPE FORM) macroexpands to FORM
-No checking is even attempted. This is just for compatibility with
-Common-Lisp codes."
- form)
-\f
-;;; Due to Aaron Larson (alarson@src.honeywell.com, 26 Jul 91)
-(put 'progv 'common-lisp-indent-hook '(4 4 &body))
-(defmacro progv (vars vals &rest body)
- "progv vars vals &body forms
-bind vars to vals then execute forms.
-If there are more vars than vals, the extra vars are unbound, if
-there are more vals than vars, the extra vals are just ignored."
- (` (progv$runtime (, vars) (, vals) (function (lambda () (,@ body))))))
-
-;;; To do this efficiently, it really needs to be a special form...
-(defun progv$runtime (vars vals body)
- (eval (let ((vars-n-vals nil)
- (unbind-forms nil))
- (do ((r vars (cdr r))
- (l vals (cdr l)))
- ((endp r))
- (push (list (car r) (list 'quote (car l))) vars-n-vals)
- (if (null l)
- (push (` (makunbound '(, (car r)))) unbind-forms)))
- (` (let (, vars-n-vals) (,@ unbind-forms) (funcall '(, body)))))))
-
-(provide 'cl)
-
-;;;; end of cl.el
+++ /dev/null
-;;; cmulisp.el --- improved version of standard inferior-lisp mode
-
-;;; Copyright Olin Shivers (1988).
-
-;; Keywords: processes, lisp
-
-;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
-;;; notice appearing here to the effect that you may use this code any
-;;; way you like, as long as you don't charge money for it, remove this
-;;; notice, or hold me liable for its results.
-
-;;; Commentary:
-
-;;; This replaces the standard inferior-lisp mode.
-;;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
-;;; Please send me bug reports, bug fixes, and extensions, so that I can
-;;; merge them into the master source.
-;;;
-;;; Change log at end of file.
-
-;;; This file defines a a lisp-in-a-buffer package (cmulisp mode) built on top
-;;; of comint mode. Cmulisp mode is similar to, and intended to replace, its
-;;; counterpart in the standard gnu emacs release. This replacements is more
-;;; featureful, robust, and uniform than the released 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 cmulisp 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 cmulisp (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?
-
-(require 'comint)
-;; YOUR .EMACS FILE
-;;=============================================================================
-;; Some suggestions for your .emacs file.
-;;
-;; ; If cmulisp 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 cmulisp from file cmulisp.el
-;; (autoload 'cmulisp "cmulisp"
-;; "Run an inferior Lisp process."
-;; t)
-;;
-;; ; Define C-c t to run my favorite command in cmulisp mode:
-;; (setq cmulisp-load-hook
-;; '((lambda ()
-;; (define-key cmulisp-mode-map "\C-ct" 'favorite-cmd))))
-
-;; Brief Command Documentation:
-;;============================================================================
-;; Comint Mode Commands: (common to cmulisp and all comint-derived modes)
-;;
-;; m-p comint-previous-input Cycle backwards in input history
-;; m-n comint-next-input Cycle forwards
-;; 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
-;; 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.
-
-;; CMU Lisp Mode Commands:
-;; c-m-x lisp-send-defun This binding is a gnu convention.
-;; c-c c-l lisp-load-file Prompt for file name; tell Lisp to load it.
-;; c-c c-k lisp-compile-file Prompt for file name; tell Lisp to kompile it.
-;; Filename completion is available, of course.
-;;
-;; Additionally, these commands are added to the key bindings of Lisp mode:
-;; c-m-x lisp-eval-defun This binding is a gnu convention.
-;; c-c c-e lisp-eval-defun Send the current defun to Lisp process.
-;; c-x c-e lisp-eval-last-sexp Send the previous sexp to Lisp process.
-;; c-c c-r lisp-eval-region Send the current region to Lisp process.
-;; c-c c-c lisp-compile-defun Compile the current defun in Lisp process.
-;; c-c c-z switch-to-lisp Switch to the Lisp process buffer.
-;; c-c c-l lisp-load-file (See above. In a Lisp file buffer, default
-;; c-c c-k lisp-compile-file is to load/compile the current file.)
-;; c-c c-d lisp-describe-sym Query Lisp for a symbol's description.
-;; c-c c-a lisp-show-arglist Query Lisp for function's arglist.
-;; c-c c-f lisp-show-function-documentation Query Lisp for a function's doc.
-;; c-c c-v lisp-show-variable-documentation Query Lisp for a variable's doc.
-
-;; cmulisp Fires up the Lisp process.
-;; lisp-compile-region Compile all forms in the current region.
-;;
-;; CMU Lisp Mode Variables:
-;; cmulisp-filter-regexp Match this => don't get saved on input hist
-;; inferior-lisp-program Name of Lisp program run-lisp executes
-;; inferior-lisp-load-command Customises lisp-load-file
-;; cmulisp-mode-hook
-;; inferior-lisp-prompt Initialises comint-prompt-regexp.
-;; Backwards compatibility.
-;; lisp-source-modes Anything loaded into a buffer that's in
-;; one of these modes is considered Lisp
-;; source by lisp-load/compile-file.
-
-;;; Code:
-
-(require 'comint)
-
-;;; Read the rest of this file for more information.
-\f
-
-;;; Code:
-
-(defvar cmulisp-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 cmulisp
-mode. Default is whitespace followed by 0 or 1 single-letter :keyword
-(as in :a, :c, etc.)")
-
-(defvar cmulisp-mode-map nil)
-(cond ((not cmulisp-mode-map)
- (setq cmulisp-mode-map
- (nconc (full-copy-sparse-keymap comint-mode-map)
- shared-lisp-mode-map))
- (define-key cmulisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp)
- (define-key cmulisp-mode-map "\C-c\C-l" 'lisp-load-file)
- (define-key cmulisp-mode-map "\C-c\C-k" 'lisp-compile-file)
- (define-key cmulisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
- (define-key cmulisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
- (define-key cmulisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
- (define-key cmulisp-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)
-
-(defvar cmulisp-buffer)
-
-;;; This function exists for backwards compatibility.
-;;; Previous versions of this package bound commands to C-c <letter>
-;;; bindings, which is not allowed by the gnumacs standard.
-
-(defun cmulisp-install-letter-bindings ()
- "This function binds many cmulisp commands to C-c <letter> bindings,
-where they are more accessible. C-c <letter> bindings are reserved for the
-user, so these bindings are non-standard. If you want them, you should
-have this function called by the cmulisp-load-hook:
- (setq cmulisp-load-hook '(cmulisp-install-letter-bindings))
-You can modify this function to install just the bindings you want."
-
- (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 cmulisp-mode-map "\C-cl" 'lisp-load-file)
- (define-key cmulisp-mode-map "\C-ck" 'lisp-compile-file)
- (define-key cmulisp-mode-map "\C-ca" 'lisp-show-arglist)
- (define-key cmulisp-mode-map "\C-cd" 'lisp-describe-sym)
- (define-key cmulisp-mode-map "\C-cf" 'lisp-show-function-documentation)
- (define-key cmulisp-mode-map "\C-cv" 'lisp-show-variable-documentation))
-
-
-(defvar inferior-lisp-program "lisp"
- "*Program name for invoking an inferior Lisp with `cmulisp'.")
-
-(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.")
-
-(defvar inferior-lisp-prompt "^[^> ]*>+:? *"
- "Regexp to recognise prompts in the inferior Lisp.
-Defaults to \"^[^> ]*>+:? *\", which works pretty good for Lucid, kcl,
-and franz. This variable is used to initialise comint-prompt-regexp in the
-cmulisp buffer.
-
-More precise choices:
-Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
-franz: \"^\\(->\\|<[0-9]*>:\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file.")
-
-(defvar cmulisp-mode-hook '()
- "*Hook for customising cmulisp mode")
-
-(defun cmulisp-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, cmulisp-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 cmulisp-buffer.
-
-\\{cmulisp-mode-map}
-
-Customisation: Entry to this mode runs the hooks on comint-mode-hook and
-cmulisp-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 'cmulisp-mode)
- (setq mode-name "CMU Lisp")
- (setq mode-line-process '(": %s"))
- (lisp-mode-variables t)
- (use-local-map cmulisp-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 'cmulisp-mode-hook))
-
-(defun lisp-get-old-input ()
- "Snarf the sexp ending at point"
- (save-excursion
- (let ((end (point)))
- (backward-sexp)
- (buffer-substring (point) end))))
-
-(defun lisp-input-filter (str)
- "Don't save anything matching cmulisp-filter-regexp"
- (not (string-match cmulisp-filter-regexp str)))
-
-(defun cmulisp (cmd)
- "Run an inferior Lisp process, input and output via buffer *cmulisp*.
-If there is a process already running in *cmulisp*, 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 cmulisp-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 "*cmulisp*"))
- (let ((cmdlist (cmulisp-args-to-list cmd)))
- (set-buffer (apply (function make-comint) "cmulisp" (car cmdlist) nil
- (cdr cmdlist)))
- (cmulisp-mode)))
- (setq cmulisp-buffer "*cmulisp*")
- (switch-to-buffer "*cmulisp*"))
-
-;;; 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 cmulisp-args-to-list (string)
- (let ((where (string-match "[ \t]" string)))
- (cond ((null where) (list string))
- ((not (= where 0))
- (cons (substring string 0 where)
- (tea-args-to-list (substring string (+ 1 where)
- (length string)))))
- (t (let ((pos (string-match "[^ \t]" string)))
- (if (null pos)
- nil
- (cmulisp-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-lisp afterwards."
- (interactive "r\nP")
- (comint-send-region (cmulisp-proc) start end)
- (comint-send-string (cmulisp-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-lisp 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-lisp 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-lisp afterwards."
- (interactive "r\nP")
- (comint-send-string (cmulisp-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-lisp 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 cmulisp-buffer)
- (pop-to-buffer cmulisp-buffer)
- (error "No current process buffer. See variable cmulisp-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 the process 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 the process 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 the process 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 the process 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 "cmulisp" (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 "cmulisp" (buffer-substring body-start (point))))
-; (process-send-string "cmulisp" ")\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
- "Saves the (directory . file) pair used in the last lisp-load-file or
-lisp-compile-file command. Used for determining the default in the
-next one.")
-
-(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 (cmulisp-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 (cmulisp-proc) (concat "(compile-file \""
- file-name
- "\"\)\n"))
- (switch-to-lisp t))
-
-
-\f
-;;; 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.
-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 (cmulisp-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 (cmulisp-proc) (format lisp-var-doc-command var)))
-
-(defun lisp-show-arglist (fn)
- "Sends an 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 (cmulisp-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 (cmulisp-proc) (format lisp-describe-sym-command sym)))
-
-\f
-(defvar cmulisp-buffer nil "*The current cmulisp process buffer.
-
-MULTIPLE PROCESS SUPPORT
-===========================================================================
-Cmulisp.el supports, in a fairly simple fashion, running multiple Lisp
-processes. To run multiple Lisp processes, you start the first up with
-\\[cmulisp]. It will be in a buffer named *cmulisp*. Rename this buffer
-with \\[rename-buffer]. You may now start up a new process with another
-\\[cmulisp]. It will be in a new buffer, named *cmulisp*. 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 cmulisp-buffer. Suppose you
-have three inferior lisps running:
- Buffer Process
- foo cmulisp
- bar cmulisp<2>
- *cmulisp* cmulisp<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 *cmulisp*),
- 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 cmulisp-buffer.
-This process selection is performed by function cmulisp-proc.
-
-Whenever \\[cmulisp] fires up a new process, it resets cmulisp-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
-cmulisp-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 processes. The approach taken here is for a
-minimal, simple implementation. Feel free to extend it.")
-
-(defun cmulisp-proc ()
- "Returns the current cmulisp process. See variable cmulisp-buffer."
- (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode)
- (current-buffer)
- cmulisp-buffer))))
- (or proc
- (error "No current process. See variable cmulisp-buffer"))))
-
-
-;;; Do the user's customisation...
-;;;===============================
-(defvar cmulisp-load-hook nil
- "This hook is run when cmulisp is loaded in.
-This is a good place to put keybindings.")
-
-(run-hooks 'cmulisp-load-hook)
-
-;;; CHANGE LOG
-;;; ===========================================================================
-;;; 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 <letter>. 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-<letter>.
-;;; - If M-x cmulisp is invoked with a prefix arg, it allows you to
-;;; edit the command line.
-
-(provide 'cmulisp)
-
-;;; cmulisp.el ends here
+++ /dev/null
-;;; custom.el -- Tools for declaring and initializing options.
-;;
-;; Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc.
-;;
-;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
-;; Keywords: help, 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-;; This file only contain the code needed to declare and initialize
-;; user options. The code to customize options is autoloaded from
-;; `cus-edit.el' and is documented in the Emacs Lisp Reference manual.
-
-;; The code implementing face declarations is in `cus-face.el'
-
-;;; Code:
-
-(require 'widget)
-
-(defvar custom-define-hook nil
- ;; Customize information for this option is in `cus-edit.el'.
- "Hook called after defining each customize option.")
-
-;;; The `defcustom' Macro.
-
-(defun custom-initialize-default (symbol value)
- "Initialize SYMBOL with VALUE.
-This will do nothing if symbol already has a default binding.
-Otherwise, if symbol has a `saved-value' property, it will evaluate
-the car of that and used as the default binding for symbol.
-Otherwise, VALUE will be evaluated and used as the default binding for
-symbol."
- (unless (default-boundp symbol)
- ;; Use the saved value if it exists, otherwise the standard setting.
- (set-default symbol (if (get symbol 'saved-value)
- (eval (car (get symbol 'saved-value)))
- (eval value)))))
-
-(defun custom-initialize-set (symbol value)
- "Initialize SYMBOL based on VALUE.
-If the symbol doesn't have a default binding already,
-then set it using its `:set' function (or `set-default' if it has none).
-The value is either the value in the symbol's `saved-value' property,
-if any, or VALUE."
- (unless (default-boundp symbol)
- (funcall (or (get symbol 'custom-set) 'set-default)
- symbol
- (if (get symbol 'saved-value)
- (eval (car (get symbol 'saved-value)))
- (eval value)))))
-
-(defun custom-initialize-reset (symbol value)
- "Initialize SYMBOL based on VALUE.
-Set the symbol, using its `:set' function (or `set-default' if it has none).
-The value is either the symbol's current value
- \(as obtained using the `:get' function), if any,
-or the value in the symbol's `saved-value' property if any,
-or (last of all) VALUE."
- (funcall (or (get symbol 'custom-set) 'set-default)
- symbol
- (cond ((default-boundp symbol)
- (funcall (or (get symbol 'custom-get) 'default-value)
- symbol))
- ((get symbol 'saved-value)
- (eval (car (get symbol 'saved-value))))
- (t
- (eval value)))))
-
-(defun custom-initialize-changed (symbol value)
- "Initialize SYMBOL with VALUE.
-Like `custom-initialize-reset', but only use the `:set' function if the
-not using the standard setting.
-For the standard setting, use the `set-default'."
- (cond ((default-boundp symbol)
- (funcall (or (get symbol 'custom-set) 'set-default)
- symbol
- (funcall (or (get symbol 'custom-get) 'default-value)
- symbol)))
- ((get symbol 'saved-value)
- (funcall (or (get symbol 'custom-set) 'set-default)
- symbol
- (eval (car (get symbol 'saved-value)))))
- (t
- (set-default symbol (eval value)))))
-
-(defun custom-declare-variable (symbol default doc &rest args)
- "Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
-DEFAULT should be an expression to evaluate to compute the default value,
-not the default value itself."
- ;; Remember the standard setting.
- (put symbol 'standard-value (list default))
- ;; Maybe this option was rogue in an earlier version. It no longer is.
- (when (get symbol 'force-value)
- (put symbol 'force-value nil))
- (when doc
- (put symbol 'variable-documentation doc))
- (let ((initialize 'custom-initialize-reset)
- (requests nil))
- (while args
- (let ((arg (car args)))
- (setq args (cdr args))
- (unless (symbolp arg)
- (error "Junk in args %S" args))
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" keyword))
- (setq args (cdr args))
- (cond ((eq keyword :initialize)
- (setq initialize value))
- ((eq keyword :set)
- (put symbol 'custom-set value))
- ((eq keyword :get)
- (put symbol 'custom-get value))
- ((eq keyword :require)
- (setq requests (cons value requests)))
- ((eq keyword :type)
- (put symbol 'custom-type (purecopy value)))
- ((eq keyword :options)
- (if (get symbol 'custom-options)
- ;; Slow safe code to avoid duplicates.
- (mapc (lambda (option)
- (custom-add-option symbol option))
- value)
- ;; Fast code for the common case.
- (put symbol 'custom-options (copy-sequence value))))
- (t
- (custom-handle-keyword symbol keyword value
- 'custom-variable))))))
- (put symbol 'custom-requests requests)
- ;; Do the actual initialization.
- (funcall initialize symbol default))
- (setq current-load-list (cons symbol current-load-list))
- (run-hooks 'custom-define-hook)
- symbol)
-
-(defmacro defcustom (symbol value doc &rest args)
- "Declare SYMBOL as a customizable variable that defaults to VALUE.
-DOC is the variable documentation.
-
-Neither SYMBOL nor VALUE needs to be quoted.
-If SYMBOL is not already bound, initialize it to VALUE.
-The remaining arguments should have the form
-
- [KEYWORD VALUE]...
-
-The following keywords are meaningful:
-
-:type VALUE should be a widget type for editing the symbols value.
- The default is `sexp'.
-:options VALUE should be a list of valid members of the widget type.
-:group VALUE should be a customization group.
- Add SYMBOL to that group.
-:initialize
- VALUE should be a function used to initialize the
- variable. It takes two arguments, the symbol and value
- given in the `defcustom' call. The default is
- `custom-initialize-default'
-:set VALUE should be a function to set the value of the symbol.
- It takes two arguments, the symbol to set and the value to
- give it. The default choice of function is `custom-set-default'.
-:get VALUE should be a function to extract the value of symbol.
- The function takes one argument, a symbol, and should return
- the current value for that symbol. The default choice of function
- is `custom-default-value'.
-:require
- VALUE should be a feature symbol. If you save a value
- for this option, then when your `.emacs' file loads the value,
- it does (require VALUE) first.
-:version
- VALUE should be a string specifying that the variable was
- first introduced, or its default value was changed, in Emacs
- version VERSION.
-
-Read the section about customization in the Emacs Lisp manual for more
-information."
- ;; It is better not to use backquote in this file,
- ;; because that makes a bootstrapping problem
- ;; if you need to recompile all the Lisp files using interpreted code.
- (nconc (list 'custom-declare-variable
- (list 'quote symbol)
- (list 'quote value)
- doc)
- args))
-
-;;; The `defface' Macro.
-
-(defmacro defface (face spec doc &rest args)
- "Declare FACE as a customizable face that defaults to SPEC.
-FACE does not need to be quoted.
-
-Third argument DOC is the face documentation.
-
-If FACE has been set with `custom-set-face', set the face attributes
-as specified by that function, otherwise set the face attributes
-according to SPEC.
-
-The remaining arguments should have the form
-
- [KEYWORD VALUE]...
-
-The following KEYWORDs are defined:
-
-:group VALUE should be a customization group.
- Add FACE to that group.
-
-SPEC should be an alist of the form ((DISPLAY ATTS)...).
-
-The first element of SPEC where the DISPLAY matches the frame
-is the one that takes effect in that frame. The ATTRs in this
-element take effect; the other elements are ignored, on that frame.
-
-ATTS is a list of face attributes followed by their values:
- (ATTR VALUE ATTR VALUE...)
-
-The possible attributes are `:family', `:width', `:height', `:weight',
-`:slant', `:underline', `:overline', `:strike-through', `:box',
-`:foreground', `:background', `:stipple', and `:inverse-video'.
-
-DISPLAY can either be the symbol t, which will match all frames, or an
-alist of the form \((REQ ITEM...)...). For the DISPLAY to match a
-FRAME, the REQ property of the frame must match one of the ITEM. The
-following REQ are defined:
-
-`type' (the value of `window-system')
- Under X, in addition to the values `window-system' can take,
- `motif', `lucid' and `x-toolkit' are allowed, and match when
- the Motif toolkit, Lucid toolkit, or any X toolkit is in use.
-
-`class' (the frame's color support)
- Should be one of `color', `grayscale', or `mono'.
-
-`background' (what color is used for the background text)
- Should be one of `light' or `dark'.
-
-Read the section about customization in the Emacs Lisp manual for more
-information."
- ;; It is better not to use backquote in this file,
- ;; because that makes a bootstrapping problem
- ;; if you need to recompile all the Lisp files using interpreted code.
- (nconc (list 'custom-declare-face (list 'quote face) spec doc) args))
-
-;;; The `defgroup' Macro.
-
-(defun custom-declare-group (symbol members doc &rest args)
- "Like `defgroup', but SYMBOL is evaluated as a normal argument."
- (while members
- (apply 'custom-add-to-group symbol (car members))
- (setq members (cdr members)))
- (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
- (when doc
- ;; This text doesn't get into DOC.
- (put symbol 'group-documentation (purecopy doc)))
- (while args
- (let ((arg (car args)))
- (setq args (cdr args))
- (unless (symbolp arg)
- (error "Junk in args %S" args))
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" keyword))
- (setq args (cdr args))
- (cond ((eq keyword :prefix)
- (put symbol 'custom-prefix value))
- (t
- (custom-handle-keyword symbol keyword value
- 'custom-group))))))
- (run-hooks 'custom-define-hook)
- symbol)
-
-(defmacro defgroup (symbol members doc &rest args)
- "Declare SYMBOL as a customization group containing MEMBERS.
-SYMBOL does not need to be quoted.
-
-Third arg DOC is the group documentation.
-
-MEMBERS should be an alist of the form ((NAME WIDGET)...) where
-NAME is a symbol and WIDGET is a widget for editing that symbol.
-Useful widgets are `custom-variable' for editing variables,
-`custom-face' for edit faces, and `custom-group' for editing groups.
-
-The remaining arguments should have the form
-
- [KEYWORD VALUE]...
-
-The following KEYWORDs are defined:
-
-:group VALUE should be a customization group.
- Add SYMBOL to that group.
-
-:version VALUE should be a string specifying that the group was introduced
- in Emacs version VERSION.
-
-Read the section about customization in the Emacs Lisp manual for more
-information."
- ;; It is better not to use backquote in this file,
- ;; because that makes a bootstrapping problem
- ;; if you need to recompile all the Lisp files using interpreted code.
- (nconc (list 'custom-declare-group (list 'quote symbol) members doc) args))
-
-(defun custom-add-to-group (group option widget)
- "To existing GROUP add a new OPTION of type WIDGET.
-If there already is an entry for OPTION and WIDGET, nothing is done."
- (let ((members (get group 'custom-group))
- (entry (list option widget)))
- (unless (member entry members)
- (put group 'custom-group (nconc members (list entry))))))
-
-;;; Properties.
-
-(defun custom-handle-all-keywords (symbol args type)
- "For customization option SYMBOL, handle keyword arguments ARGS.
-Third argument TYPE is the custom option type."
- (while args
- (let ((arg (car args)))
- (setq args (cdr args))
- (unless (symbolp arg)
- (error "Junk in args %S" args))
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" keyword))
- (setq args (cdr args))
- (custom-handle-keyword symbol keyword value type)))))
-
-(defun custom-handle-keyword (symbol keyword value type)
- "For customization option SYMBOL, handle KEYWORD with VALUE.
-Fourth argument TYPE is the custom option type."
- (if purify-flag
- (setq value (purecopy value)))
- (cond ((eq keyword :group)
- (custom-add-to-group value symbol type))
- ((eq keyword :version)
- (custom-add-version symbol value))
- ((eq keyword :link)
- (custom-add-link symbol value))
- ((eq keyword :load)
- (custom-add-load symbol value))
- ((eq keyword :tag)
- (put symbol 'custom-tag value))
- ((eq keyword :set-after)
- (custom-add-dependencies symbol value))
- (t
- (error "Unknown keyword %s" keyword))))
-
-(defun custom-add-dependencies (symbol value)
- "To the custom option SYMBOL, add dependencies specified by VALUE.
-VALUE should be a list of symbols. For each symbol in that list,
-this specifies that SYMBOL should be set after the specified symbol, if
-both appear in constructs like `custom-set-variables'."
- (unless (listp value)
- (error "Invalid custom dependency `%s'" value))
- (let* ((deps (get symbol 'custom-dependencies))
- (new-deps deps))
- (while value
- (let ((dep (car value)))
- (unless (symbolp dep)
- (error "Invalid custom dependency `%s'" dep))
- (unless (memq dep new-deps)
- (setq new-deps (cons dep new-deps)))
- (setq value (cdr value))))
- (unless (eq deps new-deps)
- (put symbol 'custom-dependencies new-deps))))
-
-(defun custom-add-option (symbol option)
- "To the variable SYMBOL add OPTION.
-
-If SYMBOL is a hook variable, OPTION should be a hook member.
-For other types variables, the effect is undefined."
- (let ((options (get symbol 'custom-options)))
- (unless (member option options)
- (put symbol 'custom-options (cons option options)))))
-
-(defun custom-add-link (symbol widget)
- "To the custom option SYMBOL add the link WIDGET."
- (let ((links (get symbol 'custom-links)))
- (unless (member widget links)
- (put symbol 'custom-links (cons (purecopy widget) links)))))
-
-(defun custom-add-version (symbol version)
- "To the custom option SYMBOL add the version VERSION."
- (put symbol 'custom-version (purecopy version)))
-
-(defun custom-add-load (symbol load)
- "To the custom option SYMBOL add the dependency LOAD.
-LOAD should be either a library file name, or a feature name."
- (let ((loads (get symbol 'custom-loads)))
- (unless (member load loads)
- (put symbol 'custom-loads (cons (purecopy load) loads)))))
-
-;;; Initializing.
-
-(defvar custom-local-buffer nil
- "Non-nil, in a Customization buffer, means customize a specific buffer.
-If this variable is non-nil, it should be a buffer,
-and it means customize the local bindings of that buffer.
-This variable is a permanent local, and it normally has a local binding
-in every Customization buffer.")
-(put 'custom-local-buffer 'permanent-local t)
-
-(defun custom-set-variables (&rest args)
- "Initialize variables according to user preferences.
-
-The arguments should be a list where each entry has the form:
-
- (SYMBOL VALUE [NOW [REQUEST [COMMENT]]])
-
-The unevaluated VALUE is stored as the saved value for SYMBOL.
-If NOW is present and non-nil, VALUE is also evaluated and bound as
-the default value for the SYMBOL.
-REQUEST is a list of features we must require for SYMBOL.
-COMMENT is a comment string about SYMBOL."
- (setq args
- (sort args
- (lambda (a1 a2)
- (let* ((sym1 (car a1))
- (sym2 (car a2))
- (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
- (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
- (cond ((and 1-then-2 2-then-1)
- (error "Circular custom dependency between `%s' and `%s'"
- sym1 sym2))
- (2-then-1 nil)
- (t t))))))
- (while args
- (let ((entry (car args)))
- (if (listp entry)
- (let* ((symbol (nth 0 entry))
- (value (nth 1 entry))
- (now (nth 2 entry))
- (requests (nth 3 entry))
- (comment (nth 4 entry))
- set)
- (when requests
- (put symbol 'custom-requests requests)
- (mapc 'require requests))
- (setq set (or (get symbol 'custom-set) 'custom-set-default))
- (put symbol 'saved-value (list value))
- (put symbol 'saved-variable-comment comment)
- ;; Allow for errors in the case where the setter has
- ;; changed between versions, say, but let the user know.
- (condition-case data
- (cond (now
- ;; Rogue variable, set it now.
- (put symbol 'force-value t)
- (funcall set symbol (eval value)))
- ((default-boundp symbol)
- ;; Something already set this, overwrite it.
- (funcall set symbol (eval value))))
- (error
- (message "Error setting %s: %s" symbol data)))
- (setq args (cdr args))
- (and (or now (default-boundp symbol))
- (put symbol 'variable-comment comment)))
- ;; Old format, a plist of SYMBOL VALUE pairs.
- (message "Warning: old format `custom-set-variables'")
- (ding)
- (sit-for 2)
- (let ((symbol (nth 0 args))
- (value (nth 1 args)))
- (put symbol 'saved-value (list value)))
- (setq args (cdr (cdr args)))))))
-
-(defun custom-set-default (variable value)
- "Default :set function for a customizable variable.
-Normally, this sets the default value of VARIABLE to VALUE,
-but if `custom-local-buffer' is non-nil,
-this sets the local binding in that buffer instead."
- (if custom-local-buffer
- (with-current-buffer custom-local-buffer
- (set variable value))
- (set-default variable value)))
-
-;;; The End.
-
-;; Process the defcustoms for variables loaded before this file.
-(while custom-declare-variable-list
- (apply 'custom-declare-variable (car custom-declare-variable-list))
- (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
-
-(provide 'custom)
-
-;;; custom.el ends here
+++ /dev/null
-;;; diary-ins.el --- calendar functions for adding diary entries.
-
-;; Copyright (C) 1990, 1994 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: diary, calendar
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This collection of functions implements the diary 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-lib)
-
-(defun make-diary-entry (string &optional nonmarking file)
- "Insert a diary entry STRING which may be NONMARKING in FILE.
-If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
- (find-file-other-window
- (substitute-in-file-name (if file file diary-file)))
- (goto-char (point-max))
- (insert
- (if (bolp) "" "\n")
- (if nonmarking diary-nonmarking-symbol "")
- string " "))
-
-(defun insert-diary-entry (arg)
- "Insert a diary entry for the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
- arg))
-
-(defun insert-weekly-diary-entry (arg)
- "Insert a weekly diary entry for the day of the week indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
- arg))
-
-(defun insert-monthly-diary-entry (arg)
- "Insert a monthly diary entry for the day of the month indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " * ")
- '("* " day))))
- (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
- arg)))
-
-(defun insert-yearly-diary-entry (arg)
- "Insert an annual diary entry for the day of the year indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname)
- '(monthname " " day))))
- (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
- arg)))
-
-(defun insert-anniversary-diary-entry (arg)
- "Insert an anniversary diary entry for the date given by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " month " " year)
- '(month " " day " " year))))
- (make-diary-entry
- (format "%s(diary-anniversary %s)"
- sexp-diary-entry-symbol
- (calendar-date-string (calendar-cursor-to-date t) nil t))
- arg)))
-
-(defun insert-block-diary-entry (arg)
- "Insert a block diary entry for the days between the point and marked date.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " month " " year)
- '(month " " day " " year)))
- (cursor (calendar-cursor-to-date t))
- (mark (or (car calendar-mark-ring)
- (error "No mark set in this buffer")))
- (start)
- (end))
- (if (< (calendar-absolute-from-gregorian mark)
- (calendar-absolute-from-gregorian cursor))
- (setq start mark
- end cursor)
- (setq start cursor
- end mark))
- (make-diary-entry
- (format "%s(diary-block %s %s)"
- sexp-diary-entry-symbol
- (calendar-date-string start nil t)
- (calendar-date-string end nil t))
- arg)))
-
-(defun insert-cyclic-diary-entry (arg)
- "Insert a cyclic diary entry starting at the date given by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " month " " year)
- '(month " " day " " year))))
- (make-diary-entry
- (format "%s(diary-cyclic %d %s)"
- sexp-diary-entry-symbol
- (calendar-read "Repeat every how many days: "
- '(lambda (x) (> x 0)))
- (calendar-date-string (calendar-cursor-to-date t) nil t))
- arg)))
-
-(defun insert-hebrew-diary-entry (arg)
- "Insert a diary entry.
-For the Hebrew date corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-month-name-array
- calendar-hebrew-month-name-array-leap-year))
- (make-diary-entry
- (concat
- hebrew-diary-entry-symbol
- (calendar-date-string
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t)))
- nil t))
- arg)))
-
-(defun insert-monthly-hebrew-diary-entry (arg)
- "Insert a monthly diary entry.
-For the day of the Hebrew month corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style '(day " * ") '("* " day )))
- (calendar-month-name-array
- calendar-hebrew-month-name-array-leap-year))
- (make-diary-entry
- (concat
- hebrew-diary-entry-symbol
- (calendar-date-string
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t)))))
- arg)))
-
-(defun insert-yearly-hebrew-diary-entry (arg)
- "Insert an annual diary entry.
-For the day of the Hebrew year corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname)
- '(monthname " " day)))
- (calendar-month-name-array
- calendar-hebrew-month-name-array-leap-year))
- (make-diary-entry
- (concat
- hebrew-diary-entry-symbol
- (calendar-date-string
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t)))))
- arg)))
-
-(defun insert-islamic-diary-entry (arg)
- "Insert a diary entry.
-For the Islamic date corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-month-name-array calendar-islamic-month-name-array))
- (make-diary-entry
- (concat
- islamic-diary-entry-symbol
- (calendar-date-string
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t)))
- nil t))
- arg)))
-
-(defun insert-monthly-islamic-diary-entry (arg)
- "Insert a monthly diary entry.
-For the day of the Islamic month corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style '(day " * ") '("* " day )))
- (calendar-month-name-array calendar-islamic-month-name-array))
- (make-diary-entry
- (concat
- islamic-diary-entry-symbol
- (calendar-date-string
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t)))))
- arg)))
-
-(defun insert-yearly-islamic-diary-entry (arg)
- "Insert an annual diary entry.
-For the day of the Islamic year corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname)
- '(monthname " " day)))
- (calendar-month-name-array calendar-islamic-month-name-array))
- (make-diary-entry
- (concat
- islamic-diary-entry-symbol
- (calendar-date-string
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-cursor-to-date t)))))
- arg)))
-
-(provide 'diary-ins)
-
-;;; diary-ins.el ends here
+++ /dev/null
-;;; diary-lib.el --- diary functions.
-
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This collection of functions implements the diary features as described
-;; in calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;; Edward M. Reingold Department of Computer Science
-;; (217) 333-6733 University of Illinois at Urbana-Champaign
-;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
-;; Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-;;;###autoload
-(defun diary (&optional arg)
- "Generate the diary window for ARG days starting with the current date.
-If no argument is provided, the number of days of diary entries is governed
-by the variable `number-of-diary-entries'. This function is suitable for
-execution in a `.emacs' file."
- (interactive "P")
- (let ((d-file (substitute-in-file-name diary-file))
- (date (calendar-current-date)))
- (if (and d-file (file-exists-p d-file))
- (if (file-readable-p d-file)
- (list-diary-entries
- date
- (cond
- (arg (prefix-numeric-value arg))
- ((vectorp number-of-diary-entries)
- (aref number-of-diary-entries (calendar-day-of-week date)))
- (t number-of-diary-entries)))
- (error "Your diary file is not readable!"))
- (error "You don't have a diary file!"))))
-
-(defun view-diary-entries (arg)
- "Prepare and display a buffer with diary entries.
-Searches the file named in `diary-file' for entries that
-match ARG days starting with the date indicated by the cursor position
-in the displayed three-month calendar."
- (interactive "p")
- (let ((d-file (substitute-in-file-name diary-file)))
- (if (and d-file (file-exists-p d-file))
- (if (file-readable-p d-file)
- (list-diary-entries (calendar-cursor-to-date t) arg)
- (error "Diary file is not readable!"))
- (error "You don't have a diary file!"))))
-
-(defun view-other-diary-entries (arg diary-file)
- "Prepare and display buffer of diary entries from an alternative diary file.
-Prompts for a file name and searches that file for entries that match ARG
-days starting with the date indicated by the cursor position in the displayed
-three-month calendar."
- (interactive
- (list (cond ((null current-prefix-arg) 1)
- ((listp current-prefix-arg) (car current-prefix-arg))
- (t current-prefix-arg))
- (setq diary-file (read-file-name "Enter diary file name: "
- default-directory nil t))))
- (view-diary-entries arg))
-
-(autoload 'check-calendar-holidays "holidays"
- "Check the list of holidays for any that occur on DATE.
-The value returned is a list of strings of relevant holiday descriptions.
-The holidays are those in the list `calendar-holidays'."
- t)
-
-(autoload 'calendar-holiday-list "holidays"
- "Form the list of holidays that occur on dates in the calendar window.
-The holidays are those in the list `calendar-holidays'."
- t)
-
-(autoload 'diary-french-date "cal-french"
- "French calendar equivalent of date diary entry."
- t)
-
-(autoload 'diary-mayan-date "cal-mayan"
- "Mayan calendar equivalent of date diary entry."
- t)
-
-(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t)
-
-(autoload 'diary-sunrise-sunset "solar"
- "Local time of sunrise and sunset as a diary entry."
- t)
-
-(autoload 'diary-sabbath-candles "solar"
- "Local time of candle lighting diary entry--applies if date is a Friday.
-No diary entry if there is no sunset on that date."
- t)
-
-(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))
- "The syntax table used when parsing dates in the diary file.
-It is the standard syntax table used in Fundamental mode, but with the
-syntax of `*' changed to be a word constituent.")
-
-(modify-syntax-entry ?* "w" diary-syntax-table)
-
-(defun list-diary-entries (date number)
- "Create and display a buffer containing the relevant lines in diary-file.
-The arguments are DATE and NUMBER; the entries selected are those
-for NUMBER days starting with date DATE. The other entries are hidden
-using selective display.
-
-Returns a list of all relevant diary entries found, if any, in order by date.
-The list entries have the form ((month day year) string). If the variable
-`diary-list-include-blanks' is t, this list includes a dummy diary entry
-\(consisting of the empty string) for a date with no diary entries.
-
-After the list is prepared, the hooks `nongregorian-diary-listing-hook',
-`list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run.
-These hooks have the following distinct roles:
-
- `nongregorian-diary-listing-hook' can cull dates from the diary
- and each included file. Usually used for Hebrew or Islamic
- diary entries in files. Applied to *each* file.
-
- `list-diary-entries-hook' adds or manipulates diary entries from
- external sources. Used, for example, to include diary entries
- from other files or to sort the diary entries. Invoked *once* only,
- before the display hook is run.
-
- `diary-display-hook' does the actual display of information. If this is
- nil, simple-diary-display will be used. Use add-hook to set this to
- fancy-diary-display, if desired. If you want no diary display, use
- add-hook to set this to ignore.
-
- `diary-hook' is run last. This can be used for an appointment
- notification function."
-
- (if (< 0 number)
- (let* ((original-date date);; save for possible use in the hooks
- (old-diary-syntax-table)
- (diary-entries-list)
- (date-string (calendar-date-string date))
- (d-file (substitute-in-file-name diary-file)))
- (message "Preparing diary...")
- (save-excursion
- (let ((diary-buffer (get-file-buffer d-file)))
- (set-buffer (if diary-buffer
- diary-buffer
- (find-file-noselect d-file t))))
- (setq selective-display t)
- (setq selective-display-ellipses nil)
- (setq old-diary-syntax-table (syntax-table))
- (set-syntax-table diary-syntax-table)
- (unwind-protect
- (let ((buffer-read-only nil)
- (diary-modified (buffer-modified-p))
- (mark (regexp-quote diary-nonmarking-symbol)))
- (goto-char (1- (point-max)))
- (if (not (looking-at "\^M\\|\n"))
- (progn
- (forward-char 1)
- (insert-string "\^M")))
- (goto-char (point-min))
- (if (not (looking-at "\^M\\|\n"))
- (insert-string "\^M"))
- (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
- (calendar-for-loop i from 1 to number do
- (let ((d diary-date-forms)
- (month (extract-calendar-month date))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date))
- (entry-found (list-sexp-diary-entries date)))
- (while d
- (let*
- ((date-form (if (equal (car (car d)) 'backup)
- (cdr (car d))
- (car d)))
- (backup (equal (car (car d)) 'backup))
- (dayname
- (concat
- (calendar-day-name date) "\\|"
- (substring (calendar-day-name date) 0 3) ".?"))
- (monthname
- (concat
- "\\*\\|"
- (calendar-month-name month) "\\|"
- (substring (calendar-month-name month) 0 3) ".?"))
- (month (concat "\\*\\|0*" (int-to-string month)))
- (day (concat "\\*\\|0*" (int-to-string day)))
- (year
- (concat
- "\\*\\|0*" (int-to-string year)
- (if abbreviated-calendar-year
- (concat "\\|" (int-to-string (% year 100)))
- "")))
- (regexp
- (concat
- "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
- (mapconcat 'eval date-form "\\)\\(")
- "\\)"))
- (case-fold-search t))
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (if backup (re-search-backward "\\<" nil t))
- (if (and (or (char-equal (preceding-char) ?\^M)
- (char-equal (preceding-char) ?\n))
- (not (looking-at " \\|\^I")))
- ;; Diary entry that consists only of date.
- (backward-char 1)
- ;; Found a nonempty diary entry--make it visible and
- ;; add it to the list.
- (setq entry-found t)
- (let ((entry-start (point))
- (date-start))
- (re-search-backward "\^M\\|\n\\|\\`")
- (setq date-start (point))
- (re-search-forward "\^M\\|\n" nil t 2)
- (while (looking-at " \\|\^I")
- (re-search-forward "\^M\\|\n" nil t))
- (backward-char 1)
- (subst-char-in-region date-start
- (point) ?\^M ?\n t)
- (add-to-diary-list
- date (buffer-substring entry-start (point)))))))
- (setq d (cdr d)))
- (or entry-found
- (not diary-list-include-blanks)
- (setq diary-entries-list
- (append diary-entries-list
- (list (list date "")))))
- (setq date
- (calendar-gregorian-from-absolute
- (1+ (calendar-absolute-from-gregorian date))))
- (setq entry-found nil)))
- (set-buffer-modified-p diary-modified))
- (set-syntax-table old-diary-syntax-table))
- (goto-char (point-min))
- (run-hooks 'nongregorian-diary-listing-hook
- 'list-diary-entries-hook)
- (if diary-display-hook
- (run-hooks 'diary-display-hook)
- (simple-diary-display))
- (run-hooks 'diary-hook)
- diary-entries-list))))
-
-(defun include-other-diary-files ()
- "Include the diary entries from other diary files with those of diary-file.
-This function is suitable for use in `list-diary-entries-hook';
-it enables you to use shared diary files together with your own.
-The files included are specified in the diaryfile by lines of this form:
- #include \"filename\"
-This is recursive; that is, #include directives in diary files thus included
-are obeyed. You can change the `#include' to some other string by
-changing the variable `diary-include-string'."
- (goto-char (point-min))
- (while (re-search-forward
- (concat
- "\\(\\`\\|\^M\\|\n\\)"
- (regexp-quote diary-include-string)
- " \"\\([^\"]*\\)\"")
- nil t)
- (let ((diary-file (substitute-in-file-name
- (buffer-substring (match-beginning 2) (match-end 2))))
- (diary-list-include-blanks nil)
- (list-diary-entries-hook 'include-other-diary-files)
- (diary-display-hook 'ignore)
- (diary-hook nil))
- (if (file-exists-p diary-file)
- (if (file-readable-p diary-file)
- (unwind-protect
- (setq diary-entries-list
- (append diary-entries-list
- (list-diary-entries original-date number)))
- (kill-buffer (get-file-buffer diary-file)))
- (beep)
- (message "Can't read included diary file %s" diary-file)
- (sleep-for 2))
- (beep)
- (message "Can't find included diary file %s" diary-file)
- (sleep-for 2))))
- (goto-char (point-min)))
-
-(defun simple-diary-display ()
- "Display the diary buffer if there are any relevant entries or holidays."
- (let* ((holiday-list (if holidays-in-diary-buffer
- (check-calendar-holidays original-date)))
- (msg (format "No diary entries for %s %s"
- (concat date-string (if holiday-list ":" ""))
- (mapconcat 'identity holiday-list "; "))))
- (if (or (not diary-entries-list)
- (and (not (cdr diary-entries-list))
- (string-equal (car (cdr (car diary-entries-list))) "")))
- (if (<= (length msg) (frame-width))
- (message msg)
- (set-buffer (get-buffer-create holiday-buffer))
- (setq buffer-read-only nil)
- (calendar-set-mode-line date-string)
- (erase-buffer)
- (insert (mapconcat 'identity holiday-list "\n"))
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (display-buffer holiday-buffer)
- (message "No diary entries for %s" date-string))
- (calendar-set-mode-line
- (concat "Diary for " date-string
- (if holiday-list ": " "")
- (mapconcat 'identity holiday-list "; ")))
- (display-buffer (get-file-buffer d-file))
- (message "Preparing diary...done"))))
-
-(defun fancy-diary-display ()
- "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
-This function is provided for optional use as the `diary-display-hook'."
- (save-excursion;; Turn off selective-display in the diary file's buffer.
- (set-buffer (get-file-buffer (substitute-in-file-name diary-file)))
- (let ((diary-modified (buffer-modified-p)))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
- (setq selective-display nil)
- (kill-local-variable 'mode-line-format)
- (set-buffer-modified-p diary-modified)))
- (if (or (not diary-entries-list)
- (and (not (cdr diary-entries-list))
- (string-equal (car (cdr (car diary-entries-list))) "")))
- (let* ((holiday-list (if holidays-in-diary-buffer
- (check-calendar-holidays original-date)))
- (msg (format "No diary entries for %s %s"
- (concat date-string (if holiday-list ":" ""))
- (mapconcat 'identity holiday-list "; "))))
- (if (<= (length msg) (frame-width))
- (message msg)
- (set-buffer (get-buffer-create holiday-buffer))
- (setq buffer-read-only nil)
- (calendar-set-mode-line date-string)
- (erase-buffer)
- (insert (mapconcat 'identity holiday-list "\n"))
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (display-buffer holiday-buffer)
- (message "No diary entries for %s" date-string)))
- (save-excursion;; Prepare the fancy diary buffer.
- (set-buffer (make-fancy-diary-buffer))
- (setq buffer-read-only nil)
- (let ((entry-list diary-entries-list)
- (holiday-list)
- (holiday-list-last-month 1)
- (holiday-list-last-year 1)
- (date (list 0 0 0)))
- (while entry-list
- (if (not (calendar-date-equal date (car (car entry-list))))
- (progn
- (setq date (car (car entry-list)))
- (and holidays-in-diary-buffer
- (calendar-date-compare
- (list (list holiday-list-last-month
- (calendar-last-day-of-month
- holiday-list-last-month
- holiday-list-last-year)
- holiday-list-last-year))
- (list date))
- ;; We need to get the holidays for the next 3 months.
- (setq holiday-list-last-month
- (extract-calendar-month date))
- (setq holiday-list-last-year
- (extract-calendar-year date))
- (increment-calendar-month
- holiday-list-last-month holiday-list-last-year 1)
- (setq holiday-list
- (let ((displayed-month holiday-list-last-month)
- (displayed-year holiday-list-last-year))
- (calendar-holiday-list)))
- (increment-calendar-month
- holiday-list-last-month holiday-list-last-year 1))
- (let* ((date-string (calendar-date-string date))
- (date-holiday-list
- (let ((h holiday-list)
- (d))
- ;; Make a list of all holidays for date.
- (while h
- (if (calendar-date-equal date (car (car h)))
- (setq d (append d (cdr (car h)))))
- (setq h (cdr h)))
- d)))
- (insert (if (= (point) (point-min)) "" ?\n) date-string)
- (if date-holiday-list (insert ": "))
- (let ((l (current-column)))
- (insert (mapconcat 'identity date-holiday-list
- (concat "\n" (make-string l ? )))))
- (let ((l (current-column)))
- (insert ?\n (make-string l ?=) ?\n)))))
- (if (< 0 (length (car (cdr (car entry-list)))))
- (insert (car (cdr (car entry-list))) ?\n))
- (setq entry-list (cdr entry-list))))
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (setq buffer-read-only t)
- (display-buffer fancy-diary-buffer)
- (message "Preparing diary...done"))))
-
-(defun make-fancy-diary-buffer ()
- "Create and return the initial fancy diary buffer."
- (save-excursion
- (set-buffer (get-buffer-create fancy-diary-buffer))
- (setq buffer-read-only nil)
- (make-local-variable 'mode-line-format)
- (calendar-set-mode-line "Diary Entries")
- (erase-buffer)
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (get-buffer fancy-diary-buffer)))
-
-(defun print-diary-entries ()
- "Print a hard copy of the diary display.
-
-If the simple diary display is being used, prepare a temp buffer with the
-visible lines of the diary buffer, add a heading line composed from the mode
-line, print the temp buffer, and destroy it.
-
-If the fancy diary display is being used, just print the buffer.
-
-The hooks given by the variable `print-diary-entries-hook' are called to do
-the actual printing."
- (interactive)
- (if (bufferp (get-buffer fancy-diary-buffer))
- (save-excursion
- (set-buffer (get-buffer fancy-diary-buffer))
- (run-hooks 'print-diary-entries-hook))
- (let ((diary-buffer
- (get-file-buffer (substitute-in-file-name diary-file))))
- (if diary-buffer
- (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
- (heading))
- (save-excursion
- (set-buffer diary-buffer)
- (setq heading
- (if (not (stringp mode-line-format))
- "All Diary Entries"
- (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
- (substring mode-line-format
- (match-beginning 1) (match-end 1))))
- (copy-to-buffer temp-buffer (point-min) (point-max))
- (set-buffer temp-buffer)
- (while (re-search-forward "\^M.*$" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (insert heading "\n"
- (make-string (length heading) ?=) "\n")
- (run-hooks 'print-diary-entries-hook)
- (kill-buffer temp-buffer)))
- (error "You don't have a diary buffer!")))))
-
-(defun show-all-diary-entries ()
- "Show all of the diary entries in the diary file.
-This function gets rid of the selective display of the diary file so that
-all entries, not just some, are visible. If there is no diary buffer, one
-is created."
- (interactive)
- (let ((d-file (substitute-in-file-name diary-file)))
- (if (and d-file (file-exists-p d-file))
- (if (file-readable-p d-file)
- (save-excursion
- (let ((diary-buffer (get-file-buffer d-file)))
- (set-buffer (if diary-buffer
- diary-buffer
- (find-file-noselect d-file t)))
- (let ((buffer-read-only nil)
- (diary-modified (buffer-modified-p)))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
- (setq selective-display nil)
- (make-local-variable 'mode-line-format)
- (setq mode-line-format default-mode-line-format)
- (display-buffer (current-buffer))
- (set-buffer-modified-p diary-modified))))
- (error "Your diary file is not readable!"))
- (error "You don't have a diary file!"))))
-
-(defun diary-name-pattern (string-array &optional fullname)
- "Convert an STRING-ARRAY, an array of strings to a pattern.
-The pattern will match any of the strings, either entirely or abbreviated
-to three characters. An abbreviated form will match with or without a period;
-If the optional FULLNAME is t, abbreviations will not match, just the full
-name."
- (let ((pattern ""))
- (calendar-for-loop i from 0 to (1- (length string-array)) do
- (setq pattern
- (concat
- pattern
- (if (string-equal pattern "") "" "\\|")
- (aref string-array i)
- (if fullname
- ""
- (concat
- "\\|"
- (substring (aref string-array i) 0 3) ".?")))))
- pattern))
-
-(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
- "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
- (+ (* 100 (string-to-int
- (substring s (match-beginning 1) (match-end 1))))
- (string-to-int (substring s (match-beginning 2) (match-end 2)))))
- ((string-match;; Hour only XXam or XXpm
- "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
- (+ (* 100 (% (string-to-int
- (substring s (match-beginning 1) (match-end 1)))
- 12))
- (if (string-equal "a"
- (substring s (match-beginning 2) (match-end 2)))
- 0 1200)))
- ((string-match;; Hour and minute XX:XXam or XX:XXpm
- "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
- (+ (* 100 (% (string-to-int
- (substring s (match-beginning 1) (match-end 1)))
- 12))
- (string-to-int (substring s (match-beginning 2) (match-end 2)))
- (if (string-equal "a"
- (substring s (match-beginning 3) (match-end 3)))
- 0 1200)))
- (t -9999)));; Unrecognizable
-
-(defun list-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."
- (calendar-day-of-year-string date))
-
-(defun diary-iso-date ()
- "ISO calendar equivalent of date diary entry."
- (format "ISO date: %s" (calendar-iso-date-string date)))
-
-(defun diary-islamic-date ()
- "Islamic calendar equivalent of date diary entry."
- (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
- (if (string-equal i "")
- "Date is pre-Islamic"
- (format "Islamic date (until sunset): %s" i))))
-
-(defun diary-hebrew-date ()
- "Hebrew calendar equivalent of date diary entry."
- (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
-
-(defun diary-julian-date ()
- "Julian calendar equivalent of date diary entry."
- (format "Julian date: %s" (calendar-julian-date-string date)))
-
-(defun diary-astro-day-number ()
- "Astronomical (Julian) day number diary entry."
- (format "Astronomical (Julian) day number %s"
- (calendar-astro-date-string date)))
-
-(defun diary-omer ()
- "Omer count diary entry.
-Entry applies if date is within 50 days after Passover."
- (let* ((passover
- (calendar-absolute-from-hebrew
- (list 1 15 (+ (extract-calendar-year date) 3760))))
- (omer (- (calendar-absolute-from-gregorian date) passover))
- (week (/ omer 7))
- (day (% omer 7)))
- (if (and (> omer 0) (< omer 50))
- (format "Day %d%s of the omer (until sunset)"
- omer
- (if (zerop week)
- ""
- (format ", that is, %d week%s%s"
- week
- (if (= week 1) "" "s")
- (if (zerop day)
- ""
- (format " and %d day%s"
- day (if (= day 1) "" "s")))))))))
-
-(defun diary-yahrzeit (death-month death-day death-year)
- "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
-Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
-to be the name of the person. Date of death is on the *civil* calendar;
-although the date of death is specified by the civil calendar, the proper
-Hebrew calendar yahrzeit is determined. If `european-calendar-style' is t, the
-order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
- (let* ((h-date (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (if european-calendar-style
- (list death-day death-month death-year)
- (list death-month death-day death-year)))))
- (h-month (extract-calendar-month h-date))
- (h-day (extract-calendar-day h-date))
- (h-year (extract-calendar-year h-date))
- (d (calendar-absolute-from-gregorian date))
- (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
- (diff (- yr h-year))
- (y (hebrew-calendar-yahrzeit h-date yr)))
- (if (and (> diff 0) (or (= y d) (= y (1+ d))))
- (format "Yahrzeit of %s%s: %d%s anniversary"
- entry
- (if (= y d) "" " (evening)")
- diff
- (cond ((= (% diff 10) 1) "st")
- ((= (% diff 10) 2) "nd")
- ((= (% diff 10) 3) "rd")
- (t "th"))))))
-
-(defun diary-rosh-hodesh ()
- "Rosh Hodesh diary entry.
-Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
- (let* ((d (calendar-absolute-from-gregorian date))
- (h-date (calendar-hebrew-from-absolute d))
- (h-month (extract-calendar-month h-date))
- (h-day (extract-calendar-day h-date))
- (h-year (extract-calendar-year h-date))
- (leap-year (hebrew-calendar-leap-year-p h-year))
- (last-day (hebrew-calendar-last-day-of-month h-month h-year))
- (h-month-names
- (if leap-year
- calendar-hebrew-month-name-array-leap-year
- calendar-hebrew-month-name-array-common-year))
- (this-month (aref h-month-names (1- h-month)))
- (h-yesterday (extract-calendar-day
- (calendar-hebrew-from-absolute (1- d)))))
- (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
- (format
- "Rosh Hodesh %s"
- (if (= h-day 30)
- (format
- "%s (first day)"
- ;; next month must be in the same year since this
- ;; month can't be the last month of the year since
- ;; it has 30 days
- (aref h-month-names h-month))
- (if (= h-yesterday 30)
- (format "%s (second day)" this-month)
- this-month)))
- (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
- (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
- (format "Mevarhim Rosh Hodesh %s (%s)"
- (aref h-month-names
- (if (= h-month
- (hebrew-calendar-last-month-of-year
- h-year))
- 0 h-month))
- (aref calendar-day-name-array (- 29 h-day))))
- ((and (< h-day 30) (> h-day 22) (= 30 last-day))
- (format "Mevarhim Rosh Hodesh %s (%s-%s)"
- (aref h-month-names h-month)
- (if (= h-day 29)
- "tomorrow"
- (aref calendar-day-name-array (- 29 h-day)))
- (aref calendar-day-name-array
- (% (- 30 h-day) 7)))))
- (if (and (= h-day 29) (/= h-month 6))
- (format "Erev Rosh Hodesh %s"
- (aref h-month-names
- (if (= h-month
- (hebrew-calendar-last-month-of-year
- h-year))
- 0 h-month))))))))
-
-(defun diary-parasha ()
- "Parasha diary entry--entry applies if date is a Saturday."
- (let ((d (calendar-absolute-from-gregorian date)))
- (if (= (% d 7) 6);; Saturday
- (let*
- ((h-year (extract-calendar-year
- (calendar-hebrew-from-absolute d)))
- (rosh-hashannah
- (calendar-absolute-from-hebrew (list 7 1 h-year)))
- (passover
- (calendar-absolute-from-hebrew (list 1 15 h-year)))
- (rosh-hashannah-day
- (aref calendar-day-name-array (% rosh-hashannah 7)))
- (passover-day
- (aref calendar-day-name-array (% passover 7)))
- (long-h (hebrew-calendar-long-heshvan-p h-year))
- (short-k (hebrew-calendar-short-kislev-p h-year))
- (type (cond ((and long-h (not short-k)) "complete")
- ((and (not long-h) short-k) "incomplete")
- (t "regular")))
- (year-format
- (symbol-value
- (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah
- rosh-hashannah-day type passover-day))))
- (first-saturday;; of Hebrew year
- (calendar-dayname-on-or-before 6 (+ 6 rosh-hashannah)))
- (saturday;; which Saturday of the Hebrew year
- (/ (- d first-saturday) 7))
- (parasha (aref year-format saturday)))
- (if parasha
- (format
- "Parashat %s"
- (if (listp parasha);; Israel differs from diaspora
- (if (car parasha)
- (format "%s (diaspora), %s (Israel)"
- (hebrew-calendar-parasha-name (car parasha))
- (hebrew-calendar-parasha-name (cdr parasha)))
- (format "%s (Israel)"
- (hebrew-calendar-parasha-name (cdr parasha))))
- (hebrew-calendar-parasha-name parasha))))))))
-
-(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-lib)
-
-;;; diary-lib.el ends here
;; When tool-bar has been switched off, correct the frame size
;; by the lines added in x-create-frame for the tool-bar and
;; switch `tool-bar-mode' off.
- (when (display-graphic-p)
- (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
- (assq 'tool-bar-lines default-frame-alist))))
- (when (or (null tool-bar-lines)
- (null (cdr tool-bar-lines))
- (eq 0 (cdr tool-bar-lines)))
- (let* ((char-height (frame-char-height frame-initial-frame))
- (image-height 24)
- (margin (cond ((and (consp tool-bar-button-margin)
- (integerp (cdr tool-bar-button-margin))
- (> tool-bar-button-margin 0))
- (cdr tool-bar-button-margin))
- ((and (integerp tool-bar-button-margin)
- (> tool-bar-button-margin 0))
- tool-bar-button-margin)
- (t 0)))
- (relief (if (and (integerp tool-bar-button-relief)
- (> tool-bar-button-relief 0))
- tool-bar-button-relief 3))
- (lines (/ (+ image-height
- (* 2 margin)
- (* 2 relief)
- (1- char-height))
- char-height))
- (height (frame-parameter frame-initial-frame 'height))
- (newparms (list (cons 'height (- height lines))))
- (initial-top (cdr (assq 'top
- frame-initial-geometry-arguments)))
- (top (frame-parameter frame-initial-frame 'top)))
- (when (and (consp initial-top) (eq '- (car initial-top)))
- (setq newparms
- (append newparms
- `((top . ,(+ top (* lines char-height))))
- nil)))
- (modify-frame-parameters frame-initial-frame newparms)
- (tool-bar-mode -1)))))
+ (when (and (display-graphic-p)
+ (or (eq 0 (cdr (assq 'tool-bar-lines initial-frame-alist)))
+ (eq 0 (cdr (assq 'tool-bar-lines default-frame-alist)))))
+ (let* ((char-height (frame-char-height frame-initial-frame))
+ (image-height 24)
+ (margin (cond ((and (consp tool-bar-button-margin)
+ (integerp (cdr tool-bar-button-margin))
+ (> tool-bar-button-margin 0))
+ (cdr tool-bar-button-margin))
+ ((and (integerp tool-bar-button-margin)
+ (> tool-bar-button-margin 0))
+ tool-bar-button-margin)
+ (t 0)))
+ (relief (if (and (integerp tool-bar-button-relief)
+ (> tool-bar-button-relief 0))
+ tool-bar-button-relief 3))
+ (lines (/ (+ image-height
+ (* 2 margin)
+ (* 2 relief)
+ (1- char-height))
+ char-height))
+ (height (frame-parameter frame-initial-frame 'height)))
+ (modify-frame-parameters frame-initial-frame
+ (list (cons 'height (- height lines))))
+ (tool-bar-mode -1)))
+
;; The initial frame we create above always has a minibuffer.
;; If the user wants to remove it, or make it a minibuffer-only
+++ /dev/null
-;;; ftp.el --- file input and output over Internet using FTP
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik <mly@prep.ai.mit.edu>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-;; Prevent changes in major modes from altering these variables.
-(put 'ftp-temp-file-name 'permanent-local t)
-(put 'ftp-file 'permanent-local t)
-(put 'ftp-host 'permanent-local t)
-
-;; you can turn this off by doing
-;; (setq ftp-password-alist 'compulsory-urinalysis)
-(defvar ftp-password-alist () "Security sucks")
-
-(defun read-ftp-user-password (host user new)
- (let (tem)
- (if (and (not new)
- (listp ftp-password-alist)
- (setq tem (cdr (assoc host ftp-password-alist)))
- (or (null user)
- (string= user (car tem))))
- tem
- (or user
- (progn
- (setq tem (or (and (listp ftp-password-alist)
- (car (cdr (assoc host ftp-password-alist))))
- (user-login-name)))
- (setq user (read-string (format
- "User-name for %s (default \"%s\"): "
- host tem)))
- (if (equal user "") (setq user tem))))
- (setq tem (cons user
- ;; If you want to use some non-echoing string-reader,
- ;; feel free to write it yourself. I don't care enough.
- (read-string (format "Password for %s@%s: " user host)
- (if (not (listp ftp-password-alist))
- ""
- (or (cdr (cdr (assoc host ftp-password-alist)))
- (let ((l ftp-password-alist))
- (catch 'foo
- (while l
- (if (string= (car (cdr (car l))) user)
- (throw 'foo (cdr (cdr (car l))))
- (setq l (cdr l))))
- nil))
- "")))))
- (message "")
- (if (and (listp ftp-password-alist)
- (not (string= (cdr tem) "")))
- (setq ftp-password-alist (cons (cons host tem)
- ftp-password-alist)))
- tem)))
-
-(defun ftp-read-file-name (prompt)
- (let ((s ""))
- (while (not (string-match "\\`[ \t]*\\([^ \t:]+\\)[ \t]*:\\(.+\\)\\'" s))
- (setq s (read-string prompt s)))
- (list (substring s (match-beginning 1) (match-end 1))
- (substring s (match-beginning 2) (match-end 2)))))
-
-
-;;;###autoload
-(defun ftp-find-file (host file &optional user password)
- "FTP to HOST to get FILE, logging in as USER with password PASSWORD.
-Interactively, HOST and FILE are specified by reading a string with
- a colon character separating the host from the filename.
-USER and PASSWORD are defaulted from the values used when
- last ftping from HOST (unless password-remembering is disabled).
- Supply a password of the symbol `t' to override this default
- (interactively, this is done by giving a prefix arg)"
- (interactive
- (append (ftp-read-file-name "FTP get host:file: ")
- (list nil (not (null current-prefix-arg)))))
- (ftp-find-file-or-directory host file t user password))
-
-;;;###autoload
-(defun ftp-list-directory (host file &optional user password)
- "FTP to HOST to list DIRECTORY, logging in as USER with password PASSWORD.
-Interactively, HOST and FILE are specified by reading a string with
- a colon character separating the host from the filename.
-USER and PASSWORD are defaulted from the values used when
- last ftping from HOST (unless password-remembering is disabled).
- Supply a password of the symbol `t' to override this default
- (interactively, this is done by giving a prefix arg)"
- (interactive
- (append (ftp-read-file-name "FTP get host:directory: ")
- (list nil (not (null current-prefix-arg)))))
- (ftp-find-file-or-directory host file nil user password))
-
-(defun ftp-find-file-or-directory (host file filep &optional user password)
- "FTP to HOST to get FILE. Third arg is t for file, nil for directory.
-Log in as USER with PASSWORD. If USER is nil or PASSWORD is nil or t,
-we prompt for the user name and password."
- (or (and user password (not (eq password t)))
- (progn (setq user (read-ftp-user-password host user (eq password t))
- password (cdr user)
- user (car user))))
- (let ((buffer (get-buffer-create (format "*ftp%s %s:%s*"
- (if filep "" "-directory")
- host file))))
- (set-buffer buffer)
- (let ((process nil)
- (case-fold-search nil))
- (let ((win nil))
- (unwind-protect
- (progn
- (setq process (ftp-setup-buffer host file))
- (if (setq win (ftp-login process host user password))
- (message "Logged in")
- (error "Ftp login failed")))
- (or win (and process (delete-process process)))))
- (message "Opening %s %s:%s..." (if filep "file" "directory")
- host file)
- (if (ftp-command process
- (format "%s \"%s\" -\nquit\n" (if filep "get" "dir")
- file)
- "\\(150\\|125\\).*\n"
- "200.*\n")
- (progn (forward-line 1)
- (let ((buffer-read-only nil))
- (delete-region (point-min) (point)))
- (message "Retrieving %s:%s in background. Bye!" host file)
- (set-process-sentinel process
- 'ftp-asynchronous-input-sentinel)
- process)
- (switch-to-buffer buffer)
- (let ((buffer-read-only nil))
- (insert-before-markers "<<<Ftp lost>>>"))
- (delete-process process)
- (error "Ftp %s:%s lost" host file)))))
-
-\f
-;;;###autoload
-(defun ftp-write-file (host file &optional user password)
- "FTP to HOST to write FILE, logging in as USER with password PASSWORD.
-Interactively, HOST and FILE are specified by reading a string with colon
-separating the host from the filename.
-USER and PASSWORD are defaulted from the values used when
- last ftping from HOST (unless `password-remembering' is disabled).
- Supply a password of the symbol `t' to override this default
- (interactively, this is done by giving a prefix arg)"
- (interactive
- (append (ftp-read-file-name "FTP write host:file: ")
- (list nil (not (null current-prefix-arg)))))
- (or (and user password (not (eq password t)))
- (progn (setq user (read-ftp-user-password host user (eq password t))
- password (cdr user)
- user (car user))))
- (let ((buffer (get-buffer-create (format "*ftp %s:%s*" host file)))
- (tmp (make-temp-name "/tmp/emacsftp")))
- (write-region (point-min) (point-max) tmp)
- (save-excursion
- (set-buffer buffer)
- (make-local-variable 'ftp-temp-file-name)
- (setq ftp-temp-file-name tmp)
- (let ((process (ftp-setup-buffer host file))
- (case-fold-search nil))
- (let ((win nil))
- (unwind-protect
- (if (setq win (ftp-login process host user password))
- (message "Logged in")
- (error "Ftp login lost"))
- (or win (delete-process process))))
- (message "Opening file %s:%s..." host file)
- (if (ftp-command process
- (format "send \"%s\" \"%s\"\nquit\n" tmp file)
- "\\(150\\|125\\).*\n"
- "200.*\n")
- (progn (forward-line 1)
- (setq foo1 (current-buffer))
- (let ((buffer-read-only nil))
- (delete-region (point-min) (point)))
- (message "Saving %s:%s in background. Bye!" host file)
- (set-process-sentinel process
- 'ftp-asynchronous-output-sentinel)
- process)
- (switch-to-buffer buffer)
- (setq foo2 (current-buffer))
- (let ((buffer-read-only nil))
- (insert-before-markers "<<<Ftp lost>>>"))
- (delete-process process)
- (error "Ftp write %s:%s lost" host file))))))
-
-\f
-(defun ftp-setup-buffer (host file)
- (fundamental-mode)
- (and (get-buffer-process (current-buffer))
- (progn (discard-input)
- (if (y-or-n-p (format "Kill process \"%s\" in %s? "
- (process-name (get-buffer-process
- (current-buffer)))
- (buffer-name (current-buffer))))
- (while (get-buffer-process (current-buffer))
- (kill-process (get-buffer-process (current-buffer))))
- (error "Foo"))))
- ;(buffer-disable-undo (current-buffer))
- (setq buffer-read-only nil)
- (erase-buffer)
- (make-local-variable 'ftp-host)
- (setq ftp-host host)
- (make-local-variable 'ftp-file)
- (setq ftp-file file)
- (setq foo3 (current-buffer))
- (setq buffer-read-only t)
- (start-process "ftp" (current-buffer) "ftp" "-i" "-n" "-g"))
-
-
-(defun ftp-login (process host user password)
- (message "FTP logging in as %s@%s..." user host)
- (if (ftp-command process
- (format "open %s\nuser %s %s\n" host user password)
- "230.*\n"
- "\\(Connected to \\|220\\|331\\|Remote system type\\|Using.*mode\\|Remember to set\\).*\n")
- t
- (switch-to-buffer (process-buffer process))
- (delete-process process)
- (if (listp ftp-password-alist)
- (setq ftp-password-alist (delq (assoc host ftp-password-alist)
- ftp-password-alist)))
- nil))
-
-(defun ftp-command (process command win ignore)
- (process-send-string process command)
- (let ((p 1))
- (while (numberp p)
- (cond ;((not (bolp)))
- ((looking-at "^[0-9]+-")
- (while (not (re-search-forward "^[0-9]+ " nil t))
- (save-excursion
- (accept-process-output process)))
- (beginning-of-line))
- ((looking-at win)
- (goto-char (point-max))
- (setq p t))
- ((looking-at "^ftp> \\|^\n")
- (goto-char (match-end 0)))
- ((looking-at ignore)
- ;; Ignore status messages whose codes indicate no problem.
- (forward-line 1))
- ((looking-at "^[^0-9]")
- ;; Ignore any lines that don't have status codes.
- (forward-line 1))
- ((not (search-forward "\n" nil t))
- ;; the way asynchronous process-output works with (point)
- ;; is really really disgusting.
- (setq p (point))
- (condition-case ()
- (accept-process-output process)
- (error nil))
- (goto-char p))
- (t
- (setq p nil))))
- p))
-
-
-(defun ftp-asynchronous-input-sentinel (process msg)
- (ftp-sentinel process msg t t))
-(defun ftp-synchronous-input-sentinel (process msg)
- (ftp-sentinel process msg nil t))
-(defun ftp-asynchronous-output-sentinel (process msg)
- (ftp-sentinel process msg t nil))
-(defun ftp-synchronous-output-sentinel (process msg)
- (ftp-sentinel process msg nil nil))
-
-(defun ftp-sentinel (process msg asynchronous input)
- (cond ((null (buffer-name (process-buffer process)))
- ;; deleted buffer
- (set-process-buffer process nil))
- ((and (eq (process-status process) 'exit)
- (= (process-exit-status process) 0))
- (save-excursion
- (set-buffer (process-buffer process))
- (let (msg
- (r (if input "[0-9]+ bytes received in [0-9]+\\.[0-9]+ seconds.*$" "[0-9]+ bytes sent in [0-9]+\\.[0-9]+ seconds.*$")))
- (goto-char (point-max))
- (search-backward "226 ")
- (if (looking-at r)
- (search-backward "226 "))
- (let ((p (point)))
- (setq msg (concat (format "ftp %s %s:%s done"
- (if input "read" "write")
- ftp-host ftp-file)
- (if (re-search-forward r nil t)
- (concat ": " (buffer-substring
- (match-beginning 0)
- (match-end 0)))
- "")))
- (delete-region p (point-max))
- (save-excursion
- (set-buffer (get-buffer-create "*ftp log*"))
- (let ((buffer-read-only nil))
- (insert msg ?\n))))
- ;; Note the preceding let must end here
- ;; so it doesn't cross the (kill-buffer (current-buffer)).
- (if (not input)
- (progn
- (condition-case ()
- (and (boundp 'ftp-temp-file-name)
- ftp-temp-file-name
- (delete-file ftp-temp-file-name))
- (error nil))
- ;; Kill the temporary buffer which the ftp process
- ;; puts its output in.
- (kill-buffer (current-buffer)))
- ;; You don't want to look at this.
- (let ((kludge (generate-new-buffer (format "%s:%s (ftp)"
- ftp-host ftp-file))))
- (setq kludge (prog1 (buffer-name kludge) (kill-buffer kludge)))
- (rename-buffer kludge)
- ;; ok, you can look again now.
- (set-buffer-modified-p nil)
- (ftp-setup-write-file-hooks)))
- (if (and asynchronous
- ;(waiting-for-user-input-p)
- )
- (progn (message "%s" msg)
- (sleep-for 2))))))
- ((memq (process-status process) '(exit signal))
- (save-excursion
- (set-buffer (process-buffer process))
- (setq msg (format "Ftp died (buffer %s): %s"
- (buffer-name (current-buffer))
- msg))
- (let ((buffer-read-only nil))
- (goto-char (point-max))
- (insert ?\n ?\n msg))
- (delete-process proc)
- (set-buffer (get-buffer-create "*ftp log*"))
- (let ((buffer-read-only nil))
- (goto-char (point-max))
- (insert msg))
- (if (waiting-for-user-input-p)
- (error "%s" msg))))))
-
-(defun ftp-setup-write-file-hooks ()
- (let ((hooks write-file-hooks))
- (make-local-variable 'write-file-hooks)
- (setq write-file-hooks (append write-file-hooks
- '(ftp-write-file-hook))))
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'ftp-revert-buffer)
- (setq default-directory "/tmp/")
- (setq buffer-file-name (concat default-directory
- (make-temp-name
- (buffer-name (current-buffer)))))
- (setq buffer-read-only nil))
-
-(defun ftp-write-file-hook ()
- (let ((process (ftp-write-file ftp-host ftp-file)))
- (set-process-sentinel process 'ftp-synchronous-output-sentinel)
- (message "FTP writing %s:%s..." ftp-host ftp-file)
- (while (eq (process-status process) 'run)
- (condition-case ()
- (accept-process-output process)
- (error nil)))
- (set-buffer-modified-p nil)
- (message "FTP writing %s:%s...done" ftp-host ftp-file))
- t)
-
-(defun ftp-revert-buffer (&rest ignore)
- (let ((process (ftp-find-file ftp-host ftp-file)))
- (set-process-sentinel process 'ftp-synchronous-input-sentinel)
- (message "FTP reverting %s:%s" ftp-host ftp-file)
- (while (eq (process-status process) 'run)
- (condition-case ()
- (accept-process-output process)
- (error nil)))
- (and (eq (process-status process) 'exit)
- (= (process-exit-status process) 0)
- (set-buffer-modified-p nil))
- (message "Reverted")))
-
-;;; ftp.el ends here
(cond ((and (eq command 'default)
gnus-last-shell-command)
gnus-last-shell-command)
- ((stringp command)
- command)
+ (command command)
(t (read-string
(format
"Shell command on %s: "
"this article"))
gnus-last-shell-command))))
(when (string-equal command "")
- (if gnus-last-shell-command
- (setq command gnus-last-shell-command)
- (error "A command is required.")))
+ (setq command gnus-last-shell-command))
(gnus-eval-in-buffer-window gnus-article-buffer
(save-restriction
(widen)
;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
;; Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
(int-to-string match)
match))))
+ (set-text-properties 0 (length match) nil match)
+
;; If this is an integer comparison, we transform from string to int.
- (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
- (if (stringp match)
- (setq match (string-to-int match)))
- (set-text-properties 0 (length match) nil match))
+ (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
+ (setq match (string-to-int match)))
(unless (eq date 'now)
;; Add the score entry to the score file.
(gnus-message 5 "Scoring...done"))))))
(defun gnus-score-lower-thread (thread score-adjust)
- "Lower the score on THREAD with SCORE-ADJUST.
+ "Lower the socre on THREAD with SCORE-ADJUST.
THREAD is expected to contain a list of the form `(PARENT [CHILD1
CHILD2 ...])' where PARENT is a header array and each CHILD is a list
of the same form as THREAD. The empty list `nil' is valid. For each
;; gnus-score-index is used as a free variable.
alike last this art entries alist articles
new news)
-
+
;; Change score file to the adaptive score file. All entries that
;; this function makes will be put into this file.
(save-excursion
(gnus-score-file-name
gnus-newsgroup-name gnus-adaptive-file-suffix))))
- (setq gnus-scores-articles (sort gnus-scores-articles
+ (setq gnus-scores-articles (sort gnus-scores-articles
'gnus-score-string<)
articles gnus-scores-articles)
(push new news)))))
;; Update expire date
(cond ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates)
+ ((and found gnus-update-score-entry-dates)
;Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
printer. If FILENAME is a string, save the PostScript image in a file with
that name. If FILENAME is a number, prompt the user for the name of the file
to save in."
- (interactive (list (ps-print-preprint current-prefix-arg)))
+ (interactive (list (ps-print-preprint current-prefix-arg)
+ current-prefix-arg))
(dolist (article (gnus-summary-work-articles n))
(gnus-summary-select-article nil nil 'pseudo article)
(gnus-eval-in-buffer-window gnus-article-buffer
(mail-header-date gnus-current-headers) ")"))))
(gnus-run-hooks 'gnus-ps-print-hook)
(save-excursion
- (ps-spool-buffer-with-faces))))
- (kill-buffer buffer))))
- (gnus-summary-remove-process-mark article))
- (ps-despool filename))
+ (ps-print-buffer-with-faces filename))))
+ (kill-buffer buffer))))))
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
+++ /dev/null
-;;; md5.el -- MD5 Message Digest Algorithm
-;;; Gareth Rees <gdr11@cl.cam.ac.uk>
-
-;; LCD Archive Entry:
-;; md5|Gareth Rees|gdr11@cl.cam.ac.uk|
-;; MD5 cryptographic message digest algorithm|
-;; 13-Nov-95|1.0|~/misc/md5.el.Z|
-
-;;; Details: ------------------------------------------------------------------
-
-;; This is a direct translation into Emacs LISP of the reference C
-;; implementation of the MD5 Message-Digest Algorithm written by RSA
-;; Data Security, Inc.
-;;
-;; The algorithm takes a message (that is, a string of bytes) and
-;; computes a 16-byte checksum or "digest" for the message. This digest
-;; is supposed to be cryptographically strong in the sense that if you
-;; are given a 16-byte digest D, then there is no easier way to
-;; construct a message whose digest is D than to exhaustively search the
-;; space of messages. However, the robustness of the algorithm has not
-;; been proven, and a similar algorithm (MD4) was shown to be unsound,
-;; so treat with caution!
-;;
-;; The C algorithm uses 32-bit integers; because GNU Emacs
-;; implementations provide 28-bit integers (with 24-bit integers on
-;; versions prior to 19.29), the code represents a 32-bit integer as the
-;; cons of two 16-bit integers. The most significant word is stored in
-;; the car and the least significant in the cdr. The algorithm requires
-;; at least 17 bits of integer representation in order to represent the
-;; carry from a 16-bit addition.
-
-;;; Usage: --------------------------------------------------------------------
-
-;; To compute the MD5 Message Digest for a message M (represented as a
-;; string or as a vector of bytes), call
-;;
-;; (md5-encode M)
-;;
-;; which returns the message digest as a vector of 16 bytes. If you
-;; need to supply the message in pieces M1, M2, ... Mn, then call
-;;
-;; (md5-init)
-;; (md5-update M1)
-;; (md5-update M2)
-;; ...
-;; (md5-update Mn)
-;; (md5-final)
-
-;;; Copyright and licence: ----------------------------------------------------
-
-;; Copyright (C) 1995 by Gareth Rees
-;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm
-;;
-;; md5.el is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the
-;; Free Software Foundation; either version 2, or (at your option) any
-;; later version.
-;;
-;; md5.el is distributed in the hope that it will be useful, but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-;; for more details.
-;;
-;; The original copyright notice is given below, as required by the
-;; licence for the original code. This code is distributed under *both*
-;; RSA's original licence and the GNU General Public Licence. (There
-;; should be no problems, as the former is more liberal than the
-;; latter).
-
-;;; Original copyright notice: ------------------------------------------------
-
-;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved.
-;;
-;; License to copy and use this software is granted provided that it is
-;; identified as the "RSA Data Security, Inc. MD5 Message- Digest
-;; Algorithm" in all material mentioning or referencing this software or
-;; this function.
-;;
-;; License is also granted to make and use derivative works provided
-;; that such works are identified as "derived from the RSA Data
-;; Security, Inc. MD5 Message-Digest Algorithm" in all material
-;; mentioning or referencing the derived work.
-;;
-;; RSA Data Security, Inc. makes no representations concerning either
-;; the merchantability of this software or the suitability of this
-;; software for any particular purpose. It is provided "as is" without
-;; express or implied warranty of any kind.
-;;
-;; These notices must be retained in any copies of any part of this
-;; documentation and/or software.
-
-;;; Code: ---------------------------------------------------------------------
-
-(defvar md5-program "md5"
- "*Program that reads a message on its standard input and writes an
-MD5 digest on its output.")
-
-(defvar md5-maximum-internal-length 4096
- "*The maximum size of a piece of data that should use the MD5 routines
-written in lisp. If a message exceeds this, it will be run through an
-external filter for processing. Also see the `md5-program' variable.
-This variable has no effect if you call the md5-init|update|final
-functions - only used by the `md5' function's simpler interface.")
-
-(defvar md5-bits (make-vector 4 0)
- "Number of bits handled, modulo 2^64.
-Represented as four 16-bit numbers, least significant first.")
-(defvar md5-buffer (make-vector 4 '(0 . 0))
- "Scratch buffer (four 32-bit integers).")
-(defvar md5-input (make-vector 64 0)
- "Input buffer (64 bytes).")
-
-(defun md5-unhex (x)
- (if (> x ?9)
- (if (>= x ?a)
- (+ 10 (- x ?a))
- (+ 10 (- x ?A)))
- (- x ?0)))
-
-(defun md5-encode (message)
- "Encodes MESSAGE using the MD5 message digest algorithm.
-MESSAGE must be a string or an array of bytes.
-Returns a vector of 16 bytes containing the message digest."
- (if (<= (length message) md5-maximum-internal-length)
- (progn
- (md5-init)
- (md5-update message)
- (md5-final))
- (save-excursion
- (set-buffer (get-buffer-create " *md5-work*"))
- (erase-buffer)
- (insert message)
- (call-process-region (point-min) (point-max)
- (or shell-file-name "/bin/sh")
- t (current-buffer) nil
- "-c" md5-program)
- ;; MD5 digest is 32 chars long
- ;; mddriver adds a newline to make neaten output for tty
- ;; viewing, make sure we leave it behind.
- (let ((data (buffer-substring (point-min) (+ (point-min) 32)))
- (vec (make-vector 16 0))
- (ctr 0))
- (while (< ctr 16)
- (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2))))
- (md5-unhex (aref data (1+ (* ctr 2))))))
- (setq ctr (1+ ctr)))))))
-
-(defsubst md5-add (x y)
- "Return 32-bit sum of 32-bit integers X and Y."
- (let ((m (+ (car x) (car y)))
- (l (+ (cdr x) (cdr y))))
- (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535))))
-
-;; FF, GG, HH and II are basic MD5 functions, providing transformations
-;; for rounds 1, 2, 3 and 4 respectively. Each function follows this
-;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x
-;; by y bits to the left):
-;;
-;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b
-;;
-;; so we use the macro `md5-make-step' to construct each one. The
-;; helper functions F, G, H and I operate on 16-bit numbers; the full
-;; operation splits its inputs, operates on the halves separately and
-;; then puts the results together.
-
-(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z)))
-(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z))))
-(defsubst md5-H (x y z) (logxor x y z))
-(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z)))))
-
-(defmacro md5-make-step (name func)
- (`
- (defun (, name) (a b c d x s ac)
- (let*
- ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac)))
- (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac)))
- (m2 (logand 65535 (+ m1 (lsh l1 -16))))
- (l2 (logand 65535 l1))
- (m3 (logand 65535 (if (> s 15)
- (+ (lsh m2 (- s 32)) (lsh l2 (- s 16)))
- (+ (lsh m2 s) (lsh l2 (- s 16))))))
- (l3 (logand 65535 (if (> s 15)
- (+ (lsh l2 (- s 32)) (lsh m2 (- s 16)))
- (+ (lsh l2 s) (lsh m2 (- s 16)))))))
- (md5-add (cons m3 l3) b)))))
-
-(md5-make-step md5-FF md5-F)
-(md5-make-step md5-GG md5-G)
-(md5-make-step md5-HH md5-H)
-(md5-make-step md5-II md5-I)
-
-(defun md5-init ()
- "Initialise the state of the message-digest routines."
- (aset md5-bits 0 0)
- (aset md5-bits 1 0)
- (aset md5-bits 2 0)
- (aset md5-bits 3 0)
- (aset md5-buffer 0 '(26437 . 8961))
- (aset md5-buffer 1 '(61389 . 43913))
- (aset md5-buffer 2 '(39098 . 56574))
- (aset md5-buffer 3 '( 4146 . 21622)))
-
-(defun md5-update (string)
- "Update the current MD5 state with STRING (an array of bytes)."
- (let ((len (length string))
- (i 0)
- (j 0))
- (while (< i len)
- ;; Compute number of bytes modulo 64
- (setq j (% (/ (aref md5-bits 0) 8) 64))
-
- ;; Store this byte (truncating to 8 bits to be sure)
- (aset md5-input j (logand 255 (aref string i)))
-
- ;; Update number of bits by 8 (modulo 2^64)
- (let ((c 8) (k 0))
- (while (and (> c 0) (< k 4))
- (let ((b (aref md5-bits k)))
- (aset md5-bits k (logand 65535 (+ b c)))
- (setq c (if (> b (- 65535 c)) 1 0)
- k (1+ k)))))
-
- ;; Increment number of bytes processed
- (setq i (1+ i))
-
- ;; When 64 bytes accumulated, pack them into sixteen 32-bit
- ;; integers in the array `in' and then tranform them.
- (if (= j 63)
- (let ((in (make-vector 16 (cons 0 0)))
- (k 0)
- (kk 0))
- (while (< k 16)
- (aset in k (md5-pack md5-input kk))
- (setq k (+ k 1) kk (+ kk 4)))
- (md5-transform in))))))
-
-(defun md5-pack (array i)
- "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer."
- (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2)))
- (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0)))))
-
-(defun md5-byte (array n b)
- "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers."
- (let ((e (aref array n)))
- (cond ((eq b 0) (logand 255 (cdr e)))
- ((eq b 1) (lsh (cdr e) -8))
- ((eq b 2) (logand 255 (car e)))
- ((eq b 3) (lsh (car e) -8)))))
-
-(defun md5-final ()
- (let ((in (make-vector 16 (cons 0 0)))
- (j 0)
- (digest (make-vector 16 0))
- (padding))
-
- ;; Save the number of bits in the message
- (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0)))
- (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2)))
-
- ;; Compute number of bytes modulo 64
- (setq j (% (/ (aref md5-bits 0) 8) 64))
-
- ;; Pad out computation to 56 bytes modulo 64
- (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0))
- (aset padding 0 128)
- (md5-update padding)
-
- ;; Append length in bits and transform
- (let ((k 0) (kk 0))
- (while (< k 14)
- (aset in k (md5-pack md5-input kk))
- (setq k (+ k 1) kk (+ kk 4))))
- (md5-transform in)
-
- ;; Store the results in the digest
- (let ((k 0) (kk 0))
- (while (< k 4)
- (aset digest (+ kk 0) (md5-byte md5-buffer k 0))
- (aset digest (+ kk 1) (md5-byte md5-buffer k 1))
- (aset digest (+ kk 2) (md5-byte md5-buffer k 2))
- (aset digest (+ kk 3) (md5-byte md5-buffer k 3))
- (setq k (+ k 1) kk (+ kk 4))))
-
- ;; Return digest
- digest))
-
-;; It says in the RSA source, "Note that if the Mysterious Constants are
-;; arranged backwards in little-endian order and decrypted with the DES
-;; they produce OCCULT MESSAGES!" Security through obscurity?
-
-(defun md5-transform (in)
- "Basic MD5 step. Transform md5-buffer based on array IN."
- (let ((a (aref md5-buffer 0))
- (b (aref md5-buffer 1))
- (c (aref md5-buffer 2))
- (d (aref md5-buffer 3)))
- (setq
- a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104))
- d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934))
- c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891))
- b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974))
- a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015))
- d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730))
- c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939))
- b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145))
- a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128))
- d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407))
- c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473))
- b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230))
- a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386))
- d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075))
- c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294))
- b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081))
- a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570))
- d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888))
- c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121))
- b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114))
- a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189))
- d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203))
- c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009))
- b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456))
- a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710))
- d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006))
- c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463))
- b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357))
- a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653))
- d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976))
- c (md5-GG c d a b (aref in 7) 14 '(26479 . 729))
- b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594))
- a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658))
- d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105))
- c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866))
- b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348))
- a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972))
- d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161))
- c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296))
- b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240))
- a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454))
- d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234))
- c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421))
- b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429))
- a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305))
- d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397))
- c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992))
- b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117))
- a (md5-II a b c d (aref in 0) 6 '(62505 . 8772))
- d (md5-II d a b c (aref in 7) 10 '(17194 . 65431))
- c (md5-II c d a b (aref in 14) 15 '(43924 . 9127))
- b (md5-II b c d a (aref in 5) 21 '(64659 . 41017))
- a (md5-II a b c d (aref in 12) 6 '(25947 . 22979))
- d (md5-II d a b c (aref in 3) 10 '(36620 . 52370))
- c (md5-II c d a b (aref in 10) 15 '(65519 . 62589))
- b (md5-II b c d a (aref in 1) 21 '(34180 . 24017))
- a (md5-II a b c d (aref in 8) 6 '(28584 . 32335))
- d (md5-II d a b c (aref in 15) 10 '(65068 . 59104))
- c (md5-II c d a b (aref in 6) 15 '(41729 . 17172))
- b (md5-II b c d a (aref in 13) 21 '(19976 . 4513))
- a (md5-II a b c d (aref in 4) 6 '(63315 . 32386))
- d (md5-II d a b c (aref in 11) 10 '(48442 . 62005))
- c (md5-II c d a b (aref in 2) 15 '(10967 . 53947))
- b (md5-II b c d a (aref in 9) 21 '(60294 . 54161)))
-
- (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a))
- (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b))
- (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c))
- (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Here begins the merger with the XEmacs API and the md5.el from the URL
-;;; package. Courtesy wmperry@spry.com
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun md5 (object &optional start end)
- "Return the MD5 (a secure message digest algorithm) of an object.
-OBJECT is either a string or a buffer.
-Optional arguments START and END denote buffer positions for computing the
-hash of a portion of OBJECT."
- (let ((buffer nil))
- (unwind-protect
- (save-excursion
- (setq buffer (generate-new-buffer " *md5-work*"))
- (set-buffer buffer)
- (cond
- ((bufferp object)
- (insert-buffer-substring object start end))
- ((stringp object)
- (insert (if (or start end)
- (substring object start end)
- object)))
- (t nil))
- (prog1
- (if (<= (point-max) md5-maximum-internal-length)
- (mapconcat
- (function (lambda (node) (format "%02x" node)))
- (md5-encode (buffer-string))
- "")
- (call-process-region (point-min) (point-max)
- (or shell-file-name "/bin/sh")
- t buffer nil
- "-c" md5-program)
- ;; MD5 digest is 32 chars long
- ;; mddriver adds a newline to make neaten output for tty
- ;; viewing, make sure we leave it behind.
- (buffer-substring (point-min) (+ (point-min) 32)))
- (kill-buffer buffer)))
- (and buffer (kill-buffer buffer) nil))))
-
-(provide 'md5)
-
-;;; md5.el ends here ----------------------------------------------------------
(viscii vietnamese-viscii-lower)
(iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
(euc-kr korean-ksc5601)
- (gb2312 chinese-gb2312)
- (big5 chinese-big5-1 chinese-big5-2)
+ (cn-gb-2312 chinese-gb2312)
+ (cn-big5 chinese-big5-1 chinese-big5-2)
(tibetan tibetan)
(thai-tis620 thai-tis620)
(iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
+++ /dev/null
-;;; nnheaderxm.el --- making Gnus backends work under XEmacs
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-and-compile
- (autoload 'nnheader-insert-file-contents "nnheader"))
-
-(defun nnheader-xmas-run-at-time (time repeat function &rest args)
- (start-itimer
- "nnheader-run-at-time"
- `(lambda ()
- (,function ,@args))
- time repeat))
-
-(defun nnheader-xmas-cancel-timer (timer)
- (delete-itimer timer))
-
-(defun nnheader-xmas-cancel-function-timers (function)
- )
-
-(defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile)
- "Read file FILENAME into a buffer and return the buffer.
-If a buffer exists visiting FILENAME, return that one, but
-verify that the file has not changed since visited or saved.
-The buffer is not selected, just returned to the caller."
- (setq filename
- (abbreviate-file-name
- (expand-file-name filename)))
- (if (file-directory-p filename)
- (if find-file-run-dired
- (dired-noselect filename)
- (error "%s is a directory." filename))
- (let* ((buf (get-file-buffer filename))
- (truename (abbreviate-file-name (file-truename filename)))
- (number (nthcdr 10 (file-attributes truename)))
- ;; Find any buffer for a file which has same truename.
- (other (and (not buf)
- (get-file-buffer filename)))
- error)
- ;; Let user know if there is a buffer with the same truename.
- (when other
- (or nowarn
- (string-equal filename (buffer-file-name other))
- (message "%s and %s are the same file"
- filename (buffer-file-name other)))
- ;; Optionally also find that buffer.
- (when (or (and (boundp 'find-file-existing-other-name)
- find-file-existing-other-name)
- find-file-visit-truename)
- (setq buf other)))
- (if buf
- (or nowarn
- (verify-visited-file-modtime buf)
- (cond ((not (file-exists-p filename))
- (error "File %s no longer exists!" filename))
- ((yes-or-no-p
- (if (string= (file-name-nondirectory filename)
- (buffer-name buf))
- (format
- (if (buffer-modified-p buf)
- "File %s changed on disk. Discard your edits? "
- "File %s changed on disk. Reread from disk? ")
- (file-name-nondirectory filename))
- (format
- (if (buffer-modified-p buf)
- "File %s changed on disk. Discard your edits in %s? "
- "File %s changed on disk. Reread from disk into %s? ")
- (file-name-nondirectory filename)
- (buffer-name buf))))
- (save-excursion
- (set-buffer buf)
- (revert-buffer t t)))))
- (save-excursion
-;;; The truename stuff makes this obsolete.
-;;; (let* ((link-name (car (file-attributes filename)))
-;;; (linked-buf (and (stringp link-name)
-;;; (get-file-buffer link-name))))
-;;; (if (bufferp linked-buf)
-;;; (message "Symbolic link to file in buffer %s"
-;;; (buffer-name linked-buf))))
- (setq buf (create-file-buffer filename))
- ;; (set-buffer-major-mode buf)
- (set-buffer buf)
- (erase-buffer)
- (if rawfile
- (condition-case ()
- (nnheader-insert-file-contents filename t)
- (file-error
- ;; Unconditionally set error
- (setq error t)))
- (condition-case ()
- (insert-file-contents filename t)
- (file-error
- ;; Run find-file-not-found-hooks until one returns non-nil.
- (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks)
- ;; If they fail too, set error.
- (setq error t)))))
- ;; Find the file's truename, and maybe use that as visited name.
- (setq buffer-file-truename truename)
- (setq buffer-file-number number)
- ;; On VMS, we may want to remember which directory in a search list
- ;; the file was found in.
- (and (eq system-type 'vax-vms)
- (let (logical)
- (when (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))
- (when 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.
- (when (not (funcall backup-enable-predicate buffer-file-name))
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t))
- (if rawfile
- nil
- (after-find-file error (not nowarn)))))
- buf)))
-
-(fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
-(fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
-(fset 'nnheader-cancel-function-timers 'nnheader-xmas-cancel-function-timers)
-(fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect)
-
-(provide 'nnheaderxm)
-
-;;; nnheaderxm.el ends here.
(iso-2022-jp . B)
(iso-2022-kr . B)
(gb2312 . B)
- (big5 . B)
- (cn-big5 . B)
(cn-gb . B)
(cn-gb-2312 . B)
(euc-kr . B)
(defun rfc2047-encode (b e charset)
"Encode the word in the region B to E with CHARSET."
(let* ((mime-charset (mm-mime-charset charset))
- (cs (mm-charset-to-coding-system mime-charset))
(encoding (or (cdr (assq mime-charset
rfc2047-charset-encoding-alist))
'B))
(unless (eobp)
(insert "\n"))))
(if (and (mm-multibyte-p)
- (mm-coding-system-p cs))
- (mm-encode-coding-region (point-min) (point-max) cs))
+ (mm-coding-system-p mime-charset))
+ (mm-encode-coding-region (point-min) (point-max) mime-charset))
(funcall (cdr (assq encoding rfc2047-encoding-function-alist))
(point-min) (point-max))
(goto-char (point-min))
-;;; webmail.el --- interface of web mail
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;;; webmail.el --- interfacing with web mail
+;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: hotmail netaddress my-deja netscape
;; Todo: To support more web mail servers.
-;; Known bugs:
+;; Known bugs:
;; 1. Net@ddress may corrupt `X-Face'.
;; Warning:
;;(list-url "%s" webmail-aux)
(list-snarf . webmail-hotmail-list)
(article-snarf . webmail-hotmail-article)
- (trash-url
- "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox="
+ (trash-url
+ "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox="
webmail-aux user id))
(yahoo
(paranoid agent cookie post)
(open-url "http://mail.yahoo.com/")
(open-snarf . webmail-yahoo-open)
(login-url;; yahoo will not accept GET
- content
+ content
("%s" webmail-aux)
".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s"
user password)
(list-url "%s&rb=Inbox&YN=1" webmail-aux)
(list-snarf . webmail-yahoo-list)
(article-snarf . webmail-yahoo-article)
- (trash-url
+ (trash-url
"%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2="
webmail-aux id))
(netaddress
(open-url "http://www.netaddress.com/")
(open-snarf . webmail-netaddress-open)
(login-url
- content
+ content
("%s" webmail-aux)
- "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&Domain=usa.net&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s"
+ "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s"
user password)
(login-snarf . webmail-netaddress-login)
- (list-url
+ (list-url
"http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
webmail-session)
(list-snarf . webmail-netaddress-list)
(article-url "http://www.netaddress.com/")
(article-snarf . webmail-netaddress-article)
- (trash-url
+ (trash-url
"http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
webmail-session id))
(netscape
(open-url "http://ureg.netscape.com/iiop/UReg2/login/login?U2_LA=en&U2_BACK_FROM_CJ=true&U2_CS=iso-8859-1&U2_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_NEW_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_EXITURL=http://home.netscape.com/&U2_SOURCE=Webmail")
(open-snarf . webmail-netscape-open)
(login-url
- content
+ content
("http://ureg.netscape.com/iiop/UReg2/login/loginform")
"U2_USERNAME=%s&U2_PASSWORD=%s%s"
user password webmail-aux)
(login-snarf . webmail-netaddress-login)
- (list-url
+ (list-url
"http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
webmail-session)
(list-snarf . webmail-netaddress-list)
(article-url "http://webmail.netscape.com/")
(article-snarf . webmail-netscape-article)
- (trash-url
+ (trash-url
"http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
webmail-session id))
(my-deja
(open-url "http://www.deja.com/my/pr.xp")
(open-snarf . webmail-my-deja-open)
(login-url
- content
+ content
("%s" webmail-aux)
"member_name=%s&pw=%s&go=&priv_opt_MyDeja99="
user password)
(trash-url webmail-aux id))))
(defvar webmail-variables
- '(address article-snarf article-url list-snarf list-url
+ '(address article-snarf article-url list-snarf list-url
login-url login-snarf open-url open-snarf site articles
post-process paranoid trash-url))
(defun webmail-debug (str)
(with-temp-buffer
(insert "\n---------------- A bug at " str " ------------------\n")
- (mapcar #'(lambda (sym)
+ (mapcar #'(lambda (sym)
(if (boundp sym)
(pp `(setq ,sym ',(eval sym)) (current-buffer))))
'(webmail-type user))
(defun webmail-url (xurl)
(mm-with-unibyte-current-buffer
- (cond
+ (cond
((eq (car xurl) 'content)
(pop xurl)
(webmail-fetch-simple (if (stringp (car xurl))
;; instead of 303, though they mean 303.
(defun webmail-url-confirmation-func (prompt)
- (cond
+ (cond
((equal prompt (concat "Honor redirection with non-GET method "
"(possible security risks)? "))
nil)
(defun webmail-refresh-redirect ()
"Redirect refresh url in META."
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
nil t)
(let ((url (match-string 1)))
item id (n 0))
(webmail-init)
(setq webmail-articles nil)
- (when webmail-open-url
+ (when webmail-open-url
(erase-buffer)
(webmail-url webmail-open-url))
(if webmail-open-snarf (funcall webmail-open-snarf))
- (when webmail-login-url
+ (when webmail-login-url
(erase-buffer)
(webmail-url webmail-login-url))
- (if webmail-login-snarf
+ (if webmail-login-snarf
(funcall webmail-login-snarf))
- (when webmail-list-url
+ (when webmail-list-url
(erase-buffer)
(webmail-url webmail-list-url))
- (if webmail-list-snarf
+ (if webmail-list-snarf
(funcall webmail-list-snarf))
(while (setq item (pop webmail-articles))
(message "Fetching mail #%d..." (setq n (1+ n)))
(mm-with-unibyte-current-buffer
(nnweb-insert (cdr item)))
(setq id (car item))
- (if webmail-article-snarf
+ (if webmail-article-snarf
(funcall webmail-article-snarf file id))
(when (and webmail-trash-url webmail-move-to-trash-can)
(message "Move mail #%d to trash can..." n)
(let (buf)
(while (setq buf (pop webmail-buffer-list))
(kill-buffer buf))))
- (error
+ (error
(let (buf)
(while (setq buf (pop webmail-buffer-list))
(kill-buffer buf)))
(defun webmail-hotmail-open ()
(goto-char (point-min))
- (if (re-search-forward
+ (if (re-search-forward
"action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t)
(setq webmail-aux (match-string 1))
(webmail-error "open@1")))
(defun webmail-hotmail-login ()
(let (site)
(goto-char (point-min))
- (if (re-search-forward
+ (if (re-search-forward
"https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
(setq site (match-string 1))
(webmail-error "login@1"))
(goto-char (point-min))
- (if (re-search-forward
+ (if (re-search-forward
"\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t)
(setq webmail-aux (concat "http://" site (match-string 1)))
(webmail-error "login@2"))))
(let (site url newp (total "0"))
(if (eobp)
(setq total "0")
- (if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
- (message "Found %s (%s new)" (setq total (match-string 1))
+ (if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
+ (message "Found %s (%s new)" (setq total (match-string 1))
(match-string 2))
- (if (re-search-forward "\\([0-9]+\\) new" nil t)
+ (if (re-search-forward "\\([0-9]+\\) new" nil t)
(message "Found %s new" (setq total (match-string 1)))
(webmail-error "list@0"))))
(unless (equal total "0")
(goto-char (point-min))
- (if (re-search-forward
+ (if (re-search-forward
"https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
(setq site (match-string 1))
(webmail-error "list@1"))
(goto-char (point-min))
(if (re-search-forward "disk=\\([^&]*\\)&" nil t)
- (setq webmail-aux
- (concat "http://" site "/cgi-bin/HoTMaiL?disk="
+ (setq webmail-aux
+ (concat "http://" site "/cgi-bin/HoTMaiL?disk="
(match-string 1)))
(webmail-error "list@2"))
(goto-char (point-max))
- (while (re-search-backward
- "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\""
+ (while (re-search-backward
+ "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\""
nil t)
(if (setq url (match-string 1))
(progn
(let (id)
(if (string-match "msg=\\([^&]+\\)" url)
(setq id (match-string 1 url)))
- (push (cons id (concat "http://" site url "&raw=0"))
+ (push (cons id (concat "http://" site url "&raw=0"))
webmail-articles)))
(setq newp nil))
(setq newp t))))))
(defun webmail-hotmail-article (file id)
(goto-char (point-min))
(skip-chars-forward " \t\n\r")
- (unless (eobp)
+ (unless (eobp)
(if (not (search-forward "<pre>" nil t))
(webmail-error "article@3"))
(skip-chars-forward "\n\r\t ")
(narrow-to-region (point-min) (point))
(if (not (search-backward "<table" nil t 2))
(webmail-error "article@1.1"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(while (search-forward "<a href=" nil t)
(setq p (match-beginning 0))
(search-forward "</a>" nil t)
(widen)
(insert "\n")
(setq p (point))
- (while (re-search-forward
- "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
+ (while (re-search-forward
+ "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
nil t)
(if (setq attachment (match-string 1))
(let ((filename (match-string 2))
(push (current-buffer) webmail-buffer-list)
(setq bufname (buffer-name)))
(setq mime t)
- (insert "<#part type="
+ (insert "<#part type="
(or (and filename
(string-match "\\.[^\\.]+$" filename)
(mailcap-extension-to-mime
(webmail-error "article@1.2")
(delete-region (match-beginning 0) (match-end 0)))
(setq count 1)
- (while (and (> count 0)
+ (while (and (> count 0)
(re-search-forward "</div>\\|\\(<div>\\)" nil t))
(if (match-string 1)
(setq count (1+ count))
(match-end 0))))))
(narrow-to-region p (point))
(goto-char (point-min))
- (cond
+ (cond
((looking-at "<pre>")
(goto-char (match-end 0))
(if (looking-at "$") (forward-char))
"@" (symbol-name webmail-type) "\n")
(if id
(insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
- (unless (looking-at "$")
+ (unless (looking-at "$")
(if (search-forward "\n\n" nil t)
(forward-line -1)
(webmail-error "article@2")))
(defun webmail-yahoo-list ()
(let (url (newp t) (tofetch 0))
(goto-char (point-min))
- (when (re-search-forward
- "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
+ (when (re-search-forward
+ "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
;;(setq listed (match-string 1))
(message "Found %s mail(s)" (match-string 2)))
(if (string-match "http://[^/]+" webmail-aux)
(setq webmail-aux (match-string 0 webmail-aux))
(webmail-error "list@1"))
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
nil t)
(if (setq url (match-string 1))
(progn
(when (or newp (not webmail-newmail-only))
- (push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
+ (push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
webmail-articles)
(setq tofetch (1+ tofetch)))
(setq newp t))
(webmail-error "article@1"))
(if (not (search-forward "<table" nil t))
(webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(if (not (search-forward "</table>" nil t))
(webmail-error "article@3"))
(narrow-to-region (point-min) (match-end 0))
"@" (symbol-name webmail-type) "\n")
(if id
(insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
- (unless (looking-at "$")
+ (unless (looking-at "$")
(if (search-forward "\n\n" nil t)
(forward-line -1)
(webmail-error "article@2")))
(defun webmail-netscape-open ()
(goto-char (point-min))
(setq webmail-aux "")
- (while (re-search-forward
- "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
+ (while (re-search-forward
+ "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
nil t)
(setq webmail-aux (concat webmail-aux "&" (match-string 1) "="
(match-string 2)))))
(webmail-refresh-redirect)
(let (item id)
(goto-char (point-min))
- (when (re-search-forward
- "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
- (message "Found %s mail(s), %s unread"
+ (when (re-search-forward
+ "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
+ (message "Found %s mail(s), %s unread"
(match-string 2) (match-string 1)))
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"MR\\[i\\]\\.R='\\([^']*\\)'\\|MR\\[i\\]\\.Q='\\([^']+\\)'" nil t)
(if (setq id (match-string 2))
- (setq item
- (cons id
+ (setq item
+ (cons id
(format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
(car webmail-article-url)
webmail-session id)))
(defun webmail-netaddress-single-part ()
(goto-char (point-min))
- (cond
+ (cond
((looking-at "[\t\040\r\n]*<font face=[^>]+>[\t\040\r\n]*")
;; text/plain
(replace-match "")
(webmail-error "article@1"))
(if (not (search-forward "<form>" nil t))
(webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(if (not (search-forward "</form>" nil t))
(webmail-error "article@3"))
(narrow-to-region (point-min) (match-end 0))
(forward-line 14)
(delete-region p (point))
(goto-char (point-max))
- (unless (re-search-backward
+ (unless (re-search-backward
"[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t)
(webmail-error "article@5"))
(delete-region (point) (point-max))
(insert "><#/part>\n")
(setq p (point))))
(delete-region p p1)
- (narrow-to-region
+ (narrow-to-region
p
- (if (search-forward
+ (if (search-forward
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
nil t)
(match-beginning 0)
"@" (symbol-name webmail-type) "\n")
(if id
(insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
- (unless (looking-at "$")
+ (unless (looking-at "$")
(if (search-forward "\n\n" nil t)
(forward-line -1)
(webmail-error "article@2")))
(goto-char (point-min))
(while (not (eobp))
(if (looking-at "MIME-Version\\|Content-Type")
- (delete-region (point)
+ (delete-region (point)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(webmail-error "article@1"))
(if (not (search-forward "<form>" nil t))
(webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
+ (delete-region (point-min) (match-beginning 0))
(if (not (search-forward "</form>" nil t))
(webmail-error "article@3"))
(narrow-to-region (point-min) (match-end 0))
(forward-line 14)
(delete-region p (point))
(goto-char (point-max))
- (unless (re-search-backward
+ (unless (re-search-backward
"<form name=\"Transfer2\"" p t)
(webmail-error "article@5"))
(delete-region (point) (point-max))
(insert "><#/part>\n")
(setq p (point))))
(delete-region p p1)
- (narrow-to-region
+ (narrow-to-region
p
- (if (search-forward
+ (if (search-forward
"<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
nil t)
(match-beginning 0)
"@" (symbol-name webmail-type) "\n")
(if id
(insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
- (unless (looking-at "$")
+ (unless (looking-at "$")
(if (search-forward "\n\n" nil t)
(forward-line -1)
(webmail-error "article@2")))
(goto-char (point-min))
(while (not (eobp))
(if (looking-at "MIME-Version\\|Content-Type")
- (delete-region (point)
+ (delete-region (point)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \t]" nil t)
(defun webmail-my-deja-open ()
(webmail-refresh-redirect)
(goto-char (point-min))
- (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\""
+ (if (re-search-forward "action=\"\\([^\"]+login_confirm\\.xp[^\"]*\\)\""
nil t)
(setq webmail-aux (match-string 1))
(webmail-error "open@1")))
(defun webmail-my-deja-list ()
(let (item id newp base)
(goto-char (point-min))
- (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
+ (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
nil t)
(let ((url (match-string 1)))
(setq base (match-string 2))
(erase-buffer)
(nnweb-insert url)))
(goto-char (point-min))
- (when (re-search-forward
+ (when (re-search-forward
"(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
- nil t)
- (message "Found %s mail(s), %s unread"
+ nil t)
+ (message "Found %s mail(s), %s unread"
(match-string 1) (match-string 2)))
(goto-char (point-min))
- (while (re-search-forward
+ (while (re-search-forward
"newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
nil t)
(if (setq id (match-string 2))
(when (and (or newp (not webmail-newmail-only))
(not (assoc id webmail-articles)))
- (push (cons id (setq webmail-aux
+ (push (cons id (setq webmail-aux
(concat base "/" (match-string 1))))
webmail-articles)
(setq newp nil))
(defun webmail-my-deja-article-part (base)
(let (p)
- (cond
+ (cond
((looking-at "[\t\040\r\n]*<!--[^>]*>")
(replace-match ""))
((looking-at "[\t\040\r\n]*</PRE>")
(if (and (search-forward "File Type:" nil t)
(re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
(setq type (match-string 1)))
- (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
+ (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
nil t)
(webmail-error "article@5"))
(setq url (concat base "/getattach.cgi/" (match-string 1)
"?sm=Download"))
- (while (re-search-forward
- "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
+ (while (re-search-forward
+ "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
nil t)
(setq url (concat url "&" (match-string 1) "="
(match-string 2))))
(unless (string-match "\\([^\"]+\\)/mail" webmail-aux)
(webmail-error "article@0"))
(setq base (match-string 1 webmail-aux))
- (when (re-search-forward
+ (when (re-search-forward
"href=\"[^\"]*\\(mailnf\\.[^\"]+act=move[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
nil t)
(setq webmail-aux (concat base "/" (match-string 1)))
(webmail-error "article@4"))
(delete-region (point) (point-max))
(goto-char (point-min))
- (while (not (eobp))
+ (while (not (eobp))
(webmail-my-deja-article-part base))
(insert "MIME-Version: 1.0\n"
(prog1
+++ /dev/null
-;;; gnusmail.el --- mail reply commands for GNUS newsreader
-
-;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; 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))
-
-\f
-;;; 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
- (mail-yank-original nil)))
-
-(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))
-
-\f
-;;; 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 (or (gnus-fetch-field "subject")
- "(None)")))
- (if (and subject
- (not (string-match "^[Rr][Ee]:.+$" subject)))
- (concat "Re: " subject) subject))
- reply-to (gnus-fetch-field "reply-to")
- cc (gnus-fetch-field "cc")
- 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
-;; <itojun@ingram.mt.cs.keio.ac.jp>
-
-(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
+++ /dev/null
-;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader
-
-;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(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)
-
-\f
-;;;
-;;; 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))
-
-\f
-;;;
-;;; 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)
- ))
-
-\f
-;;; 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
+++ /dev/null
-;;; gnuspost.el --- post news commands for GNUS newsreader
-
-;; Copyright (C) 1989, 1990, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(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)))
-
-\f
-;;; Post a News using NNTP
-
-;;;###autoload
-(defalias 'sendnews 'gnus-post-news)
-
-;;;###autoload
-(defalias '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))
- (followup-to nil))
- ;; 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.
- (let (group)
- (while (not
- (string=
- (setq group
- (completing-read "Newsgroup: "
- gnus-newsrc-assoc
- nil 'require-match))
- ""))
- (or followup-to (setq followup-to group))
- (if newsgroups
- (setq newsgroups (concat newsgroups "," group))
- (setq newsgroups group)))))
- (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.
- (gnus-read-distributions-file)
- (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 ""))
- ;; Add Followup-To header
- (if followup-to
- (progn
- (mail-position-on-field "Followup-To")
- (insert followup-to)))
- ;; 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"))
- ;; Get reply-to working corrrectly for gnus-auto-mail-to-author (jpm)
- (setq reply-to (mail-fetch-field "reply-to"))
- (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. Use Reply-To
- ;; field like gnus-mail-reply-using-m* (jpm).
- (if (and gnus-auto-mail-to-author (or reply-to from))
- (progn
- (goto-char (point-min))
- (insert "To: " (or reply-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)
- (save-restriction
- (narrow-to-region
- (point-min)
- (progn
- (goto-char (point-min))
- (search-forward (concat "\n" mail-header-separator "\n"))
- (point)))
-
- ;; Correct newsgroups field: change sequence of spaces to comma and
- ;; eliminate spaces around commas. Eliminate imbedded line breaks.
- (goto-char (point-min))
- (if (search-forward-regexp "^Newsgroups: +" nil t)
- (save-restriction
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil 'end)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min))
- (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
- (goto-char (point-min))
- (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
- ))
-
- ;; Mail the message too if To: or Cc: exists.
- (if (or (mail-fetch-field "to" nil t)
- (mail-fetch-field "cc" nil t))
- (if gnus-mail-send-method
- (progn
- (message "Sending via mail...")
- (widen)
- (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-disable-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))
- )))
- ))
-
-\f
-;;; 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-disable-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")))
- )))
-
-\f
-;; 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)
- (mail-file-babyl-p fcc-file))
- (gnus-output-to-rmail fcc-file)
- (rmail-output fcc-file 1 t t)))
- ))
- )
- ))
- ))
-
-(defun gnus-inews-path ()
- "Return uucp path."
- (let ((login-name (gnus-inews-login-name)))
- (cond ((null gnus-use-generic-path)
- (concat 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 (FULLNAME)'."
- (let ((full-name (gnus-inews-full-name)))
- (concat (if (or gnus-user-login-name gnus-use-generic-from
- gnus-local-domain (getenv "DOMAINNAME"))
- (concat (gnus-inews-login-name) "@"
- (gnus-inews-domain-name gnus-use-generic-from))
- user-mail-address)
- ;; 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' and the function
-`user-login-name'."
- (or gnus-user-login-name (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."
- (and (null gnus-local-domain)
- (boundp 'gnus-your-domain)
- (setq gnus-local-domain gnus-your-domain))
- (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
- (let ((domain (or (if (stringp genericfrom) genericfrom)
- (getenv "DOMAINNAME")
- gnus-local-domain
- ;; Function `system-name' may return full internet name.
- ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
- (if (string-match "\\." (system-name))
- (substring (system-name) (match-end 0)))
- (read-string "Domain name (no host): ")))
- (host (or (if (string-match "\\." (system-name))
- (substring (system-name) 0 (match-beginning 0)))
- (system-name))))
- (if (string-equal "." (substring domain 0 1))
- (setq domain (substring domain 1)))
- ;; Support GENERICFROM as same as standard Bnews system.
- ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
- (cond ((null genericfrom)
- (concat host "." domain))
- ;;((stringp genericfrom) genericfrom)
- (t domain)))
- (substring user-mail-address (1+ (string-match "@" user-mail-address)))))
-
-(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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
;;; image-file.el --- Support for visiting image files
;;
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2000 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: multimedia
(when (and (or (null beg) (zerop beg)) (null end))
(let* ((ibeg (point))
(iend (+ (point) (cadr rval)))
- (visitingp (and visit (= ibeg (point-min)) (= iend (point-max))))
(data
(string-make-unibyte
(buffer-substring-no-properties ibeg iend)))
;; This a cheap attempt to make the whole buffer
;; read-only when we're visiting the file (as
;; opposed to just inserting it).
- ,@(and visitingp
+ ,@(and visit
+ (= ibeg (point-min))
+ (= iend (point-max))
'(read-only t front-sticky (read-only))))))
- (add-text-properties ibeg iend props)
- (when visitingp
- ;; Inhibit the cursor when the buffer contains only an image,
- ;; because cursors look very strange on top of images.
- (setq cursor-type nil)
- ;; This just makes the arrow displayed in the right fringe
- ;; area look correct when the image is wider than the window.
- (setq truncate-lines t))))
+ (add-text-properties ibeg iend props)))
rval))
(defun image-file-handler (operation &rest args)
+++ /dev/null
-;;; 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"))
-(if (eq system-type 'ms-dos) (setq buffer-file-type t))
-(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
(let ((path (getenv "INFOPATH"))
(source (expand-file-name "info/" source-directory))
(sibling (if installation-directory
- (expand-file-name "info/" installation-directory)
- (if (and (memq system-type '(ms-dos windows-nt))
- invocation-directory)
- (let ((infodir (expand-file-name
- "../info/"
- invocation-directory)))
- (if (file-exists-p infodir)
- infodir
- (setq infodir (expand-file-name
- "../../../info/"
- invocation-directory))
- (and (file-exists-p infodir)
- infodir))))))
+ (expand-file-name "info/" installation-directory)))
alternative)
(setq Info-directory-list
(prune-directory-list
+++ /dev/null
-;;; isearch.el --- incremental search commands
-
-;; Copyright (C) 1985, 1986 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:
-
-(defvar search-last-string "" "\
-Last string search for by a non-regexp search command.
-This does not include direct calls to the primitive search functions,
-and does not include searches that are aborted.")
-
-(defvar search-last-regexp "" "\
-Last string searched for by a regexp search command.
-This does not include direct calls to the primitive search functions,
-and does not include searches that are aborted.")
-
-
-(defconst search-repeat-char ?\C-s "\
-*Character to repeat incremental search forwards.")
-(defconst search-reverse-char ?\C-r "\
-*Character to repeat incremental search backwards.")
-(defconst search-exit-char ?\C-m "\
-*Character to exit incremental search.")
-(defconst search-delete-char ?\177 "\
-*Character to delete from incremental search string.")
-(defconst search-quote-char ?\C-q "\
-*Character to quote special characters for incremental search.")
-(defconst search-yank-word-char ?\C-w "\
-*Character to pull next word from buffer into search string.")
-(defconst search-yank-line-char ?\C-y "\
-*Character to pull rest of line from buffer into search string.")
-(defconst search-ring-advance-char ?\M-n "\
-*Character to pull next (more recent) search string from the ring of same.")
-(defconst search-ring-retreat-char ?\M-p "\
-*Character to pull previous (older) search string from the ring of same.")
-
-(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.")
-
-(defconst search-upper-case t
- "*Non-nil means an upper-case letter as search input means case-sensitive.
-Any upper-case letter given explicitly as input to the incremental search
-has the effect of turning off `case-fold-search' for the rest of this search.
-Deleting the letter from the search string cancels the effect.")
-
-(fset 'search-forward-regexp 're-search-forward)
-(fset 'search-backward-regexp 're-search-backward)
-
-(defvar search-ring nil
- "List of recent non-regexp incremental searches.
-Each element is a cons cell of the form (STRING . UPPERCASE-FLAG).")
-
-(defvar regexp-search-ring nil
- "List of recent regexp incremental searches.
-Each element is a cons cell of the form (STRING . UPPERCASE-FLAG).")
-
-(defconst search-ring-max 16
- "*Maximum length of search ring before oldest elements are thrown away.")
-
-(defvar search-ring-yank-pointer nil
- "The tail of the search ring whose car is the last thing searched for.")
-
-(defvar regexp-search-ring-yank-pointer nil
- "The tail of the regular expression search ring whose car is the last
-thing searched for.")
-
-
-(defun isearch-forward ()
- "Do incremental search forward.
-As you type characters, they add to the search string and are found.
-Type Delete to cancel characters from end of search string.
-Type RET to exit, leaving point at location found.
-Type C-s to search again forward, C-r to search again backward.
-Type C-w to yank word from buffer onto end of search string and search for it.
-Type C-y to yank rest of line onto end of search string, etc.
-Type C-q to quote control character to search for it.
-Other control and meta characters terminate the search
- and are then executed normally.
-The above special characters are mostly controlled by parameters;
- do M-x apropos on search-.*-char to find them.
-C-g while searching or when search has failed
- cancels input back to what has been found successfully.
-C-g when search is successful aborts and moves point to starting point."
- (interactive)
- (isearch t))
-(define-key global-map "\C-s" 'isearch-forward)
-
-(defun isearch-forward-regexp ()
- "Do incremental search forward for regular expression.
-Like ordinary incremental search except that your input
-is treated as a regexp. See \\[isearch-forward] for more info."
- (interactive)
- (isearch t t))
-(define-key esc-map "\C-s" 'isearch-forward-regexp)
-
-(defun isearch-backward ()
- "Do incremental search backward.
-See \\[isearch-forward] for more information."
- (interactive)
- (isearch nil))
-(define-key global-map "\C-r" 'isearch-backward)
-
-(defun isearch-backward-regexp ()
- "Do incremental search backward for regular expression.
-Like ordinary incremental search except that your input
-is treated as a regexp. See \\[isearch-forward] for more info."
- (interactive)
- (isearch nil t))
-(define-key esc-map "\C-r" 'isearch-backward-regexp)
-
-
-;; This function does all the work of incremental search.
-;; The functions attached to ^R and ^S are trivial,
-;; merely calling this one, but they are always loaded by default
-;; whereas this file can optionally be autoloadable.
-;; This is the only entry point in this file.
-
-;; OP-FUN is a function to be called after each input character is processed.
-;; (It is not called after characters that exit the search.)
-
-(defun isearch (forward &optional regexp op-fun)
- (let ((search-string "")
- (search-message "")
- ;; List of previous states during this search.
- (history nil)
- ;; t means search is currently successful.
- (success t)
- ;; Set once the search has wrapped around the end of the buffer.
- (wrapped nil)
- ;; Nominal starting point for searching
- ;; Usually this is the same as the opoint,
- ;; but it is changed by wrapping
- ;; and also by repeating the search.
- (barrier (point))
- ;; Set temporarily when adding a character to a regexp
- ;; enables it to match more rather than fewer places in the buffer.
- liberalized
- ;; Set temporarily by yanking text into the search string.
- yank-flag
- (invalid-regexp nil)
- ;; non-nil means an explicit uppercase letter seen in the input
- (uppercase-flag nil)
- ;; Non-nil means start using a small window
- ;; if the search moves outside what is currently on the frame.
- (slow-terminal-mode (and (<= baud-rate search-slow-speed)
- (> (window-height)
- (* 4 search-slow-window-lines))))
- ;; t means a small window is currently in use.
- (small-window nil) ;if t, using a small window
- ;; These variables preserve information from the small window
- ;; through exit from the save-window-excursion.
- (found-point nil)
- (found-start nil)
- ;; Point is at one end of the last match.
- ;; This variable records the other end of that match.
- (other-end nil)
- ;; Value of point at start of search,
- ;; for moving the cursor back on quitting.
- (opoint (point))
- (inhibit-quit t) ;Prevent ^G from quitting, so we can read it.
- ;; The frame we're working on; if this changes, we exit isearch.
- (frame (if (fboundp 'selected-frame) (selected-frame))))
-
- (isearch-push-state)
- (save-window-excursion
- (catch 'search-done
- (while t
- (or (and (numberp unread-command-char) (>= unread-command-char 0))
- (progn
- (or (input-pending-p)
- (isearch-message))
- (if (and slow-terminal-mode
- (not (or small-window (pos-visible-in-window-p))))
- (progn
- (setq small-window t)
- (setq found-point (point))
- (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)))))
- (let ((char (if quit-flag
- ?\C-g
- (read-event))))
- (setq quit-flag nil liberalized nil yank-flag nil)
- (cond ((and (or (not (integerp char))
- (and (>= char 128)
- (not (= char search-ring-advance-char))
- (not (= char search-ring-retreat-char))))
- search-exit-option)
- (setq unread-command-char char)
- (throw 'search-done t))
-
- ;; If the user switches to a different frame, exit.
- ((not (eq frame last-event-frame))
- (setq unread-command-char char)
- (throw 'search-done t))
-
- ((eq char search-exit-char)
- ;; RET means exit search normally.
- ;; Except, if first thing typed, it means do nonincremental
- (if (= 0 (length search-string))
- (nonincremental-search forward regexp))
- (throw 'search-done t))
- ((= char ?\C-g)
- ;; ^G means the user tried to quit.
- (ding)
- (discard-input)
- (if success
- ;; If search is successful, move back to starting point
- ;; and really do quit.
- (progn (goto-char opoint)
- (signal 'quit nil))
- ;; If search is failing, rub out until it is once more
- ;; successful.
- (while (not success) (isearch-pop))))
- ((or (eq char search-repeat-char)
- (eq char search-reverse-char))
- (if (eq forward (eq char search-repeat-char))
- ;; C-s in forward or C-r in reverse.
- (if (equal search-string "")
- ;; If search string is empty, use last one.
- (isearch-get-string-from-ring)
- ;; If already have what to search for, repeat it.
- (or success
- (progn (goto-char (if forward (point-min) (point-max)))
- (setq wrapped t))))
- ;; C-s in reverse or C-r in forward, change direction.
- (setq forward (not forward)))
- (setq barrier (point)) ; For subsequent \| if regexp.
- (setq success t)
- (or (equal search-string "")
- (progn
- ;; If repeating a search that found an empty string,
- ;; ensure we advance. Test history to make sure we
- ;; actually have done a search already; otherwise,
- ;; the match data will be random.
- (if (and (cdr history)
- (= (match-end 0) (match-beginning 0)))
- (forward-char (if forward 1 -1)))
- (isearch-search)))
- (isearch-push-state))
- ((= char search-delete-char)
- ;; Rubout means discard last input item and move point
- ;; back. If buffer is empty, just beep.
- (if (null (cdr history))
- (ding)
- (isearch-pop)))
- ((= char search-ring-advance-char)
- (isearch-pop)
- (if regexp
- (let ((length (length regexp-search-ring)))
- (if (zerop length)
- ()
- (setq regexp-search-ring-yank-pointer
- (nthcdr (% (+ 1 (- length (length regexp-search-ring-yank-pointer)))
- length)
- regexp-search-ring))
- (isearch-get-string-from-ring)))
- (let ((length (length search-ring)))
- (if (zerop length)
- ()
- (setq search-ring-yank-pointer
- (nthcdr (% (+ 1 (- length (length search-ring-yank-pointer)))
- length)
- search-ring))
- (isearch-get-string-from-ring))))
- (isearch-push-state)
- (isearch-search))
- ((= char search-ring-retreat-char)
- (isearch-pop)
- (if regexp
- (let ((length (length regexp-search-ring)))
- (if (zerop length)
- ()
- (setq regexp-search-ring-yank-pointer
- (nthcdr (% (+ (- length (length regexp-search-ring-yank-pointer))
- (1- length))
- length)
- regexp-search-ring))
- (isearch-get-string-from-ring)))
- (let ((length (length search-ring)))
- (if (zerop length)
- ()
- (setq search-ring-yank-pointer
- (nthcdr (% (+ (- length (length search-ring-yank-pointer))
- (1- length))
- length)
- search-ring))
- (isearch-get-string-from-ring))))
- (isearch-push-state)
- (isearch-search))
- (t
- (cond ((or (eq char search-yank-word-char)
- (eq char search-yank-line-char))
- ;; ^W means gobble next word from buffer.
- ;; ^Y means gobble rest of line from buffer.
- (let ((word (save-excursion
- (and (not forward) other-end
- (goto-char other-end))
- (buffer-substring
- (point)
- (save-excursion
- (if (eq char search-yank-line-char)
- (end-of-line)
- (forward-word 1))
- (point))))))
- (if regexp
- (setq word (regexp-quote word)))
- (setq search-string (concat search-string word)
- search-message
- (concat search-message
- (mapconcat 'text-char-description
- word ""))
- ;; Don't move cursor in reverse search.
- yank-flag t)))
- ;; Any other control char =>
- ;; unread it and exit the search normally.
- ((and search-exit-option
- (/= char search-quote-char)
- (or (>= char ?\177)
- (and (< char ? )
- (/= char ?\t)
- (/= char ?\n))))
- (setq unread-command-char char)
- (throw 'search-done t))
- (t
- ;; Any other character => add it to the
- ;; search string and search.
- (cond ((= char search-quote-char)
- (setq char (read-quoted-char
- (isearch-message t))))
- ((= char ?\r)
- ;; RET translates to newline.
- (setq char ?\n)))
- (setq search-string (concat search-string
- (char-to-string char))
- search-message (concat search-message
- (text-char-description char))
- uppercase-flag (or uppercase-flag
- (not (= char (downcase char)))))))
- (if (and (not success)
- ;; unsuccessful regexp search may become
- ;; successful by addition of characters which
- ;; make search-string valid
- (not regexp))
- nil
- ;; Check for chars that 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.
- (and regexp history
- (cond ((and (memq char '(?* ??))
- ;; Don't treat *, ? as special
- ;; within [] or after \.
- (not (nth 6 (car history))))
- (setq liberalized t)
- ;; This used to use element 2
- ;; in a reverse search, but it seems that 5
- ;; (which is the end of the old match)
- ;; is better in that case too.
- (let ((cs (nth 5 ; old other-end.
- (car (cdr history)))))
- ;; (car history) is after last search;
- ;; (car (cdr history)) is from before it.
- (setq cs (or cs barrier))
- (goto-char
- (if forward
- (max cs barrier)
- (min cs barrier)))))
- ((eq char ?\|)
- (setq liberalized t)
- (goto-char barrier))))
- ;; Turn off case-sensitivity if string requests it.
- (let ((case-fold-search
- (and case-fold-search
- (not (and uppercase-flag
- search-upper-case)))))
- ;; 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 forward) (not liberalized)
- (condition-case ()
- (looking-at (if regexp search-string
- (regexp-quote search-string)))
- (error nil))
- (or yank-flag
- ;; Used to have (min opoint barrier)
- ;; instead of barrier.
- ;; This lost when wrapping.
- (<= (match-end 0) barrier)))
- (setq success t invalid-regexp nil
- other-end (match-end 0))
- ;; Not regexp, not reverse, or no match at point.
- (if (and other-end (not liberalized))
- (goto-char (if forward other-end
- ;; Used to have opoint inside the min.
- ;; This lost when wrapping.
- (min barrier (1+ other-end)))))
- (isearch-search))))
- (isearch-push-state))))
- (if op-fun (funcall op-fun))))
- (setq found-start (window-start (selected-window)))
- (setq found-point (point)))
- (if (> (length search-string) 0)
- (if (and regexp (not (member search-string regexp-search-ring)))
- (progn
- (setq regexp-search-ring (cons (cons search-string uppercase-flag)
- regexp-search-ring)
- regexp-search-ring-yank-pointer regexp-search-ring)
- (if (> (length regexp-search-ring) search-ring-max)
- (setcdr (nthcdr (1- search-ring-max) regexp-search-ring) nil)))
- (if (not (member search-string search-ring))
- (progn
- (setq search-ring (cons (cons search-string uppercase-flag)
- search-ring)
- search-ring-yank-pointer search-ring)
- (if (> (length search-ring) search-ring-max)
- (setcdr (nthcdr (1- search-ring-max) search-ring) nil))))))
- ;; If we displayed a single-line window, set point in this window.
- (if small-window
- (goto-char found-point))
- ;; If there was movement, mark the starting position.
- ;; Maybe should test difference between and set mark iff > threshold.
- (if (/= (point) opoint)
- (push-mark opoint)
- (message ""))
- (or small-window
- ;; Exiting the save-window-excursion clobbers this; restore it.
- (set-window-start (selected-window) found-start t))))
-
-(defun isearch-message (&optional c-q-hack ellipsis)
- ;; 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 invalid-regexp ellipsis
- (condition-case ()
- (progn (re-search-forward search-string (point) t)
- (setq invalid-regexp nil))
- (error nil)))
- ;; If currently failing, display no ellipsis.
- (or success (setq ellipsis nil))
- (let ((m (concat (if success "" "failing ")
- (if wrapped "wrapped ")
- (if (or (not case-fold-search)
- (and uppercase-flag search-upper-case))
- "case-sensitive ")
- (if regexp "regexp " "")
- "I-search"
- (if forward ": " " backward: ")
- search-message
- (if c-q-hack "^Q" "")
- (if invalid-regexp
- (concat " [" invalid-regexp "]")
- ""))))
- (aset m 0 (upcase (aref m 0)))
- (let ((cursor-in-echo-area ellipsis))
- (if c-q-hack m (message "%s" m)))))
-
-;; Get the search string from the "front" of the ring of previous searches.
-(defun isearch-get-string-from-ring ()
- (let ((elt (car (if regexp
- (or regexp-search-ring-yank-pointer regexp-search-ring)
- (or search-ring-yank-pointer search-ring)))))
- ;; ELT describes the most recent search or where we have rotated the ring.
- (if elt
- (setq search-string (car elt)
- uppercase-flag (cdr elt))
- (setq search-string "" uppercase-flag nil)))
- ;; Let's give this one the benefit of the doubt.
- (setq invalid-regexp nil)
- (setq search-message (mapconcat 'text-char-description search-string "")))
-
-(defun isearch-pop ()
- (setq history (cdr history))
- (let ((cmd (car history)))
- (setq search-string (car cmd)
- search-message (car (cdr cmd))
- success (nth 3 cmd)
- forward (nth 4 cmd)
- other-end (nth 5 cmd)
- invalid-regexp (nth 6 cmd)
- wrapped (nth 7 cmd)
- barrier (nth 8 cmd)
- uppercase-flag (nth 9 cmd))
- (goto-char (car (cdr (cdr cmd))))))
-
-(defun isearch-push-state ()
- (setq history (cons (list search-string search-message (point)
- success forward other-end invalid-regexp
- wrapped barrier uppercase-flag)
- history)))
-
-(defun isearch-search ()
- (let ((case-fold-search
- (and case-fold-search
- (not (and uppercase-flag
- search-upper-case)))))
- (isearch-message nil t)
- (condition-case lossage
- (let ((inhibit-quit nil))
- (if regexp (setq invalid-regexp nil))
- (setq success
- (funcall
- (if regexp
- (if forward 're-search-forward 're-search-backward)
- (if forward 'search-forward 'search-backward))
- search-string nil t))
- (if success
- (setq other-end
- (if forward (match-beginning 0) (match-end 0)))))
- (quit (setq unread-command-char ?\C-g)
- (setq success nil))
- (invalid-regexp (setq invalid-regexp (car (cdr lossage)))
- (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
- invalid-regexp)
- (setq invalid-regexp "incomplete input"))))
- (if success
- nil
- ;; Ding if failed this time after succeeding last time.
- (and (nth 3 (car history))
- (ding))
- (goto-char (nth 2 (car history))))))
-
-;; This is called from incremental-search
-;; if the first input character is the exit character.
-;; The interactive-arg-reader uses free variables `forward' and `regexp'
-;; which are bound by `incremental-search'.
-
-;; We store the search string in `search-string'
-;; which has been bound already by `incremental-search'
-;; so that, when we exit, it is copied into `search-last-string'.
-
-(defun nonincremental-search (forward regexp)
- (let (message char function string inhibit-quit)
- (let ((cursor-in-echo-area t))
- ;; Prompt assuming not word search,
- (setq message (if regexp
- (if forward "Regexp search: "
- "Regexp search backward: ")
- (if forward "Search: " "Search backward: ")))
- (message "%s" message)
- ;; Read 1 char and switch to word search if it is ^W.
- (setq char (read-event)))
- (if (and (numberp char) (eq char search-yank-word-char))
- (setq message (if forward "Word search: " "Word search backward: "))
- ;; Otherwise let that 1 char be part of the search string.
- (setq unread-command-char char))
- (setq function
- (if (eq char search-yank-word-char)
- (if forward 'word-search-forward 'word-search-backward)
- (if regexp
- (if forward 're-search-forward 're-search-backward)
- (if forward 'search-forward 'search-backward))))
- ;; Read the search string with corrected prompt.
- (setq string (read-string message))
- ;; Empty means use default.
- (if (= 0 (length string))
- (setq string search-last-string)
- ;; Set last search string now so it is set even if we fail.
- (setq search-last-string string))
- ;; Since we used the minibuffer, we should be available for redo.
- (setq command-history (cons (list function string) command-history))
- ;; Go ahead and search.
- (funcall function string)))
-
-;;; isearch.el ends here
ring.
Type \\[isearch-complete] to complete the search string using the search ring.
-If an input method is turned on in the current buffer, that input
-method is also active while you are typing a characters to search. To
-toggle the input method, type \\[isearch-toggle-input-method]. It
-also toggles the input method in the current buffer.
-
-To use a different input method for searching, type
-\\[isearch-toggle-specified-input-method], and specify an input method
-you want to use.
-
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
+++ /dev/null
-;;; iso8859-1.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 ((table (car (standard-case-table))))
- (set-case-syntax 160 " " table) ; NBSP (no-break space)
- (set-case-syntax 161 "." table) ; inverted exclamation mark
- (set-case-syntax 162 "w" table) ; cent sign
- (set-case-syntax 163 "w" table) ; pound sign
- (set-case-syntax 164 "w" table) ; general currency sign
- (set-case-syntax 165 "w" table) ; yen sign
- (set-case-syntax 166 "_" table) ; broken vertical line
- (set-case-syntax 167 "w" table) ; section sign
- (set-case-syntax 168 "w" table) ; diaeresis
- (set-case-syntax 169 "_" table) ; copyright sign
- (set-case-syntax 170 "w" table) ; ordinal indicator, feminine
- (set-case-syntax-delims 171 187 table) ; angle quotation marks
- (set-case-syntax 172 "_" table) ; not sign
- (set-case-syntax 173 "_" table) ; soft hyphen
- (set-case-syntax 174 "_" table) ; registered sign
- (set-case-syntax 175 "w" table) ; macron
- (set-case-syntax 176 "_" table) ; degree sign
- (set-case-syntax 177 "_" table) ; plus or minus sign
- (set-case-syntax 178 "w" table) ; superscript two
- (set-case-syntax 179 "w" table) ; superscript three
- (set-case-syntax 180 "w" table) ; acute accent
- (set-case-syntax 181 "_" table) ; micro sign
- (set-case-syntax 182 "w" table) ; pilcrow
- (set-case-syntax 183 "_" table) ; middle dot
- (set-case-syntax 184 "w" table) ; cedilla
- (set-case-syntax 185 "w" table) ; superscript one
- (set-case-syntax 186 "w" table) ; ordinal indicator, masculine
- ;; 187 ; See 171 above.
- (set-case-syntax 188 "_" table) ; fraction one-quarter
- (set-case-syntax 189 "_" table) ; fraction one-half
- (set-case-syntax 190 "_" table) ; fraction three-quarters
- (set-case-syntax 191 "." table) ; inverted question mark
- (set-case-syntax-pair 192 224 table) ; A with grave accent
- (set-case-syntax-pair 193 225 table) ; A with acute accent
- (set-case-syntax-pair 194 226 table) ; A with circumflex accent
- (set-case-syntax-pair 195 227 table) ; A with tilde
- (set-case-syntax-pair 196 228 table) ; A with diaeresis or umlaut mark
- (set-case-syntax-pair 197 229 table) ; A with ring
- (set-case-syntax-pair 198 230 table) ; AE diphthong
- (set-case-syntax-pair 199 231 table) ; C with cedilla
- (set-case-syntax-pair 200 232 table) ; E with grave accent
- (set-case-syntax-pair 201 233 table) ; E with acute accent
- (set-case-syntax-pair 202 234 table) ; E with circumflex accent
- (set-case-syntax-pair 203 235 table) ; E with diaeresis or umlaut mark
- (set-case-syntax-pair 204 236 table) ; I with grave accent
- (set-case-syntax-pair 205 237 table) ; I with acute accent
- (set-case-syntax-pair 206 238 table) ; I with circumflex accent
- (set-case-syntax-pair 207 239 table) ; I with diaeresis or umlaut mark
- (set-case-syntax-pair 208 240 table) ; D with stroke, Icelandic eth
- (set-case-syntax-pair 209 241 table) ; N with tilde
- (set-case-syntax-pair 210 242 table) ; O with grave accent
- (set-case-syntax-pair 211 243 table) ; O with acute accent
- (set-case-syntax-pair 212 244 table) ; O with circumflex accent
- (set-case-syntax-pair 213 245 table) ; O with tilde
- (set-case-syntax-pair 214 246 table) ; O with diaeresis or umlaut mark
- (set-case-syntax 215 "_" table) ; multiplication sign
- (set-case-syntax-pair 216 248 table) ; O with slash
- (set-case-syntax-pair 217 249 table) ; U with grave accent
- (set-case-syntax-pair 218 250 table) ; U with acute accent
- (set-case-syntax-pair 219 251 table) ; U with circumflex accent
- (set-case-syntax-pair 220 252 table) ; U with diaeresis or umlaut mark
- (set-case-syntax-pair 221 253 table) ; Y with acute accent
- (set-case-syntax-pair 222 254 table) ; thorn, Icelandic
- (set-case-syntax 223 "w" table) ; small sharp s, German
- (set-case-syntax 247 "_" table) ; division sign
- (set-case-syntax 255 "w" table) ; small y with diaeresis or umlaut mark
- (set-standard-case-table (list table)))
-
-(provide 'iso8859-1)
-
-;;; iso8859-1.el ends here
+++ /dev/null
-;;; libc.el -- lookup C symbols in the GNU C Library Reference Manual.
-
-;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
-
-;;; Author: Ralph Schleicher <rs@purple.UL.BaWue.DE>
-;;; Keywords: local c info
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This code has a long history. It started as a minor
-;; mode for C mode. This era ended with the release of version 2
-;; of the GNU C Library in 1997. The code was therefore rewritten
-;; more or less from scratch so that all lookups are performed via
-;; indices. Not finding an existing symbol in an index means that
-;; there is an error in the manual. Long missed features like a
-;; separate input history, symbol name completion in the mini-buffer,
-;; highlighting of looked up symbol names in the Info buffer, and
-;; implicitly prepending `struct', `union' or `enum' to data types
-;; were added in this phase too.
-
-;;; Code:
-
-(require 'info)
-
-\f
-(defvar libc-info-file-name "libc"
- "Basename of the Info file of the GNU C Library Reference Manual.")
-
-(defvar libc-highlight-face 'highlight
- "*Face for highlighting looked up symbol names in the Info buffer.
-`nil' disables highlighting.")
-
-(defvar libc-highlight-overlay nil
- "Overlay object used for highlighting.")
-
-(defconst libc-symbol-completions nil
- "Alist of documented C symbols.")
-
-(defconst libc-file-completions nil
- "Alist of documented programs or files.")
-
-(defvar libc-history nil
- "History of previous input lines.")
-
-;;;###autoload
-(defun libc-describe-symbol (symbol-name)
- "Display the documentation of a C symbol in another window.
-SYMBOL-NAME must be documented in the GNU C Library Reference Manual.
-
-If called interactively, SYMBOL-NAME will be read from the mini-buffer.
-Optional prefix argument means insert the default symbol (if any) into
-the mini-buffer so that it can be edited. The default symbol is the
-one found at point.
-
-If SYMBOL-NAME is a public function, variable, or data type of the GNU
-C Library but `libc-describe-symbol' fails to display it's documentation,
-then you have found a bug in the manual. Please report that to the mail
-address `bug-glibc-manual@prep.ai.mit.edu' so that it can be fixed."
- (interactive
- (let* ((completion-ignore-case nil)
- (enable-recursive-minibuffers t)
- (symbol (libc-symbol-at-point))
- (value (completing-read
- (if symbol
- (format "Describe symbol (default %s): " symbol)
- (format "Describe symbol: "))
- libc-symbol-completions nil nil
- (and current-prefix-arg symbol) 'libc-history)))
- (list (if (equal value "") symbol value))))
- (or (assoc symbol-name libc-symbol-completions)
- (error "Not documented as a C symbol: %s" (or symbol-name "")))
- (or (libc-lookup-function symbol-name)
- (libc-lookup-variable symbol-name)
- (libc-lookup-type symbol-name)))
-
-;;;###autoload
-(defun libc-describe-file (file-name)
- "Display the documentation of a program or file in another window.
-FILE-NAME must be documented in the GNU C Library Reference Manual."
- (interactive
- (let* ((completion-ignore-case nil)
- (enable-recursive-minibuffers t))
- (list (completing-read
- "Describe program or file: "
- libc-file-completions nil nil nil 'libc-history))))
- (or (assoc file-name libc-file-completions)
- (error "Not documented as a program or file: %s" (or file-name "")))
- (libc-lookup-file file-name))
-
-;;;###autoload
-(defun libc-search (regexp &optional arg)
- "Search in the GNU C Library Reference Manual for REGEXP.
-Prefix argument means search should ignore case."
- (interactive "sSearch `libc.info' for regexp: \nP")
- (or (get-buffer "*info*")
- (save-window-excursion
- (info)))
- (switch-to-buffer-other-window "*info*")
- (Info-goto-node (concat "(" libc-info-file-name ")"))
- (let ((case-fold-search arg))
- (Info-search regexp)))
-
-\f
-(defun libc-make-completion-alist (info-nodes &optional regexp)
- "Create a unique alist from all menu items in the Info nodes INFO-NODES
-of the GNU C Reference Manual.
-
-Optional second argument REGEXP means include only menu items matching the
-regular expression REGEXP."
- (condition-case nil
- (let (completions item)
- (save-window-excursion
- (info libc-info-file-name)
- (while info-nodes
- (Info-goto-node (car info-nodes))
- (goto-char (point-min))
- (and (search-forward "\n* Menu:" nil t)
- (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
- (setq item (buffer-substring
- (match-beginning 1) (match-end 1)))
- (and (not (assoc item completions))
- (if regexp (string-match regexp item) t)
- (setq completions (cons (cons item nil)
- completions)))))
- (setq info-nodes (cdr info-nodes)))
- (Info-directory))
- completions)
- (error nil)))
-
-(defun libc-after-manual-update ()
- "This function must only be called after a new version of the
-GNU C Library Reference Manual was installed on your system."
- (setq libc-symbol-completions (libc-make-completion-alist
- '("Function Index"
- "Variable Index"
- "Type Index"))
- libc-file-completions (libc-make-completion-alist
- '("File Index") "^[^ \t]+$")))
-
-(or (and libc-symbol-completions
- libc-file-completions)
- (libc-after-manual-update))
-
-(defun libc-symbol-at-point ()
- "Get the C symbol at point."
- (condition-case nil
- (save-excursion
- (backward-sexp)
- (let ((start (point))
- prefix name)
- ;; Test for a leading `struct', `union', or `enum' keyword
- ;; but ignore names like `foo_struct'.
- (setq prefix (and (< (skip-chars-backward " \t\n") 0)
- (< (skip-chars-backward "_a-zA-Z0-9") 0)
- (looking-at "\\(struct\\|union\\|enum\\)\\s ")
- (concat (buffer-substring
- (match-beginning 1) (match-end 1))
- " ")))
- (goto-char start)
- (and (looking-at "[_a-zA-Z][_a-zA-Z0-9]*")
- (setq name (buffer-substring
- (match-beginning 0) (match-end 0))))
- ;; Caveat! Look forward if point is at `struct' etc.
- (and (not prefix)
- (or (string-equal name "struct")
- (string-equal name "union")
- (string-equal name "enum"))
- (looking-at "[a-z]+\\s +\\([_a-zA-Z][_a-zA-Z0-9]*\\)")
- (setq prefix (concat name " ")
- name (buffer-substring
- (match-beginning 1) (match-end 1))))
- (and (or prefix name)
- (concat prefix name))))
- (error nil)))
-
-(defun libc-lookup-function (function)
- (libc-search-index "Function Index" function
- "^[ \t]+- \\(Function\\|Macro\\): .*\\<" "\\>"))
-
-(defun libc-lookup-variable (variable)
- (libc-search-index "Variable Index" variable
- "^[ \t]+- \\(Variable\\|Macro\\): .*\\<" "\\>"))
-
-(defun libc-lookup-type (data-type)
- (libc-search-index "Type Index" data-type
- "^[ \t]+- Data Type: \\<" "\\>"))
-
-(defun libc-lookup-file (file-name)
- (libc-search-index "File Index" file-name))
-
-(defun libc-search-index (index item &optional prefix suffix)
- "Search ITEM in the Info index INDEX and go to that Info node.
-
-Value is ITEM or `nil' if an error occurs.
-
-If PREFIX and/or SUFFIX are non-`nil', then search the Info node for
-the first occurrence of the regular expression `PREFIX ITEM SUFFIX' and
-leave point at the beginning of the first line of the match. ITEM will
-be highlighted with `libc-highlight-face' iff `libc-highlight-face' is
-not `nil'."
- (condition-case nil
- (save-selected-window
- (or (get-buffer "*info*")
- (save-window-excursion
- (info)))
- (switch-to-buffer-other-window "*info*")
- (Info-goto-node (concat "(" libc-info-file-name ")" index))
- (Info-menu item)
- (if (or prefix suffix)
- (let ((case-fold-search nil)
- (buffer-read-only nil))
- (goto-char (point-min))
- (re-search-forward
- (concat prefix (regexp-quote item) suffix))
- (goto-char (match-beginning 0))
- (and window-system libc-highlight-face
- ;; Search again for ITEM so that the first
- ;; occurence of ITEM will be highlighted.
- (save-excursion
- (re-search-forward (regexp-quote item))
- (let ((start (match-beginning 0))
- (end (match-end 0)))
- (if (overlayp libc-highlight-overlay)
- (move-overlay libc-highlight-overlay
- start end (current-buffer))
- (setq libc-highlight-overlay
- (make-overlay start end))))
- (overlay-put libc-highlight-overlay
- 'face libc-highlight-face)))
- (beginning-of-line)))
- item)
- (error nil)))
-
-\f
-(provide 'libc)
-
-;;; libc.el ends here
"\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:"
"\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"
"\\|^content-type:\\|^content-length:"
- "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:"
- "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent:")
+ "\\|^x-attribution:\\|^x-disclaimer:")
"*Regexp to match header fields that Rmail should normally hide.
This variable is used for reformatting the message header,
which normally happens once for each message,
+++ /dev/null
-;;; man.el --- browse UNIX manual pages
-
-;; Copyright (C) 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw <bwarsaw@cen.com>
-;; Maintainer: FSF
-;; Keywords: help
-;; Adapted-By: ESR, pot
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This code provides a function, `man', with which you can browse
-;; UNIX manual pages. Formatting is done in background so that you
-;; can continue to use your Emacs while processing is going on.
-;;
-;; The mode also supports hypertext-like following of manual page SEE
-;; ALSO references, and other features. See below or do `?' in a
-;; manual page buffer for details.
-
-;; ========== Credits and History ==========
-;; In mid 1991, several people posted some interesting improvements to
-;; man.el from the standard emacs 18.57 distribution. I liked many of
-;; these, but wanted everything in one single package, so I decided
-;; to incorporate them into a single manual browsing mode. While
-;; much of the code here has been rewritten, and some features added,
-;; these folks deserve lots of credit for providing the initial
-;; excellent packages on which this one is based.
-
-;; Nick Duffek <duffek@chaos.cs.brandeis.edu>, 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 <erose@jessica.stanford.edu>, submitted manual.el which
-;; provided a very nice manual browsing mode.
-
-;; This package was available as `superman.el' from the LCD package
-;; for some time before it was accepted into Emacs 19. The entry
-;; point and some other names have been changed to make it a drop-in
-;; replacement for the old man.el package.
-
-;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
-;; making it faster, more robust and more tolerant of different
-;; systems' man idiosyncrasies.
-
-;; ========== 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 <section>", etc.
-;; + Provides a manual browsing mode with keybindings for traversing
-;; the sections of a manpage, following references in the SEE ALSO
-;; section, and more.
-;; + Multiple manpages created with the same man command are put into
-;; a narrowed buffer circular list.
-
-;; ============= TODO ===========
-;; - Add a command for printing.
-;; - The awk script deletes multiple blank lines. This behaviour does
-;; not allow to understand if there was indeed a blank line at the
-;; end or beginning of a page (after the header, or before the
-;; footer). A different algorithm should be used. It is easy to
-;; compute how many blank lines there are before and after the page
-;; headers, and after the page footer. But it is possible to compute
-;; the number of blank lines before the page footer by euristhics
-;; only. Is it worth doing?
-;; - Allow a user option to mean that all the manpages should go in
-;; the same buffer, where they can be browsed with M-n and M-p.
-;; - Allow completion on the manpage name when calling man. This
-;; requires a reliable list of places where manpages can be found. The
-;; drawback would be that if the list is not complete, the user might
-;; be led to believe that the manpages in the missing directories do
-;; not exist.
-
-\f
-;;; Code:
-
-(require 'assoc)
-
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; empty defvars (keep the compiler quiet)
-
-(defgroup man nil
- "Browse UNIX manual pages."
- :prefix "Man-"
- :group 'help)
-
-
-(defvar Man-notify)
-(defvar Man-current-page)
-(defvar Man-page-list)
-(defcustom Man-filter-list nil
- "*Manpage cleaning filter command phrases.
-This variable contains a list of the following form:
-
-'((command-string phrase-string*)*)
-
-Each phrase-string is concatenated onto the command-string to form a
-command filter. The (standard) output (and standard error) of the Un*x
-man command is piped through each command filter in the order the
-commands appear in the association list. The final output is placed in
-the manpage buffer."
- :type '(repeat (list (string :tag "Command String")
- (repeat :inline t
- (string :tag "Phrase String"))))
- :group 'man)
-
-(defvar Man-original-frame)
-(defvar Man-arguments)
-(defvar Man-sections-alist)
-(defvar Man-refpages-alist)
-(defvar Man-uses-untabify-flag t
- "Non-nil means use `untabify' instead of `Man-untabify-command'.")
-(defvar Man-page-mode-string)
-(defvar Man-sed-script nil
- "Script for sed to nuke backspaces and ANSI codes from manpages.")
-
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; user variables
-
-(defcustom Man-fontify-manpage-flag t
- "*Non-nil means make up the manpage with fonts."
- :type 'boolean
- :group 'man)
-
-(defcustom Man-overstrike-face 'bold
- "*Face to use when fontifying overstrike."
- :type 'face
- :group 'man)
-
-(defcustom Man-underline-face 'underline
- "*Face to use when fontifying underlining."
- :type 'face
- :group 'man)
-
-;; Use the value of the obsolete user option Man-notify, if set.
-(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
- "*Selects the behavior when manpage is ready.
-This variable may have one of the following values, where (sf) means
-that the frames are switched, so the manpage is displayed in the frame
-where the man command was called from:
-
-newframe -- put the manpage in its own frame (see `Man-frame-parameters')
-pushy -- make the manpage the current buffer in the current window
-bully -- make the manpage the current buffer and only window (sf)
-aggressive -- make the manpage the current buffer in the other window (sf)
-friendly -- display manpage in the other window but don't make current (sf)
-polite -- don't display manpage, but prints message and beep when ready
-quiet -- like `polite', but don't beep
-meek -- make no indication that the manpage is ready
-
-Any other value of `Man-notify-method' is equivalent to `meek'."
- :type '(radio (const newframe) (const pushy) (const bully)
- (const aggressive) (const friendly)
- (const polite) (const quiet) (const meek))
- :group 'man)
-
-(defcustom Man-frame-parameters nil
- "*Frame parameter list for creating a new frame for a manual page."
- :type 'sexp
- :group 'man)
-
-(defcustom Man-downcase-section-letters-flag t
- "*Non-nil means 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."
- :type 'boolean
- :group 'man)
-
-(defcustom Man-circular-pages-flag t
- "*Non-nil means the manpage list is treated as circular for traversal."
- :type 'boolean
- :group 'man)
-
-(defcustom Man-section-translations-alist
- (list
- '("3C++" . "3")
- ;; Some systems have a real 3x man section, so let's comment this.
- ;; '("3X" . "3") ; Xlib man pages
- '("3X11" . "3")
- '("1-UCB" . ""))
- "*Association list of bogus sections to real section numbers.
-Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
-their references which Un*x `man' does not recognize. This
-association list is used to translate those sections, when found, to
-the associated section number."
- :type '(repeat (cons (string :tag "Bogus Section")
- (string :tag "Real Section")))
- :group 'man)
-
-(defvar manual-program "man"
- "The name of the program that produces man pages.")
-
-(defvar Man-untabify-command "pr"
- "Command used for untabifying.")
-
-(defvar Man-untabify-command-args (list "-t" "-e")
- "List of arguments to be passed to `Man-untabify-command' (which see).")
-
-(defvar Man-sed-command "sed"
- "Command used for processing sed scripts.")
-
-(defvar Man-awk-command "awk"
- "Command used for processing awk scripts.")
-
-(defvar Man-mode-line-format
- '("-"
- mode-line-mule-info
- mode-line-modified
- mode-line-frame-identification
- mode-line-buffer-identification " "
- global-mode-string
- " " Man-page-mode-string
- " %[(" mode-name mode-line-process minor-mode-alist "%n)%]--"
- (line-number-mode "L%l--")
- (column-number-mode "C%c--")
- (-3 . "%p") "-%-")
- "Mode line format for manual mode buffer.")
-
-(defvar Man-mode-map nil
- "Keymap for Man mode.")
-
-(defvar Man-mode-hook nil
- "Hook run when Man mode is enabled.")
-
-(defvar Man-cooked-hook nil
- "Hook run after removing backspaces but before `Man-mode' processing.")
-
-(defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
- "Regular expression describing the name of a manpage (without section).")
-
-(defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
- "Regular expression describing a manpage section within parentheses.")
-
-(defvar Man-page-header-regexp
- (if (and (string-match "-solaris2\\." system-configuration)
- (not (string-match "-solaris2\\.[123435]$" system-configuration)))
- (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp
- "(\\(" Man-section-regexp "\\))\\)$")
- (concat "^[ \t]*\\(" Man-name-regexp
- "(\\(" Man-section-regexp "\\))\\).*\\1"))
- "Regular expression describing the heading of a page.")
-
-(defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$"
- "Regular expression describing a manpage heading entry.")
-
-(defvar Man-see-also-regexp "SEE ALSO"
- "Regular expression for SEE ALSO heading (or your equivalent).
-This regexp should not start with a `^' character.")
-
-(defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$"
- "Regular expression describing first heading on a manpage.
-This regular expression should start with a `^' character.")
-
-(defvar Man-reference-regexp
- (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
- "Regular expression describing a reference in the SEE ALSO section.")
-
-(defvar Man-switches ""
- "Switches passed to the man command, as a single string.")
-
-(defvar Man-specified-section-option
- (if (string-match "-solaris[0-9.]*$" system-configuration)
- "-s"
- "")
- "Option that indicates a specified a manual section name.")
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user variables
-\f
-;; other variables and keymap initializations
-(make-variable-buffer-local 'Man-sections-alist)
-(make-variable-buffer-local 'Man-refpages-alist)
-(make-variable-buffer-local 'Man-page-list)
-(make-variable-buffer-local 'Man-current-page)
-(make-variable-buffer-local 'Man-page-mode-string)
-(make-variable-buffer-local 'Man-original-frame)
-(make-variable-buffer-local 'Man-arguments)
-
-(setq-default Man-sections-alist nil)
-(setq-default Man-refpages-alist nil)
-(setq-default Man-page-list nil)
-(setq-default Man-current-page 0)
-(setq-default Man-page-mode-string "1 of 1")
-
-(defconst Man-sysv-sed-script "\
-/\b/ { s/_\b//g
- s/\b_//g
- s/o\b+/o/g
- s/+\bo/o/g
- :ovstrk
- s/\\(.\\)\b\\1/\\1/g
- t ovstrk
- }
-/\e\\[[0-9][0-9]*m/ s///g"
- "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")
-
-(defconst Man-berkeley-sed-script "\
-/\b/ { s/_\b//g\\
- s/\b_//g\\
- s/o\b+/o/g\\
- s/+\bo/o/g\\
- :ovstrk\\
- s/\\(.\\)\b\\1/\\1/g\\
- t ovstrk\\
- }\\
-/\e\\[[0-9][0-9]*m/ s///g"
- "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
-
-(defvar man-mode-syntax-table
- (let ((table (copy-syntax-table (standard-syntax-table))))
- (modify-syntax-entry ?. "w" table)
- (modify-syntax-entry ?_ "w" table)
- table)
- "Syntax table used in Man mode buffers.")
-
-(if Man-mode-map
- nil
- (setq Man-mode-map (make-keymap))
- (suppress-keymap Man-mode-map)
- (define-key Man-mode-map " " 'scroll-up)
- (define-key Man-mode-map "\177" 'scroll-down)
- (define-key Man-mode-map "n" 'Man-next-section)
- (define-key Man-mode-map "p" 'Man-previous-section)
- (define-key Man-mode-map "\en" 'Man-next-manpage)
- (define-key Man-mode-map "\ep" 'Man-previous-manpage)
- (define-key Man-mode-map ">" 'end-of-buffer)
- (define-key Man-mode-map "<" 'beginning-of-buffer)
- (define-key Man-mode-map "." 'beginning-of-buffer)
- (define-key Man-mode-map "r" 'Man-follow-manual-reference)
- (define-key Man-mode-map "g" 'Man-goto-section)
- (define-key Man-mode-map "s" 'Man-goto-see-also-section)
- (define-key Man-mode-map "k" 'Man-kill)
- (define-key Man-mode-map "q" 'Man-quit)
- (define-key Man-mode-map "m" 'man)
- (define-key Man-mode-map "\r" 'man-follow)
- (define-key Man-mode-map "?" 'describe-mode)
- )
-
-\f
-;; ======================================================================
-;; utilities
-
-(defun Man-init-defvars ()
- "Used for initialising variables based on display's color support.
-This is necessary if one wants to dump man.el with Emacs."
-
- ;; Avoid possible error in call-process by using a directory that must exist.
- (let ((default-directory "/"))
- (setq Man-sed-script
- (cond
- (Man-fontify-manpage-flag
- nil)
- ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
- Man-sysv-sed-script)
- ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
- Man-berkeley-sed-script)
- (t
- nil))))
-
- (setq Man-filter-list
- ;; Avoid trailing nil which confuses customize.
- (apply 'list
- (cons
- Man-sed-command
- (list
- (if Man-sed-script
- (concat "-e '" Man-sed-script "'")
- "")
- "-e '/^[\001-\032][\001-\032]*$/d'"
- "-e '/\e[789]/s///g'"
- "-e '/Reformatting page. Wait/d'"
- "-e '/Reformatting entry. Wait/d'"
- "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
- "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
- "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
- "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
- "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
- "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
- "-e '/^[A-Za-z].*Last[ \t]change:/d'"
- "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
- "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
- "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'"
- ))
- (cons
- Man-awk-command
- (list
- "'\n"
- "BEGIN { blankline=0; anonblank=0; }\n"
- "/^$/ { if (anonblank==0) next; }\n"
- "{ anonblank=1; }\n"
- "/^$/ { blankline++; next; }\n"
- "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
- "'"
- ))
- (if (not Man-uses-untabify-flag)
- ;; The outer list will be stripped off by apply.
- (list (cons
- Man-untabify-command
- Man-untabify-command-args))
- )))
-)
-
-(defsubst Man-match-substring (&optional n string)
- "Return the substring matched by the last search.
-Optional arg N means return the substring matched by the Nth paren
-grouping. Optional second arg STRING means return a substring from
-that string instead of from the current buffer."
- (if (null n) (setq n 0))
- (if string
- (substring string (match-beginning n) (match-end n))
- (buffer-substring (match-beginning n) (match-end n))))
-
-(defsubst Man-make-page-mode-string ()
- "Formats part of the mode line for Man mode."
- (format "%s page %d of %d"
- (or (nth 2 (nth (1- Man-current-page) Man-page-list))
- "")
- Man-current-page
- (length Man-page-list)))
-
-(defsubst Man-build-man-command ()
- "Builds the entire background manpage and cleaning command."
- (let ((command (concat manual-program " " Man-switches
- ; Stock MS-DOS shells cannot redirect stderr;
- ; `call-process' below sends it to /dev/null,
- ; so we don't need `2>' even with DOS shells
- ; which do support stderr redirection.
- (if (not (fboundp 'start-process))
- " %s"
- (concat " %s 2>" null-device))))
- (flist Man-filter-list))
- (while (and flist (car flist))
- (let ((pcom (car (car flist)))
- (pargs (cdr (car flist))))
- (setq command
- (concat command " | " pcom " "
- (mapconcat (lambda (phrase)
- (if (not (stringp phrase))
- (error "Malformed Man-filter-list"))
- phrase)
- pargs " ")))
- (setq flist (cdr flist))))
- command))
-
-(defun Man-translate-references (ref)
- "Translates REF from \"chmod(2V)\" to \"2v chmod\" style.
-Leave it as is if already in that style. Possibly downcase and
-translate the section (see the Man-downcase-section-letters-flag
-and the Man-section-translations-alist variables)."
- (let ((name "")
- (section "")
- (slist Man-section-translations-alist))
- (cond
- ;; "chmod(2V)" case ?
- ((string-match (concat "^" Man-reference-regexp "$") ref)
- (setq name (Man-match-substring 1 ref)
- section (Man-match-substring 2 ref)))
- ;; "2v chmod" case ?
- ((string-match (concat "^\\(" Man-section-regexp
- "\\) +\\(" Man-name-regexp "\\)$") ref)
- (setq name (Man-match-substring 2 ref)
- section (Man-match-substring 1 ref))))
- (if (string= name "")
- ref ; Return the reference as is
- (if Man-downcase-section-letters-flag
- (setq section (downcase section)))
- (while slist
- (let ((s1 (car (car slist)))
- (s2 (cdr (car slist))))
- (setq slist (cdr slist))
- (if Man-downcase-section-letters-flag
- (setq s1 (downcase s1)))
- (if (not (string= s1 section)) nil
- (setq section (if Man-downcase-section-letters-flag
- (downcase s2)
- s2)
- slist nil))))
- (concat Man-specified-section-option section " " name))))
-
-\f
-;; ======================================================================
-;; default man entry: get word under point
-
-(defsubst Man-default-man-entry ()
- "Make a guess at a default manual entry.
-This guess is based on the text surrounding the cursor."
- (let (word)
- (save-excursion
- ;; Default man entry title is any word the cursor is on, or if
- ;; cursor not on a word, then nearest preceding word.
- (setq word (current-word))
- (if (string-match "[._]+$" word)
- (setq word (substring word 0 (match-beginning 0))))
- ;; If looking at something like ioctl(2) or brc(1M), include the
- ;; section number in the returned value. Remove text properties.
- (forward-word 1)
- ;; Use `format' here to clear any text props from `word'.
- (format "%s%s"
- word
- (if (looking-at
- (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
- (format "(%s)" (Man-match-substring 1))
- "")))))
-
-\f
-;; ======================================================================
-;; Top level command and background process sentinel
-
-;; For compatibility with older versions.
-;;;###autoload
-(defalias 'manual-entry 'man)
-
-;;;###autoload
-(defun man (man-args)
- "Get a Un*x manual page and put it in a buffer.
-This command is the top-level command in the man package. It runs a Un*x
-command to retrieve and clean a manpage in the background and places the
-results in a Man mode (manpage browsing) buffer. See variable
-`Man-notify-method' for what happens when the buffer is ready.
-If a buffer already exists for this man page, it will display immediately.
-
-To specify a man page from a certain section, type SUBJECT(SECTION) or
-SECTION SUBJECT when prompted for a manual entry."
- (interactive
- (list (let* ((default-entry (Man-default-man-entry))
- (input (read-string
- (format "Manual entry%s: "
- (if (string= default-entry "")
- ""
- (format " (default %s)" default-entry))))))
- (if (string= input "")
- (if (string= default-entry "")
- (error "No man args given")
- default-entry)
- input))))
-
- ;; Possibly translate the "subject(section)" syntax into the
- ;; "section subject" syntax and possibly downcase the section.
- (setq man-args (Man-translate-references man-args))
-
- (Man-getpage-in-background man-args))
-
-;;;###autoload
-(defun man-follow (man-args)
- "Get a Un*x manual page of the item under point and put it in a buffer."
- (interactive (list (Man-default-man-entry)))
- (if (or (not man-args)
- (string= man-args ""))
- (error "No item under point")
- (man man-args)))
-
-(defun Man-getpage-in-background (topic)
- "Use TOPIC to build and fire off the manpage and cleaning command."
- (let* ((man-args topic)
- (bufname (concat "*Man " man-args "*"))
- (buffer (get-buffer bufname)))
- (if buffer
- (Man-notify-when-ready buffer)
- (require 'env)
- (message "Invoking %s %s in the background" manual-program man-args)
- (setq buffer (generate-new-buffer bufname))
- (save-excursion
- (set-buffer buffer)
- (setq Man-original-frame (selected-frame))
- (setq Man-arguments man-args))
- (let ((process-environment (copy-sequence process-environment))
- ;; The following is so Awk script gets \n intact
- ;; But don't prevent decoding of the outside.
- (coding-system-for-write 'raw-text-unix)
- ;; We must decode the output by a coding system that the
- ;; system's locale suggests in multibyte mode.
- (coding-system-for-read
- (if default-enable-multibyte-characters
- locale-coding-system 'raw-text-unix))
- ;; Avoid possible error by using a directory that always exists.
- (default-directory "/"))
- ;; Prevent any attempt to use display terminal fanciness.
- (setenv "TERM" "dumb")
- (if (fboundp 'start-process)
- (set-process-sentinel
- (start-process manual-program buffer "sh" "-c"
- (format (Man-build-man-command) man-args))
- 'Man-bgproc-sentinel)
- (progn
- (let ((exit-status
- (call-process shell-file-name nil (list buffer nil) nil "-c"
- (format (Man-build-man-command) man-args)))
- (msg ""))
- (or (and (numberp exit-status)
- (= exit-status 0))
- (and (numberp exit-status)
- (setq msg
- (format "exited abnormally with code %d"
- exit-status)))
- (setq msg exit-status))
- (Man-bgproc-sentinel bufname msg))))))))
-
-(defun Man-notify-when-ready (man-buffer)
- "Notify the user when MAN-BUFFER is ready.
-See the variable `Man-notify-method' for the different notification behaviors."
- (let ((saved-frame (save-excursion
- (set-buffer man-buffer)
- Man-original-frame)))
- (cond
- ((eq Man-notify-method 'newframe)
- ;; Since we run asynchronously, perhaps while Emacs is waiting
- ;; for input, we must not leave a different buffer current. We
- ;; can't rely on the editor command loop to reselect the
- ;; selected window's buffer.
- (save-excursion
- (let ((frame (make-frame Man-frame-parameters)))
- (set-window-buffer (frame-selected-window frame) man-buffer)
- (set-window-dedicated-p (frame-selected-window frame) t)
- (or (display-multi-frame-p frame)
- (select-frame frame)))))
- ((eq Man-notify-method 'pushy)
- (switch-to-buffer man-buffer))
- ((eq Man-notify-method 'bully)
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer)
- (delete-other-windows))
- ((eq Man-notify-method 'aggressive)
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (pop-to-buffer man-buffer))
- ((eq Man-notify-method 'friendly)
- (and (frame-live-p saved-frame)
- (select-frame saved-frame))
- (display-buffer man-buffer 'not-this-window))
- ((eq Man-notify-method 'polite)
- (beep)
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- ((eq Man-notify-method 'quiet)
- (message "Manual buffer %s is ready" (buffer-name man-buffer)))
- ((or (eq Man-notify-method 'meek)
- t)
- (message ""))
- )))
-
-(defun Man-softhyphen-to-minus ()
- ;; \255 is some kind of dash in Latin-N. Versions of Debian man, at
- ;; least, emit it even when not in a Latin-N locale.
- (unless (eq t (compare-strings "latin-" 0 nil
- current-language-environment 0 6 t))
- (goto-char (point-min))
- (let ((str "\255"))
- (if enable-multibyte-characters
- (setq str (string-as-multibyte str)))
- (while (search-forward str nil t) (replace-match "-")))))
-
-(defun Man-fontify-manpage ()
- "Convert overstriking and underlining to the correct fonts.
-Same for the ANSI bold and normal escape sequences."
- (interactive)
- (message "Please wait: making up the %s man page..." Man-arguments)
- (goto-char (point-min))
- (while (search-forward "\e[1m" nil t)
- (delete-backward-char 4)
- (put-text-property (point)
- (progn (if (search-forward "\e[0m" nil 'move)
- (delete-backward-char 4))
- (point))
- 'face Man-overstrike-face))
- (if (< (buffer-size) (position-bytes (point-max)))
- ;; Multibyte characters exist.
- (progn
- (goto-char (point-min))
- (while (search-forward "__\b\b" nil t)
- (backward-delete-char 4)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
- (goto-char (point-min))
- (while (search-forward "\b\b__" nil t)
- (backward-delete-char 4)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))))
- (goto-char (point-min))
- (while (search-forward "_\b" nil t)
- (backward-delete-char 2)
- (put-text-property (point) (1+ (point)) 'face Man-underline-face))
- (goto-char (point-min))
- (while (search-forward "\b_" nil t)
- (backward-delete-char 2)
- (put-text-property (1- (point)) (point) 'face Man-underline-face))
- (goto-char (point-min))
- (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
- (replace-match "\\1")
- (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
- (goto-char (point-min))
- (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
- (replace-match "o")
- (put-text-property (1- (point)) (point) 'face 'bold))
- (goto-char (point-min))
- (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
- (replace-match "+")
- (put-text-property (1- (point)) (point) 'face 'bold))
- (Man-softhyphen-to-minus)
- (message "%s man page made up" Man-arguments))
-
-(defun Man-cleanup-manpage ()
- "Remove overstriking and underlining from the current buffer."
- (interactive)
- (message "Please wait: cleaning up the %s man page..."
- Man-arguments)
- (if (or (interactive-p) (not Man-sed-script))
- (progn
- (goto-char (point-min))
- (while (search-forward "_\b" nil t) (backward-delete-char 2))
- (goto-char (point-min))
- (while (search-forward "\b_" nil t) (backward-delete-char 2))
- (goto-char (point-min))
- (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
- (replace-match "\\1"))
- (goto-char (point-min))
- (while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
- (goto-char (point-min))
- (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
- ))
- (goto-char (point-min))
- (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
- (Man-softhyphen-to-minus)
- (message "%s man page cleaned up" Man-arguments))
-
-(defun Man-bgproc-sentinel (process msg)
- "Manpage background process sentinel.
-When manpage command is run asynchronously, PROCESS is the process
-object for the manpage command; when manpage command is run
-synchronously, PROCESS is the name of the buffer where the manpage
-command is run. Second argument MSG is the exit message of the
-manpage command."
- (let ((Man-buffer (if (stringp process) (get-buffer process)
- (process-buffer process)))
- (delete-buff nil)
- (err-mess nil))
-
- (if (null (buffer-name Man-buffer)) ;; deleted buffer
- (or (stringp process)
- (set-process-buffer process nil))
-
- (save-excursion
- (set-buffer Man-buffer)
- (let ((case-fold-search nil))
- (goto-char (point-min))
- (cond ((or (looking-at "No \\(manual \\)*entry for")
- (looking-at "[^\n]*: nothing appropriate$"))
- (setq err-mess (buffer-substring (point)
- (progn
- (end-of-line) (point)))
- delete-buff t))
- ((or (stringp process)
- (not (and (eq (process-status process) 'exit)
- (= (process-exit-status process) 0))))
- (or (zerop (length msg))
- (progn
- (setq err-mess
- (concat (buffer-name Man-buffer)
- ": process "
- (let ((eos (1- (length msg))))
- (if (= (aref msg eos) ?\n)
- (substring msg 0 eos) msg))))
- (goto-char (point-max))
- (insert (format "\nprocess %s" msg))))
- ))
- (if delete-buff
- (kill-buffer Man-buffer)
- (if Man-fontify-manpage-flag
- (Man-fontify-manpage)
- (Man-cleanup-manpage))
- (run-hooks 'Man-cooked-hook)
- (Man-mode)
- (set-buffer-modified-p nil)
- ))
- ;; Restore case-fold-search before calling
- ;; Man-notify-when-ready because it may switch buffers.
-
- (if (not delete-buff)
- (Man-notify-when-ready Man-buffer))
-
- (if err-mess
- (error err-mess))
- ))))
-
-\f
-;; ======================================================================
-;; 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] <key> RET\" for more information:
-
-\\[man] Prompt to retrieve a new manpage.
-\\[Man-follow-manual-reference] Retrieve reference in SEE ALSO section.
-\\[Man-next-manpage] Jump to next manpage in circular list.
-\\[Man-previous-manpage] Jump to previous manpage in circular list.
-\\[Man-next-section] Jump to next manpage section.
-\\[Man-previous-section] Jump to previous manpage section.
-\\[Man-goto-section] Go to a manpage section.
-\\[Man-goto-see-also-section] Jumps to the SEE ALSO manpage section.
-\\[Man-quit] Deletes the manpage window, bury its buffer.
-\\[Man-kill] Deletes the manpage window, kill its buffer.
-\\[describe-mode] Prints this help text.
-
-The following variables may be of some use. Try
-\"\\[describe-variable] <variable-name> RET\" for more information:
-
-`Man-notify-method' What happens when manpage formatting is done.
-`Man-downcase-section-letters-flag' Force section letters to lower case.
-`Man-circular-pages-flag' Treat multiple manpage list as circular.
-`Man-section-translations-alist' List of section numbers and their Un*x equiv.
-`Man-filter-list' Background manpage filter command.
-`Man-mode-line-format' Mode line format for Man mode buffers.
-`Man-mode-map' Keymap bindings for Man mode buffers.
-`Man-mode-hook' Normal hook run on entry to Man mode.
-`Man-section-regexp' Regexp describing manpage section letters.
-`Man-heading-regexp' Regexp describing section headers.
-`Man-see-also-regexp' Regexp for SEE ALSO section (or your equiv).
-`Man-first-heading-regexp' Regexp for first heading on a manpage.
-`Man-reference-regexp' Regexp matching a references in SEE ALSO.
-`Man-switches' Background `man' command switches.
-
-The following key bindings are currently in effect in the buffer:
-\\{Man-mode-map}"
- (interactive)
- (setq major-mode 'Man-mode
- mode-name "Man"
- buffer-auto-save-file-name nil
- mode-line-format Man-mode-line-format
- truncate-lines t
- buffer-read-only t)
- (buffer-disable-undo (current-buffer))
- (auto-fill-mode -1)
- (use-local-map Man-mode-map)
- (set-syntax-table man-mode-syntax-table)
- (Man-build-page-list)
- (Man-strip-page-headers)
- (Man-unindent)
- (Man-goto-page 1)
- (run-hooks 'Man-mode-hook))
-
-(defsubst Man-build-section-alist ()
- "Build the association list of manpage sections."
- (setq Man-sections-alist nil)
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (while (re-search-forward Man-heading-regexp (point-max) t)
- (aput 'Man-sections-alist (Man-match-substring 1))
- (forward-line 1))))
-
-(defsubst Man-build-references-alist ()
- "Build the association list of references (in the SEE ALSO section)."
- (setq Man-refpages-alist nil)
- (save-excursion
- (if (Man-find-section Man-see-also-regexp)
- (let ((start (progn (forward-line 1) (point)))
- (end (progn
- (Man-next-section 1)
- (point)))
- hyphenated
- (runningpoint -1))
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (back-to-indentation)
- (while (and (not (eobp)) (/= (point) runningpoint))
- (setq runningpoint (point))
- (if (re-search-forward Man-reference-regexp end t)
- (let* ((word (Man-match-substring 0))
- (len (1- (length word))))
- (if hyphenated
- (setq word (concat hyphenated word)
- hyphenated nil))
- (if (= (aref word len) ?-)
- (setq hyphenated (substring word 0 len))
- (aput 'Man-refpages-alist word))))
- (skip-chars-forward " \t\n,")))))))
-
-(defun Man-build-page-list ()
- "Build the list of separate manpages in the buffer."
- (setq Man-page-list nil)
- (let ((page-start (point-min))
- (page-end (point-max))
- (header ""))
- (goto-char page-start)
- ;; (switch-to-buffer (current-buffer))(debug)
- (while (not (eobp))
- (setq header
- (if (looking-at Man-page-header-regexp)
- (Man-match-substring 1)
- nil))
- ;; Go past both the current and the next Man-first-heading-regexp
- (if (re-search-forward Man-first-heading-regexp nil 'move 2)
- (let ((p (progn (beginning-of-line) (point))))
- ;; We assume that the page header is delimited by blank
- ;; lines and that it contains at most one blank line. So
- ;; if we back by three blank lines we will be sure to be
- ;; before the page header but not before the possible
- ;; previous page header.
- (search-backward "\n\n" nil t 3)
- (if (re-search-forward Man-page-header-regexp p 'move)
- (beginning-of-line))))
- (setq page-end (point))
- (setq Man-page-list (append Man-page-list
- (list (list (copy-marker page-start)
- (copy-marker page-end)
- header))))
- (setq page-start page-end)
- )))
-
-(defun Man-strip-page-headers ()
- "Strip all the page headers but the first from the manpage."
- (let ((buffer-read-only nil)
- (case-fold-search nil)
- (page-list Man-page-list)
- (page ())
- (header ""))
- (while page-list
- (setq page (car page-list))
- (and (nth 2 page)
- (goto-char (car page))
- (re-search-forward Man-first-heading-regexp nil t)
- (setq header (buffer-substring (car page) (match-beginning 0)))
- ;; Since the awk script collapses all successive blank
- ;; lines into one, and since we don't want to get rid of
- ;; the fast awk script, one must choose between adding
- ;; spare blank lines between pages when there were none and
- ;; deleting blank lines at page boundaries when there were
- ;; some. We choose the first, so we comment the following
- ;; line.
- ;; (setq header (concat "\n" header)))
- (while (search-forward header (nth 1 page) t)
- (replace-match "")))
- (setq page-list (cdr page-list)))))
-
-(defun Man-unindent ()
- "Delete the leading spaces that indent the manpage."
- (let ((buffer-read-only nil)
- (case-fold-search nil)
- (page-list Man-page-list))
- (while page-list
- (let ((page (car page-list))
- (indent "")
- (nindent 0))
- (narrow-to-region (car page) (car (cdr page)))
- (if Man-uses-untabify-flag
- (untabify (point-min) (point-max)))
- (if (catch 'unindent
- (goto-char (point-min))
- (if (not (re-search-forward Man-first-heading-regexp nil t))
- (throw 'unindent nil))
- (beginning-of-line)
- (setq indent (buffer-substring (point)
- (progn
- (skip-chars-forward " ")
- (point))))
- (setq nindent (length indent))
- (if (zerop nindent)
- (throw 'unindent nil))
- (setq indent (concat indent "\\|$"))
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at indent)
- (forward-line 1)
- (throw 'unindent nil)))
- (goto-char (point-min)))
- (while (not (eobp))
- (or (eolp)
- (delete-char nindent))
- (forward-line 1)))
- (setq page-list (cdr page-list))
- ))))
-
-\f
-;; ======================================================================
-;; Man mode commands
-
-(defun Man-next-section (n)
- "Move point to Nth next section (default 1)."
- (interactive "p")
- (let ((case-fold-search nil))
- (if (looking-at Man-heading-regexp)
- (forward-line 1))
- (if (re-search-forward Man-heading-regexp (point-max) t n)
- (beginning-of-line)
- (goto-char (point-max)))))
-
-(defun Man-previous-section (n)
- "Move point to Nth previous section (default 1)."
- (interactive "p")
- (let ((case-fold-search nil))
- (if (looking-at Man-heading-regexp)
- (forward-line -1))
- (if (re-search-backward Man-heading-regexp (point-min) t n)
- (beginning-of-line)
- (goto-char (point-min)))))
-
-(defun Man-find-section (section)
- "Move point to SECTION if it exists, otherwise don't move point.
-Returns t if section is found, nil otherwise."
- (let ((curpos (point))
- (case-fold-search nil))
- (goto-char (point-min))
- (if (re-search-forward (concat "^" section) (point-max) t)
- (progn (beginning-of-line) t)
- (goto-char curpos)
- nil)
- ))
-
-(defun Man-goto-section ()
- "Query for section to move point to."
- (interactive)
- (aput 'Man-sections-alist
- (let* ((default (aheadsym Man-sections-alist))
- (completion-ignore-case t)
- chosen
- (prompt (concat "Go to section: (default " default ") ")))
- (setq chosen (completing-read prompt Man-sections-alist))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))
- (Man-find-section (aheadsym Man-sections-alist)))
-
-(defun Man-goto-see-also-section ()
- "Move point the the \"SEE ALSO\" section.
-Actually the section moved to is described by `Man-see-also-regexp'."
- (interactive)
- (if (not (Man-find-section Man-see-also-regexp))
- (error (concat "No " Man-see-also-regexp
- " section found in the current manpage"))))
-
-(defun Man-follow-manual-reference (reference)
- "Get one of the manpages referred to in the \"SEE ALSO\" section.
-Specify which REFERENCE to use; default is based on word at point."
- (interactive
- (if (not Man-refpages-alist)
- (error "There are no references in the current man page")
- (list (let* ((default (or
- (car (all-completions
- (save-excursion
- (skip-syntax-backward "w()")
- (skip-chars-forward " \t")
- (let ((word (current-word)))
- ;; strip a trailing '-':
- (if (string-match "-$" word)
- (substring word 0
- (match-beginning 0))
- word)))
- Man-refpages-alist))
- (aheadsym Man-refpages-alist)))
- chosen
- (prompt (concat "Refer to: (default " default ") ")))
- (setq chosen (completing-read prompt Man-refpages-alist nil t))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))))
- (if (not Man-refpages-alist)
- (error "Can't find any references in the current manpage")
- (aput 'Man-refpages-alist reference)
- (Man-getpage-in-background
- (Man-translate-references (aheadsym Man-refpages-alist)))))
-
-(defun Man-kill ()
- "Kill the buffer containing the manpage."
- (interactive)
- (quit-window t))
-
-(defun Man-quit ()
- "Bury the buffer containing the manpage."
- (interactive)
- (quit-window))
-
-(defun Man-goto-page (page)
- "Go to the manual page on page PAGE."
- (interactive
- (if (not Man-page-list)
- (let ((args Man-arguments))
- (kill-buffer (current-buffer))
- (error "Can't find the %s manpage" args))
- (if (= (length Man-page-list) 1)
- (error "You're looking at the only manpage in the buffer")
- (list (read-minibuffer (format "Go to manpage [1-%d]: "
- (length Man-page-list)))))))
- (if (not Man-page-list)
- (let ((args Man-arguments))
- (kill-buffer (current-buffer))
- (error "Can't find the %s manpage" args)))
- (if (or (< page 1)
- (> page (length Man-page-list)))
- (error "No manpage %d found" page))
- (let* ((page-range (nth (1- page) Man-page-list))
- (page-start (car page-range))
- (page-end (car (cdr page-range))))
- (setq Man-current-page page
- Man-page-mode-string (Man-make-page-mode-string))
- (widen)
- (goto-char page-start)
- (narrow-to-region page-start page-end)
- (Man-build-section-alist)
- (Man-build-references-alist)
- (goto-char (point-min))))
-
-
-(defun Man-next-manpage ()
- "Find the next manpage entry in the buffer."
- (interactive)
- (if (= (length Man-page-list) 1)
- (error "This is the only manpage in the buffer"))
- (if (< Man-current-page (length Man-page-list))
- (Man-goto-page (1+ Man-current-page))
- (if Man-circular-pages-flag
- (Man-goto-page 1)
- (error "You're looking at the last manpage in the buffer"))))
-
-(defun Man-previous-manpage ()
- "Find the previous manpage entry in the buffer."
- (interactive)
- (if (= (length Man-page-list) 1)
- (error "This is the only manpage in the buffer"))
- (if (> Man-current-page 1)
- (Man-goto-page (1- Man-current-page))
- (if Man-circular-pages-flag
- (Man-goto-page (length Man-page-list))
- (error "You're looking at the first manpage in the buffer"))))
-\f
-;; Init the man package variables, if not already done.
-(Man-init-defvars)
-
-(add-to-list 'debug-ignored-errors "^No manpage [0-9]* found$")
-(add-to-list 'debug-ignored-errors "^Can't find the .* manpage$")
-
-(provide 'man)
-
-;;; man.el ends here
+++ /dev/null
-;;; 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 "%s" (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
+++ /dev/null
-;;; 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 <gildea@lcs.mit.edu>
-;; 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.15 1993/07/20 04:35:00 rms Exp rms $")
-
-;;; Code:
-
-\f
-
-;;; 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-letter-mode-map>\\[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))))
-
-\f
-
-;;; 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))
-
-\f
-
-;;; 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))
-
-\f
-
-;;; 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)))
-
-\f
-
-;;; 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))
-
-\f
-
-;;; 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")))
-
-\f
-
-;;; 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))))
-
-\f
-
-;;; 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)))))
-
-\f
-
-;;; 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)))
-
-\f
-
-;;; 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)))
-
-\f
-
-;;; 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)))))
-
-\f
-
-;;; 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)))
-
-\f
-
-;;; 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)))
-
-\f
-
-;;; 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)
-
-\f
-
-;;; 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
+++ /dev/null
-;;; mhspool.el --- MH folder access using NNTP for GNU Emacs
-
-;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; 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.")
-
-\f
-
-(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)
- )))
-
-\f
-;;;
-;;; 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
- )
-
-\f
-;;;
-;;; 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
- ))
-
-\f
-;; 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
+++ /dev/null
-;;; 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
-<FOO ...> 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 <cons>\) where <cons> is a list or pointed list
-of integers, means indent each form in <FOO ...> by the amount specified
-in <cons>. When <cons> is exhausted, indent remaining forms by
-`mim-body-indent' unless <cons> 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\)\)
-<FROBIT
- <CHOMP-IT>
- <CHOMP-SOME-MORE>
- <DIGEST>
- <BELCH>
- ...>
-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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; netunam.el --- HP-UX RFA Commands
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Chris Hanson <cph@zurich.ai.mit.edu>
-;; 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))))))))
-\f
-(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)))))
-\f
-(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
+++ /dev/null
-;;; old-shell.el --- run a shell in an Emacs window
-
-;; Copyright (C) 1985, 1986, 1987, 1990 Free Software Foundation, Inc.
-
-;; 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.
-
-;;; Hacked from tea.el and shell.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
-
-;;; 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.
-
-;;; For documentation on the functionality provided by comint mode, and
-;;; the hooks available for customising it, see the file comint.el.
-
-;;; 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?
-
-;;; Code:
-
-(require 'comint)
-(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-cd-regexp "cd"
- "*Regexp to match subshell commands equivalent to cd.")
-
-(defvar explicit-shell-file-name nil
- "*If non-nil, is file name to use for explicitly requested inferior shell.")
-
-(defvar explicit-csh-args
- (if (eq system-type 'hpux)
- ;; -T persuades HP's csh not to think it is smarter
- ;; than us about what terminal modes to use.
- '("-i" "-T")
- '("-i"))
- "*Args passed to inferior shell by M-x shell, if the shell is csh.
-Value is a list of strings, which may be nil.")
-
-(defvar shell-dirstack nil
- "List of directories saved by pushd in this buffer's shell.")
-
-(defvar shell-dirstack-query "dirs"
- "Command used by shell-resync-dirlist to query shell.")
-
-(defvar shell-mode-map ())
-(cond ((not shell-mode-map)
- (setq shell-mode-map (copy-keymap comint-mode-map))
- (define-key shell-mode-map "\t" 'comint-dynamic-complete)
- (define-key shell-mode-map "\M-?" 'comint-dynamic-list-completions)))
-
-(defvar shell-mode-hook '()
- "*Hook for customising shell mode")
-
-\f
-;;; 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 rest of line to end (skipping
- the prompt) and sends it.
-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 \\[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}
-Customisation: Entry to this mode runs the hooks on comint-mode-hook and
-shell-mode-hook (in that order).
-
-Variables shell-cd-regexp, shell-pushd-regexp and shell-popd-regexp are used
-to match their respective commands."
- (interactive)
- (comint-mode)
- (setq major-mode 'shell-mode
- mode-name "Shell"
- comint-prompt-regexp shell-prompt-pattern
- comint-input-sentinel 'shell-directory-tracker)
- (use-local-map shell-mode-map)
- (make-local-variable 'shell-dirstack)
- (set (make-local-variable 'shell-dirtrackp) t)
- (run-hooks 'shell-mode-hook))
-
-\f
-(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*.
-
-The shell to use comes from the first non-nil variable found from these:
-explicit-shell-file-name in Emacs, ESHELL in the environment or SHELL in the
-environment. If none is found, /bin/sh is used.
-
-If a file ~/.emacs_SHELLNAME exists, it is given as initial input, simulating
-a start-up file for the shell like .profile or .cshrc. 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.
-
-The shell file name, sans directories, is used to make a symbol name
-such as `explicit-csh-arguments'. 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*"))
-
-\f
-;;; 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 original version in shell.el. It has the following failings:
-;;; 1. It doesn't know about the cdpath shell variable.
-;;; 2. It only spots the first command in a command sequence. E.g., it will
-;;; miss the cd in "ls; cd foo"
-;;; 3. More generally, any complex command (like ";" sequencing) 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* effect 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 | <cwd> |
-;;; where <cwd> 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.
-
-;;; REGEXP is a regular expression. STR is a string. START is a fixnum.
-;;; Returns T if REGEXP matches STR where the match is anchored to start
-;;; at position START in STR. Sort of like LOOKING-AT for strings.
-(defun shell-front-match (regexp str start)
- (eq start (string-match regexp str start)))
-
-(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.
-Environment variables are expanded, see function substitute-in-file-name."
- (condition-case err
- (cond (shell-dirtrackp
- (string-match "^\\s *" str) ; skip whitespace
- (let ((bos (match-end 0))
- (x nil))
- (cond ((setq x (shell-match-cmd-w/optional-arg shell-popd-regexp
- str bos))
- (shell-process-popd (substitute-in-file-name x)))
- ((setq x (shell-match-cmd-w/optional-arg shell-pushd-regexp
- str bos))
- (shell-process-pushd (substitute-in-file-name x)))
- ((setq x (shell-match-cmd-w/optional-arg shell-cd-regexp
- str bos))
- (shell-process-cd (substitute-in-file-name x)))))))
- (error (message (car (cdr err))))))
-
-
-;;; Try to match regexp CMD to string, anchored at position START.
-;;; CMD may be followed by a single argument. If a match, then return
-;;; the argument, if there is one, or the empty string if not. If
-;;; no match, return nil.
-
-(defun shell-match-cmd-w/optional-arg (cmd str start)
- (and (shell-front-match cmd str start)
- (let ((eoc (match-end 0))) ; end of command
- (cond ((shell-front-match "\\s *\\(\;\\|$\\)" str eoc)
- "") ; no arg
- ((shell-front-match "\\s +\\([^ \t\;]+\\)\\s *\\(\;\\|$\\)"
- str eoc)
- (substring str (match-beginning 1) (match-end 1))) ; arg
- (t nil))))) ; something else.
-;;; The first regexp is [optional whitespace, (";" or the end of string)].
-;;; The second regexp is [whitespace, (an arg), optional whitespace,
-;;; (";" or end of string)].
-
-
-;;; popd [+n]
-(defun shell-process-popd (arg)
- (let ((num (if (zerop (length arg)) 0 ; no arg means +0
- (shell-extract-num arg))))
- (if (and num (< num (length shell-dirstack)))
- (if (= num 0) ; condition-case because the CD could lose.
- (condition-case nil (progn (cd (car shell-dirstack))
- (setq shell-dirstack
- (cdr shell-dirstack))
- (shell-dirstack-message))
- (error (message "Couldn't cd.")))
- (let* ((ds (cons nil shell-dirstack))
- (cell (nthcdr (- num 1) ds)))
- (rplacd cell (cdr (cdr cell)))
- (setq shell-dirstack (cdr ds))
- (shell-dirstack-message)))
- (message "Bad popd."))))
-
-
-;;; cd [dir]
-(defun shell-process-cd (arg)
- (condition-case nil (progn (cd (if (zerop (length arg)) (getenv "HOME")
- arg))
- (shell-dirstack-message))
- (error (message "Couldn't cd."))))
-
-
-;;; pushd [+n | dir]
-(defun shell-process-pushd (arg)
- (if (zerop (length arg))
- ;; no arg -- swap pwd and car of shell stack
- (condition-case nil (if shell-dirstack
- (let ((old default-directory))
- (cd (car shell-dirstack))
- (setq shell-dirstack
- (cons old (cdr shell-dirstack)))
- (shell-dirstack-message))
- (message "Directory stack empty."))
- (message "Couldn't cd."))
-
- (let ((num (shell-extract-num arg)))
- (if num ; pushd +n
- (if (> num (length shell-dirstack))
- (message "Directory stack not that deep.")
- (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)))
- (condition-case nil
- (progn (cd (car new-ds))
- (setq shell-dirstack (cdr new-ds))
- (shell-dirstack-message))
- (error (message "Couldn't cd.")))))
-
- ;; pushd <dir>
- (let ((old-wd default-directory))
- (condition-case nil
- (progn (cd arg)
- (setq shell-dirstack
- (cons old-wd shell-dirstack))
- (shell-dirstack-message))
- (error (message "Couldn't cd."))))))))
-
-;; 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:
-(fset '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) (- (match-end 0) 1)))
- (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:
-(fset '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)))
- (while ds
- (let ((dir (car ds)))
- (if (string-match (format "^%s\\(/\\|$\\)" (getenv "HOME")) dir)
- (setq dir (concat "~/" (substring dir (match-end 0)))))
- (if (string-equal dir "~/") (setq dir "~"))
- (setq msg (concat msg dir " "))
- (setq ds (cdr ds))))
- (message msg)))
-
-(provide 'shell)
-
-;;; old-shell.el ends here
;;; ebnf2ps --- Translate an EBNF to a syntatic chart on PostScript
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
;; Keywords: wp, ebnf, PostScript
-;; Time-stamp: <2001/02/02 15:23:39 vinicius>
-;; Version: 3.5
+;; Time-stamp: <2000/12/19 15:17:15 vinicius>
+;; Version: 3.4
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/Emacs.html
;; This file is part of GNU Emacs.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-(defconst ebnf-version "3.5"
- "ebnf2ps.el, v 3.5 <2001/02/02 vinicius>
-
+(defconst ebnf-version "3.4"
+ "ebnf2ps.el, v 3.4 <2000/12/19 vinicius>
Vinicius's last change version. When reporting bugs, please also
report the version of Emacs, if any, that ebnf2ps was running with.
"\n%%BoundingBox: 0 0 "
(format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
"\n%%Title: " filename
- "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
+ "\n%%CreationDate: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
"\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
"\n%%DocumentNeededResources: font "
(or ebnf-fonts-required
+++ /dev/null
-;; -*- Mode: Emacs-Lisp -*-
-;; sc-alist.el -- Version 1.0 (used to be baw-alist.el)
-
-;; association list utilities providing insertion, deletion, sorting
-;; fetching off key-value pairs in association lists.
-
-;; ========== Disclaimer ==========
-;; 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.
-
-;; ========== Author (unless otherwise stated) ========================
-;; NAME: Barry A. Warsaw USMAIL: Century Computing, Inc.
-;; TELE: (301) 593-3330 1014 West Street
-;; INET: bwarsaw@cen.com Laurel, Md 20707
-;; UUCP: uunet!cen.com!bwarsaw
-;;
-(provide 'sc-alist)
-
-
-(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))
+++ /dev/null
-;; -*- Mode: Emacs-Lisp -*-
-;; sc.el -- Version 2.3 (used to be supercite.el)
-
-;; ========== Introduction ==========
-;; Citation and attribution package for various GNU emacs news and
-;; electronic mail reading subsystems. This version of supercite should
-;; work with Rmail and GNUS as found in Emacs 19. It may also work with
-;; VM 4.40+ and MH-E 3.7.
-
-;; This package does not do any yanking of messages, but instead
-;; massages raw reply buffers set up by the reply/forward functions in
-;; the news/mail subsystems. Therefore, such useful operations as
-;; yanking and citing portions of the original article (instead of the
-;; whole article) are not within the ability or responsibility of
-;; supercite.
-
-;; ========== Disclaimer ==========
-;; This software is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor, nor any
-;; author's past, present, or future employers 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.
-
-;; Some of this software was written as part of the supercite author's
-;; official duty as an employee of the United States Government and is
-;; thus not subject to copyright. 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 or other freely
-;; available code, you give due credit to the author.
-
-;; Other parts of this code were written by other people. Wherever
-;; possible, credit to that author, and the copy* notice supplied by
-;; the author are included with that code. The supercite author is no
-;; longer an employee of the U.S. Government so the GNU Public Licence
-;; should be considered in effect for all enhancements and bug fixes
-;; performed by the author.
-
-;; ========== Author (unless otherwise stated) ========================
-;; NAME: Barry A. Warsaw USMAIL: Century Computing, Inc.
-;; TELE: (301) 593-3330 1014 West Street
-;; INET: bwarsaw@cen.com Laurel, Md 20707
-;; UUCP: uunet!cen.com!bwarsaw
-;;
-;; Want to be on the Supercite mailing list?
-;;
-;; Send articles to:
-;; Internet: supercite@anthem.nlm.nih.gov
-;; UUCP: uunet!anthem.nlm.nih.gov!supercite
-;;
-;; Send administrivia (additions/deletions to list, etc) to:
-;; Internet: supercite-request@anthem.nlm.nih.gov
-;; UUCP: uunet!anthem.nlm.nih.gov!supercite-request
-
-;; ========== Credits and Thanks ==========
-;; This package was derived from the Superyank 1.11 package as posted
-;; to the net. Superyank 1.11 was inspired by code and ideas from
-;; Martin Neitzel and Ashwin Ram. Supercite version 2.3 has evolved
-;; through the comments and suggestions of the supercite mailing list
-;; which consists of many authors and users of the various mail and
-;; news reading subsystems.
-
-;; Many folks on the supercite mailing list have contributed their
-;; help in debugging, making suggestions and supplying support code or
-;; bug fixes for the previous versions of supercite. I want to thank
-;; everyone who helped, especially (in no particular order):
-;;
-;; Mark D. Baushke, Khalid Sattar, David Lawrence, Chris Davis, Kyle
-;; Jones, Kayvan Sylvan, Masanobu Umeda, Dan Jacobson, Piet van
-;; Oostrum, Hamish (H.I.) Macdonald, and Joe Wells.
-;;
-;; I don't mean to leave anyone out. All who have helped have been
-;; appreciated.
-
-;; ========== Getting Started ==========
-;; Here is a quick guide to getting started with supercite. The
-;; information contained here is mostly excerpted from the more
-;; detailed explanations given in the accompanying README file.
-;; Naturally, there are many customizations you can do to give your
-;; replies that personalized flair, but the instructions in this
-;; section should be sufficient for getting started.
-
-;; First, to connect supercite to any mail/news reading subsystem, put
-;; this in your .emacs file:
-;;
-;; (setq mail-yank-hooks 'sc-cite-original) ; for old mail agents
-;; (setq mh-yank-hooks 'sc-cite-original) ; for MH-E only
-;; (add-hook 'mail-citation-hook 'sc-cite-original) ; for newer mail agents
-;;
-;; If supercite is not pre-loaded into your emacs session, you should
-;; add the following autoload:
-;;
-;; (autoload 'sc-cite-original "sc" "Supercite 2.3" t)
-;;
-;; Finally, if you want to customize supercite, you should do it in a
-;; function called my-supercite-hook and:
-;;
-;; (setq sc-load-hook 'my-supercite-hook)
-
-(require 'assoc)
-
-\f
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; start of user defined variables
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-
-(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. Type
-\\[sc-describe] for more information.")
-
-(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-default-author-name "Anonymous"
- "*String used when author's name cannot be determined.")
-
-(defvar sc-default-attribution "Anon"
- "*String used when author's attribution cannot be determined.")
-
-;; Noriya KOBAYASHI (nk@ics.osaka-u.ac.jp) writes to the supercite
-;; mailing list:
-;; I use supercite in Nemacs-3.3.2. In order to handle citation using
-;; Kanji, [...set sc-cite-regexp to...]
-;; "\\s *\\([a-zA-Z0-9]\\|\\cc\\|\\cC\\|\\ch\\|\\cH\\|\\ck\\|\\cK\\)*\\s *>+"
-;;
-(defvar sc-cite-regexp "\\s *[-a-zA-Z0-9_.]*>+\\s *"
- "*Regular expression describing how a already cited line begins.
-The regexp is only used at the beginning of a line, so it doesn't need
-to start with a '^'.")
-
-(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-spacify-name-chars '(?_ ?* ?+ ?=)
- "*List of characters to convert to spaces if found in an author's name.")
-
-(defvar sc-nicknames-alist
- '(("Michael" "Mike")
- ("Daniel" "Dan")
- ("David" "Dave")
- ("Jonathan" "John")
- ("William" "Bill")
- ("Elizabeth" "Beth")
- ("Elizabeth" "Betsy")
- ("Kathleen" "Kathy")
- ("Smith" "Smitty"))
- "*Association list of names and their common nicknames.
-Entries are of the form (NAME NICKNAME), and NAMEs can have more than
-one nickname. Nicknames will not be automatically used as an
-attribution string, since I'm not sure this is really polite, but if a
-name is glommed from the author name and presented in the attribution
-string completion list, the matching nicknames will also be presented.
-Set this variable to nil to defeat nickname expansions. Also note that
-nicknames are not put in the supercite information alist.")
-
-(defvar sc-confirm-always-p t
- "*If non-nil, always confirm attribution string before citing text body.")
-
-(defvar sc-preferred-attribution 'firstname
- "*Specifies which part of the author's name becomes the attribution.
-The value of this variable must be one of the following quoted symbols:
-
- emailname -- email terminus name
- initials -- initials of author
- firstname -- first name of author
- lastname -- last name of author
- middlename1 -- first middle name of author
- middlename2 -- second middle name of author
- ...
-
-Middle name indexes can be any positive integer greater than 0, though
-it is unlikely that many authors will supply more than one middle
-name, if that many.")
-
-(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.")
-
-(defvar sc-downcase-p nil
- "*Non-nil means downcase the attribution and citation strings.")
-
-(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-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. For more
-information, type \\[sc-describe].")
-
-(defvar sc-preferred-header-style 1
- "*Index into sc-rewrite-header-list specifying preferred header style.
-Index zero accesses the first function in the list.")
-
-(defvar sc-electric-references-p t
- "*Use electric references if non-nil.")
-
-(defvar sc-electric-circular-p t
- "*Treat electric references as circular if non-nil.")
-
-(defvar sc-mail-fields-list
- '("date" "message-id" "subject" "newsgroups" "references"
- "from" "return-path" "path" "reply-to" "organization"
- "reply" )
- "*List of mail header whose values will be saved by supercite.
-These values can be used in header rewrite functions by accessing them
-with the sc-field function. Mail headers in this list are case
-insensitive and do not require a trailing colon.")
-
-(defvar sc-mumble-string ""
- "*Value returned by sc-field if chosen field cannot be found.")
-
-(defvar sc-nuke-mail-headers-p t
- "*Nuke or don't nuke mail headers.
-If non-nil, nuke mail headers after gleaning useful information from
-them.")
-
-(defvar sc-reference-tag-string ">>>>> "
- "*String used at the beginning of built-in reference headers.")
-
-(defvar sc-fill-paragraph-hook 'sc-fill-paragraph
- "*Hook for filling a paragraph.
-This hook gets executed when you fill a paragraph either manually or
-automagically. It expects point to be within the extent of the
-paragraph that is going to be filled. This hook allows you to use a
-different paragraph filling package than the one supplied with
-supercite.")
-
-(defvar sc-auto-fill-region-p nil
- "*If non-nil, automatically fill each paragraph after it has been cited.")
-
-(defvar sc-auto-fill-query-each-paragraph-p nil
- "*If non-nil, query before filling each paragraph.
-No querying and no filling will be performed if sc-auto-fill-region-p
-is set to nil.")
-
-(defvar sc-fixup-whitespace-p nil
- "*If non-nil, delete all leading white space before citing.")
-
-(defvar sc-all-but-cite-p nil
- "*If non-nil, sc-cite-original does everything but cite the text.
-This is useful for manually citing large messages, or portions of
-large messages. When non-nil, sc-cite-original will still set up all
-necessary variables and databases, but will skip the citing routine
-which modify the reply buffer's text.")
-
-(defvar sc-load-hook nil
- "*User definable hook.
-Runs after supercite is loaded. Set your customizations here.")
-
-(defvar sc-pre-hook nil
- "*User definable hook.
-Runs before sc-cite-original executes.")
-
-(defvar sc-post-hook nil
- "*User definable hook.
-Runs after sc-cite-original executes.")
-
-(defvar sc-header-nuke-list
- '("via" "origin" "status" "received" "remailed" "cc" "sender" "replied"
- "organization" "keywords" "distribution" "xref" "references" "expires"
- "approved" "summary" "precedence" "subject" "newsgroup[s]?"
- "\\(followup\\|apparently\\|errors\\|\\(\\(in-\\)?reply\\)?-\\)?to"
- "x-[a-z0-9-]+" "[a-z-]*message-id" "\\(summary-\\)?line[s]"
- "\\(\\(return\\|reply\\)-\\)?path" "\\(posted-\\)?date"
- "\\(mail-\\)?from")
- "*List of mail headers to remove from body of reply.")
-
-
-\f
-;; ======================================================================
-;; keymaps
-
-(defvar sc-default-keymap
- '(lambda ()
- (local-set-key "\C-c\C-r" 'sc-insert-reference)
- (local-set-key "\C-c\C-t" 'sc-cite)
- (local-set-key "\C-c\C-a" 'sc-recite)
- (local-set-key "\C-c\C-u" 'sc-uncite)
- (local-set-key "\C-c\C-i" 'sc-insert-citation)
- (local-set-key "\C-c\C-o" 'sc-open-line)
- (local-set-key "\C-c\C-q" 'sc-fill-paragraph-manually)
- (local-set-key "\C-cq" 'sc-fill-paragraph-manually)
- (local-set-key "\C-c\C-m" 'sc-modify-information)
- (local-set-key "\C-cf" 'sc-view-field)
- (local-set-key "\C-cg" 'sc-glom-headers)
- (local-set-key "\C-c\C-v" 'sc-version)
- (local-set-key "\C-c?" 'sc-describe)
- )
- "*Default keymap if major-mode can't be found in `sc-local-keymaps'.")
-
-(defvar sc-local-keymaps
- '((mail-mode
- (lambda ()
- (local-set-key "\C-c\C-r" 'sc-insert-reference)
- (local-set-key "\C-c\C-t" 'sc-cite)
- (local-set-key "\C-c\C-a" 'sc-recite)
- (local-set-key "\C-c\C-u" 'sc-uncite)
- (local-set-key "\C-c\C-i" 'sc-insert-citation)
- (local-set-key "\C-c\C-o" 'sc-open-line)
- (local-set-key "\C-c\C-q" 'sc-fill-paragraph-manually)
- (local-set-key "\C-cq" 'sc-fill-paragraph-manually)
- (local-set-key "\C-c\C-m" 'sc-modify-information)
- (local-set-key "\C-cf" 'sc-view-field)
- (local-set-key "\C-cg" 'sc-glom-headers)
- (local-set-key "\C-c\C-v" 'sc-version)
- (local-set-key "\C-c?" 'sc-describe)
- ))
- (mh-letter-mode
- (lambda ()
- (local-set-key "\C-c\C-r" 'sc-insert-reference)
- (local-set-key "\C-c\C-t" 'sc-cite)
- (local-set-key "\C-c\C-a" 'sc-recite)
- (local-set-key "\C-c\C-u" 'sc-uncite)
- (local-set-key "\C-ci" 'sc-insert-citation)
- (local-set-key "\C-c\C-o" 'sc-open-line)
- (local-set-key "\C-cq" 'sc-fill-paragraph-manually)
- (local-set-key "\C-c\C-m" 'sc-modify-information)
- (local-set-key "\C-cf" 'sc-view-field)
- (local-set-key "\C-cg" 'sc-glom-headers)
- (local-set-key "\C-c\C-v" 'sc-version)
- (local-set-key "\C-c?" 'sc-describe)
- ))
- (news-reply-mode mail-mode)
- (vm-mail-mode mail-mode)
- (e-reply-mode mail-mode)
- (n-reply-mode mail-mode)
- )
- "*List of keymaps to use with the associated major-mode.")
-
-(defvar sc-electric-mode-map nil
- "*Keymap for sc-electric-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 "\r" 'sc-eref-exit)
- (define-key sc-electric-mode-map "\n" 'sc-eref-exit)
- (define-key sc-electric-mode-map "q" 'sc-eref-exit)
- (define-key sc-electric-mode-map "g" 'sc-eref-goto)
- )
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end of user defined variables
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-\f
-;; ======================================================================
-;; global variables, not user accessible
-
-(defconst sc-version-number "2.3"
- "Supercite's version number.")
-
-;; when rnewspost.el patch is installed (or function is overloaded)
-;; this should be nil since supercite now does this itself.
-(setq news-reply-header-hook nil)
-
-;; autoload for sc-electric-mode
-(autoload 'sc-electric-mode "sc-elec"
- "Quasi-major mode for viewing supercite reference headers." nil)
-
-;; global alists (gals), misc variables. make new bytecompiler happy
-(defvar sc-gal-information nil
- "Internal global alist variable containing information.")
-(defvar sc-gal-attributions nil
- "Internal global alist variable containing attributions.")
-(defvar sc-fill-arg nil
- "Internal fill argument holder.")
-(defvar sc-cite-context nil
- "Internal citation context holder.")
-(defvar sc-force-confirmation-p nil
- "Internal variable.")
-
-(make-variable-buffer-local 'sc-gal-attributions)
-(make-variable-buffer-local 'sc-gal-information)
-(make-variable-buffer-local 'sc-leached-keymap)
-(make-variable-buffer-local 'sc-fill-arg)
-(make-variable-buffer-local 'sc-cite-context)
-
-(setq-default sc-gal-attributions nil)
-(setq-default sc-gal-information nil)
-(setq-default sc-leached-keymap (current-local-map))
-(setq-default sc-fill-arg nil)
-(setq-default sc-cite-context nil)
-
-
-\f
-;; ======================================================================
-;; miscellaneous support functions
-
-(defun sc-mark ()
- "Mark compatibility between emacs v18 and v19."
- (let ((zmacs-regions nil))
- (marker-position (mark-marker))))
-
-(defun sc-update-gal (attribution)
- "Update the information alist.
-Add ATTRIBUTION and compose the nested and non-nested citation
-strings."
- (let ((attrib (if sc-downcase-p (downcase attribution) attribution)))
- (aput 'sc-gal-information "sc-attribution" attrib)
- (aput 'sc-gal-information "sc-nested-citation"
- (concat attrib sc-citation-delimiter))
- (aput 'sc-gal-information "sc-citation"
- (concat sc-citation-leader
- attrib
- sc-citation-delimiter
- sc-citation-separator))))
-
-(defun sc-valid-index-p (index)
- "Returns t if INDEX is a valid index into sc-rewrite-header-list."
- (let ((last (1- (length sc-rewrite-header-list))))
- (and (natnump index) ;; a number, and greater than or equal to zero
- (<= index last) ;; less than or equal to the last index
- )))
-
-(defun sc-string-car (namestring)
- "Return the string-equivalent \"car\" of NAMESTRING.
-
- example: (sc-string-car \"John Xavier Doe\")
- => \"John\""
- (substring namestring
- (progn (string-match "\\s *" namestring) (match-end 0))
- (progn (string-match "\\s *\\S +" namestring) (match-end 0))))
-
-(defun sc-string-cdr (namestring)
- "Return the string-equivalent \"cdr\" of NAMESTRING.
-
- example: (sc-string-cdr \"John Xavier Doe\")
- => \"Xavier Doe\""
- (substring namestring
- (progn (string-match "\\s *\\S +\\s *" namestring)
- (match-end 0))))
-
-(defun sc-linepos (&optional position col-p)
- "Return the character position at various line positions.
-Optional POSITION can be one of the following symbols:
- bol == beginning of line
- boi == beginning of indentation
- eol == end of line [default]
-
-Optional COL-P non-nil returns current-column instead of character position."
- (let ((tpnt (point))
- rval)
- (cond
- ((eq position 'bol) (beginning-of-line))
- ((eq position 'boi) (back-to-indentation))
- (t (end-of-line)))
- (setq rval (if col-p (current-column) (point)))
- (goto-char tpnt)
- rval))
-
-\f
-;; ======================================================================
-;; this section snarfs mail fields and places them in the info alist
-
-(defun sc-build-header-zap-regexp ()
- "Return a regexp for sc-mail-yank-clear-headers."
- (let ((headers sc-header-nuke-list)
- (regexp nil))
- (while headers
- (setq regexp (concat regexp
- "^" (car headers) ":"
- (if (cdr headers) "\\|" nil)))
- (setq headers (cdr headers)))
- regexp))
-
-(defun sc-mail-yank-clear-headers (start end)
- "Nuke mail headers between START and END."
- (if (and sc-nuke-mail-headers-p sc-header-nuke-list)
- (let ((regexp (sc-build-header-zap-regexp)))
- (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 regexp nil t))
- (beginning-of-line)
- (delete-region (point)
- (progn (re-search-forward "\n[^ \t]")
- (forward-char -1)
- (point)))
- )))
- ))))
-
-(defun sc-mail-fetch-field (field)
- "Return the value of the header field FIELD.
-The buffer is expected to be narrowed to just the headers of the
-message."
- (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search t)
- (name (concat "^" (regexp-quote field) "[ \t]*:[ \t]*")))
- (goto-char (point-min))
- (if (re-search-forward name nil t)
- (let ((opoint (point)))
- (while (progn (forward-line 1)
- (looking-at "[ \t]")))
- (buffer-substring opoint (1- (point))))))))
-
-(defun sc-fetch-fields (start end)
- "Fetch the mail fields in the region from START to END.
-These fields can be accessed in header rewrite functions with sc-field."
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (let ((fields sc-mail-fields-list))
- (while fields
- (let ((value (sc-mail-fetch-field (car fields)))
- (next (cdr fields)))
- (and value
- (aput 'sc-gal-information (car fields) value))
- (setq fields next)))
- (if (sc-mail-fetch-field "from")
- (aput 'sc-gal-information "from" (sc-mail-fetch-field "from")))))))
-
-(defun sc-field (field)
- "Return the alist information associated with the FIELD.
-If FIELD is not a valid key, return sc-mumble-string."
- (or (aget sc-gal-information field) sc-mumble-string))
-
-\f
-;; ======================================================================
-;; built-in reference header rewrite functions
-
-(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 preceding 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 <date>, <from> said:\", unless 1. the \"from\" field cannot be
-found, in which case nothing is inserted; or 2. the \"date\" field is
-missing in which case only the from part is printed."
- (let* ((sc-mumble-string "")
- (whofrom (sc-field "from"))
- (when (sc-field "date")))
- (if (not (string= whofrom ""))
- (insert sc-reference-tag-string
- (if (not (string= when ""))
- (concat "On " when ", ") "")
- whofrom " said:\n"))))
-
-(defun sc-header-inarticle-writes ()
- "\"In article <message-id>, <from> writes:\"
-Treats \"message-id\" and \"from\" fields similar to sc-header-on-said."
- (let* ((sc-mumble-string "")
- (whofrom (sc-field "from"))
- (msgid (sc-field "message-id")))
- (if (not (string= whofrom ""))
- (insert sc-reference-tag-string
- (if (not (string= msgid ""))
- (concat "In article " msgid ", ") "")
- whofrom " writes:\n"))))
-
-(defun sc-header-regarding-adds ()
- "\"Regarding <subject>; <from> adds:\"
-Treats \"subject\" and \"from\" fields similar to sc-header-on-said."
- (let* ((sc-mumble-string "")
- (whofrom (sc-field "from"))
- (subj (sc-field "subject")))
- (if (not (string= whofrom ""))
- (insert sc-reference-tag-string
- (if (not (string= subj ""))
- (concat "Regarding " subj "; ") "")
- whofrom " adds:\n"))))
-
-(defun sc-header-attributed-writes ()
- "\"<sc-attribution>\" == <sc-author> <address> writes:
-Treats these fields in a similar manner to sc-header-on-said."
- (let* ((sc-mumble-string "")
- (whofrom (sc-field "from"))
- (reply (sc-field "sc-reply-address"))
- (from (sc-field "sc-from-address"))
- (attr (sc-field "sc-attribution"))
- (auth (sc-field "sc-author")))
- (if (not (string= whofrom ""))
- (insert sc-reference-tag-string
- (if (not (string= attr ""))
- (concat "\"" attr "\" == " ) "")
- (if (not (string= auth ""))
- (concat auth " ") "")
- (if (not (string= reply ""))
- (concat "<" reply ">")
- (if (not (string= from ""))
- (concat "<" from ">") ""))
- " writes:\n"))))
-
-(defun sc-header-verbose ()
- "Very verbose, some say gross."
- (let* ((sc-mumble-string "")
- (whofrom (sc-field "from"))
- (reply (sc-field "sc-reply-address"))
- (from (sc-field "sc-from-address"))
- (author (sc-field "sc-author"))
- (date (sc-field "date"))
- (org (sc-field "organization"))
- (msgid (sc-field "message-id"))
- (ngrps (sc-field "newsgroups"))
- (subj (sc-field "subject"))
- (refs (sc-field "references"))
- (cite (sc-field "sc-citation"))
- (nl sc-reference-tag-string))
- (if (not (string= whofrom ""))
- (insert (if (not (string= date ""))
- (concat nl "On " date ",\n") "")
- (concat nl (if (not (string= author ""))
- author
- whofrom) "\n")
- (if (not (string= org ""))
- (concat nl "from the organization of " org "\n") "")
- (if (not (string= reply ""))
- (concat nl "who can be reached at: " reply "\n")
- (if (not (string= from ""))
- (concat nl "who can be reached at: " from "\n") ""))
- (if (not (string= cite ""))
- (concat nl "(whose comments are cited below with \""
- cite "\"),\n") "")
- (if (not (string= msgid ""))
- (concat nl "had this to say in article " msgid "\n") "")
- (if (not (string= ngrps ""))
- (concat nl "in newsgroups " ngrps "\n") "")
- (if (not (string= subj ""))
- (concat nl "concerning the subject of " subj "\n") "")
- (if (not (string= refs ""))
- (concat nl "(see " refs " for more details)\n") "")
- ))))
-
-\f
-;; ======================================================================
-;; this section queries the user for necessary information
-
-(defun sc-query (&optional default)
- "Query for an attribution string with the optional DEFAULT choice.
-Returns the string entered by the user, if non-empty and non-nil, or
-DEFAULT otherwise. If DEFAULT is not supplied, sc-default-attribution
-is used."
- (if (not default) (setq default sc-default-attribution))
- (let* ((prompt (concat "Enter attribution string: (default " default ") "))
- (query (read-string prompt)))
- (if (or (null query)
- (string= query ""))
- default
- query)))
-
-(defun sc-confirm ()
- "Confirm the preferred attribution with the user."
- (if (or sc-confirm-always-p
- sc-force-confirmation-p)
- (aput 'sc-gal-attributions
- (let* ((default (aheadsym sc-gal-attributions))
- chosen
- (prompt (concat "Complete "
- (cond
- ((eq sc-cite-context 'citing) "cite")
- ((eq sc-cite-context 'reciting) "recite")
- (t ""))
- " attribution string: (default "
- default ") "))
- (minibuffer-local-completion-map
- (copy-keymap minibuffer-local-completion-map)))
- (define-key minibuffer-local-completion-map "\C-g"
- '(lambda () (interactive) (beep) (throw 'select-abort nil)))
- (setq chosen (completing-read prompt sc-gal-attributions))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))))
-
-\f
-;; ======================================================================
-;; this section contains primitive functions used in the email address
-;; parsing schemes. they extract name fields from various parts of
-;; the "from:" field.
-
-(defun sc-style1-addresses (from-string &optional delim)
- "Extract the author's email terminus from email address FROM-STRING.
-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-string 0)
- (substring from-string
- (match-beginning 0)
- (- (match-end 0) (if (null delim) 0 1)))))
-
-(defun sc-style2-addresses (from-string)
- "Extract the author's email terminus from email address FROM-STRING.
-Match addresses of the style \"[stuff]![stuff]...!name[stuff].\""
- (let ((eos (length from-string))
- (mstart (string-match "![a-zA-Z0-9_-]+\\([^!a-zA-Z0-9_-]\\|$\\)"
- from-string 0))
- (mend (match-end 0)))
- (and mstart
- (substring from-string (1+ mstart) (- mend (if (= mend eos) 0 1)))
- )))
-
-(defun sc-get-address (from-string author)
- "Get the full email address path from FROM-STRING.
-AUTHOR is the author's name (which is removed from the address)."
- (let ((eos (length from-string)))
- (if (string-match (concat "\\(^\\|^\"\\)" author
- "\\(\\s +\\|\"\\s +\\)") from-string 0)
- (let ((addr (substring from-string (match-end 0) eos)))
- (if (and (= (aref addr 0) ?<)
- (= (aref addr (1- (length addr))) ?>))
- (substring addr 1 (1- (length addr)))
- addr))
- (if (string-match "[a-zA-Z0-9!@%._-]+" from-string 0)
- (substring from-string (match-beginning 0) (match-end 0))
- "")
- )))
-
-(defun sc-get-emailname (from-string)
- "Get the email terminus name from FROM-STRING."
- (cond
- ((sc-style1-addresses from-string "%"))
- ((sc-style1-addresses from-string "@"))
- ((sc-style2-addresses from-string))
- ((sc-style1-addresses from-string nil))
- (t (substring from-string 0 10))))
-
-\f
-;; ======================================================================
-;; this section contains functions that will extract a list of names
-;; from the name field string.
-
-(defun sc-spacify-name-chars (name)
- (let ((len (length name))
- (s 0))
- (while (< s len)
- (if (memq (aref name s) sc-spacify-name-chars)
- (aset name s 32))
- (setq s (1+ s)))
- name))
-
-(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-extract-namestring (from-string)
- "Extract the name string from FROM-STRING.
-This should be the author's full name minus an optional title."
- (let ((pstart (string-match "(.*)" from-string 0))
- (pend (match-end 0))
- (qstart (string-match "\".*\"" from-string 0))
- (qend (match-end 0))
- (bstart (string-match "\\([.a-zA-Z0-9_-]+\\s *\\)+" from-string 0))
- (bend (match-end 0)))
- (sc-spacify-name-chars
- (cond
- ((sc-name-substring from-string pstart pend 1))
- ((sc-name-substring from-string qstart qend 1))
- ((sc-name-substring from-string bstart bend 0))
- ))))
-
-(defun sc-chop-namestring (namestring)
- "Convert NAMESTRING to a list of names.
-
- example: (sc-namestring-to-list \"John Xavier Doe\")
- => (\"John\" \"Xavier\" \"Doe\")"
- (if (not (string= namestring ""))
- (append (list (sc-string-car namestring))
- (sc-chop-namestring (sc-string-cdr namestring)))))
-
-(defun sc-strip-initials (namelist)
- "Extract the author's initials from the NAMELIST."
- (if (not namelist)
- nil
- (concat (if (string= (car namelist) "")
- ""
- (substring (car namelist) 0 1))
- (sc-strip-initials (cdr namelist)))))
-
-\f
-;; ======================================================================
-;; this section handles selection of the attribution and citation strings
-
-(defun sc-populate-alists (from-string)
- "Put important and useful information in the alists using FROM-STRING.
-Return the list of name symbols."
- (let* ((namelist (sc-chop-namestring (sc-extract-namestring from-string)))
- (revnames (reverse (cdr namelist)))
- (midnames (reverse (cdr revnames)))
- (firstname (car namelist))
- (midnames (reverse (cdr revnames)))
- (lastname (car revnames))
- (initials (sc-strip-initials namelist))
- (emailname (sc-get-emailname from-string))
- (n 1)
- (symlist (list 'emailname 'initials 'firstname 'lastname)))
-
- ;; put basic information
- (aput 'sc-gal-attributions 'firstname firstname)
- (aput 'sc-gal-attributions 'lastname lastname)
- (aput 'sc-gal-attributions 'emailname emailname)
- (aput 'sc-gal-attributions 'initials initials)
-
- (aput 'sc-gal-information "sc-firstname" firstname)
- (aput 'sc-gal-information "sc-lastname" lastname)
- (aput 'sc-gal-information "sc-emailname" emailname)
- (aput 'sc-gal-information "sc-initials" initials)
-
- ;; put middle names and build sc-author entry
- (let ((author (concat firstname " ")))
- (while midnames
- (let ((name (car midnames))
- (next (cdr midnames))
- (symbol (intern (format "middlename%d" n)))
- (string (format "sc-middlename-%d" n)))
- ;; first put new middlename
- (aput 'sc-gal-attributions symbol name)
- (aput 'sc-gal-information string name)
- (setq n (1+ n))
- (nconc symlist (list symbol))
-
- ;; now build author name
- (setq author (concat author name " "))
-
- ;; incr loop
- (setq midnames next)
- ))
- (setq author (concat author lastname))
-
- ;; put author name and email address
- (aput 'sc-gal-information "sc-author" author)
- (aput 'sc-gal-information "sc-from-address"
- (sc-get-address from-string author))
- (aput 'sc-gal-information "sc-reply-address"
- (sc-get-address (sc-field "reply-to") author))
- )
- ;; return value
- symlist))
-
-(defun sc-sort-attribution-alist ()
- "Put preferred attribution at head of attributions alist."
- (asort 'sc-gal-attributions sc-preferred-attribution)
-
- ;; use backup scheme if preference is not legal
- (if (or (null sc-preferred-attribution)
- (anot-head-p sc-gal-attributions sc-preferred-attribution)
- (let ((prefval (aget sc-gal-attributions
- sc-preferred-attribution)))
- (or (null prefval)
- (string= prefval ""))))
- ;; no legal attribution
- (if sc-use-only-preference-p
- (aput 'sc-gal-attributions 'sc-user-query
- (sc-query sc-default-attribution))
- ;; else use secondary scheme
- (asort 'sc-gal-attributions 'firstname))))
-
-(defun sc-build-attribution-alist (from-string)
- "Extract attributions from FROM-STRING, applying preferences."
- (let ((symlist (sc-populate-alists from-string))
- (headval (progn (sc-sort-attribution-alist)
- (aget sc-gal-attributions
- (aheadsym sc-gal-attributions) t))))
-
- ;; for each element in the symlist, remove the corresponding
- ;; key-value pair in the alist, then insert just the value.
- (while symlist
- (let ((value (aget sc-gal-attributions (car symlist) t))
- (next (cdr symlist)))
- (if (not (or (null value)
- (string= value "")))
- (aput 'sc-gal-attributions value))
- (adelete 'sc-gal-attributions (car symlist))
- (setq symlist next)))
-
- ;; add nicknames to the completion list
- (let ((gal sc-gal-attributions))
- (while gal
- (let ((nns sc-nicknames-alist)
- (galname (car (car gal))))
- (while nns
- (if (string= galname (car (car nns)))
- (aput 'sc-gal-attributions (car (cdr (car nns)))))
- (setq nns (cdr nns)))
- (setq gal (cdr gal)))))
-
- ;; now reinsert the head (preferred) attribution unless it is nil,
- ;; this effectively just moves the head value to the front of the
- ;; list.
- (if headval
- (aput 'sc-gal-attributions headval))
-
- ;; check to be sure alist is not nil
- (if (null sc-gal-attributions)
- (aput 'sc-gal-attributions sc-default-attribution))))
-
-(defun sc-select ()
- "Select an attribution and create a citation string."
- (cond
- (sc-nested-citation-p
- (sc-update-gal ""))
- ((null (aget sc-gal-information "from" t))
- (aput 'sc-gal-information "sc-author" sc-default-author-name)
- (sc-update-gal (sc-query sc-default-attribution)))
- ((null sc-gal-attributions)
- (sc-build-attribution-alist (aget sc-gal-information "from" t))
- (sc-confirm)
- (sc-update-gal (aheadsym sc-gal-attributions)))
- (t
- (sc-confirm)
- (sc-update-gal (aheadsym sc-gal-attributions))))
- t)
-
-\f
-;; ======================================================================
-;; region citing and unciting
-
-(defun sc-cite-region (start end)
- "Cite a region delineated by START and END."
- (save-excursion
- ;; set real end-of-region
- (goto-char end)
- (forward-line 1)
- (set-mark (point))
- ;; goto real beginning-of-region
- (goto-char start)
- (beginning-of-line)
- (let ((fstart (point))
- (fend (point)))
- (while (< (point) (sc-mark))
- ;; remove leading whitespace if desired
- (and sc-fixup-whitespace-p
- (fixup-whitespace))
- ;; if end of line then perhaps autofill
- (cond ((eolp)
- (or (= fstart fend)
- (not sc-auto-fill-region-p)
- (and sc-auto-fill-query-each-paragraph-p
- (not (y-or-n-p "Fill this paragraph? ")))
- (save-excursion (set-mark fend)
- (goto-char (/ (+ fstart fend 1) 2))
- (run-hooks 'sc-fill-paragraph-hook)))
- (setq fstart (point)
- fend (point)))
- ;; not end of line so perhaps cite it
- ((not (looking-at sc-cite-regexp))
- (insert (aget sc-gal-information "sc-citation")))
- (sc-nested-citation-p
- (insert (aget sc-gal-information "sc-nested-citation"))))
- (setq fend (point))
- (forward-line 1))
- (and sc-auto-fill-query-each-paragraph-p
- (message " "))
- )))
-
-(defun sc-uncite-region (start end cite-regexp)
- "Uncite a previously cited region delineated by START and END.
-CITE-REGEXP describes how a cited line of texts starts. Unciting also
-auto-fills paragraph if sc-auto-fill-region-p is non-nil."
- (save-excursion
- (set-mark end)
- (goto-char start)
- (beginning-of-line)
- (let ((fstart (point))
- (fend (point)))
- (while (< (point) (sc-mark))
- ;; if end of line, then perhaps autofill
- (cond ((eolp)
- (or (= fstart fend)
- (not sc-auto-fill-region-p)
- (and sc-auto-fill-query-each-paragraph-p
- (not (y-or-n-p "Fill this paragraph? ")))
- (save-excursion (set-mark fend)
- (goto-char (/ (+ fstart fend 1) 2))
- (run-hooks 'sc-fill-paragraph-hook)))
- (setq fstart (point)
- fend (point)))
- ;; not end of line so perhaps uncite it
- ((looking-at cite-regexp)
- (save-excursion
- (save-restriction
- (narrow-to-region (sc-linepos 'bol) (sc-linepos))
- (beginning-of-line)
- (delete-region (point-min)
- (progn (re-search-forward cite-regexp
- (point-max)
- t)
- (match-end 0)))))))
- (setq fend (point))
- (forward-line 1)))))
-
-\f
-;; ======================================================================
-;; this section contains paragraph filling support
-
-(defun sc-guess-fill-prefix (&optional literalp)
- "Guess the fill prefix used on the current line.
-Use various heuristics to find the fill prefix. Search begins on first
-non-blank line after point.
-
- 1) If fill-prefix is already bound to the empty string, return
- nil.
-
- 2) If fill-prefix is already bound, but not to the empty
- string, return the value of fill-prefix.
-
- 3) If the current line starts with the last chosen citation
- string, then that string is returned.
-
- 4) If the current line starts with a string matching the regular
- expression sc-cite-regexp, return the match. Note that if
- optional LITERALP is provided and non-nil, then the *string*
- that matches the regexp is return. Otherwise, if LITERALP is
- not provided or is nil, the *regexp* sc-cite-regexp is
- returned.
-
- 5) If the current line starts with any number of characters,
- followed by the sc-citation-delimiter and then white space,
- that match is returned. See comment #4 above for handling of
- LITERALP.
-
- 6) Nil is returned."
- (save-excursion
- ;; scan for first non-blank line in the region
- (beginning-of-line)
- (skip-chars-forward "\n\t ")
- (beginning-of-line)
- (let ((citation (aget sc-gal-information "sc-citation"))
- (generic-citation
- (concat "\\s *[^ \t\n" sc-citation-delimiter "]+>\\s +")))
- (cond
- ((string= fill-prefix "") nil) ;; heuristic #1
- (fill-prefix) ;; heuristic #2
- ((looking-at (regexp-quote citation)) citation) ;; heuristic #3
- ((looking-at sc-cite-regexp) ;; heuristic #4
- (if literalp
- (buffer-substring
- (point)
- (progn (re-search-forward (concat sc-cite-regexp "\\s *")
- (point-max) nil)
- (point)))
- sc-cite-regexp))
- ((looking-at generic-citation) ;; heuristic #5
- (if literalp
- (buffer-substring
- (point)
- (progn (re-search-forward generic-citation) (point)))
- generic-citation))
- (t nil))))) ;; heuristic #6
-
-(defun sc-consistent-cite-p (prefix)
- "Check current paragraph for consistent citation.
-Scans to paragraph delineated by (forward|backward)-paragraph to see
-if all lines start with PREFIX. Returns t if entire paragraph is
-consistently cited, nil otherwise."
- (save-excursion
- (let ((end (progn (forward-paragraph)
- (beginning-of-line)
- (or (not (eolp))
- (forward-char -1))
- (point)))
- (start (progn (backward-paragraph)
- (beginning-of-line)
- (or (not (eolp))
- (forward-char 1))
- (point)))
- (badline t))
- (goto-char start)
- (beginning-of-line)
- (while (and (< (point) end)
- badline)
- (setq badline (looking-at prefix))
- (forward-line 1))
- badline)))
-
-(defun sc-fill-start (fill-prefix)
- "Find buffer position of start of region which begins with FILL-PREFIX.
-Restrict scan to current paragraph."
- (save-excursion
- (let ((badline nil)
- (top (save-excursion
- (backward-paragraph)
- (beginning-of-line)
- (or (not (eolp))
- (forward-char 1))
- (point))))
- (while (and (not badline)
- (> (point) top))
- (forward-line -1)
- (setq badline (not (looking-at fill-prefix)))))
- (forward-line 1)
- (point)))
-
-(defun sc-fill-end (fill-prefix)
- "Find the buffer position of end of region which begins with FILL-PREFIX.
-Restrict scan to current paragraph."
- (save-excursion
- (let ((badline nil)
- (bot (save-excursion
- (forward-paragraph)
- (beginning-of-line)
- (or (not (eolp))
- (forward-char -1))
- (point))))
- (while (and (not badline)
- (< (point) bot))
- (beginning-of-line)
- (setq badline (not (looking-at fill-prefix)))
- (forward-line 1)))
- (forward-line -1)
- (point)))
-
-(defun sc-fill-paragraph ()
- "Supercite's paragraph fill function.
-Fill the paragraph containing or following point. Use
-sc-guess-fill-prefix to find the fill-prefix for the paragraph.
-
-If the paragraph is inconsistently cited (mixed fill-prefix), then the
-user is queried to restrict the the fill to only those lines around
-point which begin with the fill prefix.
-
-The variable sc-fill-arg is passed to fill-paragraph and
-fill-region-as-paragraph which controls justification of the
-paragraph. sc-fill-arg is set by sc-fill-paragraph-manually."
- (save-excursion
- (let ((pnt (point))
- (fill-prefix (sc-guess-fill-prefix t)))
- (cond
- ((not fill-prefix)
- (fill-paragraph sc-fill-arg))
- ((sc-consistent-cite-p fill-prefix)
- (fill-paragraph sc-fill-arg))
- ((y-or-n-p "Inconsistent citation found. Restrict? ")
- (message "")
- (fill-region-as-paragraph (progn (goto-char pnt)
- (sc-fill-start fill-prefix))
- (progn (goto-char pnt)
- (sc-fill-end fill-prefix))
- sc-fill-arg))
- (t
- (message "")
- (progn
- (setq fill-prefix (aget sc-gal-information "sc-citation"))
- (fill-paragraph sc-fill-arg)))))))
-
-\f
-;; ======================================================================
-;; the following functions are the top level, interactive commands that
-;; can be bound to key strokes
-
-(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 ((pref (cond ((sc-valid-index-p arg) arg)
- ((sc-valid-index-p sc-preferred-header-style)
- sc-preferred-header-style)
- (t 0))))
- (if sc-electric-references-p (sc-electric-mode pref)
- (condition-case err
- (eval (nth pref sc-rewrite-header-list))
- (void-function
- (progn (message
- "Symbol's function definition is void: %s. (Header %d)."
- (symbol-name (car (cdr err)))
- pref)
- (beep)))
- (error
- (progn (message "Error evaluating rewrite header function %d."
- pref)
- (beep)))
- )))))
-
-(defun sc-cite (arg)
- "Cite the region of text between point and mark.
-Numeric ARG, if supplied, is passed unaltered to sc-insert-reference."
- (interactive "P")
- (if (not (sc-mark))
- (error "Please designate a region to cite (i.e. set the mark)."))
- (catch 'select-abort
- (let ((sc-cite-context 'citing)
- (sc-force-confirmation-p (interactive-p)))
- (sc-select)
- (undo-boundary)
- (let ((xchange (if (> (sc-mark) (point)) nil
- (exchange-point-and-mark)
- t)))
- (sc-insert-reference arg)
- (sc-cite-region (point) (sc-mark))
- ;; leave point on first cited line
- (while (and (< (point) (sc-mark))
- (not (looking-at (aget sc-gal-information
- (if sc-nested-citation-p
- "sc-nested-citation"
- "sc-citation")))))
- (forward-line 1))
- (and xchange
- (exchange-point-and-mark))
- ))))
-
-(defun sc-uncite ()
- "Uncite the region between point and mark."
- (interactive)
- (if (not (sc-mark))
- (error "Please designate a region to uncite (i.e. set the mark)."))
- (undo-boundary)
- (let ((xchange (if (> (sc-mark) (point)) nil
- (exchange-point-and-mark)
- t))
- (fp (or (sc-guess-fill-prefix)
- "")))
- (sc-uncite-region (point) (sc-mark) fp)
- (and xchange
- (exchange-point-and-mark))))
-
-(defun sc-recite ()
- "Recite the region by first unciting then citing the text."
- (interactive)
- (if (not (sc-mark))
- (error "Please designate a region to recite (i.e. set the mark)."))
- (catch 'select-abort
- (let ((sc-cite-context 'reciting)
- (sc-force-confirmation-p t))
- (sc-select)
- (undo-boundary)
- (let ((xchange (if (> (sc-mark) (point)) nil
- (exchange-point-and-mark)
- t))
- (fp (or (sc-guess-fill-prefix)
- "")))
- (sc-uncite-region (point) (sc-mark) fp)
- (sc-cite-region (point) (sc-mark))
- (and xchange
- (exchange-point-and-mark))
- ))))
-
-(defun sc-insert-citation ()
- "Insert citation string at beginning of current line."
- (interactive)
- (save-excursion
- (beginning-of-line)
- (insert (aget sc-gal-information "sc-citation"))))
-
-(defun sc-open-line (arg)
- "Insert a newline and leave point before it.
-Also inserts the guessed prefix at the beginning of the new line. With
-numeric ARG, inserts that many new lines."
- (interactive "p")
- (save-excursion
- (let ((start (point))
- (string (or (sc-guess-fill-prefix t)
- "")))
- (open-line arg)
- (goto-char start)
- (forward-line 1)
- (while (< 0 arg)
- (insert string)
- (forward-line 1)
- (setq arg (- arg 1))))))
-
-(defun sc-fill-paragraph-manually (arg)
- "Fill current cited paragraph.
-Really just runs the hook sc-fill-paragraph-hook, however it does set
-the global variable sc-fill-arg to the value of ARG. This is
-currently the only way to pass an argument to a hookified function."
- (interactive "P")
- (setq sc-fill-arg arg)
- (run-hooks 'sc-fill-paragraph-hook))
-
-(defun sc-modify-information (arg)
- "Interactively modify information in the information alist.
-\\[universal-argument] if supplied, deletes the entry from the alist.
-You can add an entry by supplying a key instead of completing."
- (interactive "P")
- (let* ((delete-p (consp arg))
- (action (if delete-p "delete" "modify"))
- (defaultkey (aheadsym sc-gal-information))
- (prompt (concat "Select information key to "
- action ": (default "
- defaultkey ") "))
- (key (completing-read prompt sc-gal-information))
- )
- (if (or (string= key "")
- (null key))
- (setq key defaultkey))
- (if delete-p (adelete 'sc-gal-information key)
- (let* ((oldval (aget sc-gal-information key t))
- (prompt (concat "Enter new value for key \""
- key "\" (default \"" oldval "\") "))
- (newval (read-input prompt)))
- (if (or (string= newval "")
- (null newval))
- nil
- (aput 'sc-gal-information key newval)
- )))))
-
-(defun sc-view-field (arg)
- "View field values in the information alist.
-This is essentially an interactive version of sc-field, and is similar
-to sc-modify-information, except that the field values can't be
-modified. With \\[universal-argument], if supplied, inserts the value
-into the current buffer as well."
- (interactive "P")
- (let* ((defaultkey (aheadsym sc-gal-information))
- (prompt (concat "View information key: (default "
- defaultkey ") "))
- (key (completing-read prompt sc-gal-information)))
- (if (or (string= key "")
- (null key))
- (setq key defaultkey))
- (let* ((val (aget sc-gal-information key t))
- (pval (if val (concat "\"" val "\"") "nil")))
- (message "value of key %s: %s" key pval)
- (if (and key (consp arg)) (insert val)))))
-
-(defun sc-glom-headers ()
- "Glom information from mail headers in region between point and mark.
-Any old information is lost, unless an error occurs."
- (interactive)
- (let ((attr (copy-sequence sc-gal-attributions))
- (info (copy-sequence sc-gal-information)))
- (setq sc-gal-attributions nil
- sc-gal-information nil)
- (let (start end
- (sc-force-confirmation-p t)
- (sc-cite-context nil))
- (let ((mark-active t))
- (setq start (region-beginning)
- end (region-end)))
- (sc-fetch-fields start end)
- (if (null sc-gal-information)
- (progn
- (message "No mail headers found! Restoring old information.")
- (setq sc-gal-attributions attr
- sc-gal-information info))
- (sc-mail-yank-clear-headers start end)
- (if (not (catch 'select-abort
- (condition-case foo
- (sc-select)
- (quit (beep) (throw 'select-abort nil)))
- ))
- (setq sc-gal-attributions attr
- sc-gal-information info))
- ))))
-
-(defun sc-version (arg)
- "Show supercite version.
-Universal argument (\\[universal-argument]) ARG inserts version
-information in the current buffer instead of printing the message in
-the echo area."
- (interactive "P")
- (if (consp arg)
- (insert "Using Supercite version " sc-version-number)
- (message "Using Supercite version %s" sc-version-number)))
-
-\f
-;; ======================================================================
-;; leach onto current mode
-
-(defun sc-append-current-keymap ()
- "Append some useful key bindings to the current local key map.
-This searches sc-local-keymap for the keymap to install based on the
-major-mode of the current buffer."
- (let ((hook (car (cdr (assq major-mode sc-local-keymaps)))))
- (cond
- ((not hook)
- (run-hooks 'sc-default-keymap))
- ((not (listp hook))
- (setq hook (car (cdr (assq hook sc-local-keymaps))))
- (run-hooks 'hook))
- (t
- (run-hooks 'hook))))
- (setq sc-leached-keymap (current-local-map)))
-
-(defun sc-snag-all-keybindings ()
- "Snag all keybindings in major-mode's current keymap."
- (let* ((curkeymap (current-local-map))
- (symregexp ".*sc-.*\n")
- (docstring (substitute-command-keys "\\{curkeymap}"))
- (start 0)
- (maxend (length docstring))
- (spooge ""))
- (while (and (< start maxend)
- (string-match symregexp docstring start))
- (setq spooge (concat spooge (substring docstring
- (match-beginning 0)
- (match-end 0))))
- (setq start (match-end 0)))
- spooge))
-
-(defun sc-spoogify-docstring ()
- "Modifies (makes into spooge) the docstring for the current major mode.
-This will leach the keybinding descriptions for supercite onto the end
-of the current major mode's docstring. If major mode is preloaded,
-this function will first make a copy of the list associated with the
-mode, then modify this copy."
- (let* ((symfunc (symbol-function major-mode))
- (doc-cdr (and (listp symfunc) (nthcdr 2 symfunc)))
- (doc-str (documentation major-mode)))
- (cond
- ;; is a docstring even provided?
- ((not (stringp doc-str)))
- ;; have we already leached on?
- ((string-match "Supercite" doc-str))
- ;; lets build the new doc string
- (t
- (let* ((described (sc-snag-all-keybindings))
- (commonstr "
-
-The major mode for this buffer has been modified to include the
-Supercite 2.3 package for handling attributions and citations of
-original messages in email replies. For more information on this
-package, type \"\\[sc-describe]\".")
- (newdoc-str
- (concat doc-str commonstr
- (if (not (string= described ""))
- (concat "\n\nThe following keys are bound "
- "to Supercite commands:\n\n"
- described)))
- ))
- (cond
- (doc-cdr
- (condition-case nil
- (setcar doc-cdr newdoc-str)
- (error
- ;; the major mode must be preloaded, make a copy first
- (setq symfunc (copy-sequence (symbol-function major-mode))
- doc-cdr (nthcdr 2 symfunc))
- (setcar doc-cdr newdoc-str)
- (fset major-mode symfunc))))
- ;; lemacs 19 byte-code.
- ;; Set function to a new byte-code vector with the
- ;; new documentation in the documentation slot (element 4).
- ;; We can't use aset because aset won't allow you to modify
- ;; a byte-code vector.
- ;; Include element 5 if the vector has one.
- (t
- (fset major-mode
- (apply 'make-byte-code
- (aref symfunc 0) (aref symfunc 1)
- (aref symfunc 2) (aref symfunc 3)
- newdoc-str
- (if (> (length symfunc) 5)
- (list (aref symfunc 5)))))
- )))))))
-
-\f
-;; ======================================================================
-;; this section contains default hooks and hook support for execution
-
-;;;###autoload
-(defun sc-cite-original ()
- "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."
- (run-hooks 'sc-pre-hook)
- (setq sc-gal-attributions nil)
- (setq sc-gal-information nil)
- (let (start end)
- (let ((mark-active t))
- (setq start (region-beginning)
- end (region-end)))
- (sc-fetch-fields start end)
- (sc-mail-yank-clear-headers start end)
- (if (not sc-all-but-cite-p)
- (sc-cite sc-preferred-header-style))
- (sc-append-current-keymap)
- (sc-spoogify-docstring)
- (run-hooks 'sc-post-hook)))
-
-\f
-;; ======================================================================
-;; describe this package
-;;
-(defun sc-describe ()
- "Supercite version 2.3 is now described in a texinfo manual which
-makes the documentation available both for online perusal via emacs'
-info system, or for hard-copy printing using the TeX facility.
-
-To view the online document hit \\[info], then \"mSupercite <RET>\"."
- (interactive)
- (describe-function 'sc-describe))
-
-;; ======================================================================
-;; load hook
-(run-hooks 'sc-load-hook)
-(provide 'sc)
+++ /dev/null
-;; -*- Mode: Emacs-Lisp -*-
-;; sc-elec.el -- Version 2.3
-
-;; ========== Introduction ==========
-;; This file contains sc-electric mode for viewing reference headers.
-;; It is loaded automatically by supercite.el when needed.
-
-;; ========== Disclaimer ==========
-;; 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.
-
-;; Some of 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.
-
-;; Other parts of this code were written by other people. Wherever
-;; possible, credit to that author, and the copy* notice supplied by
-;; the author are included with that code. In all cases, the spirit,
-;; if not the letter of the GNU General Public Licence applies.
-
-;; ========== Author (unless otherwise stated) ==========
-;; NAME: Barry A. Warsaw USMAIL: Century Computing, Inc.
-;; TELE: (301) 593-3330 1014 West Street
-;; UUCP: uunet!cen.com!bwarsaw Laurel, MD 20707
-;; INET: bwarsaw@cen.com
-
-;; Want to be on the Supercite mailing list?
-;;
-;; Send articles to:
-;; INET: supercite@anthem.nlm.nih.gov
-;; UUCP: uunet!anthem.nlm.nih.gov!supercite
-;;
-;; Send administrivia (additions/deletions to list, etc) to:
-;; INET: supercite-request@anthem.nlm.nih.gov
-;; UUCP: uunet!anthem.nlm.nih.gov!supercite-request
-;;
-(provide 'sc-elec)
-
-
-;; ======================================================================
-;; set up vars for major mode
-
-(defconst sc-electric-bufname "*sc-erefs*"
- "*Supercite's electric buffer name.")
-
-
-(defvar sc-electric-mode-hook nil
- "*Hook for sc-electric-mode.")
-
-
-\f
-;; ======================================================================
-;; sc-electric-mode
-
-(defun sc-electric-mode (&optional arg)
- "Quasi major 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."
- (let ((gal sc-gal-information)
- (sc-eref-style (if arg ;; assume passed arg is okay
- arg
- (if (and (natnump sc-preferred-header-style)
- (sc-valid-index-p sc-preferred-header-style))
- 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)
- (setq sc-gal-information gal
- buffer-read-only t
- mode-name "Supercite-Electric-References"
- 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)
- ))
- (if sc-eref-style
- (condition-case nil
- (eval (nth sc-eref-style sc-rewrite-header-list))
- (error nil)
- ))
- ;; now restore state
- (kill-buffer sc-electric-bufname)
- ))
-
-
-\f
-;; ======================================================================
-;; functions for electric mode
-
-(defun sc-eref-index (index)
- "Check INDEX to be sure it is a valid index into sc-rewrite-header-list.
-If sc-electric-circular-p is non-nil, then list is considered circular
-so that movement across the ends of the list wraparound."
- (let ((last (1- (length sc-rewrite-header-list))))
- (cond ((sc-valid-index-p index) index)
- ((< index 0)
- (if sc-electric-circular-p last
- (progn (error "No preceding reference headers in list.") 0)))
- ((> index last)
- (if sc-electric-circular-p 0
- (progn (error "No following reference headers in list.") last)))
- )
- ))
-
-
-(defun sc-eref-show (index)
- "Show reference INDEX in sc-rewrite-header-list."
- (setq sc-eref-style (sc-eref-index index))
- (save-excursion
- (set-buffer sc-electric-bufname)
- (let ((ref (nth sc-eref-style sc-rewrite-header-list))
- (buffer-read-only nil))
- (erase-buffer)
- (goto-char (point-min))
- (condition-case err
- (progn
- (set-mark (point-min))
- (eval ref)
- (message "Showing reference header %d." sc-eref-style)
- (goto-char (point-max))
- )
- (void-function
- (progn (message
- "Symbol's function definition is void: %s (Header %d)"
- (symbol-name (car (cdr err)))
- sc-eref-style)
- (beep)
- ))
- ))))
-
-
-\f
-;; ======================================================================
-;; interactive commands
-
-(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))
+++ /dev/null
-;;; setaddr.el --- determine whether sendmail is configured on this machine
-
-;; Copyright (C) 1997 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; If neither sendmail nor Emacs knows what host address to use
-;; for this machine, ask for it, and save it in site-start.el
-;; so we won't have to ask again.
-
-;; This uses a heuristic about the output from sendmail
-;; which may or may not really work. We will have to find
-;; out by experiment.
-
-;;; Code:
-
-(or mail-host-address
- (let (sendmail-configured)
- (with-temp-buffer " mail-host-address"
- (call-process sendmail-program nil t nil "-bv" "root")
- (goto-char (point-min))
- (setq sendmail-configured (looking-at "root@")))
- (or sendmail-configured
- (let (buffer)
- (setq mail-host-address
- (read-string "Specify your host's fully qualified domain name: ")))
- ;; Create an init file, and if we just read mail-host-address,
- ;; make the init file set it.
- (unwind-protect
- (save-excursion
- (set-buffer (find-file-noselect "site-start.el"))
- (setq buffer (current-buffer))
- ;; Get rid of the line that ran this file.
- (if (search-forward "(load \"setaddr\")\n")
- (progn
- (beginning-of-line)
- (delete-region (point)
- (progn (end-of-line)
- (point)))))
- ;; Add the results
- (goto-char (point-max))
- (insert "\n(setq mail-host-address "
- (prin1-to-string mail-host-address)
- ")\n")
- (condition-case nil
- (save-buffer)
- (file-error nil)))
- (if buffer
- (kill-buffer buffer))))))
-
-;;; setaddr.el ends here
(if (save-excursion (end-of-line) (eobp))
;; When adding a newline, don't expand an abbrev.
(let ((abbrev-mode nil))
- (end-of-line)
- (insert "\n"))
+ (newline 1))
(line-move arg))
(if (interactive-p)
(condition-case nil
`skeleton-transformation'). Other possibilities are:
\\n go to next line and indent according to mode
- _ interesting point, interregion here
+ _ interesting point, interregion here, point after termination
> indent line (or interregion if > _) according to major mode
@ add position to `skeleton-positions'
& do next ELEMENT if previous moved point
resume: skipped, continue here if quit is signaled
nil skipped
-After termination, point will be positioned at the first occurrence
-of _ or @ or at the end of the inserted text.
-
Further elements can be defined via `skeleton-further-elements'. ELEMENT may
itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for
different inputs. The SKELETON is processed as often as the user enters a
(or (eolp) (newline))
(indent-region (line-beginning-position)
(car skeleton-regions) nil))
- ;; \n as last element only inserts \n if not at eol.
((and (null (cdr skeleton)) (eolp)) nil)
(skeleton-newline-indent-rigidly
(indent-to (prog1 (current-indentation) (newline))))
(or skeleton-point
(setq skeleton-point (point)))))
((eq element '&)
- (when skeleton-modified (pop skeleton)))
+ (if skeleton-modified
+ (setq skeleton (cdr skeleton))))
((eq element '|)
- (unless skeleton-modified (pop skeleton)))
+ (or skeleton-modified
+ (setq skeleton (cdr skeleton))))
((eq element '@)
- (push (point) skeleton-positions)
- (unless skeleton-point (setq skeleton-point (point))))
+ (if skeleton-point
+ (push (point) skeleton-positions)
+ (setq skeleton-point (point))))
((eq 'quote (car-safe element))
(eval (nth 1 element)))
((or (stringp (car-safe element))
+++ /dev/null
-;;; sun-keys.el --- support for Sun function keys
-
-;;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Author: Ian G. Batten <batten@uk.ac.bham.multics>
-;; 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:
-
-;;; Support (cleanly) for Sun function keys. Provides help facilities,
-;;; better diagnostics, etc.
-;;;
-;;; To use: make sure your .ttyswrc binds 'F1' to <ESC> * F1 <CR> and so on.
-;;; load this lot from your start_up
-
-;;; Code:
-
-(defun sun-function-keys-dispatch (arg)
- "Dispatcher for function keys."
- (interactive "p")
- (let* ((key-stroke (read t))
- (command (assq key-stroke sun-function-keys-command-list)))
- (cond (command (funcall (cdr command) arg))
- (t (error "Unbound function key %s" key-stroke)))))
-
-(defvar sun-function-keys-command-list
- '((F1 . sun-function-keys-describe-bindings)
- (R8 . previous-line) ; arrow keys
- (R10 . backward-char)
- (R12 . forward-char)
- (R14 . next-line)))
-
-(defun sun-function-keys-bind-key (arg1 arg2)
- "Bind a specified key."
- (interactive "xFunction Key Cap Label:
-CCommand To Use:")
- (setq sun-function-keys-command-list
- (cons (cons arg1 arg2) sun-function-keys-command-list)))
-
-(defun sun-function-keys-describe-bindings (arg)
- "Describe the function key bindings we're running"
- (interactive)
- (with-output-to-temp-buffer "*Help*"
- (sun-function-keys-write-bindings
- (sort (copy-sequence sun-function-keys-command-list)
- '(lambda (x y) (string-lessp (car x) (car y)))))))
-
-(defun sun-function-keys-write-bindings (list)
- (cond ((null list)
- t)
- (t
- (princ (format "%s: %s\n"
- (car (car list))
- (cdr (car list))))
- (sun-function-keys-write-bindings (cdr list)))))
-
-(global-set-key "\e*" 'sun-function-keys-dispatch)
-
-(make-variable-buffer-local 'sun-function-keys-command-list)
-
-;;; sun-keys.el ends here
+++ /dev/null
-;;; superyank.el --- smart message-yanking code for GNUS
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw <warsaw@cme.nist.gov>
-;; Version: 1.1
-;; Adapted-By: ESR
-;; 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:
-
-;; Inserts the message being replied to with various user controlled
-;; citation styles.
-;;
-
-;; 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.
-
-;; NAME: Barry A. Warsaw USMAIL: National Institute of Standards
-;; TELE: (301) 975-3460 and Technology (formerly NBS)
-;; UUCP: {...}!uunet!cme-durer!warsaw Rm. B-124, Bldg. 220
-;; ARPA: warsaw@cme.nist.gov Gaithersburg, MD 20899
-
-;; Modification history:
-;;
-;; modified: 14-Jun-1989 baw (better keymap set procedure, rewrite-headers)
-;; modified: 12-Jun-1989 baw (added defvar for sy-use-only-preference-p)
-;; modified: 6-Jun-1989 baw (better sy-rewrite-headers, no kill/yank)
-;; modified: 5-Jun-1989 baw (requires rnewspost.el)
-;; modified: 1-Jun-1989 baw (persistent attribution, sy-open-line)
-;; modified: 31-May-1989 baw (fixed some gnus problems, id'd another)
-;; modified: 22-May-1989 baw (documentation)
-;; modified: 8-May-1989 baw (auto filling of regions)
-;; modified: 1-May-1989 baw (documentation)
-;; modified: 27-Apr-1989 baw (new preference scheme)
-;; modified: 24-Apr-1989 baw (remove gnus headers, attrib scheme, cite lines)
-;; modified: 19-Apr-1989 baw (cite key, fill p, yank region, naming scheme)
-;; modified: 12-Apr-1989 baw (incorp other mail yank features seen on net)
-;; created : 16-Feb-1989 baw (mod vanilla fn indent-rigidly mail-yank-original)
-
-;; Though I wrote this package basically from scratch, as an Emacs Lisp
-;; learning exercise, it was inspired by postings of similar packages to
-;; the gnu.emacs newsgroup over the past month or so.
-;;
-;; Here's a brief history of how this package developed:
-;;
-;; I as well as others on the net were pretty unhappy about the way emacs
-;; cited replies with the tab or 4 spaces. It looked ugly and made it hard
-;; to distinguish between original and cited lines. I hacked on the function
-;; yank-original to at least give the user the ability to define the citation
-;; character. I posted this simple hack, and others did as well. The main
-;; difference between mine and others was that a space was put after the
-;; citation string on on new citations, but not after previously cited lines:
-;;
-;; >> John wrote this originally
-;; > Jane replied to that
-;;
-;; Then Martin Neitzel posted some code that he developed, derived in part
-;; from code that Ashwin Ram posted previous to that. In Martin's
-;; posting, he introduced a new, and (IMHO) superior, citation style,
-;; eliminating nested citations. Yes, I wanted to join the Small-But-
-;; Growing-Help-Stamp-Out-Nested-Citation-Movement! You should too.
-;;
-;; But Martin's code simply asks the user for the citation string (here
-;; after called the `attribution' string), and I got to thinking, it wouldn't
-;; be that difficult to automate that part. So I started hacking this out.
-;; It proved to be not as simple as I first thought. But anyway here it
-;; is. See the wish list below for future plans (if I have time).
-;;
-;; Type "C-h f mail-yank-original" after this package is loaded to get a
-;; description of what it does and the variables that control it.
-;;
-;; ======================================================================
-;;
-;; Changes wish list
-;;
-;; 1) C-x C-s yanks a region from the RMAIL buffer instead of the
-;; whole buffer
-;;
-;; 2) reparse nested citations to try to recast as non-nested citations
-;; perhaps by checking the References: line
-;;
-
-;;; Code:
-
-;; ======================================================================
-;;
-;; require and provide features
-;;
-(require 'sendmail)
-;;
-;; ======================================================================
-;;
-;; don't need rnewspost.el to rewrite the header. This only works
-;; with diffs to rnewspost.el that I posted with the original
-;; superyank code.
-;;
-(setq news-reply-header-hook nil)
-
-;; **********************************************************************
-;; start of user defined variables
-;; **********************************************************************
-;;
-;; this section defines variables that control the operation of
-;; super-mail-yank. Most of these are described in the comment section
-;; as well as the DOCSTRING.
-;;
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; this variable holds the default author's name for citations
-;;
-(defvar sy-default-attribution "Anon"
- "String that describes attribution to unknown person. This string
-should not contain the citation string.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; string used as an end delimiter for both nested and non-nested citations
-;;
-(defvar sy-citation-string ">"
- "String to use as an end-delimiter for citations. This string is
-used in both nested and non-nested citations. For best results, use a
-single character with no trailing space. Most commonly used string
-is: \">\.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; variable controlling citation type, nested or non-nested
-;;
-(defvar sy-nested-citation-p nil
- "Non-nil uses nested citations, nil uses non-nested citations.
-Nested citations are of the style:
-
-I wrote this
-> He wrote this
->> She replied to something he wrote
-
-Non-nested citations are of the style:
-
-I wrote this
-John> He wrote this
-Jane> She originally wrote this")
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; regular expression that matches existing citations
-;;
-(defvar sy-cite-regexp "[a-zA-Z0-9]*>"
- "Regular expression that describes how an already cited line in an
-article begins. The regexp is only used at the beginning of a line,
-so it doesn't need to begin with a '^'.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; regular expression that delimits names from titles in the field that
-;; looks like: (John X. Doe -- Computer Hacker Extraordinaire)
-;;
-(defvar sy-titlecue-regexp "\\s +-+\\s +"
-
- "Regular expression that delineates names from titles in the name
-field. Often, people will set up their name field to look like this:
-
-(John Xavier Doe -- Computer Hacker Extraordinaire)
-
-Set to nil to treat entire field as a name.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;;
-(defvar sy-preferred-attribution 2
-
- "This is an integer indicating what the user's preference is in
-attribution style, based on the following key:
-
-0: email address name is preferred
-1: initials are preferred
-2: first name is preferred
-3: last name is preferred
-
-The value of this variable may also be greater than 3, which would
-allow you to prefer the 2nd through nth - 1 name. If the preferred
-attribution is nil or the empty string, then the secondary preferrence
-will be the first name. After that, the entire name alist is search
-until a non-empty, non-nil name is found. If no such name is found,
-then the user is either queried or the default attribution string is
-used depending on the value of sy-confirm-always-p.
-
-Examples:
-
-assume the from: line looks like this:
-
-from: doe@computer.some.where.com (John Xavier Doe)
-
-The following preferences would return these strings:
-
-0: \"doe\"
-1: \"JXD\"
-2: \"John\"
-3: \"Doe\"
-4: \"Xavier\"
-
-anything else would return \"John\".")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-(defvar sy-confirm-always-p t
- "If t, always confirm attribution string before inserting into
-buffer.")
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; informative header hook
-;;
-(defvar sy-rewrite-header-hook 'sy-header-on-said
- "Hook for inserting informative header at the top of the yanked
-message. Set to nil for no header. Here is a list of predefined
-header styles; you can use these as a model to write you own:
-
-sy-header-on-said [default]: On 14-Jun-1989 GMT,
- John Xavier Doe said:
-
-sy-header-inarticle-writes: In article <123456789> John Xavier Doe writes:
-
-sy-header-regarding-writes: Regarding RE: superyank; John Xavier Doe adds:
-
-sy-header-verbose: On 14-Jun-1989 GMT, John Xavier Doe
- from the organization Great Company
- has this to say about article <123456789>
- in newsgroups misc.misc
- concerning RE: superyank
- referring to previous articles <987654321>
-
-You can use the following variables as information strings in your header:
-
-sy-reply-yank-date: the date field [ex: 14-Jun-1989 GMT]
-sy-reply-yank-from: the from field [ex: John Xavier Doe]
-sy-reply-yank-message-id: the message id [ex: <123456789>]
-sy-reply-yank-subject: the subject line [ex: RE: superyank]
-sy-reply-yank-newsgroup: the newsgroup name for GNUS [ex: misc.misc]
-sy-reply-yank-references: the article references [ex: <987654321>]
-sy-reply-yank-organization: the author's organization [ex: Great Company]
-
-If a field can't be found, because it doesn't exist or is not being
-shown, perhaps because of toggle-headers, the corresponding field
-variable will contain the string \"mumble mumble\".")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; non-nil means downcase the author's name string
-;;
-(defvar sy-downcase-p nil
- "Non-nil means downcase the author's name string.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; controls removal of leading white spaces
-;;
-(defvar sy-left-justify-p nil
- "If non-nil, delete all leading white space before citing.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; controls auto filling of region
-;;
-(defvar sy-auto-fill-region-p nil
- "If non-nil, automatically fill each paragraph that is cited. If
-nil, do not auto fill each paragraph.")
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; controls use of preferred attribution only, or use of attribution search
-;; scheme if the preferred attrib can't be found.
-;;
-(defvar sy-use-only-preference-p nil
-
- "If non-nil, then only the preferred attribution string will be
-used. If the preferred attribution string can not be found, then the
-sy-default-attribution will be used. If nil, and the preferred
-attribution string is not found, then some secondary scheme will be
-employed to find a suitable attribution string.")
-
-;; **********************************************************************
-;; end of user defined variables
-;; **********************************************************************
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; The new citation style means we can clean out other headers in addition
-;; to those previously cleaned out. Anyway, we create our own headers.
-;; Also, we want to clean out any headers that gnus puts in. Add to this
-;; for other mail or news readers you may be using.
-;;
-(setq mail-yank-ignored-headers "^via:\\|^origin:\\|^status:\\|^re\\(mail\\|ceiv\\)ed\\|^[a-z-]*message-id:\\|^\\(summary-\\)?line[s]?:\\|^cc:\\|^subject:\\|^\\(\\(in-\\)?reply-\\)?to:\\|^\\(\\(return\\|reply\\)-\\)?path:\\|^\\(posted-\\)?date:\\|^\\(mail-\\)?from:\\|^newsgroup[s]?:\\|^organization:\\|^keywords:\\|^distribution:\\|^references:")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; global variables, not user accessable
-;;
-(setq sy-persist-attribution (concat sy-default-attribution "> "))
-(setq sy-reply-yank-date "")
-(setq sy-reply-yank-from "")
-(setq sy-reply-yank-message-id "")
-(setq sy-reply-yank-subject "")
-(setq sy-reply-yank-newsgroups "")
-(setq sy-reply-yank-references "")
-(setq sy-reply-yank-organization "")
-
-;;
-;; ======================================================================
-;;
-;; This section contains primitive functions used in the schemes. They
-;; extract name fields from various parts of the "from:" field based on
-;; the control variables described above.
-;;
-;; Some will use recursion to pick out the correct namefield in the namestring
-;; or the list of initials. These functions all scan a string that contains
-;; the name, ie: "John Xavier Doe". There is no limit on the number of names
-;; in the string. Also note that all white spaces are basically ignored and
-;; are stripped from the returned strings, and titles are ignored if
-;; sy-titlecue-regexp is set to non-nil.
-;;
-;; Others will use methods to try to extract the name from the email
-;; address of the originator. The types of addresses readable are
-;; described above.
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; try to extract the name from an email address of the form
-;; name%[stuff]
-;;
-;; Unlike the get-name functions above, these functions operate on the
-;; buffer instead of a supplied name-string.
-;;
-(defun sy-%-style-address ()
- (beginning-of-line)
- (buffer-substring
- (progn (re-search-forward "%" (point-max) t)
- (if (not (bolp)) (forward-char -1))
- (point))
- (progn (re-search-backward "^\\|[^a-zA-Z0-9]")
- (point))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; try to extract names from addresses with the form:
-;; [stuff]name@[stuff]
-;;
-(defun sy-@-style-address ()
- (beginning-of-line)
- (buffer-substring
- (progn (re-search-forward "@" (point-max) t)
- (if (not (bolp)) (forward-char -1))
- (point))
- (progn (re-search-backward "^\\|[^a-zA-Z0-0]")
- (if (not (bolp)) (forward-char 1))
- (point))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; try to extract the name from addresses with the form:
-;; [stuff]![stuff]...!name[stuff]
-;;
-(defun sy-!-style-address ()
- (beginning-of-line)
- (buffer-substring
- (progn (while (re-search-forward "!" (point-max) t))
- (point))
- (progn (re-search-forward "[^a-zA-Z0-9]\\|$")
- (if (not (eolp)) (forward-char -1))
- (point))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; using the different email name schemes, try each one until you get a
-;; non-nil entry
-;;
-(defun sy-get-emailname ()
- (let ((en1 (sy-%-style-address))
- (en2 (sy-@-style-address))
- (en3 (sy-!-style-address)))
- (cond
- ((not (string-equal en1 "")) en1)
- ((not (string-equal en2 "")) en2)
- ((not (string-equal en3 "")) en3)
- (t ""))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; returns the "car" of the namestring, really the first namefield
-;;
-;; (sy-string-car "John Xavier Doe")
-;; => "John"
-;;
-(defun sy-string-car (namestring)
- (substring namestring
- (progn (string-match "\\s *" namestring) (match-end 0))
- (progn (string-match "\\s *\\S +" namestring) (match-end 0))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; returns the "cdr" of the namestring, really the whole string from
-;; after the first name field to the end of the string.
-;;
-;; (sy-string-cdr "John Xavier Doe")
-;; => "Xavier Doe"
-;;
-(defun sy-string-cdr (namestring)
- (substring namestring
- (progn (string-match "\\s *\\S +\\s *" namestring)
- (match-end 0))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; convert a namestring to a list of namefields
-;;
-;; (sy-namestring-to-list "John Xavier Doe")
-;; => ("John" "Xavier" "Doe")
-;;
-(defun sy-namestring-to-list (namestring)
- (if (not (string-match namestring ""))
- (append (list (sy-string-car namestring))
- (sy-namestring-to-list (sy-string-cdr namestring)))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; strip the initials from each item in the list and return a string
-;; that is the concatenation of the initials
-;;
-(defun sy-strip-initials (raw-nlist)
- (if (not raw-nlist)
- nil
- (concat (substring (car raw-nlist) 0 1)
- (sy-strip-initials (cdr raw-nlist)))))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; using the namestring, build a list which is in the following order
-;;
-;; (email, initials, firstname, lastname, name1, name2, name3 ... nameN-1)
-;;
-(defun sy-build-ordered-namelist (namestring)
- (let* ((raw-nlist (sy-namestring-to-list namestring))
- (initials (sy-strip-initials raw-nlist))
- (firstname (car raw-nlist))
- (revnames (reverse (cdr raw-nlist)))
- (lastname (car revnames))
- (midnames (reverse (cdr revnames)))
- (emailnames (sy-get-emailname)))
- (append (list emailnames)
- (list initials)
- (list firstname)
- (list lastname)
- midnames)))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; Query the user for the attribution string. Supply sy-default-attribution
-;; as the default choice.
-;;
-(defun sy-query-for-attribution ()
- (concat
- (let* ((prompt (concat "Enter attribution string: (default "
- sy-default-attribution
- ") "))
- (query (read-input prompt))
- (attribution (if (string-equal query "")
- sy-default-attribution
- query)))
- (if sy-downcase-p
- (downcase attribution)
- attribution))
- sy-citation-string))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; parse the current line for the namestring
-;;
-(defun sy-get-namestring ()
- (save-restriction
- (beginning-of-line)
- (if (re-search-forward "(.*)" (point-max) t)
- (let ((start (progn
- (beginning-of-line)
- (re-search-forward "\\((\\s *\\)\\|$" (point-max) t)
- (point)))
- (end (progn
- (re-search-forward
- (concat "\\(\\s *\\()\\|" sy-titlecue-regexp "\\)\\)\\|$")
- (point-max) t)
- (point))))
- (narrow-to-region start end)
- (let ((start (progn
- (beginning-of-line)
- (point)))
- (end (progn
- (end-of-line)
- (re-search-backward
- (concat "\\s *\\()\\|" sy-titlecue-regexp "\\)$")
- (point-min) t)
- (point))))
- (buffer-substring start end)))
- (let ((start (progn
- (beginning-of-line)
- (re-search-forward "^\"*")
- (point)))
- (end (progn
- (re-search-forward "\\(\\s *[a-zA-Z0-9\\.]+\\)*"
- (point-max) t)
- (point))))
- (buffer-substring start end)))))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; scan the nlist and return the integer pointing to the first legal
-;; non-empty namestring. Returns the integer pointing to the index
-;; in the nlist of the preferred namestring, or nil if no legal
-;; non-empty namestring could be found.
-;;
-(defun sy-return-preference-n (nlist)
- (let ((p sy-preferred-attribution)
- (exception nil))
- ;;
- ;; check to be sure the index is not out-of-bounds
- ;;
- (cond
- ((< p 0) (setq p 2) (setq exception t))
- ((not (nth p nlist)) (setq p 2) (setq exception t)))
- ;;
- ;; check to be sure that the explicit preference is not empty
- ;;
- (if (string-equal (nth p nlist) "")
- (progn (setq p 0)
- (setq exception t)))
- ;;
- ;; find the first non-empty namestring
- ;;
- (while (and (nth p nlist)
- (string-equal (nth p nlist) ""))
- (setq exception t)
- (setq p (+ p 1)))
- ;;
- ;; return the preference index if non-nil, otherwise nil
- ;;
- (if (or (and exception sy-use-only-preference-p)
- (not (nth p nlist)))
- nil
- p)))
-
-;;
-;;
-;; ----------------------------------------------------------------------
-;;
-;; rebuild the nlist into an alist for completing-read. Use as a guide
-;; the index of the preferred name field. Get the actual preferred
-;; name field base on other factors (see above). If no actual preferred
-;; name field is found, then query the user for the attribution string.
-;;
-;; also note that the nlist is guaranteed to be non-empty. At the very
-;; least it will consist of 4 empty strings ("" "" "" "")
-;;
-(defun sy-nlist-to-alist (nlist)
- (let ((preference (sy-return-preference-n nlist))
- alist
- (n 0))
- ;;
- ;; check to be sure preference is not nil
- ;;
- (if (not preference)
- (setq alist (list (cons (sy-query-for-attribution) nil)))
- ;;
- ;; preference is non-nil
- ;;
- (setq alist (list (cons (nth preference nlist) nil)))
- (while (nth n nlist)
- (if (= n preference) nil
- (setq alist (append alist (list (cons (nth n nlist) nil)))))
- (setq n (+ n 1))))
- alist))
-
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; confirm if desired after the alist has been built
-;;
-(defun sy-get-attribution (alist)
- (concat
- ;;
- ;; check to see if nested citations are to be used
- ;;
- (if sy-nested-citation-p
- ""
- ;;
- ;; check to see if confirmation is needed
- ;; if not, just return the preference (first element in alist)
- ;;
- (if (not sy-confirm-always-p)
- (car (car alist))
- ;;
- ;; confirmation is requested so build the prompt, confirm
- ;; and return the chosen string
- ;;
- (let* (ignore
- (prompt (concat "Complete attribution string: (default "
- (car (car alist))
- ") "))
- ;;
- ;; set up the local completion keymap
- ;;
- (minibuffer-local-must-match-map
- (let ((map (make-sparse-keymap)))
- (define-key map "?" 'minibuffer-completion-help)
- (define-key map " " 'minibuffer-complete-word)
- (define-key map "\t" 'minibuffer-complete)
- (define-key map "\00A" 'exit-minibuffer)
- (define-key map "\00D" 'exit-minibuffer)
- (define-key map "\007"
- '(lambda ()
- (interactive)
- (beep)
- (exit-minibuffer)))
- map))
- ;;
- ;; read the completion
- ;;
- (attribution (completing-read prompt alist))
- ;;
- ;; check attribution string for emptyness
- ;;
- (choice (if (or (not attribution)
- (string-equal attribution ""))
- (car (car alist))
- attribution)))
-
- (if sy-downcase-p
- (downcase choice)
- choice))))
- sy-citation-string))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; this function will scan the current rmail buffer, narrowing it to the
-;; from: line, then using this, it will try to decipher some names from
-;; that line. It will then build the name alist and try to confirm
-;; its choice of attribution strings. It returns the chosen attribution
-;; string.
-;;
-(defun sy-scan-rmail-for-names (rmailbuffer)
- (save-excursion
- (let ((case-fold-search t)
- alist
- attribution)
- (switch-to-buffer rmailbuffer)
- (goto-char (point-min))
- ;;
- ;; be sure there is a from: line
- ;;
- (if (not (re-search-forward "^from:\\s *" (point-max) t))
- (setq attribution (sy-query-for-attribution))
- ;;
- ;; if there is a from: line, then scan the narrow the buffer,
- ;; grab the namestring, and build the alist, then using this
- ;; get the attribution string.
- ;;
- (save-restriction
- (narrow-to-region (point)
- (progn (end-of-line) (point)))
- (let* ((namestring (sy-get-namestring))
- (nlist (sy-build-ordered-namelist namestring)))
- (setq alist (sy-nlist-to-alist nlist))))
- ;;
- ;; we've built the alist, now confirm the attribution choice
- ;; if appropriate
- ;;
- (setq attribution (sy-get-attribution alist)))
- attribution)))
-
-
-;;
-;; ======================================================================
-;;
-;; the following function insert of citations, writing of headers, filling
-;; paragraphs and general higher level operations
-;;
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; insert a nested citation
-;;
-(defun sy-insert-citation (start end cite-string)
- (save-excursion
- (goto-char end)
- (setq end (point-marker))
- (goto-char start)
- (or (bolp)
- (forward-line 1))
-
- (let ((fill-prefix (concat cite-string " "))
- (fstart (point))
- (fend (point)))
-
- (while (< (point) end)
- ;;
- ;; remove leading tabs if desired
- ;;
- (if sy-left-justify-p
- (delete-region (point)
- (progn (skip-chars-forward " \t") (point))))
- ;;
- ;; check to see if the current line should be cited
- ;;
- (if (or (eolp)
- (looking-at sy-cite-regexp))
- ;;
- ;; do not cite this line unless nested-citations are to be
- ;; used
- ;;
- (progn
- (or (eolp)
- (if sy-nested-citation-p
- (insert cite-string)))
-
- ;; set fill start and end points
- ;;
- (or (= fstart fend)
- (not sy-auto-fill-region-p)
- (progn (goto-char fend)
- (or (not (eolp))
- (setq fend (+ fend 1)))
- (fill-region-as-paragraph fstart fend)))
- (setq fstart (point))
- (setq fend (point)))
-
- ;; else
- ;;
- (insert fill-prefix)
- (end-of-line)
- (setq fend (point)))
-
- (forward-line 1)))
- (move-marker end nil)))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; yank a particular field into a holding variable
-;;
-(defun sy-yank-fields (start)
- (save-excursion
- (goto-char start)
- (setq sy-reply-yank-date (mail-fetch-field "date")
- sy-reply-yank-from (mail-fetch-field "from")
- sy-reply-yank-subject (mail-fetch-field "subject")
- sy-reply-yank-newsgroups (mail-fetch-field "newsgroups")
- sy-reply-yank-references (mail-fetch-field "references")
- sy-reply-yank-message-id (mail-fetch-field "message-id")
- sy-reply-yank-organization (mail-fetch-field "organization"))
- (or sy-reply-yank-date
- (setq sy-reply-yank-date "mumble mumble"))
- (or sy-reply-yank-from
- (setq sy-reply-yank-from "mumble mumble"))
- (or sy-reply-yank-subject
- (setq sy-reply-yank-subject "mumble mumble"))
- (or sy-reply-yank-newsgroups
- (setq sy-reply-yank-newsgroups "mumble mumble"))
- (or sy-reply-yank-references
- (setq sy-reply-yank-references "mumble mumble"))
- (or sy-reply-yank-message-id
- (setq sy-reply-yank-message-id "mumble mumble"))
- (or sy-reply-yank-organization
- (setq sy-reply-yank-organization "mumble mumble"))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; rewrite the header to be more conversational
-;;
-(defun sy-rewrite-headers (start)
- (goto-char start)
- (run-hooks 'sy-rewrite-header-hook))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; some different styles of headers
-;;
-(defun sy-header-on-said ()
- (insert-string "\nOn " sy-reply-yank-date ",\n"
- sy-reply-yank-from " said:\n"))
-
-(defun sy-header-inarticle-writes ()
- (insert-string "\nIn article " sy-reply-yank-message-id
- " " sy-reply-yank-from " writes:\n"))
-
-(defun sy-header-regarding-writes ()
- (insert-string "\nRegarding " sy-reply-yank-subject
- "; " sy-reply-yank-from " adds:\n"))
-
-(defun sy-header-verbose ()
- (insert-string "\nOn " sy-reply-yank-date ",\n"
- sy-reply-yank-from "\nfrom the organization "
- sy-reply-yank-organization "\nhad this to say about article "
- sy-reply-yank-message-id "\nin newsgroups "
- sy-reply-yank-newsgroups "\nconcerning "
- sy-reply-yank-subject "\nreferring to previous articles "
- sy-reply-yank-references "\n"))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; yank the original article in and attribute
-;;
-(defun sy-yank-original (arg)
-
- "Insert the message being replied to, if any (in rmail/gnus). Puts
-point before the text and mark after. Calls generalized citation
-function sy-insert-citation to cite all allowable lines."
-
- (interactive "P")
- (if mail-reply-buffer
- (let* ((sy-confirm-always-p (if (consp arg)
- t
- sy-confirm-always-p))
- (attribution (sy-scan-rmail-for-names mail-reply-buffer))
- (top (point))
- (start (point))
- (end (progn (delete-windows-on mail-reply-buffer)
- (insert-buffer mail-reply-buffer)
- (mark))))
-
- (sy-yank-fields start)
- (sy-rewrite-headers start)
- (setq start (point))
- (mail-yank-clear-headers top (mark))
- (setq sy-persist-attribution (concat attribution " "))
- (sy-insert-citation start end attribution))
-
- (goto-char top)
- (exchange-point-and-mark)))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; this is here for compatibility with existing mail/news yankers
-;; overloads the default mail-yank-original
-;;
-(defun mail-yank-original (arg)
-
- "Yank original message buffer into the reply buffer, citing as per
-user preferences. Numeric Argument forces confirmation.
-
-Here is a description of the superyank.el package, what it does and
-what variables control its operation. This was written by Barry
-Warsaw (warsaw@cme.nist.gov, {...}!uunet!cme-durer!warsaw).
-
-A 'Citation' is the acknowledgement of the original author of a mail
-message. There are two general forms of citation. In 'nested
-citations', indication is made that the cited line was written by
-someone *other* that the current message author (or by that author at
-an earlier time). No indication is made as to the identity of the
-original author. Thus, a nested citation after multiple replies would
-look like this (this is after my reply to a previous message):
-
->>John originally wrote this
->>and this as well
-> Jane said that John didn't know
-> what he was talking about
-And that's what I think as well.
-
-In non-nested citations, you won't see multiple \">\" characters at
-the beginning of the line. Non-nested citations will insert an
-informative string at the beginning of a cited line, attributing that
-line to an author. The same message described above might look like
-this if non-nested citations were used:
-
-John> John originally wrote this
-John> and this as well
-Jane> Jane said that John didn't know
-Jane> what he was talking about
-And that's what I think as well.
-
-Notice that my inclusion of Jane's inclusion of John's original
-message did not result in a cited line of the form: Jane>John>. Thus
-no nested citations. The style of citation is controlled by the
-variable `sy-nested-citation-p'. Nil uses non-nested citations and
-non-nil uses old style, nested citations.
-
-The variable `sy-citation-string' is the string to use as a marker for
-a citation, either nested or non-nested. For best results, this
-string should be a single character with no trailing space and is
-typically the character \">\". In non-nested citations this string is
-appended to the attribution string (author's name), along with a
-trailing space. In nested citations, a trailing space is only added
-to a first level citation.
-
-Another important variable is `sy-cite-regexp' which describes strings
-that indicate a previously cited line. This regular expression is
-always used at the beginning of a line so it doesn't need to begin
-with a \"^\" character. Change this variable if you change
-`sy-citation-string'.
-
-The following section only applies to non-nested citations.
-
-This package has a fair amount of intellegence related to deciphering
-the author's name based on information provided by the original
-message buffer. In normal operation, the program will pick out the
-author's first and last names, initials, terminal email address and
-any other names it can find. It will then pick an attribution string
-from this list based on a user defined preference and it will ask for
-confirmation if the user specifies. This package gathers its
-information from the `From:' line of the original message buffer. It
-recognizes From: lines with the following forms:
-
-From: John Xavier Doe <doe@speedy.computer.com>
-From: \"John Xavier Doe\" <doe@speedy.computer.com>
-From: doe@speedy.computer.com (John Xavier Doe)
-From: computer!speedy!doe (John Xavier Doe)
-From: computer!speedy!doe (John Xavier Doe)
-From: doe%speedy@computer.com (John Xavier Doe)
-
-In this case, if confirmation is requested, the following strings will
-be made available for completion and confirmation:
-
-\"John\"
-\"Xavier\"
-\"Doe\"
-\"JXD\"
-\"doe\"
-
-Note that completion is case sensitive. If there was a problem
-picking out a From: line, or any other problem getting even a single
-name, then the user will be queried for an attribution string. The
-default attribution string is set in the variable
-`sy-default-attribution'.
-
-Sometimes people set their name fields so that it also includes a
-title of the form:
-
-From: doe@speedy.computer.com (John Doe -- Hacker Extraordinaire)
-
-To avoid the inclusion of the string \"-- Hacker Extraordinaire\" in
-the name list, the variable `sy-titlecue-regexp' is provided. Its
-default setting will still properly recognize names of the form:
-
-From: xdoe@speedy.computer.com (John Xavier-Doe -- Crazed Hacker)
-
-The variable `sy-preferred-attribution' contains an integer that
-indicates which name field the user prefers to use as the attribution
-string, based on the following key:
-
-0: email address name is preferred
-1: initials are preferred
-2: first name is preferred
-3: last name is preferred
-
-The value can be greater than 3, in which case, you would be
-preferring the 2nd throught nth -1 name. In any case, if the
-preferred name can't be found, then one of two actions will be taken
-depending on the value of the variable `sy-use-only-preference-p'. If
-this is non-nil, then the `sy-default-attribution will be used. If it
-is nil, then a secondary scheme will be employed to find a suitable
-attribution scheme. First, the author's first name will be used. If
-that can't be found than the name list is searched for the first
-non-nil, non-empty name string. If still no name can be found, then
-the user is either queried, or the `sy-default-attribution' is used,
-depending on the value of `sy-confirm-always-p'.
-
-If the variable `sy-confirm-always-p' is non-nil, superyank will always
-confirm the attribution string with the user before inserting it into
-the reply buffer. Confirmation is with completion, but the completion
-list is merely a suggestion; the user can override the list by typing
-in a string of their choice.
-
-The variable `sy-rewrite-header-hook' is a hook that contains a lambda
-expression which rewrites the informative header at the top of the
-yanked message. Set to nil to avoid writing any header.
-
-You can make superyank autofill each paragraph it cites by setting the
-variable `sy-auto-fill-region-p' to non-nil. Or set the variable to nil
-and fill the paragraphs manually with sy-fill-paragraph-manually (see
-below).
-
-Finally, `sy-downcase-p' if non-nil, indicates that you always want to
-downcase the attribution string before insertion, and
-`sy-left-justify-p', if non-nil, indicates that you want to delete all
-leading white space before citing.
-
-Since the almost all yanking in other modes (RMAIL, GNUS) is done
-through the function `mail-yank-original', and since superyank
-overloads this function, cited yanking is automatically bound to the
-C-c C-y key. There are three other smaller functions that are
-provided with superyank and they are bound as below. Try C-h f on
-each function to get more information on these functions.
-
-Key Bindings:
-
-C-c C-y mail-yank-original (superyank's version)
-C-c q sy-fill-paragraph-manually
-C-c C-q sy-fill-paragraph-manually
-C-c i sy-insert-persist-attribution
-C-c C-i sy-insert-persist-attribution
-C-c C-o sy-open-line
-
-
-Summary of variables, with their default values:
-
-sy-default-attribution (default: \"Anon\")
- Attribution to use if no attribution string can be deciphered
- from the original message buffer.
-
-sy-citation-string (default: \">\")
- String to append to the attribution string for citation, for
- best results, it should be one character with no trailing space.
-
-sy-nested-citation-p (default: nil)
- Nil means use non-nested citations, non-nil means use old style
- nested citations.
-
-sy-cite-regexp (default: \"[a-zA-Z0-9]*>\")
- Regular expression that matches the beginning of a previously
- cited line. Always used at the beginning of a line so it does
- not need to start with a \"^\" character.
-
-sy-titlecue-regexp (default: \"\\s +-+\\s +\")
- Regular expression that matches a title delimiter in the name
- field.
-
-sy-preferred-attribution (default: 2)
- Integer indicating user's preferred attribution field.
-
-sy-confirm-always-p (default: t)
- Non-nil says always confirm with completion before inserting
- attribution.
-
-sy-rewrite-header-hook (default: 'sy-header-on-said)
- Hook for inserting informative header at the top of the yanked
- message.
-
-sy-downcase-p (default: nil)
- Non-nil says downcase the attribution string before insertion.
-
-sy-left-justify-p (default: nil)
- Non-nil says delete leading white space before citing.
-
-sy-auto-fill-region-p (default: nil)
- Non-nil says don't auto fill the region. T says auto fill the
- paragraph.
-
-sy-use-only-preference-p (default: nil)
- If nil, use backup scheme when preferred attribution string
- can't be found. If non-nil and preferred attribution string
- can't be found, then use sy-default-attribution."
-
- (interactive "P")
-
- (local-set-key "\C-cq" 'sy-fill-paragraph-manually)
- (local-set-key "\C-c\C-q" 'sy-fill-paragraph-manually)
- (local-set-key "\C-c\i" 'sy-insert-persist-attribution)
- (local-set-key "\C-c\C-i" 'sy-insert-persist-attribution)
- (local-set-key "\C-c\C-o" 'sy-open-line)
-
- (sy-yank-original arg))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; based on Bruce Israel's "fill-paragraph-properly", and modified from
-;; code posted by David C. Lawrence. Modified to use the persistant
-;; attribution if none could be found from the paragraph.
-;;
-(defun sy-fill-paragraph-manually (arg)
- "Fill paragraph containing or following point.
-This automatically finds the sy-cite-regexp and uses it as the prefix.
-If the sy-cite-regexp is not in the first line of the paragraph, it
-makes a guess at what the fill-prefix for the paragraph should be by
-looking at the first line and taking anything up to the first
-alphanumeric character.
-
-Prefix arg means justify both sides of paragraph as well.
-
-This function just does fill-paragraph if the fill-prefix is set. If
-what it deduces to be the paragraph prefix (based on the first line)
-does not precede each line in the region, then the persistant
-attribution is used. The persistant attribution is just the last
-attribution string used to cite lines."
-
- (interactive "P")
- (save-excursion
- (forward-paragraph)
- (or (bolp)
- (newline 1))
-
- (let ((end (point))
- st
- (fill-prefix fill-prefix))
- (backward-paragraph)
- (if (looking-at "\n")
- (forward-char 1))
- (setq st (point))
- (if fill-prefix
- nil
- (untabify st end) ;; die, scurvy tabs!
- ;;
- ;; untabify might have made the paragraph longer character-wise,
- ;; make sure end reflects the correct location of eop.
- ;;
- (forward-paragraph)
- (setq end (point))
- (goto-char st)
- (if (looking-at sy-cite-regexp)
- (setq fill-prefix (concat
- (buffer-substring
- st (progn (re-search-forward sy-cite-regexp)
- (point)))
- " "))
- ;;
- ;; this regexp is is convenient because paragraphs quoted by simple
- ;; indentation must still yield to us <evil laugh>
- ;;
- (while (looking-at "[^a-zA-Z0-9]")
- (forward-char 1))
- (setq fill-prefix (buffer-substring st (point))))
- (next-line 1) (beginning-of-line)
- (while (and (< (point) end)
- (not (string-equal fill-prefix "")))
- ;;
- ;; if what we decided was the fill-prefix does not precede all
- ;; of the lines in the paragraph, we probably goofed. In this
- ;; case set it to the persistant attribution.
- ;;
- (if (looking-at (regexp-quote fill-prefix))
- ()
- (setq fill-prefix sy-persist-attribution))
- (next-line 1)
- (beginning-of-line)))
- (fill-region-as-paragraph st end arg))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; insert the persistant attribution at point
-;;
-(defun sy-insert-persist-attribution ()
- "Insert the persistant attribution.
-This inserts the peristant attribution at the beginning of the line that
-point is on. This string is the last attribution confirmed and used
-in the yanked reply buffer."
- (interactive)
- (save-excursion
- (beginning-of-line)
- (insert-string sy-persist-attribution)))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; open a line putting the attribution at the beginning
-
-(defun sy-open-line (arg)
- "Insert a newline and leave point before it.
-Also inserts the persistant attribution at the beginning of the line.
-With argument, inserts ARG newlines."
- (interactive "p")
- (save-excursion
- (let ((start (point)))
- (open-line arg)
- (goto-char start)
- (forward-line)
- (while (< 0 arg)
- (sy-insert-persist-attribution)
- (forward-line 1)
- (setq arg (- arg 1))))))
-
-(provide 'superyank)
-
-;;; superyank.el ends here
(modify-syntax-entry ?\n "> 1" nroff-mode-syntax-table))
(set-syntax-table nroff-mode-syntax-table)
(make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults
- ;; SYNTAX-BEGIN is set to backward-paragraph to avoid slow-down
- ;; near the end of large buffers due to searching to buffer's
- ;; beginning.
- '(nroff-font-lock-keywords nil t nil backward-paragraph))
+ (setq font-lock-defaults '(nroff-font-lock-keywords nil t))
(setq local-abbrev-table nroff-mode-abbrev-table)
(make-local-variable 'nroff-electric-mode)
(setq nroff-electric-mode nil)
+++ /dev/null
-;;; timer.el --- run a function with args at some time in future.
-
-;; Copyright (C) 1996 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, 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.
-
-;;; Code:
-
-;; Layout of a timer vector:
-;; [triggered-p high-seconds low-seconds usecs repeat-delay
-;; function args idle-delay]
-
-(defun timer-create ()
- "Create a timer object."
- (let ((timer (make-vector 8 nil)))
- (aset timer 0 t)
- timer))
-
-(defun timerp (object)
- "Return t if OBJECT is a timer."
- (and (vectorp object) (= (length object) 8)))
-
-(defun timer-set-time (timer time &optional delta)
- "Set the trigger time of TIMER to TIME.
-TIME must be in the internal format returned by, e.g., `current-time'.
-If optional third argument DELTA is a non-zero integer, make the timer
-fire repeatedly that many seconds apart."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 (car time))
- (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
- (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time)))
- (nth 2 time))
- 0))
- (aset timer 4 (and (numberp delta) (> delta 0) delta))
- timer)
-
-(defun timer-set-idle-time (timer secs &optional repeat)
- "Set the trigger idle time of TIMER to SECS.
-If optional third argument REPEAT is non-nil, make the timer
-fire each time Emacs is idle for that many seconds."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 0)
- (aset timer 2 0)
- (aset timer 3 0)
- (timer-inc-time timer secs)
- (aset timer 4 repeat)
- timer)
-
-(defun timer-next-integral-multiple-of-time (time secs)
- "Yield the next value after TIME that is an integral multiple of SECS.
-More precisely, the next value, after TIME, that is an integral multiple
-of SECS seconds since the epoch. SECS may be a fraction."
- (let ((time-base (ash 1 16)))
- (if (fboundp 'atan)
- ;; Use floating point, taking care to not lose precision.
- (let* ((float-time-base (float time-base))
- (million 1000000.0)
- (time-usec (+ (* million
- (+ (* float-time-base (nth 0 time))
- (nth 1 time)))
- (nth 2 time)))
- (secs-usec (* million secs))
- (mod-usec (mod time-usec secs-usec))
- (next-usec (+ (- time-usec mod-usec) secs-usec))
- (time-base-million (* float-time-base million)))
- (list (floor next-usec time-base-million)
- (floor (mod next-usec time-base-million) million)
- (floor (mod next-usec million))))
- ;; Floating point is not supported.
- ;; Use integer arithmetic, avoiding overflow if possible.
- (let* ((mod-sec (mod (+ (* (mod time-base secs)
- (mod (nth 0 time) secs))
- (nth 1 time))
- secs))
- (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
- (list (+ (nth 0 time) (floor next-1-sec time-base))
- (mod next-1-sec time-base)
- 0)))))
-
-(defun timer-relative-time (time secs &optional usecs)
- "Advance TIME by SECS seconds and optionally USECS microseconds.
-SECS may be a fraction."
- (let ((high (car time))
- (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
- (micro (if (numberp (car-safe (cdr-safe (cdr time))))
- (nth 2 time)
- 0)))
- ;; Add
- (if usecs (setq micro (+ micro usecs)))
- (if (floatp secs)
- (setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
- (setq low (+ low (floor secs)))
-
- ;; Normalize
- (setq low (+ low (/ micro 1000000)))
- (setq micro (mod micro 1000000))
- (setq high (+ high (/ low 65536)))
- (setq low (logand low 65535))
-
- (list high low (and (/= micro 0) micro))))
-
-(defun timer-inc-time (timer secs &optional usecs)
- "Increment the time set in TIMER by SECS seconds and USECS microseconds.
-SECS may be a fraction."
- (let ((time (timer-relative-time
- (list (aref timer 1) (aref timer 2) (aref timer 3))
- secs
- usecs)))
- (aset timer 1 (nth 0 time))
- (aset timer 2 (nth 1 time))
- (aset timer 3 (or (nth 2 time) 0))))
-
-(defun timer-set-time-with-usecs (timer time usecs &optional delta)
- "Set the trigger time of TIMER to TIME.
-TIME must be in the internal format returned by, e.g., `current-time'.
-If optional third argument DELTA is a non-zero integer, make the timer
-fire repeatedly that many seconds apart."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 1 (car time))
- (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
- (aset timer 3 usecs)
- (aset timer 4 (and (numberp delta) (> delta 0) delta))
- timer)
-
-(defun timer-set-function (timer function &optional args)
- "Make TIMER call FUNCTION with optional ARGS when triggering."
- (or (timerp timer)
- (error "Invalid timer"))
- (aset timer 5 function)
- (aset timer 6 args)
- timer)
-\f
-(defun timer-activate (timer)
- "Put TIMER on the list of active timers."
- (if (and (timerp timer)
- (integerp (aref timer 1))
- (integerp (aref timer 2))
- (integerp (aref timer 3))
- (aref timer 5))
- (let ((timers timer-list)
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers
- (or (> (aref timer 1) (aref (car timers) 1))
- (and (= (aref timer 1) (aref (car timers) 1))
- (> (aref timer 2) (aref (car timers) 2)))
- (and (= (aref timer 1) (aref (car timers) 1))
- (= (aref timer 2) (aref (car timers) 2))
- (> (aref timer 3) (aref (car timers) 3)))))
- (setq last timers
- timers (cdr timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (if last
- (setcdr last (cons timer timers))
- (setq timer-list (cons timer timers)))
- (aset timer 0 nil)
- (aset timer 7 nil)
- nil)
- (error "Invalid or uninitialized timer")))
-
-(defun timer-activate-when-idle (timer &optional dont-wait)
- "Arrange to activate TIMER whenever Emacs is next idle.
-If optional argument DONT-WAIT is non-nil, then enable the
-timer to activate immediately, or at the right time, if Emacs
-is already idle."
- (if (and (timerp timer)
- (integerp (aref timer 1))
- (integerp (aref timer 2))
- (integerp (aref timer 3))
- (aref timer 5))
- (let ((timers timer-idle-list)
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers
- (or (> (aref timer 1) (aref (car timers) 1))
- (and (= (aref timer 1) (aref (car timers) 1))
- (> (aref timer 2) (aref (car timers) 2)))
- (and (= (aref timer 1) (aref (car timers) 1))
- (= (aref timer 2) (aref (car timers) 2))
- (> (aref timer 3) (aref (car timers) 3)))))
- (setq last timers
- timers (cdr timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (if last
- (setcdr last (cons timer timers))
- (setq timer-idle-list (cons timer timers)))
- (aset timer 0 (not dont-wait))
- (aset timer 7 t)
- nil)
- (error "Invalid or uninitialized timer")))
-
-;;;###autoload
-(defalias 'disable-timeout 'cancel-timer)
-;;;###autoload
-(defun cancel-timer (timer)
- "Remove TIMER from the list of active timers."
- (or (timerp timer)
- (error "Invalid timer"))
- (setq timer-list (delq timer timer-list))
- (setq timer-idle-list (delq timer timer-idle-list))
- nil)
-
-;;;###autoload
-(defun cancel-function-timers (function)
- "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
- (interactive "aCancel timers of function: ")
- (let ((tail timer-list))
- (while tail
- (if (eq (aref (car tail) 5) function)
- (setq timer-list (delq (car tail) timer-list)))
- (setq tail (cdr tail))))
- (let ((tail timer-idle-list))
- (while tail
- (if (eq (aref (car tail) 5) function)
- (setq timer-idle-list (delq (car tail) timer-idle-list)))
- (setq tail (cdr tail)))))
-\f
-;; Record the last few events, for debugging.
-(defvar timer-event-last-2 nil)
-(defvar timer-event-last-1 nil)
-(defvar timer-event-last nil)
-
-(defvar timer-max-repeats 10
- "*Maximum number of times to repeat a timer, if real time jumps.")
-
-(defun timer-until (timer time)
- "Calculate number of seconds from when TIMER will run, until TIME.
-TIMER is a timer, and stands for the time when its next repeat is scheduled.
-TIME is a time-list."
- (let ((high (- (car time) (aref timer 1)))
- (low (- (nth 1 time) (aref timer 2))))
- (+ low (* high 65536))))
-
-(defun timer-event-handler (timer)
- "Call the handler for the timer TIMER.
-This function is called, by name, directly by the C code."
- (setq timer-event-last-2 timer-event-last-1)
- (setq timer-event-last-1 timer-event-last)
- (setq timer-event-last timer)
- (let ((inhibit-quit t))
- (if (timerp timer)
- (progn
- ;; Delete from queue.
- (cancel-timer timer)
- ;; Re-schedule if requested.
- (if (aref timer 4)
- (if (aref timer 7)
- (timer-activate-when-idle timer)
- (timer-inc-time timer (aref timer 4) 0)
- ;; If real time has jumped forward,
- ;; perhaps because Emacs was suspended for a long time,
- ;; limit how many times things get repeated.
- (if (and (numberp timer-max-repeats)
- (< 0 (timer-until timer (current-time))))
- (let ((repeats (/ (timer-until timer (current-time))
- (aref timer 4))))
- (if (> repeats timer-max-repeats)
- (timer-inc-time timer (* (aref timer 4) repeats)))))
- (timer-activate timer)))
- ;; Run handler.
- ;; We do this after rescheduling so that the handler function
- ;; can cancel its own timer successfully with cancel-timer.
- (condition-case nil
- (apply (aref timer 5) (aref timer 6))
- (error nil)))
- (error "Bogus timer event"))))
-
-;; This function is incompatible with the one in levents.el.
-(defun timeout-event-p (event)
- "Non-nil if EVENT is a timeout event."
- (and (listp event) (eq (car event) 'timer-event)))
-\f
-;;;###autoload
-(defun run-at-time (time repeat function &rest args)
- "Perform an action at time TIME.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
-from now, a value from `current-time', or t (with non-nil REPEAT)
-meaning the next integral multiple of REPEAT.
-REPEAT may be an integer or floating point number.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
-
- (or (null repeat)
- (and (numberp repeat) (< 0 repeat))
- (error "Invalid repetition interval"))
-
- ;; Special case: nil means "now" and is useful when repeating.
- (if (null time)
- (setq time (current-time)))
-
- ;; Special case: t means the next integral multiple of REPEAT.
- (if (and (eq time t) repeat)
- (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
-
- ;; Handle numbers as relative times in seconds.
- (if (numberp time)
- (setq time (timer-relative-time (current-time) time)))
-
- ;; Handle relative times like "2 hours and 35 minutes"
- (if (stringp time)
- (let ((secs (timer-duration time)))
- (if secs
- (setq time (timer-relative-time (current-time) secs)))))
-
- ;; Handle "11:23pm" and the like. Interpret it as meaning today
- ;; which admittedly is rather stupid if we have passed that time
- ;; already. (Though only Emacs hackers hack Emacs at that time.)
- (if (stringp time)
- (progn
- (require 'diary-lib)
- (let ((hhmm (diary-entry-time time))
- (now (decode-time)))
- (if (>= hhmm 0)
- (setq time
- (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
- (nth 4 now) (nth 5 now) (nth 8 now)))))))
-
- (or (consp time)
- (error "Invalid time format"))
-
- (let ((timer (timer-create)))
- (timer-set-time timer time repeat)
- (timer-set-function timer function args)
- (timer-activate timer)
- timer))
-
-;;;###autoload
-(defun run-with-timer (secs repeat function &rest args)
- "Perform an action after a delay of SECS seconds.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-SECS and REPEAT may be integers or floating point numbers.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
- (apply 'run-at-time secs repeat function args))
-
-;;;###autoload
-(defun add-timeout (secs function object &optional repeat)
- "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
-If REPEAT is non-nil, repeat the timer every REPEAT seconds.
-This function is for compatibility; see also `run-with-timer'."
- (run-with-timer secs repeat function object))
-
-;;;###autoload
-(defun run-with-idle-timer (secs repeat function &rest args)
- "Perform an action the next time Emacs is idle for SECS seconds.
-The action is to call FUNCTION with arguments ARGS.
-SECS may be an integer or a floating point number.
-
-If REPEAT is non-nil, do the action each time Emacs has been idle for
-exactly SECS seconds (that is, only once for each time Emacs becomes idle).
-
-This function returns a timer object which you can use in `cancel-timer'."
- (interactive
- (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
- (y-or-n-p "Repeat each time Emacs is idle? ")
- (intern (completing-read "Function: " obarray 'fboundp t))))
- (let ((timer (timer-create)))
- (timer-set-function timer function args)
- (timer-set-idle-time timer secs repeat)
- (timer-activate-when-idle timer)
- timer))
-\f
-(defun with-timeout-handler (tag)
- (throw tag 'timeout))
-
-;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
-
-;;;###autoload
-(defmacro with-timeout (list &rest body)
- "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
-If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
-The call should look like:
- (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
-The timeout is checked whenever Emacs waits for some kind of external
-event \(such as keyboard input, input from subprocesses, or a certain time);
-if the program loops without waiting in any way, the timeout will not
-be detected."
- (let ((seconds (car list))
- (timeout-forms (cdr list)))
- `(let ((with-timeout-tag (cons nil nil))
- with-timeout-value with-timeout-timer)
- (if (catch with-timeout-tag
- (progn
- (setq with-timeout-timer
- (run-with-timer ,seconds nil
- 'with-timeout-handler
- with-timeout-tag))
- (setq with-timeout-value (progn . ,body))
- nil))
- (progn . ,timeout-forms)
- (cancel-timer with-timeout-timer)
- with-timeout-value))))
-
-(defun y-or-n-p-with-timeout (prompt seconds default-value)
- "Like (y-or-n-p PROMPT), with a timeout.
-If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
- (with-timeout (seconds default-value)
- (y-or-n-p prompt)))
-\f
-(defvar timer-duration-words
- (list (cons "microsec" 0.000001)
- (cons "microsecond" 0.000001)
- (cons "millisec" 0.001)
- (cons "millisecond" 0.001)
- (cons "sec" 1)
- (cons "second" 1)
- (cons "min" 60)
- (cons "minute" 60)
- (cons "hour" (* 60 60))
- (cons "day" (* 24 60 60))
- (cons "week" (* 7 24 60 60))
- (cons "fortnight" (* 14 24 60 60))
- (cons "month" (* 30 24 60 60)) ; Approximation
- (cons "year" (* 365.25 24 60 60)) ; Approximation
- )
- "Alist mapping temporal words to durations in seconds")
-
-(defun timer-duration (string)
- "Return number of seconds specified by STRING, or nil if parsing fails."
- (let ((secs 0)
- (start 0)
- (case-fold-search t))
- (while (string-match
- "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
- string start)
- (let ((count (if (match-beginning 1)
- (string-to-number (match-string 1 string))
- 1))
- (itemsize (cdr (assoc (match-string 2 string)
- timer-duration-words))))
- (if itemsize
- (setq start (match-end 0)
- secs (+ secs (* count itemsize)))
- (setq secs nil
- start (length string)))))
- (if (= start (length string))
- secs
- (if (string-match "\\`[0-9.]+\\'" string)
- (string-to-number string)))))
-\f
-(provide 'timer)
-
-;;; timer.el ends here
+++ /dev/null
-;;; tpu-doc.el --- Documentation for TPU-edt
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
-;; 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.
-
-
-;; This is documentation for the TPU-edt editor for GNU emacs. Major
-;; sections of this document are separated with lines that begin with
-;; ";; %% <topic>", where <topic> 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 and Bob Covey. 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-<key> 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 <enter info mode>
-;; m regex <select the "regular expression" topic>
-;; m directives <select the "directives" topic>
-
-;; 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 "^" "> " <add "> " to beginning of line>
-;; replace "$" "00711" <add "00711" to end of line>
-
-;; 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
;;; vc-cvs.el --- non-resident support for CVS version-control
-;; Copyright (C) 1995,98,99,2000,2001 Free Software Foundation, Inc.
+;; Copyright (C) 1995,98,99,2000 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-cvs.el,v 1.19 2001/02/01 15:10:16 spiegel Exp $
+;; $Id: vc-cvs.el,v 1.18 2001/01/29 19:12:40 sds Exp $
;; This file is part of GNU Emacs.
;;; Code:
(eval-when-compile
- (require 'vc))
+ ;; keep the compiler happy
+ ;; note that there is another option: (require 'vc)
+ (defvar vc-register-switches) ; defined in "vc.el", used in `vc-cvs-register'
+ (defvar vc-checkin-switches) ; defined in "vc.el", used in `vc-cvs-checkin'
+ (defvar vc-checkout-switches) ; defined in "vc.el", used in `vc-cvs-checkout'
+ (autoload 'vc-diff-switches-list "vc") ; used in `vc-cvs-diff'
+ (autoload 'vc-do-command "vc") ; used all over the place
+ (autoload 'vc-trunk-p "vc") ; used in `vc-cvs-checkin'
+ (autoload 'vc-resynch-buffer "vc")) ; used in `vc-cvs-retrieve-snapshot'
;;;
;;; Customization options
+++ /dev/null
-;;; 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
"Invoke the button that the mouse is pointing at."
(interactive "@e")
(if (widget-event-point event)
- (let* ((pos (widget-event-point event))
- (button (get-char-property pos 'button)))
- (if button
- ;; Mouse click on a widget button. Do the following
- ;; in a save-excursion so that the click on the button
- ;; doesn't change point.
- (progn
+ (progn
+ (mouse-set-point event)
+ (let* ((pos (widget-event-point event))
+ (button (get-char-property pos 'button)))
+ (if button
(save-excursion
- (mouse-set-point event)
(let* ((overlay (widget-get button :button-overlay))
(face (overlay-get overlay 'face))
(mouse-face (overlay-get overlay 'mouse-face)))
(unwind-protect
- ;; Read events, including mouse-movement events
- ;; until we receive a release event. Highlight/
- ;; unhighlight the button the mouse was initially
- ;; on when we move over it.
(let ((track-mouse t))
(save-excursion
(when face ; avoid changing around image
widget-button-pressed-face))
(overlay-put overlay 'face face)
(overlay-put overlay 'mouse-face mouse-face))))
-
- ;; When mouse is released over the button, run
- ;; its action function.
(when (and pos
(eq (get-char-property pos 'button) button))
(widget-apply-action button event))))
(overlay-put overlay 'face face)
(overlay-put overlay 'mouse-face mouse-face))))
- (unless (pos-visible-in-window-p (widget-event-point event))
- (mouse-set-point event)
- (beginning-of-line)
- (recenter)))
-
- (let ((up t) command)
- ;; Mouse click not on a widget button. Find the global
- ;; command to run, and check whether it is bound to an
- ;; up event.
- (mouse-set-point event)
+ ;; Not on a button. Find the global command to run, and
+ ;; check whether it is bound to an up event. Avoid a
+ ;; `save-excursion' here, since a global command may
+ ;; to change point, e.g. like `mouse-drag-drag' does.
+ (let ((up t)
+ command)
(if (memq (event-basic-type event) '(mouse-1 down-mouse-1))
(cond ((setq command ;down event
(lookup-key widget-global-map [down-mouse-1]))
(setq event (read-event))))
(when command
(call-interactively command)))))
+ (unless (pos-visible-in-window-p (widget-event-point event))
+ (mouse-set-point event)
+ (beginning-of-line)
+ (recenter)))
(message "You clicked somewhere weird.")))
(defun widget-button-press (pos &optional event)
+++ /dev/null
-;;; word-help.el --- keyword help for any language doc'd in TeXinfo.
-
-;; Copyright (c) 1996 Free Software Foundation, Inc.
-
-;; Author: Jens T. Berger Thielemann <jensthi@ifi.uio.no>
-;; Keywords: help, keyword, languages, completion
-
-;; 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.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package provides a rather general interface for doing keyword
-;; help in most languages. In short, it'll determine which TeXinfo
-;; file which is relevant for the current mode; cache the index and
-;; use regexps to give you help on the keyword you're looking at.
-
-;; Installation
-;; ************
-
-;; For the default setup to work for all supported modes, make sure
-;; the Texinfo files from the following packages are installed:
-
-;; Texinfo file | Available in archive or URL | Notes
-;; autoconf.info | autoconf-2.10.tar.gz | -
-;; bison.info | bison-1.25.tar.gz | -
-;; libc.info | glibc-1.09.1.tar.gz | -
-;; elisp.info | elisp-manual-19-2.4.tar.gz | -
-;; latex.info | ftp://ftp.dante.de/pub/tex/info/latex2e-help-texinfo/latex2e.texi
-;; groff.info | groff-1.10.tar.gz | -
-;; m4.info | m4-1.4.tar.gz | -
-;; make.info | make-3.75.tar.gz | -
-;; perl.info | http://www.perl.com/CPAN/doc/manual/info/
-;; simula.info | Mail bjort@ifi.uio.no | Written in Norwegian
-;; texinfo.info | texinfo-3.9.tar.gz | -
-
-;; BTW: We refer to Texinfo files by just their last component, not
-;; with an absolute file name. You must thus set up
-;; `Info-directory-list' and `Info-default-directory-list' so that
-;; these can automatically be located.
-
-;; Usage
-;; *****
-;;
-;; Place the cursor over the function/variable/type/whatever you want
-;; help on. Type "C-h C-i". `word-help' will then make a suggestion
-;; to an index topic; press return to accept this. If not, you may use
-;; tab-completion to find the topic you're interested in.
-
-;; `word-help' is also able to do symbol completion via the
-;; `word-help-complete' function. Bind this function to C-TAB by
-;; adding the following line to your .emacs file:
-;;
-;; (global-set-key [?\M-\t] 'word-help-complete)
-;;
-;; Note that some modes automatically override this key; you may
-;; therefore wish to either put the above statement in a hook or
-;; associate the function with an other key.
-
-;; Usually, `word-help' is able to determine the relevant Texinfo
-;; file from looking at the buffer's `mode-name'; if not, you can use
-;; the interactive function `set-help-file' to set this.
-
-;; Customizing
-;; ***********
-;;
-;; User interface
-;; --------------
-;;
-;; Two variables control the behaviour of the user-interface of
-;; `word-help': `word-help-split-window' and
-;; `word-help-magic-index'. Do C-h v to get more information on
-;; these.
-
-;; Adding more Texinfo files
-;; -------------------------
-;;
-;; Associations between mode-names and Texinfo files can be done
-;; through the `word-help-mode-alist' variable, which defines an
-;; `alist' making `set-help-file' able to initialize the necessary
-;; variable.
-
-;; NOTE: If you have to customize the regexps, it is *CRUCIAL* that
-;; none of your regexps match the empty string! Not adhering to this
-;; restriction will make `word-help' enter an infinite loop.
-
-;; Contacting the author
-;; *********************
-;;
-;; If you wish to contact me for any reason, please feel free to write
-;; to:
-
-;; Jens Berger
-;; Spektrumveien 4
-;; N-0666 Oslo
-;; Norway
-;;
-;; E-mail: <jensthi@ifi.uio.no>
-
-;; Have fun.
-
-;;
-;;; Code:
-;;
-
-(require 'info)
-
-;;;--------------------
-;;; USER OPTIONS
-;;;--------------------
-
-(defvar word-help-split-window t
- "*Non-nil means that the info buffer will pop up in a separate window.
-If nil, we will just switch to it.")
-
-(defvar word-help-magic-index t
- "*Non-nil means that the keyword will be searched for in the requested node.
-This is done by determining whether the line the point is positioned
-on after using `Info-goto-node', actually contains the keyword. If
-not, we will search for the first occurence of the keyword. This may
-help when the info file isn't correctly indexed.")
-
-;;; ---- end of user configurable variables
-
-;;;-------------------------
-;;; ADVANCED USER OPTIONS
-;;;-------------------------
-
-(defvar word-help-mode-alist
- '(
- ("autoconf"
- (("autoconf" "Macro Index") ("m4" "Macro index"))
- (("AC_\\([A-Za-z0-9_]+\\)" 1)
- ("[a-z]+"))
- nil
- nil
- (("AC_\\([A-Za-z0-9_]+\\)" 1 nil (("^[A-Z_]+$")))
- ("[a-z_][a-z_]*" 0 nil (("^[a-z_]+$")))))
-
- ("Bison"
- (("bison" "Index")
- ("libc" "Type Index" "Function Index" "Variable Index"))
- (("%[A-Za-z]*")
- ("[A-Za-z_][A-Za-z0-9_]*"))
- nil
- nil
- (("%[A-Za-z]*" nil nil (("^%")))
- ("[A-Za-z_][A-Za-z0-9_]*" nil nil (("[A-Za-z_][A-Za-z0-9_]*")))))
-
- ("YACC" . "Bison")
-
- ("C" (("libc" "Type Index" "Function Index" "Variable Index")))
- ("C++" . "C")
-
- ("Emacs-Lisp"
- (("elisp" "Index"))
- (("[^][ ()\n\t.\"'#]+"))
- nil
- nil
- lisp-complete-symbol)
-
- ("LaTeX"
- (("latex" "Command Index"))
- (("\\\\\\(begin\\|end\\){\\([^}\n]+\\)}" 2 0)
- ("\\\\[A-Za-z]+")
- ("\\\\[^A-Za-z]")
- ("[A-Za-z]+"))
- nil
- nil
- (("\\\\begin{\\([A-Za-z]*\\)" 1 "}" (("^[A-Za-z]+$")))
- ("\\\\end{\\([A-Za-z]*\\)" 1 "}" (("^[A-Za-z]+$")))
- ("\\\\renewcommand{\\(\\\\?[A-Za-z]*\\)" 1 "}" (("^\\\\[A-Za-z]+")))
- ("\\\\renewcommand\\(\\\\?[A-Za-z]*\\)" 1 "" (("^\\\\[A-Za-z]+")))
- ("\\\\renewenvironment{?\\([A-Za-z]*\\)" 1 "}"(("^[A-Za-z]+$")))
- ("\\\\[A-Za-z]*" 0 "" (("^\\\\[A-Za-z]+")))))
-
- ("latex" . "LaTeX")
-
- ("Nroff"
- (("groff" "Macro Index" "Register Index" "Request Index"))
- (("\\.[^A-Za-z]")
- ("\\.[A-Za-z]+")
- ("\\.\\([A-Za-z]+\\)" 1))
- nil
- nil
- (("\\.[A-Za-z]*" nil nil (("^\\.[A-Za-z]+$")))
- ("\\.\\([A-Za-z]*\\)" 1 nil (("^[A-Za-z]+$")))))
-
- ("Groff" . "Nroff")
-
- ("m4"
- (("m4" "Macro index"))
- (("\\([mM]4_\\)?\\([A-Za-z_][A-Za-z_0-9]*\\)" 2))
- nil
- nil
- (("[mM]4_\\([A-Za-z_]?[A-Za-z_0-9]*\\)" 1)
- ("[A-Za-z_][A-Za-z_0-9]*")))
-
- ("Makefile"
- (("make" "Name Index"))
- (("\\.[A-Za-z]+") ;; .SUFFIXES
- ("\\$[^()]") ;; $@
- ("\\$([^A-Za-z].)") ;; $(<@)
- ("\\$[\(\{]\\([a-zA-Z+]\\)" 1) ;; $(wildcard)
- ("[A-Za-z]+")) ;; foreach
- nil
- nil
- (("\\.[A-Za-z]*" nil ":" (("^\\.[A-Za-z]+$")))
- ("\\$(\\([A-Z]*\\)" 1 ")" (("^[A-Z]")))
- ("[a-z]+" nil nil (("^[a-z]+$")))))
-
- ("Perl"
- (("perl" "Variable Index" "Function Index"))
- (("\\$[^A-Za-z^]") ;; $@
- ("\\$\\^[A-Za-z]?") ;; $^D
- ("\\$[A-Za-z][A-Za-z_0-9]+") ;; $foobar
- ("[A-Za-z_][A-Za-z_0-9]+")) ;; dbmopen
- nil
- nil
- (("\\$[A-Za-z]*" nil nil (("^\\$[A-Za-z]+$"))) ;; $variable
- ("[A-Za-z_][A-Za-z_0-9]*" nil nil
- (("^[A-Za-z_][A-Za-z_0-9]*$"))))) ;; function
-
- ("Simula" (("simula" "Index")) nil t)
- ("Ifi Simula" . "Simula")
- ("SIMULA" . "Simula")
-
- ("Texinfo"
- (("texinfo" "Command and Variable Index"))
- (("@\\([A-Za-z]+\\)" 1))
- nil
- nil
- (("@\\([A-Za-z]*\\)" 1)))
-
- )
- "Assoc list between `mode-name' and Texinfo files.
-The variable should be initialized with a list of elements with the
-following form:
-
-\(mode-name (word-help-info-files) (word-help-keyword-regexps)
- word-help-ignore-case word-help-index-mapper
- word-help-complete-list)
-
-where `word-help-info-files', `word-help-keyword-regexps' and so
-forth of course are the values which should be put in these variables
-for this mode. Note that `mode-name' doesn't have to be a legal
-mode-name; the user may use the call `set-help-file', where
-`mode-name' will be used in the `completing-read'.
-
-Example entry (for C):
-
-\(\"C\" ((\"libc\" \"Type Index\" \"Function Index\" \"Variable Index\"))
- ((\"[A-Za-z_][A-Za-z0-9]+\")))
-
-The two first variables must be initialized; the two remaining will
-get default values if you omit them or set them to nil. The default
-values are:
-
-word-help-keyword-regexps: (\"[A-Za-z_][A-Za-z0-9]+\")
-word-help-ignore-case: nil
-
-More settings may be defined in the future.
-
-You may also define aliases, if there are several relevant mode-names
-to a single entry. These should be of the form:
-
-\(MODE-NAME-ALIAS . MODE-NAME-REAL)
-
-For C++, you would use the alias
-
-\(\"C++\" . \"C\")
-
-to make C++ mode use the same help files as C files do. Please note
-that you can shoot yourself in the foot with this possibility, by
-defining recursive aliases.")
-
-;;; --- end of advanced user options
-
-(defvar word-help-ignore-case nil
- "Non-nil means that case is ignored when doing lookup.")
-(make-variable-buffer-local 'word-help-ignore-case)
-
-(defvar word-help-info-files nil
- "List of info files with respective nodes, for the current mode.
-
-This should be a list of the following form:
-
-\((INFO-FILE-1 NODE-NAME-1 NODE-NAME-2 ...)
- (INFO-FILE-1 NODE-NAME-1 NODE-NAME-2 ...)
- : : :
- (INFO-FILE-1 NODE-NAME-1 NODE-NAME-2 ...))
-
-An example entry for e.g. C would be:
-
-\((\"/local/share/gnu/info/libc\" \"Function Index\" \"Type Index\"
- \"Variable Index\"))
-
-The files and nodes will be searched/cached in the order specified.
-This variable is usually set by the `word-help-switch-help-file'
-function, which utilizes the `word-help-mode-alist'.")
-(make-variable-buffer-local 'word-help-info-files)
-
-(defvar word-help-keyword-regexps nil
- "Regexps for finding keywords in the current mode.
-
-This is constructed as a list of the following form:
-
-\((REGEXP SUBMATCH-LOOKUP SUBMATCH-CURSOR)
- (REGEXP SUBMATCH-LOOKUP SUBMATCH-CURSOR)
- : : :
- (REGEXP SUBMATCH-LOOKUP SUBMATCH-CURSOR))
-
-The regexps will be searched in order for a match which the cursor is
-within.
-
-submatch-lookup is the submatch number which will be looked for in the
-index. May be omitted; defaults to 0 (e.g. the entire pattern). This is
-useful in for instance configure lookup; each command is there prefixed
-with 'AC_', which must be ignored when doing a lookup. Example regexp
-entry for this:
-
-\(\"AC_\\\\([A-Za-z0-9]+\\\\)\" 1)
-
-submatch-cursor is the part of the match which the cursor must be within.
-May be omitted; defaults to 0 (e.g. the entire pattern).")
-(make-variable-buffer-local 'word-help-keyword-regexps)
-(set-default 'word-help-keyword-regexps '(("[A-Za-z_][A-Za-z_0-9]*")))
-
-(defvar word-help-index-mapper nil
- "Regexps to use for massaging index-entries into keywords.
-This variable should contain a list of regexps with sub-expressions,
-where we will only look for the sub-expression in the user text.
-
-The regexp list should be formatted as:
-
- ((REGEXP SUBEXP) (REGEXP SUBEXP) ... )
-
-If the index entry does not match any of the regexps, it will be ignored.
-
-Example:
-
-Perl has index entries of the following form:
-
-* abs VALUE: perlfunc.
-* accept NEWSOCKET,GENERICSOCKET: perlfunc.
-* alarm SECONDS: perlfunc.
-* atan2 Y,X: perlfunc.
-* bind SOCKET,NAME: perlfunc.
- : : :
-
-We will thus try to extract the first word in the index entry -
-\"abs\" from \"abs VALUE\", etc. This is done by the following entry:
-
-\((\"^\\\\([^ \\t\\n]+\\\\)\" 1))
-
-This value is btw. the default one, and works with most Texinfo files")
-(make-variable-buffer-local 'word-help-index-mapper)
-(set-default 'word-help-index-mapper '(("^\\([^ \t\n]+\\)" 1)))
-
-
-(defvar word-help-complete-list nil
- "Regexps or function to use for completion of symbols.
-The list should have the following format:
-
- ((REGEXP SUBMATCH TEXT-APPEND (RE-FILTER-1 REG-FILTER-2 ...)
- : : : : :
- (REGEXP SUBMATCH TEXT-APPEND (RE-FILTER-1 REG-FILTER-2 ...))
-
-The two first entries are similar to `word-help-keyword-regexps',
-REGEXP is a regular expression which should match any relevant
-expression, and where SUBMATCH should be used for look up. By
-specifying non-nil REGEXP-FILTERs, we'll only include entries in the
-index which matches the regexp specified.
-
-If the contents of this variable is a symbol of a function, this
-function will be called instead. This is useful for modes providing
-a more intelligent function (like `lisp-complete-symbol' in Emacs Lisp mode).
-
-If you would like to use another function instead, you may.
-
-Non-nil TEXT-APPEND means that this text will be inserted after the
-completion, if we manage to do make a completion.")
-(make-variable-buffer-local 'word-help-complete-list)
-(set-default 'word-help-complete-list '(("[A-Za-z_][A-Za-z_0-9]*")))
-
-;;; Work variables
-
-
-(defvar word-help-main-index nil
- "List of all index entries.
-
-See `word-help-process-indexes' for structure formatting.
-
-Minor note: This variable is a list if it is initialized, t if
-initializing failed and nil if uninitialized.")
-(make-variable-buffer-local 'word-help-main-index)
-
-(defvar word-help-complete-index nil
- "List of regexps for completion, with matching index entries.
-Value is nil if uninitialized, t if initialized but not accessible,
-a list if we're feeling ok.")
-(make-variable-buffer-local 'word-help-complete-index)
-
-(defvar word-help-main-obarray nil
- "Global work variable for `word-help' system.
-Do Not mess with this!")
-
-(defvar word-help-history nil
- "History for `word-help' minibuffer queries.")
-(make-local-variable 'word-help-history)
-
-(defvar word-help-current-help-file nil
- "Current help file active for this mode.")
-
-(defvar word-help-index-alist nil
- "An assoc list mapping help files to info indexes.
-This means that `word-help-mode-index' can be init'ed faster.")
-
-(defvar word-help-help-mode nil
- "Which mode the help system is bound to for the current mode.")
-(make-variable-buffer-local 'word-help-help-mode)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;; User Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Debugging
-
-;;;###autoload
-(defun reset-word-help ()
- "Clear all cached indexes in the `word-help' system.
-You should only need this when installing new info files, and/or
-adding more Texinfo files to the `word-help' system."
- (interactive)
- (setq word-help-index-alist nil
- word-help-main-index nil
- word-help-info-files nil
- word-help-complete-index nil))
-
-
-;;; Changing help file
-
-;;;###autoload
-(defun set-word-help-file ()
- "Change which set of Texinfo files used for word-help.
-
-`word-help' maintains a list over which Texinfo files which are
-relevant for each programming language (`word-help-mode-alist'). It
-usually selects the correct one, based upon the value of `mode-name'.
-If this guess is incorrect, you may also use this function manually to
-instruct future `word-help' calls which Texinfo files to use."
- (interactive)
- (let (helpfile helpguess (completion-ignore-case t))
-;; Try to make a guess
- (setq helpguess (cond
- (word-help-current-help-file)
- ((word-help-guess-help-file))))
-;; Ask the user
- (setq helpfile (completing-read
- (if helpguess
- (format "Select help mode (default %s): " helpguess)
- "Select help mode: ")
- word-help-mode-alist
- nil t nil nil))
- (if (equal "" helpfile)
- (setq helpfile helpguess))
- (if helpfile
- (word-help-switch-help-file helpfile))))
-
-;;; Main user interface
-
-;;;###autoload
-(defun word-help ()
- "Find documentation on the keyword under the cursor.
-The determination of which language the keyword belongs to, is based upon
-The relevant info file is selected by matching `mode-name' (the major
-mode) against the assoc list `word-help-mode-alist'.
-
-If this is not possible, `set-help-file' will be invoked for selecting
-the relevant info file. `set-help-file' may also be invoked
-interactively by the user.
-
-If the keyword you are looking at is not available in any index, no
-default suggestion will be presented. "
- (interactive)
- (let (myguess guess index-info
- (completion-ignore-case word-help-ignore-case))
-;; Set necessary variables for later lookup
- (word-help-find-help-file)
-;; Have we previously cached datas?
- (word-help-process-indexes)
- (if
- (atom word-help-main-index)
- (message "No help file available for this mode.")
-;; First make a guess at what the user is looking for
- (setq myguess (word-help-guess
- (point)
- (cond
- ((not (atom word-help-main-index))
- (car word-help-main-index)))
- word-help-keyword-regexps))
-;; Ask the user himself
- (setq guess (completing-read
- ; Format string
- (if myguess
- (format "Look up keyword (default %s): " myguess)
- "Look up keyword: ")
- ; Collection
- (car word-help-main-index)
- nil t nil 'word-help-history))
- (if (equal guess "")
- (setq guess myguess))
-;; If we've got anything meaningful to lookup, do so
- (if (not guess)
- (message "Help aborted.")
- (setq index-info (word-help-find-index-node
- guess
- word-help-main-index))
- (if (not index-info)
- (message "Oops, I could not find \"%s\" anyway! Bug?" guess)
- (word-help-goto-index-node (nconc index-info (list guess))))))))
-
-;;;###autoload
-(defun word-help-complete ()
- "Perform completion on the symbol preceding the point.
-The determination of which language the keyword belongs to, is based upon
-The relevant info file is selected by matching `mode-name' (the major
-mode) against the assoc list `word-help-mode-alist'.
-
-If this is not possible, `set-help-file' will be invoked for selecting
-the relevant info file. `set-help-file' may also be invoked
-interactively by the user.
-
-The keywords are extracted from the index of the info file defined for
-this mode, by using the `word-help-complete-list' variable."
- (interactive)
- (word-help-make-complete)
- (cond
- ((not word-help-complete-index)
- (message "No completion available for this mode."))
- ((symbolp word-help-complete-index)
- (call-interactively word-help-complete-index))
- ((listp word-help-complete-index)
- (let ((all-match (word-help-guess-all (point)
- word-help-complete-index t))
- (completion-ignore-case word-help-ignore-case)
- (c-list word-help-complete-index)
- c-entry word-match completion completed)
-;; Loop over and try to find a match
- (while (and all-match (not completed))
- (setq word-match (car all-match)
- c-entry (car c-list)
- c-list (cdr c-list)
- all-match (cdr all-match))
-;; Check whether the current pattern matched
- (if word-match
- (let ((close (nth 3 c-entry))
- (words (nth 4 c-entry)))
-;; Find the maximum completion for this word
-; (print word-match)
-; (print c-entry)
-; (print close)
- (setq completion (try-completion word-match words))
-;; Was the match exact
- (cond ((eq completion t)
- (and close
- (not (looking-at (regexp-quote close)))
- (insert close))
- (setq completed t))
-;; Silently ignore non-matches
- ((not completion))
-;; May we complete more unambiguously
- ((not (string-equal completion word-match))
- (delete-region (- (point) (length word-match))
- (point))
- (insert completion)
- (if (eq t (try-completion completion words))
- (progn
- (and close
- (not (looking-at (regexp-quote close)))
- (insert close))))
- (setq completed t))
- (t
- (message "Making completion list...")
- (let ((list (all-completions word-match words nil)))
- (setq completed list)
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list list)))
- (message "Making completion list...done"))))))
- (if (not completed) (message "No match."))))
- (t (message "No completion available for this mode."))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;; Index mapping ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defun word-help-map-index-entries (str re-list)
- "Transform an Info index entry into a programming keyword.
-Uses this by mapping the entries through `word-help-index-mapper'."
- (let ((regexp (car (car re-list)))
- (subexp (car (cdr (car re-list))))
- (next (cdr re-list)))
- (cond
- ((string-match regexp str)
- (substring str (match-beginning subexp) (match-end subexp)))
- (next
- (word-help-map-index-entries str next)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;; Switch mode files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Mode lookup
-
-(defun word-help-guess-help-file ()
- "Guesses a relevant help file based on mode name.
-Returns nil if no guess could be made. Uses `word-help-mode-alist'."
- (let (guess)
- (cond
- ((setq guess (assoc mode-name word-help-mode-alist))
- (car guess)))))
-
-
-(defun word-help-switch-help-file (helpfile)
- "Changes the help-file to the mode name given.
-Uses `word-help-mode-alist'."
- (if helpfile
- (let (helpdesc)
- (if (not (setq helpdesc (assoc helpfile word-help-mode-alist)))
- (message "No help defined for \"%s\"." helpfile)
- (if (stringp (cdr helpdesc))
- (word-help-switch-help-file (cdr helpdesc))
- (word-help-make-default-map
- helpdesc
- (list 'word-help-help-mode
- 'word-help-info-files
- 'word-help-keyword-regexps
- 'word-help-ignore-case
- 'word-help-index-mapper
- 'word-help-complete-list))))
- (setq word-help-main-index nil
- word-help-complete-index nil))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;; Index collection ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defun word-help-extract-index (file-name index-list index-map ignore-case)
- "Extract index from filename and the first node name in index list.
-`file-name' is the name of the info file, while `index-list' is a list
-of node-names to search."
- (let (cmd1 cmdlow nodename ob-array next (case-fold-search word-help-ignore-case))
- (setq nodename (car index-list))
- (setq ob-array (make-vector 211 0))
- (message "Processing \"%s\" in %s..." nodename file-name)
- (save-window-excursion
- (Info-goto-node (concat "(" file-name ")" nodename))
- (end-of-buffer)
- (while (re-search-backward "\\* \\([^\n:]+\\):" nil t)
- (setq cmd1 (buffer-substring (match-beginning 1) (match-end 1)))
- (setq cmdlow (if ignore-case (downcase cmd1) cmd1))
- (if index-map
- (setq cmdlow (word-help-map-index-entries cmdlow
- index-map)))
-;; We have to do this workaround to support case-insensitive matching
- (cond
- (cmdlow
- (put (intern cmdlow ob-array) 'word-help-real-name cmd1)
- (intern cmdlow word-help-main-obarray)))))
- (setq next (cond
- ((cdr index-list)
- (word-help-extract-index file-name (cdr index-list)
- index-map ignore-case))))
- (nconc (list (list nodename ob-array)) next)))
-
-
-(defun word-help-collect-indexes (info-file)
- "Process all the indexes in an info file.
-
-Uses `word-help-extract-index' on each node, and returns an entry
-suitable for merging into `word-help-process-indexes'. `info-file'
-is an entry of the form
-
-\(FILE-NAME INDEX-NAME-1 INDEX-NAME-2 ...)"
- (let ((file (car info-file))
- (nodes (cdr info-file)))
- (nconc (list file) (word-help-extract-index file nodes
- word-help-index-mapper
- word-help-ignore-case))))
-
-(defun word-help-process-indexes ()
- "Process all the entries in the global variable `word-help-info-files'.
-Returns a list formatted as follows:
-
-\(all-entries-ob
- (file-name-1 (node-name-1 this-node-entries-ob)
- (node-name-2 this-node-entries-ob)
- : : :
- (node-name-n this-node-entries-ob))
- (file-name-2 (node-name-1 this-node-entries-ob)
- (node-name-2 this-node-entries-ob)
- : : :
- (node-name-n this-node-entries-ob))
- : : : : : : : : :
- (file-name-n (node-name-1 this-node-entries-ob)
- (node-name-2 this-node-entries-ob)
- : : :
- (node-name-n this-node-entries-ob)))
-
-The symbols in the obarrays may contain the additional property
-`word-help-real-name', which tells the *real* node to go to.
-
-Note that we use `word-help-index-alist' to speed up the process. Note
-that `word-help-switch-help-file' must have been called before this function.
-
-This structure is then later searched by `word-help-find-index-node'."
- (let (index-words old-index)
- (if (not word-help-main-index)
- (cond
- ((setq old-index
- (assoc word-help-help-mode word-help-index-alist))
- (setq word-help-main-index (nth 1 old-index)))
- (word-help-info-files
- (setq word-help-main-obarray (make-vector 307 0)
- index-words (mapcar 'word-help-collect-indexes
- word-help-info-files)
- word-help-main-index
- (append (list word-help-main-obarray) index-words))
- (setq word-help-index-alist (cons (list word-help-help-mode
- word-help-main-index)
- word-help-index-alist)))
- (t (setq word-help-main-index t))))))
-
-(defun word-help-find-help-file ()
- "Tries to find and set a relevant help file for the current mode."
- (let (helpguess)
- (if (not word-help-info-files)
- (if (setq helpguess (word-help-guess-help-file))
- (word-help-switch-help-file helpguess)
- (set-help-file)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;; Keyword guess ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun word-help-guess-all (cur-point re-list
- &optional copy-to-point)
- "Guesses *all* keywords the user possibly may be looking at.
-Returns a list of all possible keywords. "
- (let ((regexp (car (car re-list)))
- (submatch (cond ((nth 1 (car re-list))) (0)))
- (cursmatch (cond ((nth 2 (car re-list))) (0)))
- (guess nil)
- (next-guess nil)
- (case-fold-search word-help-ignore-case)
- (end-point nil))
- (save-excursion
- (end-of-line)
- (setq end-point (point))
- ;; Start at the beginning
- (beginning-of-line)
- (while (and (not guess) (re-search-forward regexp end-point t))
- ;; Look whether the cursor is within the match
- (if (and (<= (match-beginning cursmatch) cur-point)
- (>= (match-end cursmatch) cur-point))
- (if (or (not copy-to-point) (<= cur-point (match-end submatch)))
- (setq guess (buffer-substring (match-beginning submatch)
- (if copy-to-point
- cur-point
- (match-end submatch)))))))
- ;; If we found anything, return it and call ourselves again
- (if (cdr re-list)
- (setq next-guess (word-help-guess-all cur-point (cdr re-list)
- copy-to-point))))
- (cons guess next-guess)))
-
-(defun word-help-guess-match (all-match cmd-array)
- (let ((sym (car all-match)))
- (cond
- ((and sym (intern-soft (if word-help-ignore-case
- (downcase sym)
- sym) cmd-array)
- sym))
- ((cdr all-match)
- (word-help-guess-match (cdr all-match) cmd-array)))))
-
-
-(defun word-help-guess (cur-point cmd-array re-list)
- "Guesses what keyword the user is looking at, and returns that.
-CUR-POINT should be the current value of `point', CMD-ARRAY an obarray
-of all the keywords which are defined for the current mode, and
-RE-LIST a list of regexps use for the hunt. See also
-`word-help-keyword-regexps'."
- (let ((all-matches (word-help-guess-all cur-point re-list)))
-; (print all-matches)
- (word-help-guess-match all-matches cmd-array)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;; Show node for keyword ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Find an index entry
-
-(defun word-help-find-index-node (node index-reg)
- "Finds the node named `node' in the index-register `index-reg'.
-`index-reg' has the format as returned (and documented) by the
-`word-help-process-indexes' call. In most cases, this will be equal to
-`word-help-main-index'.
-
-Returns a list with format
- (file-name index-node-name index-entry)
-which contains the file and index where the entry can be found.
-Returns nil if the entry can't be found."
- (let (file-info node-name)
- (setq node-name (cond (word-help-ignore-case (downcase node)) (node)))
- (if (intern-soft node-name (car index-reg))
- (setq file-info (word-help-index-search-file node-name
- (cdr index-reg))))
- file-info))
-
-(defun word-help-index-search-file (entry file-data)
- "Searches a cached file for the index-entry `entry'."
- (let (this-file next-files file-name node node-infos)
- (setq this-file (car file-data)
- next-files (cdr file-data)
- file-name (car this-file)
- node-infos (cdr this-file)
- node (word-help-index-search-nodes entry node-infos))
- (cond
- (node
- (cons file-name node))
- (next-files (word-help-index-search-file entry next-files)))))
-
-(defun word-help-index-search-nodes (entry node-info)
- "Searches a cached list of nodes for the entry `entry'."
- (let (this-node next-nodes node-name node-ob node-sym)
- (setq this-node (car node-info)
- next-nodes (cdr node-info)
- node-name (car this-node)
- node-ob (car (cdr this-node))
- node-sym (intern-soft entry node-ob))
- (cond
- (node-sym
- (list node-name (get node-sym 'word-help-real-name)))
- (next-nodes (word-help-index-search-nodes entry next-nodes)))))
-
-;;; Switch to a node in an index
-
-(defun word-help-goto-index-node (index-info)
- "Jumps to an index node.
-`index-info' should be a list with the following format:
-
-\(FILE-NAME INDEX-NODE-NAME INDEX-ENTRY KEYWORD)"
-
- (let* ((file-name (car index-info))
- (node-name (nth 1 index-info))
- (entry-name (nth 2 index-info))
- (kw-name (nth 3 index-info))
- (buffer (current-buffer)))
- (if word-help-split-window
- (pop-to-buffer nil))
- (Info-goto-node (concat "(" file-name ")" node-name))
- (Info-menu entry-name)
-;; Do magic keyword search
- (if word-help-magic-index
- (let (end-point regs this-re found entry-re)
- (setq entry-re (regexp-quote kw-name)
- regs (list (concat
- (if (string-match "^[A-Za-z]" entry-name)
- "\\<" "")
- entry-re
- (if (string-match "[A-Za-z]$" entry-name)
- "\\>" ""))
- (concat "[`\"\(]" entry-re)
- (concat "^" entry-re
- (if (string-match "[A-Za-z]$" entry-name)
- "\\>" ""))))
- (end-of-line)
- (setq end-point (point))
- (beginning-of-line)
- (if (not (re-search-forward (car regs) end-point t))
- (while (and (not found) (car regs))
- (setq this-re (car regs)
- regs (cdr regs)
- found (re-search-forward this-re nil t))))
- (recenter 0)))
- (if word-help-split-window
- (pop-to-buffer buffer))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Completion ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
-(defun word-help-extract-matches (from-ob dest-ob re-list)
- "Takes atoms from from-ob, and puts them in dest-ob if they match re-list."
- (let ((regexp (car (car re-list))))
- (mapatoms (lambda (x)
- (if (or (not regexp) (string-match regexp (symbol-name x)))
- (intern (symbol-name x) dest-ob)))
- from-ob)
- (if (cdr re-list)
- (word-help-extract-matches from-ob dest-ob (cdr re-list))))
- dest-ob)
-
-(defun word-help-make-complete ()
- "Generates the `word-help-complete-index'."
- (if word-help-complete-index
- nil
- (word-help-find-help-file)
- (cond
- ((symbolp word-help-complete-list)
- (setq word-help-complete-index word-help-complete-list))
- (t
- (word-help-process-indexes)
- (if (not (atom word-help-main-index))
- (let ((from-ob (car word-help-main-index)))
- (message "Processing keywords...")
- (setq word-help-complete-index
- (mapcar
- (lambda (cmpl)
- (let
- ((regexp (car cmpl))
- (subm (cond ((nth 1 cmpl)) (0)))
- (app (cond ((nth 2 cmpl)) ("")))
- (re-list (cond ((nth 3 cmpl)) ('((".")))))
- (obarr (make-vector 47 0)))
- (list regexp subm subm app
- (word-help-extract-matches from-ob obarr
- re-list))))
- word-help-complete-list))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Misc. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;; Default mapping
-
-(defun word-help-make-default-map (list vars)
- "Makes a default mapping for `vars', which must be listed in order.
-vars is a list of quoted symbols. If the nth entry in the list is
-non-nil, the nth variable will be given this value. If nil, the var
-will be given the global default value."
- (set (car vars) (cond ((car list)) ((default-value (car vars)))))
- (if (cdr vars)
- (word-help-make-default-map (cdr list) (cdr vars))))
-
-(provide 'word-help)
-
-;;; word-help.el ends here
+++ /dev/null
-@c -*-texinfo-*-
-@setfilename ../info/locals
-@node Standard Buffer-Local Variables, Standard Keymaps, Standard Errors, Top
-@appendix Standard Buffer-Local Variables
-
- The table below shows all of the variables that are automatically
-local (when set) in each buffer in Emacs Version 18 with the common
-packages loaded.
-
-@table @code
-@item abbrev-mode
-@xref{Abbrevs}.
-
-@item auto-fill-function
-@xref{Auto Filling}.
-
-@item buffer-auto-save-file-name
-@xref{Auto-Saving}.
-
-@item buffer-backed-up
-@xref{Backup Files}.
-
-@item buffer-display-table
-@xref{Active Display Table}.
-
-@item buffer-file-name
-@xref{Buffer File Name}.
-
-@item buffer-file-truename
-@xref{Buffer File Name}.
-
-@item buffer-read-only
-@xref{Read Only Buffers}.
-
-@item buffer-saved-size
-@xref{Point}.
-
-@item case-fold-search
-@xref{Searching and Case}.
-
-@item ctl-arrow
-@xref{Control Char Display}.
-
-@item default-directory
-@xref{System Environment}.
-
-@item fill-column
-@xref{Auto Filling}.
-
-@item left-margin
-@xref{Indentation}.
-
-@item list-buffers-directory
-@xref{Buffer File Name}.
-
-@item local-abbrev-table
-@xref{Abbrevs}.
-
-@item major-mode
-@xref{Mode Help}.
-
-@item mark-ring
-@xref{The Mark}.
-
-@item minor-modes
-@xref{Minor Modes}.
-
-@item mode-name
-@xref{Mode Line Variables}.
-
-@item overwrite-mode
-@xref{Insertion}.
-
-@item paragraph-separate
-@xref{Standard Regexps}.
-
-@item paragraph-start
-@xref{Standard Regexps}.
-
-@item require-final-newline
-@xref{Insertion}.
-
-@item selective-display
-@xref{Selective Display}.
-
-@item selective-display-ellipses
-@xref{Selective Display}.
-
-@item tab-width
-@xref{Control Char Display}.
-
-@item truncate-lines
-@xref{Truncation}.
-@end table
-2001-01-28 Andrew Choi <akochoi@i-cable.com>
-
- * src/macterm.c (mac_font_pattern_match): Allocate three more
- bytes to regex for '^', '$', and '\0'.
-
- * src/macterm.c (x_list_fonts): Protect pattern and newlist from
- garbage collection.
-
- * src/macfns.c (QCconversion): Replaces QCalgorithm.
-
- * src/macfns.c (image_ascent, lookup_image): Adapt to change of
- image margins.
-
- * src/macterm.c (x_produce_image_glyph, x_draw_image_foreground)
- (x_draw_image_relief, x_draw_image_foreground_1)
- (x_draw_image_glyph_string): Adapt to change of image margins.
-
- * src/macterm.c (mac_to_x_fontname): Change charset name of
- Simplify Chinese fonts from gb2312 to gb2312.1980 and Korean fonts
- from ksc5601 to ksc5601.1989.
-
2000-12-12 Andrew Choi <akochoi@i-cable.com>
* cw5-mcp.xml: add md5.c to project.
extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
extern Lisp_Object QCdata;
Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
-Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
+Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
Lisp_Object QCindex;
/* Other symbols. */
struct image *img;
struct face *face;
{
- int height = img->height + img->vmargin;
+ int height = img->height + img->margin;
int ascent;
if (img->ascent == CENTERED_IMAGE_ASCENT)
{
/* Handle image type independent image attributes
`:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
- Lisp_Object ascent, margin, relief;
+ Lisp_Object ascent, margin, relief, algorithm, heuristic_mask;
+ Lisp_Object file;
ascent = image_spec_value (spec, QCascent, NULL);
if (INTEGERP (ascent))
margin = image_spec_value (spec, QCmargin, NULL);
if (INTEGERP (margin) && XINT (margin) >= 0)
- img->vmargin = img->hmargin = XFASTINT (margin);
- else if (CONSP (margin) && INTEGERP (XCAR (margin))
- && INTEGERP (XCDR (margin)))
- {
- if (XINT (XCAR (margin)) > 0)
- img->hmargin = XFASTINT (XCAR (margin));
- if (XINT (XCDR (margin)) > 0)
- img->vmargin = XFASTINT (XCDR (margin));
- }
+ img->margin = XFASTINT (margin);
relief = image_spec_value (spec, QCrelief, NULL);
if (INTEGERP (relief))
{
img->relief = XINT (relief);
- img->hmargin += abs (img->relief);
- img->vmargin += abs (img->relief);
+ img->margin += abs (img->relief);
}
+
+ /* Should we apply a Laplace edge-detection algorithm? */
+ algorithm = image_spec_value (spec, QCalgorithm, NULL);
+ if (img->pixmap && EQ (algorithm, Qlaplace))
+ x_laplace (f, img);
+
+ /* Should we built a mask heuristically? */
+ heuristic_mask = image_spec_value (spec, QCheuristic_mask, NULL);
+ if (img->pixmap && !img->mask && !NILP (heuristic_mask))
+ x_build_heuristic_mask (f, img, heuristic_mask);
}
}
staticpro (&Qxbm);
QCtype = intern (":type");
staticpro (&QCtype);
- QCconversion = intern (":conversion");
- staticpro (&QCconversion);
+ QCalgorithm = intern (":algorithm");
+ staticpro (&QCalgorithm);
QCheuristic_mask = intern (":heuristic-mask");
staticpro (&QCheuristic_mask);
QCcolor_symbols = intern (":color-symbols");
prepare_image_for_display (it->f, img);
it->ascent = it->phys_ascent = image_ascent (img, face);
- it->descent = it->phys_descent = img->height + 2 * img->vmargin - it->ascent;
- it->pixel_width = img->width + 2 * img->hmargin;
+ it->descent = it->phys_descent = img->height + 2 * img->margin - it->ascent;
+ it->pixel_width = img->width + 2 * img->margin;
it->nglyphs = 1;
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
+ if (s->img->margin)
+ {
+ x += s->img->margin;
+ y += s->img->margin;
+ }
if (s->img->pixmap)
{
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
+ if (s->img->margin)
+ {
+ x += s->img->margin;
+ y += s->img->margin;
+ }
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
/* If there is a margin around the image, adjust x- and y-position
by that margin. */
- x += s->img->hmargin;
- y += s->img->vmargin;
+ if (s->img->margin)
+ {
+ x += s->img->margin;
+ y += s->img->margin;
+ }
if (s->img->pixmap)
{
| s->face->box
|
| +-------------------------
- | | s->img->vmargin
+ | | s->img->margin
| |
| | +-------------------
| | | the image
{
int x, y;
int box_line_width = s->face->box_line_width;
+ int margin = s->img->margin;
int height;
Pixmap pixmap = 0;
flickering. */
s->stippled_p = s->face->stipple != 0;
if (height > s->img->height
- || s->img->vmargin
- || s->img->hmargin
+ || margin
#if 0 /* MAC_TODO: image mask */
|| s->img->mask
#endif
char * fontname;
char * pattern;
{
- char *regex = (char *) alloca (strlen (pattern) * 2 + 3);
+ char *regex = (char *) alloca (strlen (pattern) * 2);
char *font_name_copy = (char *) alloca (strlen (fontname) + 1);
char *ptr;
strcpy(cs, "big5-0");
break;
case smSimpChinese:
- strcpy(cs, "gb2312.1980-0");
+ strcpy(cs, "gb2312-0");
break;
case smJapanese:
strcpy(cs, "jisx0208.1983-sjis");
break;
case smKorean:
- strcpy(cs, "ksc5601.1989-0");
+ strcpy(cs, "ksc5601-0");
break;
default:
strcpy(cs, "mac-roman");
foundry, family, weight, slant, cs) != 5)
return;
- if (strcmp (cs, "big5-0") == 0 || strcmp (cs, "gb2312.1980-0") == 0
+ if (strcmp (cs, "big5-0") == 0 || strcmp (cs, "gb2312-0") == 0
|| strcmp (cs, "jisx0208.1983-sjis") == 0
- || strcmp (cs, "ksc5601.1989-0") == 0 || strcmp (cs, "mac-roman") == 0)
+ || strcmp (cs, "ksc5601-0") == 0 || strcmp (cs, "mac-roman") == 0)
strcpy(mf, family);
else
sprintf(mf, "%s-%s-%s", foundry, family, cs);
Lisp_Object newlist = Qnil;
int n_fonts = 0;
int i;
- struct gcpro gcpro1, gcpro2;
if (font_name_table == NULL) /* Initialize when first used. */
init_font_name_table ();
ptnstr = XSTRING (pattern)->data;
- GCPRO2 (pattern, newlist);
-
/* Scan and matching bitmap fonts. */
for (i = 0; i < font_name_count; i++)
{
/* MAC_TODO: add code for matching outline fonts here */
- UNGCPRO;
-
return newlist;
}
# Created: 1993-05-16
# Public domain
-# $Id: mkinstalldirs,v 1.1 2001/02/02 13:04:53 gerd Exp $
+# $Id: mkinstalldirs,v 1.11 1998/05/19 07:05:25 drepper dead $
errstatus=0
if test ! -d "$pathcomp"; then
echo "mkdir $pathcomp" 1>&2
- (mkdir "$pathcomp" && chmod a+rx "$pathcomp") || lasterr=$?
+ mkdir "$pathcomp" || lasterr=$?
if test ! -d "$pathcomp"; then
errstatus=$lasterr
all install:
# Avoid error when these targets are used.
-clean extraclean distclean mostlyclean maintainer-clean::
+clean distclean mostlyclean maintainer-clean:
-2001-02-05 Andrew Innes <andrewi@gnu.org>\r
-\r
- * nmake.defs (THISDIR): New definition.\r
-\r
- * gmake.defs (THISDIR): New definition.\r
-\r
-2001-02-03 Andrew Innes <andrewi@gnu.org>\r
-\r
- * configure.bat: Leave a space before >> only when there is a\r
- preceding digit. Add a comment about the importance of this.\r
-\r
- * README: Replace outdated information.\r
-\r
- * INSTALL (Trouble-shooting): Add note about need to specify extra\r
- compiler flags with recent Cygwin ports of gcc.\r
-\r
-2001-02-01 Eli Zaretskii <eliz@is.elta.co.il>\r
-\r
- * configure.bat: Use "rm -f" instead of "del /f", as the latter\r
- is not supported by Windows 9X's COMMAND.COM.\r
-\r
-2001-01-31 Eli Zaretskii <eliz@is.elta.co.il>\r
-\r
- * configure.bat: Make sure redirection is preceeded by a blank, to\r
- avoid problems with "1>>foo" when CMD.EXE is the shell, which eats\r
- up the "1" part. From Rob Giardina <rob@criticalpointsoftware.com>.\r
-\r
-2001-01-30 Eli Zaretskii <eliz@is.elta.co.il>\r
-\r
- * INSTALL: Copy the table of tested combinations of development\r
- tools from confuigure.bat. Add suggestion to install Bash on\r
- Windows 9X.\r
-\r
- * configure.bat: Don't copy lisp/Makefile, it doesn't exist; copy\r
- lisp/Makefile.in instead. Use "rm -f" where more than one file\r
- needs to be deleted, since command.com in Windows 9X doesn't grok\r
- more than one argument.\r
-\r
-2001-01-24 Andrew Innes <andrewi@gnu.org>\r
-\r
- * makefile.w32-in (cleanall-other-dirs-nmake): \r
- (cleanall-other-dirs-gmake): New targets.\r
- (cleanall): Invoke them.\r
-\r
-2001-01-19 Andrew Innes <andrewi@gnu.org>\r
-\r
- * addpm.c (env_vars): Add a version-independent site-lisp\r
- directory to EMACSLOADPATH, after the version dependent one.\r
-\r
2001-01-06 Andrew Innes <andrewi@gnu.org>\r
\r
* README: Update info about compilers.\r
Building and Installing Emacs
- on Windows NT/2000 and Windows 95/98/ME
+ on Windows NT and Windows 95/98/2000
To compile Emacs, you will need either Microsoft Visual C++ 2.0 or
later, or a Windows port of GCC 2.95 or later with Mingw and W32 API
support and a port of GNU make. You can use the Cygwin ports of GCC,
but Emacs requires the Mingw headers and libraries to build.
- If you build Emacs on Windows 9X or ME, not on Windows 2000 or
- Windows NT, we suggest to install the Cygwin port of Bash.
-
Please see http://www.mingw.org for pointers to GCC/Mingw binaries.
- For reference, here is a list of which builds of GNU make are known
- to work or not, and whether they work in the presence and/or absence
- of sh.exe, the Cygwin port of Bash.
-
- sh exists no sh
-
- cygwin b20.1 make (3.75): okay[1] fails[2]
- MSVC compiled gmake 3.77: okay okay
- MSVC compiled gmake 3.78.1: okay okay
- MSVC compiled gmake 3.79.1: okay okay
- mingw32/gcc-2.92.2 make (3.77): okay okay[4]
- cygwin compiled gmake 3.77: okay[1] fails[2]
- cygwin compiled gmake 3.78.1: okay fails[2]
- cygwin compiled gmake 3.79.1: couldn't build make[3]
-
- Notes:
-
- [1] doesn't cope with makefiles with DOS line endings, so must mount
- emacs source with text!=binary.
- [2] fails when needs to invoke shell commands; okay invoking gcc etc.
- [3] requires LC_MESSAGES support to build; maybe 2.95.x update to
- cygwin provides this?
- [4] may fail on Windows 9X and Windows ME; if so, install Bash.
-
-* Configuring
+Configuring:
Configuration of Emacs is now handled by running configure.bat in the
nt subdirectory. It will detect which compiler you have available,
is running, when gcc support is being tested. These cannot be
surpressed because of limitations in the Windows 9x command.com shell.
-* Building
+Building:
After running configure, simply run the appropriate `make' program for
your compiler to build Emacs. For MSVC, this is nmake; for GCC, it is
The warnings may be fixed in the main FSF source at some point, but
until then we will just live with them.
-* Installing
+Installing:
To install Emacs after it has compiled, simply run `make install'.
The install process will run addpm to setup the registry entries, and
to create a Start menu icon for Emacs.
-* Trouble-shooting
+Trouble-shooting:
The main problems that are likely to be encountered when building
Emacs stem from using an old version of GCC, or old Mingw or W32 API
addsection.c relies on. Versions of w32api-xxx.zip from at least
1999-11-18 onwards are okay.
- If configure succeeds, but make fails, install the Cygwin port of
- Bash, even if the table above indicates that Emacs should be able to
- build without sh.exe. (Some versions of Windows shells are too dumb
- for Makefile's used by Emacs.)
-
- If you are using a recent Cygwin build of GCC, such as Cygwin version
- 1.1.8, you may need to specify some extra compiler flags like so:
-
- configure --with-gcc --cflags -mwin32 --cflags -D__MSVCRT__
-
- We will attempt to auto-detect the need for these flags in a future
- release.
-
-* Debugging
+Debugging:
You should be able to debug Emacs using the debugger that is
appropriate for the compiler you used, namely DevStudio or Windbg if
- Emacs for Windows NT/2000 and Windows 95/98/ME
+ Emacs for Windows NT and Windows 95
- This directory contains support for compiling and running GNU Emacs on
- Windows NT, Windows 95, and their successors. This port supports all
- of the major functionality of the Unix version, including
- subprocesses, windowing features (fonts, colors, scroll bars, multiple
- frames, etc.), and networking support.
+This directory contains support for compiling and running GNU Emacs on
+Windows NT and Windows 95. This port supports all of the major
+functionality of the Unix version, including subprocesses, windowing
+features (fonts, colors, scroll bars, multiple frames, etc.), and
+networking support.
- Precompiled distributions are also available; ftp to
+Precompiled distributions are also available; ftp to
- ftp://ftp.gnu.org/gnu/windows/emacs/latest/
+ ftp://ftp.cs.washington.edu/pub/ntemacs/latest
- for the latest precompiled distributions.
+for the latest precompiled distributions.
+
+* Preliminaries
+
+To compile Emacs, you will need a Microsoft C compiler package. For
+NT, this can be any of the SDK compilers from NT 3.1 and up, Microsoft
+Visual C++ for NT (versions 1.0 and up), or Microsoft Visual C++
+(versions 2.0 and up). For Windows 95, this can be Microsoft Visual
+C++ versions 2.0 and up.
* Building and installing
- See the INSTALL file in this directory for detailed instructions on
- building and installing Emacs on your system.
+See the INSTALL file in this directory for detailed instructions on
+building and installing Emacs on your system.
* Further information
- There is a web page that serves as a FAQ at:
-
- http://www.gnu.org/software/emacs/windows/ntemacs.html
+If you have access to the World Wide Web, I would recommend pointing
+your favorite web browser to the document (if you haven't already):
- There is also a mailing list for discussing issues related to this
- port of Emacs. For information about the list, send a message to
- ntemacs-users-request@cs.washington.edu with the word "info" in the
- *body* of the message. To subscribe to the list, send a message to
- the same address with the word "subscribe" in the body of the message;
- similarly, to unsubscribe from the list, send a message with the word
- "unsubscribe" in the message body.
+ http://www.cs.washington.edu/homes/voelker/ntemacs.html
- Another valuable source of information and help which should not be
- overlooked is the various Usenet news groups dedicated to Emacs.
- These are particuarly good for help with general issues which aren't
- specific to the Windows port of Emacs. The main news groups to use
- for seeking help are:
+This web document serves as a FAQ and a source for further information
+about the port and related software packages.
- gnu.emacs.help
- comp.emacs
+There is also a mailing list for discussing issues related to this
+port of Emacs. For information about the list, send a message to
+ntemacs-users-request@cs.washington.edu with the word "info" in the
+*body* of the message. To subscribe to the list, send a message to
+the same address with the word "subscribe" in the body of the message;
+similarly, to unsubscribe from the list, send a message with the word
+"unsubscribe" in the message body.
- There are also fairly regular postings and announcements of new or
- updated Emacs packages on this group:
+You are also always welcome to send me mail directly. If you don't
+hear from me immediately, however, don't worry; it sometimes takes me
+a few days (or longer) to get to all of my mail regarding Emacs.
- gnu.emacs.sources
+* Reporting bugs
- You are also always welcome to send me mail directly. If you don't
- hear from me immediately, however, don't worry; it sometimes takes me
- a few days (or longer) to get to all of my mail regarding Emacs.
+If you encounter bugs in this port of Emacs, first check the FAQ on
+the web page above to see if the bug is already known and if there are
+any workarounds. If not, then I would like to hear about it; either
+send a bug report to the mailing list, or to me directly (I would
+recommend sending to the list first).
-* Reporting bugs
+Enjoy.
- If you encounter a bug in this port of Emacs, we would like to hear
- about it. First check the file etc/PROBLEMS and the FAQ on the web
- page above to see if the bug is already known and if there are any
- workarounds. If not, then check whether the bug has something to do
- with code in your .emacs file, e.g. by invoking Emacs with the "-q
- --no-site-file" options.
-
- If you decide that it is a bug in Emacs that might be specific to the
- Windows port, send a message to the ntemacs-users@cs.washington.edu
- mailing list describing the bug, the version of Emacs that you are
- using, and the operating system that you are running on (Windows NT,
- 95 or 98 including service pack level if known). If the bug is
- related to subprocesses, also specify which shell you are using (e.g.,
- include the values of `shell-file-name' and `shell-explicit-file-name'
- in your message).
-
- If you think the bug is not specific to the Windows port of Emacs,
- then it is better to mail the bug report to bug-gnu-emacs@gnu.org so
- that it will be seen by the right people. If Emacs has been set up to
- send mail, you can use the command M-x report-emacs-bug to create and
- send the bug report, but in some cases there is a function to report
- bugs in a specific package; e.g. M-x gnus-bug for Gnus, M-x
- c-submit-bug-report for C/C++/Java mode, etc.
+-geoff
+(voelker@cs.washington.edu)
env_vars[] =
{
{"emacs_dir", NULL},
- {"EMACSLOADPATH", "%emacs_dir%/site-lisp;%emacs_dir%/../site-lisp;%emacs_dir%/lisp;%emacs_dir%/leim"},
+ {"EMACSLOADPATH", "%emacs_dir%/site-lisp;%emacs_dir%/lisp;%emacs_dir%/leim"},
{"SHELL", "%emacs_dir%/bin/cmdproxy.exe"},
{"EMACSDATA", "%emacs_dir%/etc"},
{"EMACSPATH", "%emacs_dir%/bin"},
#ifdef emacs /* Don't do this for lib-src. */
/* Tell regex.c to use a type compatible with Emacs. */
#define RE_TRANSLATE_TYPE Lisp_Object
-#define RE_TRANSLATE(TBL, C) CHAR_TABLE_TRANSLATE (TBL, C)
+#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C)
#define RE_TRANSLATE_P(TBL) (XFASTINT (TBL) != 0)
#endif
+++ /dev/null
-/* GNU Emacs site configuration template file. -*- C -*-
- Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-
-/* No code in Emacs #includes config.h twice, but some of the code
- intended to work with other packages as well (like gmalloc.c)
- think they can include it as many times as they like. */
-#ifndef EMACS_CONFIG_H
-#define EMACS_CONFIG_H
-
-
-/* These are all defined in the top-level Makefile by configure.
- They're here only for reference. */
-
-/* Define LISP_FLOAT_TYPE if you want emacs to support floating-point
- numbers. */
-#undef LISP_FLOAT_TYPE
-
-/* Define GNU_MALLOC if you want to use the *new* GNU memory allocator. */
-#undef GNU_MALLOC
-
-/* Define REL_ALLOC if you want to use the relocating allocator for
- buffer space. */
-#undef REL_ALLOC
-
-/* Define HAVE_X_WINDOWS if you want to use the X window system. */
-#undef HAVE_X_WINDOWS
-
-/* Define HAVE_X11 if you want to use version 11 of X windows.
- Otherwise, Emacs expects to use version 10. */
-#undef HAVE_X11
-
-/* Define if using an X toolkit. */
-#undef USE_X_TOOLKIT
-
-/* Define this if you're using XFree386. */
-#undef HAVE_XFREE386
-
-/* Define HAVE_X_MENU if you want to use the X window menu system.
- This appears to work on some machines that support X
- and not on others. */
-#undef HAVE_X_MENU
-
-/* Define if we have the X11R6 or newer version of Xt. */
-#undef HAVE_X11XTR6
-
-/* Define if netdb.h declares h_errno. */
-#undef HAVE_H_ERRNO
-
-/* Nowadays we have frame objects even if we support only ASCII terminals. */
-#define MULTI_FRAME
-
-/* If we're using any sort of window system, define some consequences. */
-#ifdef HAVE_X_WINDOWS
-#define HAVE_WINDOW_SYSTEM
-#define MULTI_KBOARD
-#define HAVE_FACES
-#define HAVE_MOUSE
-#endif
-
-/* Define USE_TEXT_PROPERTIES to support visual and other properties
- on text. */
-#define USE_TEXT_PROPERTIES
-
-/* Define USER_FULL_NAME to return a string
- that is the user's full name.
- It can assume that the variable `pw'
- points to the password file entry for this user.
-
- At some sites, the pw_gecos field contains
- the user's full name. If neither this nor any other
- field contains the right thing, use pw_name,
- giving the user's login name, since that is better than nothing. */
-#define USER_FULL_NAME pw->pw_gecos
-
-/* Define AMPERSAND_FULL_NAME if you use the convention
- that & in the full name stands for the login id. */
-#undef AMPERSAND_FULL_NAME
-
-/* Things set by --with options in the configure script. */
-
-/* Define to support POP mail retrieval. */
-#undef MAIL_USE_POP
-
-/* Define to support Kerberos-authenticated POP mail retrieval. */
-#undef KERBEROS
-
-/* Define to support using a Hesiod database to find the POP server. */
-#undef HESIOD
-
-/* Some things figured out by the configure script, grouped as they are in
- configure.in. */
-#ifndef _ALL_SOURCE /* suppress warning if this is pre-defined */
-#undef _ALL_SOURCE
-#endif
-#undef HAVE_SYS_SELECT_H
-#undef HAVE_SYS_TIMEB_H
-#undef HAVE_SYS_TIME_H
-#undef HAVE_UNISTD_H
-#undef HAVE_UTIME_H
-#undef STDC_HEADERS
-#undef TIME_WITH_SYS_TIME
-
-#undef HAVE_LIBDNET
-#undef HAVE_LIBPTHREADS
-#undef HAVE_LIBRESOLV
-
-#undef HAVE_ALLOCA_H
-
-#undef HAVE_GETTIMEOFDAY
-#undef GETTIMEOFDAY_ONE_ARGUMENT
-#undef HAVE_GETHOSTNAME
-#undef HAVE_DUP2
-#undef HAVE_RENAME
-#undef HAVE_CLOSEDIR
-
-#undef TM_IN_SYS_TIME
-#undef HAVE_TM_ZONE
-#undef HAVE_TZNAME
-
-#undef const
-
-#undef HAVE_LONG_FILE_NAMES
-
-#undef CRAY_STACKSEG_END
-
-#undef UNEXEC_SRC
-
-#undef HAVE_LIBXBSD
-#undef HAVE_XRMSETDATABASE
-#undef HAVE_XSCREENRESOURCESTRING
-#undef HAVE_XSCREENNUMBEROFSCREEN
-#undef HAVE_XSETWMPROTOCOLS
-
-#undef HAVE_MKDIR
-#undef HAVE_RMDIR
-#undef HAVE_RANDOM
-#undef HAVE_LRAND48
-#undef HAVE_BCOPY
-#undef HAVE_BCMP
-#undef HAVE_LOGB
-#undef HAVE_FREXP
-#undef HAVE_FMOD
-#undef HAVE_FTIME
-#undef HAVE_RES_INIT /* For -lresolv on Suns. */
-#undef HAVE_SETSID
-#undef HAVE_FPATHCONF
-#undef HAVE_SELECT
-#undef HAVE_MKTIME
-#undef HAVE_EACCESS
-#undef HAVE_GETPAGESIZE
-#undef HAVE_INET_SOCKETS
-
-#undef HAVE_AIX_SMT_EXP
-
-/* Define if you have the ANSI `strerror' function.
- Otherwise you must have the variable `char *sys_errlist[]'. */
-#undef HAVE_STRERROR
-
-#undef HAVE_UTIMES
-
-/* Define if `sys_siglist' is declared by <signal.h>. */
-#undef SYS_SIGLIST_DECLARED
-
-/* Define if `struct utimbuf' is declared by <utime.h>. */
-#undef HAVE_STRUCT_UTIMBUF
-
-/* Define if `struct timeval' is declared by <sys/time.h>. */
-#undef HAVE_TIMEVAL
-
-/* If using GNU, then support inline function declarations. */
-#ifdef __GNUC__
-#define INLINE __inline__
-#else
-#define INLINE
-#endif
-
-#undef EMACS_CONFIGURATION
-
-#undef EMACS_CONFIG_OPTIONS
-
-/* The configuration script defines opsysfile to be the name of the
- s/SYSTEM.h file that describes the system type you are using. The file
- is chosen based on the configuration name you give.
-
- See the file ../etc/MACHINES for a list of systems and the
- configuration names to use for them.
-
- See s/template.h for documentation on writing s/SYSTEM.h files. */
-#undef config_opsysfile
-#include "s/windows95.h"
-
-/* The configuration script defines machfile to be the name of the
- m/MACHINE.h file that describes the machine you are using. The file is
- chosen based on the configuration name you give.
-
- See the file ../etc/MACHINES for a list of machines and the
- configuration names to use for them.
-
- See m/template.h for documentation on writing m/MACHINE.h files. */
-#undef config_machfile
-#include "m/intel386.h"
-
-/* These typedefs shouldn't appear when alloca.s or Makefile.in
- includes config.h. */
-#ifndef NOT_C_CODE
-#ifndef SPECIAL_EMACS_INT
-typedef long EMACS_INT;
-typedef unsigned long EMACS_UINT;
-#endif
-#endif
-
-/* Load in the conversion definitions if this system
- needs them and the source file being compiled has not
- said to inhibit this. There should be no need for you
- to alter these lines. */
-
-#ifdef SHORTNAMES
-#ifndef NO_SHORTNAMES
-#include "../shortnames/remap.h"
-#endif /* not NO_SHORTNAMES */
-#endif /* SHORTNAMES */
-
-/* If no remapping takes place, static variables cannot be dumped as
- pure, so don't worry about the `static' keyword. */
-#ifdef NO_REMAP
-#undef static
-#endif
-
-/* Define `subprocesses' should be defined if you want to
- have code for asynchronous subprocesses
- (as used in M-x compile and M-x shell).
- These do not work for some USG systems yet;
- for the ones where they work, the s/SYSTEM.h file defines this flag. */
-
-#ifndef VMS
-#ifndef USG
-/* #define subprocesses */
-#endif
-#endif
-
-/* Define LD_SWITCH_SITE to contain any special flags your loader may need. */
-#undef LD_SWITCH_SITE
-
-/* Define C_SWITCH_SITE to contain any special flags your compiler needs. */
-#undef C_SWITCH_SITE
-
-/* Define LD_SWITCH_X_SITE to contain any special flags your loader
- may need to deal with X Windows. For instance, if you've defined
- HAVE_X_WINDOWS above and your X libraries aren't in a place that
- your loader can find on its own, you might want to add "-L/..." or
- something similar. */
-#undef LD_SWITCH_X_SITE
-
-/* Define LD_SWITCH_X_SITE_AUX with an -R option
- in case it's needed (for Solaris, for example). */
-#undef LD_SWITCH_X_SITE_AUX
-
-/* Define C_SWITCH_X_SITE to contain any special flags your compiler
- may need to deal with X Windows. For instance, if you've defined
- HAVE_X_WINDOWS above and your X include files aren't in a place
- that your compiler can find on its own, you might want to add
- "-I/..." or something similar. */
-#undef C_SWITCH_X_SITE
-
-/* Define STACK_DIRECTION here, but not if m/foo.h did. */
-#ifndef STACK_DIRECTION
-#undef STACK_DIRECTION
-#endif
-
-/* Define the return type of signal handlers if the s-xxx file
- did not already do so. */
-#define RETSIGTYPE void
-
-/* SIGTYPE is the macro we actually use. */
-#ifndef SIGTYPE
-#define SIGTYPE RETSIGTYPE
-#endif
-
-#ifdef emacs /* Don't do this for lib-src. */
-/* Tell regex.c to use a type compatible with Emacs. */
-#define RE_TRANSLATE_TYPE Lisp_Object *
-#endif
-
-/* The rest of the code currently tests the CPP symbol BSTRING.
- Override any claims made by the system-description files.
- Note that on some SCO version it is possible to have bcopy and not bcmp. */
-#undef BSTRING
-#if defined (HAVE_BCOPY) && defined (HAVE_BCMP)
-#define BSTRING
-#endif
-
-/* Non-ANSI C compilers usually don't have volatile. */
-#ifndef HAVE_VOLATILE
-#ifndef __STDC__
-#define volatile
-#endif
-#endif
-
-/* Some of the files of Emacs which are intended for use with other
- programs assume that if you have a config.h file, you must declare
- the type of getenv.
-
- This declaration shouldn't appear when alloca.s or Makefile.in
- includes config.h. */
-#ifndef NOT_C_CODE
-extern char *getenv ();
-#endif
-
-#endif /* EMACS_CONFIG_H */
-
-/* These default definitions are good for almost all machines.
- The exceptions override them in m/*.h. */
-
-#ifndef BITS_PER_CHAR
-#define BITS_PER_CHAR 8
-#endif
-
-#ifndef BITS_PER_SHORT
-#define BITS_PER_SHORT 16
-#endif
-
-/* Note that lisp.h uses this in a preprocessor conditional, so it
- would not work to use sizeof. That being so, we do all of them
- without sizeof, for uniformity's sake. */
-#ifndef BITS_PER_INT
-#define BITS_PER_INT 32
-#endif
-
-#ifndef BITS_PER_LONG
-#define BITS_PER_LONG 32
-#endif
if not exist junk.o goto checkw32api\r
gcc -mno-cygwin -c junk.c\r
if exist junk.o set nocygwin=Y\r
-rm -f junk.c junk.o\r
+del junk.o junk.c\r
\r
:checkw32api\r
rem ----------------------------------------------------------------------\r
rem\r
echo Checking whether W32 API headers are too old...\r
echo #include "windows.h" >junk.c\r
-echo test(PIMAGE_NT_HEADERS pHeader) >>junk.c\r
-echo {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);} >>junk.c\r
+echo test(PIMAGE_NT_HEADERS pHeader)>>junk.c\r
+echo {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);}>>junk.c\r
gcc -c junk.c\r
if exist junk.o goto gccOk\r
\r
\r
:gccOk\r
set COMPILER=gcc\r
-rm -f junk.c junk.o\r
+del junk.c junk.o\r
echo Using 'gcc'\r
goto genmakefiles\r
\r
:clOk\r
set COMPILER=cl\r
-rm -f junk.c junk.obj\r
+del junk.c junk.obj\r
echo Using 'MSVC'\r
goto genmakefiles\r
\r
if %COMPILER% == cl set MAKECMD=nmake\r
\r
rem Pass on chosen settings to makefiles.\r
-rem NB. Be very careful to not have a space before redirection symbols\r
-rem except when there is a preceding digit, when a space is required.\r
-rem\r
echo # Start of settings from configure.bat >config.settings\r
-echo COMPILER=%COMPILER%>>config.settings\r
+echo COMPILER=%COMPILER% >>config.settings\r
if (%nodebug%) == (Y) echo NODEBUG=1 >>config.settings\r
if (%noopt%) == (Y) echo NOOPT=1 >>config.settings\r
if (%nocygwin%) == (Y) echo NOCYGWIN=1 >>config.settings\r
-if not "(%prefix%)" == "()" echo INSTALL_DIR=%prefix%>>config.settings\r
-if not "(%usercflags%)" == "()" echo USER_CFLAGS=%usercflags%>>config.settings\r
-if not "(%userldflags%)" == "()" echo USER_LDFLAGS=%userldflags%>>config.settings\r
-echo # End of settings from configure.bat>>config.settings\r
+if not "(%prefix%)" == "()" echo INSTALL_DIR=%prefix% >>config.settings\r
+if not "(%usercflags%)" == "()" echo USER_CFLAGS=%usercflags% >>config.settings\r
+if not "(%userldflags%)" == "()" echo USER_LDFLAGS=%userldflags% >>config.settings\r
+echo # End of settings from configure.bat >>config.settings\r
echo. >>config.settings\r
\r
copy config.nt ..\src\config.h\r
copy /b config.settings+%MAKECMD%.defs+..\nt\makefile.w32-in ..\nt\makefile\r
copy /b config.settings+%MAKECMD%.defs+..\lib-src\makefile.w32-in ..\lib-src\makefile\r
copy /b config.settings+%MAKECMD%.defs+..\src\makefile.w32-in ..\src\makefile\r
-if not exist ..\lisp\Makefile.unix rename ..\lisp\Makefile.in Makefile.unix\r
-if exist ..\lisp\makefile rm -f ../lisp/[Mm]akefile\r
+if not exist ..\lisp\Makefile.unix rename ..\lisp\Makefile Makefile.unix\r
+if exist ..\lisp\makefile del /f ..\lisp\makefile\r
copy /b config.settings+%MAKECMD%.defs+..\lisp\makefile.w32-in ..\lisp\makefile\r
rem Use the default (no-op) Makefile.in if the nt version is not present.\r
if exist ..\leim\makefile.w32-in copy /b config.settings+%MAKECMD%.defs+..\leim\makefile.w32-in ..\leim\makefile\r
+++ /dev/null
-@echo off \r
-set emacs_dir=c:\emacs\r
-\r
-REM Here begins emacs.bat.in\r
-\r
-REM Set OS specific values.\r
-set ARCH_SAVE=%PROCESSOR_ARCHITECTURE%\r
-set PROCESSOR_ARCHITECTURE=\r
-if "%ARCH_SAVE%" == "%PROCESSOR_ARCHITECTURE%" goto win95\r
-set PROCESSOR_ARCHITECTURE=%ARCH_SAVE%\r
-set SHELL=cmd\r
-goto next\r
-\r
-:win95\r
-set SHELL=command\r
-\r
-:next\r
-\r
-set EMACSLOADPATH=%emacs_dir%\lisp\r
-set EMACSDATA=%emacs_dir%\etc\r
-set EMACSPATH=%emacs_dir%\bin\r
-set EMACSLOCKDIR=%emacs_dir%\lock\r
-set INFOPATH=%emacs_dir%\info\r
-set EMACSDOC=%emacs_dir%\etc\r
-set TERM=CMD\r
-\r
-REM The variable HOME is used to find the startup file, ~\_emacs. Ideally,\r
-REM this will not be set in this file but should already be set before\r
-REM this file is invoked. If HOME is not set, use some generic default.\r
-\r
-set HOME_SAVE=%HOME%\r
-set HOME_EXISTS=yes\r
-set HOME_DEFAULT=C:\\r
-set HOME=\r
-if "%HOME%" == "%HOME_SAVE%" set HOME_EXISTS=no\r
-if "%HOME_EXISTS%" == "yes" set HOME=%HOME_SAVE%\r
-if "%HOME_EXISTS%" == "no" set HOME=%HOME_DEFAULT%\r
-if "%HOME_EXISTS%" == "no" echo HOME is not set! Using %HOME% as a default...\r
-\r
-start c:\msdev\bin\msdev -nologo %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9\r
+++ /dev/null
-@echo off\r
-\r
-REM Change this to the directory into which you installed Emacs:\r
-set emacs_path=C:\emacs\r
-\r
-REM\r
-REM You shouldn't have to change any of the below.\r
-REM\r
-\r
-REM Set OS specific values.\r
-set ARCH_SAVE=%PROCESSOR_ARCHITECTURE%\r
-set PROCESSOR_ARCHITECTURE=\r
-if "%ARCH_SAVE%" == "%PROCESSOR_ARCHITECTURE%" goto win95\r
-set PROCESSOR_ARCHITECTURE=%ARCH_SAVE%\r
-set SHELL=cmd\r
-goto next\r
-\r
-:win95\r
-set SHELL=command\r
-\r
-:next\r
-\r
-set EMACSLOADPATH=%emacs_path%\lisp\r
-set EMACSDATA=%emacs_path%\etc\r
-set EMACSPATH=%emacs_path%\bin\r
-set EMACSLOCKDIR=%emacs_path%\lock\r
-set INFOPATH=%emacs_path%\info\r
-set EMACSDOC=%emacs_path%\etc\r
-set TERM=CMD\r
-\r
-REM The variable HOME is used to find the startup file, ~\_emacs. Ideally,\r
-REM this will not be set in this file but should already be set before\r
-REM this file is invoked. If HOME is not set, use some generic default.\r
-\r
-set HOME_SAVE=%HOME%\r
-set HOME_EXISTS=yes\r
-set HOME_DEFAULT=C:\\r
-set HOME=\r
-if "%HOME%" == "%HOME_SAVE%" set HOME_EXISTS=no\r
-if "%HOME_EXISTS%" == "yes" set HOME=%HOME_SAVE%\r
-if "%HOME_EXISTS%" == "no" set HOME=%HOME_DEFAULT%\r
-if "%HOME_EXISTS%" == "no" echo HOME is not set! Using %HOME% as a default...\r
-\r
-%emacs_path%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9\r
SETLOADPATH=EMACSLOADPATH=$(CURDIR)/../lisp
endif
-MAKETYPE=gmake
-
-THISDIR = .
-
# Cygwin has changed quoting rules somewhat since b20, in a way that
# affects makefiles using sh as the command processor, so we need to
# detect which rules to use.
$(BLD): $(OBJDIR)
-mkdir "$(BLD)"
-COMPILER_TEMP_FILES =
-
CP = cp -f
CP_DIR = cp -rf
DEL = rm
endif
+# The location of the icon file
+EMACS_ICON_PATH = ../nt/emacs.ico
+
ifdef NODEBUG
DEBUG_FLAG =
else
+++ /dev/null
-/* null version of <arpa/inet.h> - <sys/socket.h> has everything */
+++ /dev/null
-/* null version of <netdb.h> - <sys/socket.h> has everything */
+++ /dev/null
-/* null version of <netinet/in.h> - <sys/socket.h> has everything */
+++ /dev/null
-#ifndef _PWD_H_
-#define _PWD_H_
-/*
- * pwd.h doesn't exist on NT, so we put together our own.
- */
-
-struct passwd {
- char *pw_name;
- char *pw_passwd;
- int pw_uid;
- int pw_gid;
- int pw_quota;
- char *pw_gecos;
- char *pw_dir;
- char *pw_shell;
-};
-
-#endif /* _PWD_H_ */
+++ /dev/null
-/*
- * map sys\dir.h to ..\..\..\src\ndir.h
- */
-
-#include "..\..\..\src\ndir.h"
+++ /dev/null
-/*
- * sys\file.h doesn't exist on NT - only needed for these constants
- */
-
-#ifndef D_OK
-#define F_OK 0
-#define X_OK 1
-#define W_OK 2
-#define R_OK 4
-#define D_OK 8
-#endif
+++ /dev/null
-/*
- * sys\ioctl.h doesn't exist on NT...rather than including it conditionally
- * in many of the source files, we just extend the include path so that the
- * compiler will pick this up empty header instead.
- */
+++ /dev/null
-#ifndef _PARAM_H_
-#define _PARAM_H_
-
-/*
- * sys\param.h doesn't exist on NT, so we'll make one.
- */
-
-#define NBPG 4096
-
-#endif /* _PARAM_H_ */
+++ /dev/null
-/* Workable version of <sys/socket.h> based on winsock.h */
-
-#ifndef _SOCKET_H_
-#define _SOCKET_H_
-
-/* defeat the multiple include protection */
-#ifdef _WINSOCKAPI_
-#undef _WINSOCKAPI_
-#endif
-#ifdef _WINSOCK_H
-#undef _WINSOCK_H
-#endif
-
-/* avoid confusion with our version of select */
-#ifdef select
-#undef select
-#define MUST_REDEF_SELECT
-#endif
-
-/* avoid clashing with our version of FD_SET if already defined */
-#ifdef FD_SET
-#undef FD_SET
-#undef FD_CLR
-#undef FD_ISSET
-#undef FD_ZERO
-#endif
-
-/* avoid duplicate definition of timeval */
-#ifdef HAVE_TIMEVAL
-#define timeval ws_timeval
-#endif
-
-#include <winsock.h>
-
-/* redefine select to reference our version */
-#ifdef MUST_REDEF_SELECT
-#define select sys_select
-#undef MUST_REDEF_SELECT
-#endif
-
-/* revert to our version of FD_SET */
-#undef FD_SET
-#undef FD_CLR
-#undef FD_ISSET
-#undef FD_ZERO
-
-/* allow us to provide our own version of fd_set */
-#define fd_set ws_fd_set
-#include "w32.h"
-
-#ifdef HAVE_TIMEVAL
-#undef timeval
-#endif
-
-/* shadow functions where we provide our own wrapper */
-#define socket sys_socket
-#define bind sys_bind
-#define connect sys_connect
-#define htons sys_htons
-#define ntohs sys_ntohs
-#define inet_addr sys_inet_addr
-#define gethostname sys_gethostname
-#define gethostbyname sys_gethostbyname
-#define getservbyname sys_getservbyname
-#define shutdown sys_shutdown
-
-int sys_socket(int af, int type, int protocol);
-int sys_bind (int s, const struct sockaddr *addr, int namelen);
-int sys_connect (int s, const struct sockaddr *addr, int namelen);
-u_short sys_htons (u_short hostshort);
-u_short sys_ntohs (u_short netshort);
-unsigned long sys_inet_addr (const char * cp);
-int sys_gethostname (char * name, int namelen);
-struct hostent * sys_gethostbyname(const char * name);
-struct servent * sys_getservbyname(const char * name, const char * proto);
-int sys_shutdown (int socket, int how);
-
-/* we are providing a real h_errno variable */
-#undef h_errno
-extern int h_errno;
-
-/* map winsock error codes to standard names */
-#define EWOULDBLOCK WSAEWOULDBLOCK
-#define EINPROGRESS WSAEINPROGRESS
-#define EALREADY WSAEALREADY
-#define ENOTSOCK WSAENOTSOCK
-#define EDESTADDRREQ WSAEDESTADDRREQ
-#define EMSGSIZE WSAEMSGSIZE
-#define EPROTOTYPE WSAEPROTOTYPE
-#define ENOPROTOOPT WSAENOPROTOOPT
-#define EPROTONOSUPPORT WSAEPROTONOSUPPORT
-#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
-#define EOPNOTSUPP WSAEOPNOTSUPP
-#define EPFNOSUPPORT WSAEPFNOSUPPORT
-#define EAFNOSUPPORT WSAEAFNOSUPPORT
-#define EADDRINUSE WSAEADDRINUSE
-#define EADDRNOTAVAIL WSAEADDRNOTAVAIL
-#define ENETDOWN WSAENETDOWN
-#define ENETUNREACH WSAENETUNREACH
-#define ENETRESET WSAENETRESET
-#define ECONNABORTED WSAECONNABORTED
-#define ECONNRESET WSAECONNRESET
-#define ENOBUFS WSAENOBUFS
-#define EISCONN WSAEISCONN
-#define ENOTCONN WSAENOTCONN
-#define ESHUTDOWN WSAESHUTDOWN
-#define ETOOMANYREFS WSAETOOMANYREFS
-#define ETIMEDOUT WSAETIMEDOUT
-#define ECONNREFUSED WSAECONNREFUSED
-#define ELOOP WSAELOOP
-/* #define ENAMETOOLONG WSAENAMETOOLONG */
-#define EHOSTDOWN WSAEHOSTDOWN
-#define EHOSTUNREACH WSAEHOSTUNREACH
-/* #define ENOTEMPTY WSAENOTEMPTY */
-#define EPROCLIM WSAEPROCLIM
-#define EUSERS WSAEUSERS
-#define EDQUOT WSAEDQUOT
-#define ESTALE WSAESTALE
-#define EREMOTE WSAEREMOTE
-
-#endif /* _SOCKET_H_ */
-
-/* end of socket.h */
+++ /dev/null
-#ifndef SYS_TIME_H_INCLUDED
-#define SYS_TIME_H_INCLUDED
-
-/*
- * sys/time.h doesn't exist on NT
- */
-
-struct timeval
- {
- long tv_sec; /* seconds */
- long tv_usec; /* microseconds */
- };
-struct timezone
- {
- int tz_minuteswest; /* minutes west of Greenwich */
- int tz_dsttime; /* type of dst correction */
- };
-
-void gettimeofday (struct timeval *, struct timezone *);
-
-#endif /* SYS_TIME_H_INCLUDED */
-
-/* end of sys/time.h */
+++ /dev/null
-/* Fake unistd.h: config.h already provides most of the relevant things. */
+++ /dev/null
- Building and Installing Emacs
- on Windows NT and Windows 95
-
-You need a compiler package to build and install Emacs on NT or Win95.
-If you don't have one, precompiled versions are available in
-ftp://ftp.cs.washington.edu/pub/ntemacs/<version>.
-
-Configuring:
-
-(1) In previous versions, you needed to edit makefile.def
- to reflect the compiler package that you are using. You should no
- longer have to do this if you have defined the INCLUDE and LIB
- environment variables, as is customary for use with Windows compilers.
- (Unless you are using MSVCNT 1.1, in which case you will need
- to set MSVCNT11 to be a non-zero value at the top of makefile.def.)
-
-(2) Choose the directory into which Emacs will be installed, and
- edit makefile.def to define INSTALL_DIR to be this directory.
- (Alternatively, if you have INSTALL_DIR set as an environment
- variable, the build process will ignore the value in makefile.def
- and use the value of the environment variable instead.) Note
- that if it is not installed in the directory in which it is built,
- the ~16 MB of lisp files will be copied into the installation directory.
-
- Also, makefile.def is sometimes unpacked read-only; use
-
- > attrib -r makefile.def
-
- to make it writable.
-
-(3) You may need to edit nt/paths.h to specify some other device
- instead of `C:'.
-
-Building:
-
-(4) The target to compile the sources is "all", and is recursive starting
- one directory up. The makefiles for the NT port are in files named
- "makefile.nt". To get things started, type in this directory:
-
- > nmake -f makefile.nt all
-
- or use the ebuild.bat file.
-
- When the files are compiled, you will see some warning messages declaring
- that some functions don't return a value, or that some data conversions
- will be lossy, etc. You can safely ignore these messages. The warnings
- may be fixed in the main FSF source at some point, but until then we
- will just live with them.
-
- NOTE: You should not have to edit src\paths.h to get Emacs to run
- correctly. All of the variables in src\paths.h are configured
- during start up using the nt\emacs.bat file (which gets installed
- as bin\emacs.bat -- see below).
-
-Installing:
-
-(5) Currently, Emacs requires a number of environment variables to be set
- for it to run correctly. A batch file, emacs.bat, is provided that
- sets these variables appropriately and then runs the executable
- (emacs.bat is generated using the definition of INSTALL_DIR in
- nt\makefile.def and the contents of nt\emacs.bat.in).
-
-(6) The install process will install the files necessary to run Emacs in
- INSTALL_DIR (which may be the directory in which it was built),
- and create a program manager/folder icon in a folder called GNU Emacs.
- From this directory, type:
-
- > nmake -f makefile.nt install
-
- or use the install.bat file.
-
-(7) Create the Emacs startup file. Under Unix, this file is .emacs;
- under NT and Win95, this files is _emacs. (If you would like to
- use a .emacs file that, for example, you share with a Unix version
- of Emacs, you can invoke Emacs with the -l option to specify the
- .emacs file that you would like to load.) Note that Emacs requires
- the environment variable HOME to be set in order for it to locate the
- _emacs file. Ideally, HOME should not be set in the emacs.bat file
- as it will be different for each user. (HOME could be set,
- for example, in the System panel of the Control Panel).
-
-(8) Either click on the icon, or run the emacs.bat file, and away you go.
-
- If you would like to resize the command window that Emacs uses,
- or change the font or colors, click on the program manager icon
- to start Emacs. Change the settings using the "-" menu in the upper
- left hand corner of the window, making sure to select the "Save"
- options in the dialog boxes as you do so. Exit Emacs and restart.
DEL_TREE = rd /s/q
!endif
+# The location of the icon file
+EMACS_ICON_PATH = ..\nt\emacs.ico
+
# Lets us add icons to the GNU Emacs folder
ADDPM = ..\nt\$(BLD)\addpm.exe
#
# Build emacs
#
-all: which-sh $(BLD) $(ALL) all-other-dirs-$(MAKETYPE)
+all: which-sh $(BLD) $(ALL) all-other-dirs-$(SHELLTYPE)
-all-other-dirs-nmake:
+all-other-dirs-CMD:
cd ..\lib-src
$(MAKE) $(MFLAGS) all
cd ..\src
$(MAKE) $(MFLAGS) all
cd ..\nt
-all-other-dirs-gmake:
+all-other-dirs-SH:
$(MAKE) $(MFLAGS) -C ../lib-src all
$(MAKE) $(MFLAGS) -C ../src all
$(MAKE) $(MFLAGS) -C ../lisp all
$(MAKE) $(MFLAGS) -C ../leim all
-recompile: recompile-$(MAKETYPE)
+recompile: recompile-$(SHELLTYPE)
-recompile-nmake:
+recompile-CMD:
cd ..\lisp
$(MAKE) $(MFLAGS) recompile
cd ..\nt
-recompile-gmake:
+recompile-SH:
$(MAKE) $(MFLAGS) -C ../lisp recompile
-bootstrap: $(BLD) $(ALL) bootstrap-$(MAKETYPE)
+bootstrap: $(BLD) $(ALL) bootstrap-$(SHELLTYPE)
-bootstrap-nmake:
+bootstrap-CMD:
cd ..\src
$(MAKE) $(MFLAGS) bootstrap
$(MAKE) $(MFLAGS) bootstrap-clean
$(MAKE) $(MFLAGS) bootstrap
cd ..\nt
-bootstrap-gmake:
+bootstrap-SH:
$(MAKE) $(MFLAGS) -C ../src bootstrap
$(MAKE) $(MFLAGS) -C ../src bootstrap-clean
$(MAKE) $(MFLAGS) -C ../lisp bootstrap
-bootstrap-clean: bootstrap-clean-$(MAKETYPE)
+bootstrap-clean: bootstrap-clean-$(SHELLTYPE)
-bootstrap-clean-nmake:
+bootstrap-clean-CMD:
cd ..\src
$(MAKE) $(MFLAGS) bootstrap-clean
cd ..\lisp
$(MAKE) $(MFLAGS) bootstrap-clean
-bootstrap-clean-gmake:
+bootstrap-clean-SH:
$(MAKE) $(MFLAGS) -C ../src bootstrap-clean
$(MAKE) $(MFLAGS) -C ../lisp bootstrap-clean
#
# Build and install emacs in INSTALL_DIR
#
-install: all $(INSTALL_DIR)/bin install-other-dirs-$(MAKETYPE)
+install: all $(INSTALL_DIR)/bin install-other-dirs-$(SHELLTYPE)
- $(CP) $(BLD)/addpm.exe $(INSTALL_DIR)/bin
- $(CP) $(BLD)/ddeclient.exe $(INSTALL_DIR)/bin
- $(CP) $(BLD)/cmdproxy.exe $(INSTALL_DIR)/bin
- $(DEL) ../same-dir.tst
- $(DEL) $(INSTALL_DIR)/same-dir.tst
-install-other-dirs-nmake:
+install-other-dirs-CMD:
cd ..\lib-src
$(MAKE) $(MFLAGS) install
cd ..\src
$(MAKE) $(MFLAGS) install
cd ..\nt
-install-other-dirs-gmake:
+install-other-dirs-SH:
$(MAKE) $(MFLAGS) -C ../lib-src install
$(MAKE) $(MFLAGS) -C ../src install
$(MAKE) $(MFLAGS) -C ../lisp install
#
# Maintenance
#
-clean: clean-other-dirs-$(MAKETYPE)
- - $(DEL) *~ $(COMPILER_TEMP_FILES)
+clean: clean-other-dirs-$(SHELLTYPE)
+ - $(DEL) *~ *.pdb
- $(DEL_TREE) $(OBJDIR)
- $(DEL) ../etc/DOC ../etc/DOC-X
-clean-other-dirs-nmake:
+clean-other-dirs-CMD:
cd ..\lib-src
$(MAKE) $(MFLAGS) clean
cd ..\src
$(MAKE) $(MFLAGS) clean
cd ..\nt
-clean-other-dirs-gmake:
+clean-other-dirs-SH:
$(MAKE) $(MFLAGS) -C ../lib-src clean
$(MAKE) $(MFLAGS) -C ../src clean
$(MAKE) $(MFLAGS) -C ../lisp clean
$(MAKE) $(MFLAGS) -C ../leim clean
-cleanall-other-dirs-nmake:
- cd ..\lib-src
- $(MAKE) $(MFLAGS) cleanall
- cd ..\src
- $(MAKE) $(MFLAGS) cleanall
- cd ..\nt
-
-cleanall-other-dirs-gmake:
- $(MAKE) $(MFLAGS) -C ../lib-src cleanall
- $(MAKE) $(MFLAGS) -C ../src cleanall
-
-cleanall: clean cleanall-other-dirs-$(MAKETYPE)
+cleanall: clean
- $(DEL_TREE) obj
- $(DEL_TREE) obj-spd
- $(DEL_TREE) oo
THE_SHELL = $(COMSPEC)
SHELLTYPE=CMD
-MAKETYPE=nmake
-
-CURDIR = $(MAKEDIR:\=/)
-THISDIR = $(MAKEDIR)
-
ALL_DEPS = $**
SUBSYSTEM_WINDOWS=-subsystem:windows
SUBSYSTEM_CONSOLE=-subsystem:console
+CURDIR = $(MAKEDIR:\=/)
+
# INSTALL_DIR is the directory into which emacs will be installed.
#
!ifndef INSTALL_DIR
$(BLD): $(OBJDIR)
-mkdir "$(BLD)"
-COMPILER_TEMP_FILES = *.pdb
-
CP = cp -f
CP_DIR = cp -rf
IFNOTSAMEDIR = if not exist ..\same-dir.tst
DEL = rm
DEL_TREE = rm -r
+# The location of the icon file
+EMACS_ICON_PATH = ../nt/emacs.ico
+
!ifdef NODEBUG
DEBUG_FLAG =
!else
+++ /dev/null
-# Makefile for GNU Emacs.
-# Copyright (C) 1985, 87, 88, 93, 94, 95, 99, 2000, 2001
-# Free Software Foundation, Inc.
-
-# This file is part of GNU Emacs.
-
-# GNU Emacs is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-
-# Note that this file is edited by msdos/sed1v2.inp for MSDOS. That
-# script may need modifying in sync with changes made here. Try to
-# avoid shell-ism because the DOS build has to use the DOS shell.
-
-# Don't try to replace the ccp processing using autoconf facilities,
-# says rms.
-
-# Here are the things that we expect ../configure to edit.
-# We use $(srcdir) explicitly in dependencies so as not to depend on VPATH.
-srcdir=@srcdir@
-VPATH=@srcdir@
-CC=@CC@
-CPP=@CPP@
-CFLAGS=@CFLAGS@
-CPPFLAGS=@CPPFLAGS@
-LDFLAGS=@LDFLAGS@
-LN_S=@LN_S@
-# Substitute an assignment for the MAKE variable, because
-# BSD doesn't have it as a default.
-@SET_MAKE@
-# Don't use LIBS. configure puts stuff in it that either shouldn't be
-# linked with Emacs or is duplicated by the cpp stuff below.
-# LIBS = @LIBS@
-LIBOBJS = @LIBOBJS@
-
-# On Xenix and the IBM RS6000, double-dot gets screwed up.
-dot = .
-dotdot = ${dot}${dot}
-lispsource = ${srcdir}/$(dot)$(dot)/lisp/
-libsrc = $(dot)$(dot)/lib-src/
-etc = $(dot)$(dot)/etc/
-oldXMenudir = $(dot)$(dot)/oldXMenu/
-lwlibdir = $(dot)$(dot)/lwlib/
-
-# Configuration files for .o files to depend on.
-M_FILE = ${srcdir}/@machfile@
-S_FILE = ${srcdir}/@opsysfile@
-config_h = config.h $(M_FILE) $(S_FILE)
-
-# ========================== start of cpp stuff =======================
-/* From here on, comments must be done in C syntax. */
-
-C_SWITCH_SYSTEM=
-
-/* just to be sure the sh is used */
-SHELL=/bin/sh
-
-#define THIS_IS_MAKEFILE
-#define NO_SHORTNAMES
-#define NOT_C_CODE
-#include "config.h"
-
-/* We won't really call alloca;
- don't let the file name alloca.c get messed up. */
-#ifdef alloca
-#undef alloca
-#endif
-
-/* Don't let the file name mktime.c get messed up. */
-#ifdef mktime
-#undef mktime
-#endif
-
-/* Use HAVE_X11 as an alias for X11 in this file
- to avoid problems with X11 as a subdirectory name
- in -I and other such options which pass through this file. */
-
-#ifdef X11
-#define HAVE_X11
-#undef X11
-#endif
-
-/* On some machines #define register is done in config;
- don't let it interfere with this file. */
-#undef register
-
-/* On some systems we may not be able to use the system make command. */
-#ifdef MAKE_COMMAND
-MAKE = MAKE_COMMAND
-#endif
-
-#ifdef C_COMPILER
-CC = C_COMPILER
-#endif
-
-/* GNU libc requires ORDINARY_LINK so that its own crt0 is used.
- Linux is an exception because it uses a funny variant of GNU libc. */
-#ifdef __GNU_LIBRARY__
-#ifndef LINUX
-#define ORDINARY_LINK
-#endif
-#endif
-
-/* Some machines don't find the standard C libraries in the usual place. */
-#ifndef ORDINARY_LINK
-#ifndef LIB_STANDARD
-#define LIB_STANDARD -lc
-#endif
-#else
-#ifndef LIB_STANDARD
-#define LIB_STANDARD
-#endif
-#endif
-
-/* Unless inhibited or changed, use -lg to link for debugging. */
-#ifndef LIBS_DEBUG
-#define LIBS_DEBUG -lg
-#endif
-
-/* Some s/SYSTEM.h files define this to request special libraries. */
-#ifndef LIBS_SYSTEM
-#define LIBS_SYSTEM
-#endif
-
-/* Some m/MACHINE.h files define this to request special libraries. */
-#ifndef LIBS_MACHINE
-#define LIBS_MACHINE
-#endif
-
-#ifndef LIB_MATH
-# define LIB_MATH -lm
-#endif /* LIB_MATH */
-
-/* Some s/SYSTEM.h files define this to request special switches in ld. */
-#ifndef LD_SWITCH_SYSTEM
-#if !defined (__GNUC__) && (defined(COFF_ENCAPSULATE) || (defined (BSD_SYSTEM) && !defined (COFF)))
-#define LD_SWITCH_SYSTEM -X
-#else /* ! defined(COFF_ENCAPSULATE) || (defined (BSD_SYSTEM) && !defined (COFF)) */
-#define LD_SWITCH_SYSTEM
-#endif /* ! defined(COFF_ENCAPSULATE) || (defined (BSD_SYSTEM) && !defined (COFF)) */
-#endif /* LD_SWITCH_SYSTEM */
-
-/* This holds special options for linking temacs
- that should be used for linking anything else. */
-#ifndef LD_SWITCH_SYSTEM_TEMACS
-#define LD_SWITCH_SYSTEM_TEMACS
-#endif
-
-/* Some m/MACHINE.h files define this to request special switches in ld. */
-#ifndef LD_SWITCH_MACHINE
-#define LD_SWITCH_MACHINE
-#endif
-
-/* This holds special options for linking temacs
- that should be used for linking anything else. */
-#ifndef LD_SWITCH_MACHINE_TEMACS
-#define LD_SWITCH_MACHINE_TEMACS
-#endif
-
-/* Some m/MACHINE.h files define this to request special switches in cc. */
-#ifndef C_SWITCH_MACHINE
-#define C_SWITCH_MACHINE
-#endif
-
-/* Some s/SYSTEM.h files define this to request special switches in cc. */
-#ifndef C_SWITCH_SYSTEM
-#define C_SWITCH_SYSTEM
-#endif
-
-/* These macros are for switches specifically related to X Windows. */
-#ifndef C_SWITCH_X_MACHINE
-#define C_SWITCH_X_MACHINE
-#endif
-
-#ifndef C_SWITCH_X_SYSTEM
-#define C_SWITCH_X_SYSTEM
-#endif
-
-#ifndef C_SWITCH_X_SITE
-#define C_SWITCH_X_SITE
-#endif
-
-#ifndef LD_SWITCH_X_SITE
-#define LD_SWITCH_X_SITE
-#endif
-
-#ifndef LD_SWITCH_X_DEFAULT
-#define LD_SWITCH_X_DEFAULT
-#endif
-
-/* These can be passed in from config.h to define special load and
- compile switches needed by individual sites */
-#ifndef LD_SWITCH_SITE
-#define LD_SWITCH_SITE
-#endif
-
-#ifndef C_SWITCH_SITE
-#define C_SWITCH_SITE
-#endif
-
-#ifndef ORDINARY_LINK
-
-#ifndef CRT0_COMPILE
-#define CRT0_COMPILE $(CC) -c $(ALL_CFLAGS) C_SWITCH_ASM
-#endif
-
-#ifndef START_FILES
-#ifdef NO_REMAP
-#ifdef COFF_ENCAPSULATE
-#define START_FILES pre-crt0.o /usr/local/lib/gcc-crt0.o
-#else /* ! defined (COFF_ENCAPSULATE) */
-#define START_FILES pre-crt0.o /lib/crt0.o
-#endif /* ! defined (COFF_ENCAPSULATE) */
-#else /* ! defined (NO_REMAP) */
-#define START_FILES ecrt0.o
-#endif /* ! defined (NO_REMAP) */
-#endif /* START_FILES */
-STARTFILES = START_FILES
-
-#else /* ORDINARY_LINK */
-
-/* config.h might want to force START_FILES anyway */
-#ifdef START_FILES
-STARTFILES = START_FILES
-#endif /* START_FILES */
-
-#endif /* not ORDINARY_LINK */
-
-
-/* cc switches needed to make `asm' keyword work.
- Nothing special needed on most machines. */
-#ifndef C_SWITCH_ASM
-#define C_SWITCH_ASM
-#endif
-
-#ifdef USE_X_TOOLKIT
-#define USE_@X_TOOLKIT_TYPE@
-TOOLKIT_DEFINES = -DUSE_@X_TOOLKIT_TYPE@
-#else
-TOOLKIT_DEFINES =
-#endif
-
-/* DO NOT use -R. There is a special hack described in lastfile.c
- which is used instead. Some initialized data areas are modified
- at initial startup, then labeled as part of the text area when
- Emacs is dumped for the first time, and never changed again. */
-
-/* -Demacs is needed to make some files produce the correct version
- for use in Emacs.
-
- -DHAVE_CONFIG_H is needed for some other files to take advantage of
- the information in `config.h'. */
-
-/* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM
- since it may have -I options that should override those two. */
-ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAG) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM ${CFLAGS}
-.c.o:
- $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
-
-#ifndef LIBX10_MACHINE
-#define LIBX10_MACHINE
-#endif
-
-#ifndef LIBX11_MACHINE
-#define LIBX11_MACHINE
-#endif
-
-#ifndef LIBX10_SYSTEM
-#define LIBX10_SYSTEM
-#endif
-
-#ifndef LIBX11_SYSTEM
-#define LIBX11_SYSTEM
-#endif
-
-#ifndef LIB_X11_LIB
-#define LIB_X11_LIB -lX11
-#endif
-
-#ifdef HAVE_X_WINDOWS
-#ifdef HAVE_MENUS
-
-/* Include xmenu.o in the list of X object files. */
-XOBJ= xterm.o xfns.o xselect.o xrdb.o fontset.o
-
-/* The X Menu stuff is present in the X10 distribution, but missing
- from X11. If we have X10, just use the installed library;
- otherwise, use our own copy. */
-#ifdef HAVE_X11
-#ifdef USE_X_TOOLKIT
-OLDXMENU=${lwlibdir}liblw.a
-LIBXMENU= $(OLDXMENU)
-#else /* not USE_X_TOOLKIT */
-OLDXMENU= ${oldXMenudir}libXMenu11.a
-LIBXMENU= $(OLDXMENU)
-#endif /* not USE_X_TOOLKIT */
-#else /* not HAVE_X11 */
-LIBXMENU= -lXMenu
-#endif /* not HAVE_X11 */
-
-#else /* not HAVE_MENUS */
-
-/* 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 xselect.o xrdb.o fontset.o
-LIBXMENU=
-#endif /* not HAVE_MENUS */
-
-#ifdef USE_X_TOOLKIT
-#define @X_TOOLKIT_TYPE@
-#if defined (LUCID) || defined (ATHENA)
-#if HAVE_XAW3D
-LIBW= -lXaw3d
-#else
-LIBW= -lXaw
-#endif
-#endif
-#ifdef MOTIF
-#if defined (HAVE_MOTIF_2_1) && defined (HAVE_LIBXP)
-#define LIB_MOTIF_EXTRA -lXp
-#else
-#define LIB_MOTIF_EXTRA
-#endif
-#ifdef LIB_MOTIF
-LIBW= LIB_MOTIF LIB_MOTIF_EXTRA
-#else
-LIBW= -lXm LIB_MOTIF_EXTRA
-#endif
-#endif
-#ifdef OPEN_LOOK
-LIBW= -lXol
-#endif
-
-#ifdef HAVE_X11XTR6
-#ifdef NEED_LIBW
-LIBXTR6 = -lSM -lICE -lw
-#else
-LIBXTR6 = -lSM -lICE
-#endif
-#endif
-
-#ifndef LIBXMU
-#define LIBXMU -lXmu
-#endif
-
-#ifdef LIBXT_STATIC
-/* We assume the config files have defined STATIC_OPTION
- since that might depend on the operating system.
- (Don't forget you need different definitions with and without __GNUC__.) */
-LIBXT= STATIC_OPTION $(LIBW) LIBXMU -lXt $(LIBXTR6) -lXext DYNAMIC_OPTION
-#else /* not LIBXT_STATIC */
-LIBXT= $(LIBW) LIBXMU -lXt $(LIBXTR6) -lXext
-#endif /* not LIBXT_STATIC */
-
-#else /* not USE_X_TOOLKIT */
-LIBXT=
-#endif /* not USE_X_TOOLKIT */
-
-#if HAVE_XPM
-#ifndef LIBXPM
-#define LIBXPM -lXpm
-#endif /* not defined LIBXPM */
-#else /* not HAVE_XPM */
-#define LIBXPM
-#endif /* not HAVE_XPM */
-
-#if HAVE_JPEG
-#ifndef LIBJPEG
-#define LIBJPEG -ljpeg
-#endif /* not defined LIBJPEG */
-#else /* not HAVE_JPEG */
-#define LIBJPEG
-#endif /* not HAVE_JPEG */
-
-#if HAVE_PNG
-#ifndef LIBPNG
-#define LIBPNG -lpng -lz -lm
-#endif /* not defined LIBPNG */
-#else /* not HAVE_PNG */
-#define LIBPNG
-#endif /* not HAVE_PNG */
-
-#if HAVE_TIFF
-#ifndef LIBTIFF
-#define LIBTIFF -ltiff
-#endif /* not defined LIBTIFF */
-#else /* not HAVE_TIFF */
-#define LIBTIFF
-#endif /* not HAVE_TIFF */
-
-#if HAVE_GIF
-#ifndef LIBGIF
-#define LIBGIF -lungif
-#endif /* not defined LIBGIF */
-#else /* not HAVE_GIF */
-#define LIBGIF
-#endif /* not HAVE_GIF */
-
-#ifdef HAVE_X11
-/* LD_SWITCH_X_DEFAULT comes after everything else that specifies
- options for where to find X libraries, but before those libraries. */
-X11_LDFLAGS = LD_SWITCH_X_SITE LD_SWITCH_X_DEFAULT
-LIBX= $(LIBXMENU) $(X11_LDFLAGS) $(LIBXT) LIBTIFF LIBJPEG LIBPNG LIBGIF LIBXPM LIB_X11_LIB LIBX11_MACHINE LIBX11_SYSTEM
-#else /* not HAVE_X11 */
-LIBX= $(LIBXMENU) LD_SWITCH_X_SITE -lX10 LIBX10_MACHINE LIBX10_SYSTEM
-#endif /* not HAVE_X11 */
-#endif /* not HAVE_X_WINDOWS */
-
-LIBSOUND= @LIBSOUND@
-
-#ifndef ORDINARY_LINK
-/* Fix linking if compiled with GCC. */
-#ifdef __GNUC__
-
-#if __GNUC__ > 1
-
-#ifdef LINKER
-#define LINKER_WAS_SPECIFIED
-#endif
-
-/* Versions of GCC >= 2.0 put their library, libgcc.a, in obscure
- places that are difficult to figure out at make time. Fortunately,
- these same versions allow you to pass arbitrary flags on to the
- linker, so there's no reason not to use it as a linker.
-
- Well, it's not quite perfect. The `-nostdlib' keeps GCC from
- searching for libraries in its internal directories, so we have to
- ask GCC explicitly where to find libgcc.a. */
-
-#ifndef LINKER
-#define LINKER $(CC) -nostdlib
-#endif
-
-#ifndef LIB_GCC
-/* Ask GCC where to find libgcc.a. */
-#define LIB_GCC `$(CC) -print-libgcc-file-name`
-#endif /* not LIB_GCC */
-
-GNULIB_VAR = LIB_GCC
-
-#ifndef LINKER_WAS_SPECIFIED
-/* GCC passes any argument prefixed with -Xlinker directly to the
- linker. See prefix-args.c for an explanation of why we don't do
- this with the shell's `for' construct.
- Note that some people don't have '.' in their paths, so we must
- use ./prefix-args. */
-#define YMF_PASS_LDFLAGS(flags) `./prefix-args -Xlinker flags`
-#else
-#define YMF_PASS_LDFLAGS(flags) flags
-#endif
-
-#else /* __GNUC__ < 2 */
-
-#ifndef LIB_GCC
-#define LIB_GCC /usr/local/lib/gcc-gnulib
-#endif /* not LIB_GCC */
-GNULIB_VAR = `if [ -f LIB_GCC ] ; then echo LIB_GCC; else echo; fi`
-#endif /* __GNUC__ < 2 */
-#else /* not __GNUC__ */
-GNULIB_VAR =
-
-#endif /* not __GNUC__ */
-#endif /* not ORDINARY_LINK */
-
-/* Specify address for ld to start loading at,
- if requested by configuration. */
-#ifdef LD_TEXT_START_ADDR
-STARTFLAGS = -T LD_TEXT_START_ADDR -e __start
-#endif
-
-#ifdef ORDINARY_LINK
-LD = $(CC)
-#else
-#ifdef COFF_ENCAPSULATE
-LD=$(CC) -nostdlib
-#else /* not ORDINARY_LINK */
-#ifdef LINKER
-LD=LINKER
-#else /* not LINKER */
-LD=ld
-#endif /* not LINKER */
-#endif /* not COFF_ENCAPSULATE */
-#endif /* not ORDINARY_LINK */
-
-ALL_LDFLAGS = LD_SWITCH_SYSTEM LD_SWITCH_SYSTEM_TEMACS LD_SWITCH_MACHINE \
- LD_SWITCH_MACHINE_TEMACS LD_SWITCH_SITE $(LDFLAGS)
-
-/* A macro which other sections of Makefile can redefine to munge the
- flags before they're passed to LD. This is helpful if you have
- redefined LD to something odd, like "gcc".
- (The YMF prefix is a holdover from the old name "ymakefile".)
- */
-#ifndef YMF_PASS_LDFLAGS
-#define YMF_PASS_LDFLAGS(flags) flags
-#endif
-
-/* Allow config.h to specify a replacement file for unexec.c. */
-#ifndef UNEXEC
-#define UNEXEC unexec.o
-#endif
-#ifndef UNEXEC_SRC
-#define UNEXEC_SRC unexec.c
-#endif
-
-INTERVAL_SRC = intervals.h composite.h
-
-GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
-
-#ifdef MSDOS
-#ifdef HAVE_X_WINDOWS
-MSDOS_OBJ = dosfns.o msdos.o
-#else
-MSDOS_OBJ = dosfns.o msdos.o w16select.o
-#endif
-#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 xmenu.o window.o \
- charset.o coding.o category.o ccl.o\
- cm.o term.o xfaces.o $(XOBJ) \
- emacs.o keyboard.o macros.o keymap.o sysdep.o \
- buffer.o filelock.o insdel.o marker.o \
- minibuf.o fileio.o dired.o filemode.o \
- cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \
- alloc.o data.o doc.o editfns.o callint.o \
- eval.o floatfns.o fns.o print.o lread.o \
- abbrev.o syntax.o UNEXEC mocklisp.o bytecode.o \
- process.o callproc.o \
- region-cache.o sound.o atimer.o \
- doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \
- $(MSDOS_OBJ)
-
-/* Object files used on some machine or other.
- These go in the DOC file on all machines
- in case they are needed there. */
-SOME_MACHINE_OBJECTS = sunfns.o dosfns.o msdos.o \
- xterm.o xfns.o xmenu.o xselect.o xrdb.o
-
-
-#ifdef TERMINFO
-/* Used to be -ltermcap here. If your machine needs that,
- define LIBS_TERMCAP in the m/MACHINE.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 DOUG_LEA_MALLOC
-#ifdef REL_ALLOC
-mallocobj = ralloc.o vm-limit.o
-#else /* ! defined (REL_ALLOC) */
-mallocobj = vm-limit.o
-#endif /* ! defined (REL_ALLOC) */
-#else /* ! defined (DOUG_LEA_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) */
-#endif /* ! defined (DOUG_LEA_MALLOC) */
-
-#endif /* SYSTEM_MALLOC */
-
-
-#ifndef HAVE_ALLOCA
-allocaobj = alloca.o
-#else
-allocaobj =
-#endif
-
-#ifdef USE_X_TOOLKIT
-widgetobj= widget.o
-#else /* not USE_X_TOOLKIT */
-widgetobj=
-#endif /* not USE_X_TOOLKIT */
-
-
-/* define otherobj as list of object files that make-docfile
- should not be told about. */
-otherobj= $(termcapobj) lastfile.o $(mallocobj) $(allocaobj) $(widgetobj) $(LIBOBJS)
-
-#ifdef HAVE_MOUSE
-#define MOUSE_SUPPORT ${lispsource}mouse.elc \
- ${lispsource}select.elc ${lispsource}scroll-bar.elc
-#else
-#define MOUSE_SUPPORT
-#endif
-
-#ifdef VMS
-#define VMS_SUPPORT ${lispsource}vmsproc.elc ${lispsource}vms-patch.elc
-#else
-#define VMS_SUPPORT
-#endif
-
-#ifdef MSDOS
-#define MSDOS_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}disp-table.elc \
- ${lispsource}dos-fns.elc ${lispsource}dos-w32.elc ${lispsource}dos-vars.elc \
- ${lispsource}international/ccl.elc ${lispsource}international/codepage.elc
-
-#else
-#define MSDOS_SUPPORT
-#endif
-
-#ifdef WINDOWSNT
-#define WINNT_SUPPORT ${lispsource}ls-lisp.elc ${lispsource}w32-fns.elc \
- ${lispsource}dos-w32.elc
-#else
-#define WINNT_SUPPORT
-#endif
-
-/* List of Lisp files loaded into the dumped Emacs. It's arranged
- like this because it's easier to generate it semi-mechanically from
- loadup.el this way.
-
- Note that this list should not include lisp files which might not
- be present, like site-load.el and site-init.el; this makefile
- expects them all to be either present or buildable.
-
- Files which are loaded unconditionally should be in shortlisp as well.
- Files included conditionally here should be included (unconditionally)
- in SOME_MACHINE_LISP. */
-
-lisp= \
- ${lispsource}abbrev.elc \
- ${lispsource}buff-menu.elc \
- ${lispsource}byte-run.elc \
- ${lispsource}cus-start.el \
- ${lispsource}custom.elc \
- ${lispsource}emacs-lisp/lisp-mode.elc \
- ${lispsource}emacs-lisp/lisp.elc \
- ${lispsource}env.elc \
- ${lispsource}faces.elc \
- ${lispsource}files.elc \
- ${lispsource}format.elc \
- ${lispsource}facemenu.elc \
- MOUSE_SUPPORT \
- ${lispsource}float-sup.elc \
- ${lispsource}frame.elc\
- ${lispsource}help.elc \
- ${lispsource}indent.elc \
- ${lispsource}isearch.elc \
- ${lispsource}loadup.el \
- ${lispsource}loaddefs.el \
- ${lispsource}bindings.el \
- ${lispsource}map-ynp.elc \
- ${lispsource}menu-bar.elc \
- ${lispsource}international/mule.elc \
- ${lispsource}international/mule-conf.el \
- ${lispsource}international/mule-cmds.elc \
- ${lispsource}international/characters.elc \
- ${lispsource}case-table.elc \
- ${lispsource}language/chinese.elc \
- ${lispsource}language/cyrillic.elc \
- ${lispsource}language/indian.elc \
- ${lispsource}language/devanagari.elc \
- ${lispsource}language/english.elc \
- ${lispsource}language/ethiopic.elc \
- ${lispsource}language/european.elc \
- ${lispsource}language/czech.elc \
- ${lispsource}language/slovak.elc \
- ${lispsource}language/romanian.elc \
- ${lispsource}language/greek.elc \
- ${lispsource}language/hebrew.elc \
- ${lispsource}language/japanese.elc \
- ${lispsource}language/korean.elc \
- ${lispsource}language/lao.elc \
- ${lispsource}language/thai.elc \
- ${lispsource}language/tibetan.elc \
- ${lispsource}language/vietnamese.elc \
- ${lispsource}language/misc-lang.elc \
- ${lispsource}paths.el \
- ${lispsource}register.elc \
- ${lispsource}replace.elc \
- ${lispsource}simple.elc \
- ${lispsource}startup.elc \
- ${lispsource}subr.elc \
- ${lispsource}term/tty-colors.elc \
- ${lispsource}textmodes/fill.elc \
- ${lispsource}textmodes/page.elc \
- ${lispsource}textmodes/paragraphs.elc \
- ${lispsource}textmodes/text-mode.elc \
- ${lispsource}vc-hooks.elc \
- ${lispsource}ediff-hook.elc \
- VMS_SUPPORT \
- MSDOS_SUPPORT \
- WINNT_SUPPORT \
- ${lispsource}widget.elc \
- ${lispsource}window.elc \
- ${lispsource}version.el
-
-/* These are relative file names for the Lisp files
- that are loaded unconditionally. This is used in make-docfile.
- It need not contain the files that are loaded conditionally
- because SOME_MACHINE_LISP has those. */
-shortlisp= \
- ../lisp/abbrev.elc \
- ../lisp/buff-menu.elc \
- ../lisp/byte-run.elc \
- ../lisp/cus-start.el \
- ../lisp/custom.elc \
- ../lisp/emacs-lisp/lisp-mode.elc \
- ../lisp/emacs-lisp/lisp.elc \
- ../lisp/facemenu.elc \
- ../lisp/faces.elc \
- ../lisp/files.elc \
- ../lisp/float-sup.elc \
- ../lisp/format.elc \
- ../lisp/frame.elc \
- ../lisp/help.elc \
- ../lisp/indent.elc \
- ../lisp/isearch.elc \
- ../lisp/loadup.el \
- ../lisp/loaddefs.el \
- ../lisp/bindings.el \
- ../lisp/map-ynp.elc \
- ../lisp/international/mule.elc \
- ../lisp/international/mule-conf.el \
- ../lisp/international/mule-cmds.elc \
- ../lisp/international/characters.elc \
- ../lisp/case-table.elc \
- ../lisp/language/chinese.elc \
- ../lisp/language/cyrillic.elc \
- ../lisp/language/indian.elc \
- ../lisp/language/devanagari.elc \
- ../lisp/language/english.elc \
- ../lisp/language/ethiopic.elc \
- ../lisp/language/european.elc \
- ../lisp/language/czech.elc \
- ../lisp/language/slovak.elc \
- ../lisp/language/romanian.elc \
- ../lisp/language/greek.elc \
- ../lisp/language/hebrew.elc \
- ../lisp/language/japanese.elc \
- ../lisp/language/korean.elc \
- ../lisp/language/lao.elc \
- ../lisp/language/thai.elc \
- ../lisp/language/tibetan.elc \
- ../lisp/language/vietnamese.elc \
- ../lisp/language/misc-lang.elc \
- ../lisp/paths.el \
- ../lisp/register.elc \
- ../lisp/replace.elc \
- ../lisp/simple.elc \
- ../lisp/startup.elc \
- ../lisp/subr.elc \
- ../lisp/term/tty-colors.elc \
- ../lisp/textmodes/fill.elc \
- ../lisp/textmodes/page.elc \
- ../lisp/textmodes/paragraphs.elc \
- ../lisp/textmodes/text-mode.elc \
- ../lisp/vc-hooks.elc \
- ../lisp/ediff-hook.elc \
- ../lisp/widget.elc \
- ../lisp/window.elc \
- ../lisp/version.el
-
-/* Lisp files that may or may not be used.
- We must unconditionally put them in the DOC file.
- We use ../lisp/ to start the file names
- to reduce the size of the argument list for make-docfile
- for the sake of systems which can't handle large ones. */
-SOME_MACHINE_LISP = ${dotdot}/lisp/menu-bar.elc ${dotdot}/lisp/mouse.elc \
- ${dotdot}/lisp/select.elc ${dotdot}/lisp/scroll-bar.elc \
- ${dotdot}/lisp/vmsproc.elc ${dotdot}/lisp/vms-patch.elc \
- ${dotdot}/lisp/ls-lisp.elc ${dotdot}/lisp/dos-fns.elc \
- ${dotdot}/lisp/w32-fns.elc ${dotdot}/lisp/dos-w32.elc \
- ${dotdot}/lisp/disp-table.elc ${dotdot}/lisp/dos-vars.elc \
- ${dotdot}/lisp/international/ccl.elc \
- ${dotdot}/lisp/international/codepage.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 = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) \
- LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \
- LIBS_DEBUG $(GETLOADAVG_LIBS) $(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
-
-#ifndef OBJECTS_MACHINE
-#define OBJECTS_MACHINE
-#endif
-
-all: emacs OTHER_FILES
-
-emacs: temacs ${etc}DOC ${lisp}
-#ifdef CANNOT_DUMP
- rm -f emacs
- ln temacs emacs
-#else
-#ifdef HAVE_SHM
- LC_ALL=C ./temacs -nl -batch -l loadup dump
-#else /* ! defined (HAVE_SHM) */
- LC_ALL=C ./temacs -batch -l loadup dump
-#endif /* ! defined (HAVE_SHM) */
-#endif /* ! defined (CANNOT_DUMP) */
- -./emacs -q -batch -f list-load-path-shadows
-
-/* We run make-docfile twice because the command line may get too long
- on some systems. */
-/* ${SOME_MACHINE_OBJECTS} comes before ${obj} because some files may
- or may not be included in ${obj}, but they are always included in
- ${SOME_MACHINE_OBJECTS}. Since a file is processed when it is mentioned
- for the first time, this prevents any variation between configurations
- in the contents of the DOC file.
- Likewise for ${SOME_MACHINE_LISP}. */
-${etc}DOC: ${libsrc}make-docfile ${obj} ${shortlisp} ${SOME_MACHINE_LISP}
- -rm -f ${etc}DOC
- ${libsrc}make-docfile -d ${srcdir} ${SOME_MACHINE_OBJECTS} ${obj} > ${etc}DOC
- ${libsrc}make-docfile -a ${etc}DOC -d ${srcdir} ${SOME_MACHINE_LISP} ${shortlisp}
-
-${libsrc}make-docfile:
- cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile
-
-/* Some systems define this to cause parallel Make-ing. */
-#ifndef MAKE_PARALLEL
-#define MAKE_PARALLEL
-#endif
-
-temacs: MAKE_PARALLEL $(LOCALCPP) $(STARTFILES) stamp-oldxmenu ${obj} ${otherobj} OBJECTS_MACHINE prefix-args
- $(LD) YMF_PASS_LDFLAGS (${STARTFLAGS} ${ALL_LDFLAGS}) \
- -o temacs ${STARTFILES} ${obj} ${otherobj} \
- OBJECTS_MACHINE ${LIBES}
-
-/* We don't use ALL_LDFLAGS because LD_SWITCH_SYSTEM and LD_SWITCH_MACHINE
- often contain options that have to do with using Emacs's crt0,
- which are only good with temacs. */
-prefix-args: prefix-args.c $(config_h)
- $(CC) $(ALL_CFLAGS) $(LDFLAGS) ${srcdir}/prefix-args.c -o prefix-args
-
-/* Don't lose if this was not defined. */
-#ifndef OLDXMENU_OPTIONS
-#define OLDXMENU_OPTIONS
-#endif
-
-/* Don't lose if this was not defined. */
-#ifndef LWLIB_OPTIONS
-#define LWLIB_OPTIONS
-#endif
-
-#if defined (HAVE_X_WINDOWS) && defined (HAVE_X11) && defined (HAVE_MENUS)
-
-/* We use stamp-xmenu with these two deps
- to both ensure that lwlib gets remade based on its dependencies
- in its own makefile,
- and remake temacs if lwlib gets changed by this. */
-stamp-oldxmenu: ${OLDXMENU} ../src/$(OLDXMENU)
- touch stamp-oldxmenu
-/* Supply an ordering for parallel make. */
-../src/$(OLDXMENU): ${OLDXMENU}
-
-#ifdef USE_X_TOOLKIT
-$(OLDXMENU): really-lwlib
-
-/* Encode the values of these two macros in Make variables,
- so we can use $(...) to substitute their values within "...". */
-C_SWITCH_MACHINE_1 = C_SWITCH_MACHINE
-C_SWITCH_SYSTEM_1 = C_SWITCH_SYSTEM
-C_SWITCH_SITE_1 = C_SWITCH_SITE
-C_SWITCH_X_SITE_1 = C_SWITCH_X_SITE
-C_SWITCH_X_MACHINE_1 = C_SWITCH_X_MACHINE
-C_SWITCH_X_SYSTEM_1 = C_SWITCH_X_SYSTEM
-really-lwlib:
- cd ${lwlibdir}; ${MAKE} ${MFLAGS} LWLIB_OPTIONS \
- CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' \
- "C_SWITCH_X_SITE=$(C_SWITCH_X_SITE_1)" \
- "C_SWITCH_X_MACHINE=$(C_SWITCH_X_MACHINE_1)" \
- "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" \
- "C_SWITCH_SITE=$(C_SWITCH_SITE_1)" \
- "C_SWITCH_MACHINE=$(C_SWITCH_MACHINE_1)" \
- "C_SWITCH_SYSTEM=$(C_SWITCH_SYSTEM_1)"
- @true /* make -t should not create really-lwlib. */
-.PHONY: really-lwlib
-#else /* not USE_X_TOOLKIT */
-$(OLDXMENU): really-oldXMenu
-
-/* Encode the values of these two macros in Make variables,
- so we can use $(...) to substitute their values within "...". */
-C_SWITCH_MACHINE_1 = C_SWITCH_MACHINE
-C_SWITCH_SYSTEM_1 = C_SWITCH_SYSTEM
-C_SWITCH_SITE_1 = C_SWITCH_SITE
-C_SWITCH_X_SITE_1 = C_SWITCH_X_SITE
-C_SWITCH_X_MACHINE_1 = C_SWITCH_X_MACHINE
-C_SWITCH_X_SYSTEM_1 = C_SWITCH_X_SYSTEM
-really-oldXMenu:
- cd ${oldXMenudir}; ${MAKE} ${MFLAGS} OLDXMENU_OPTIONS \
- CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' \
- "C_SWITCH_X_SITE=$(C_SWITCH_X_SITE_1)" \
- "C_SWITCH_X_MACHINE=$(C_SWITCH_X_MACHINE_1)" \
- "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" \
- "C_SWITCH_SITE=$(C_SWITCH_SITE_1)" \
- "C_SWITCH_MACHINE=$(C_SWITCH_MACHINE_1)" \
- "C_SWITCH_SYSTEM=$(C_SWITCH_SYSTEM_1)"
- @true /* make -t should not create really-oldXMenu. */
-.PHONY: really-oldXMenu
-#endif /* not USE_X_TOOLKIT */
-#else /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS) */
-
-/* We don't really need this, but satisfy the dependency. */
-stamp-oldxmenu:
- touch stamp-oldxmenu
-#endif /* not (HAVE_X_WINDOWS && HAVE_X11 && HAVE_MENUS) */
-
-../config.status:: epaths.in
- @echo "The file epaths.h needs to be set up from epaths.in."
- @echo "Please run the `configure' script again."
- exit 1
-
-../config.status:: config.in
- @echo "The file config.h needs to be set up from config.in."
- @echo "Please run the `configure' script again."
- 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) -DEMACS_FREE=xfree \
- $(ALL_CFLAGS) ${srcdir}/alloca.c
-#else
-#ifndef HAVE_ALLOCA
-alloca.o : alloca.s $(config_h)
-/* $(CPP) is cc -E, which may get confused by filenames
- that do not end in .c. So copy file to a safe name. */
- -rm -f allocatem.c
- cp ${srcdir}/alloca.s allocatem.c
-/* Remove any ^L, blank lines, and preprocessor comments,
- since some assemblers barf on them. Use a different basename for the
- output file, since some stupid compilers (Green Hill's) use that
- name for the intermediate assembler file. */
- $(CPP) $(CPPFLAGS) $(ALL_CFLAGS) allocatem.c | \
- sed -e 's/\f//' -e 's/^#.*//' | \
- sed -n -e '/^..*$$/p' > allocax.s
- -rm -f alloca.o
-/* Xenix, in particular, needs to run assembler via cc. */
- $(CC) -c allocax.s
- mv allocax.o alloca.o
- -rm -f allocax.s allocatem.c
-#endif /* HAVE_ALLOCA */
-#endif /* ! defined (C_ALLOCA) */
-
-/* Nearly all the following files depend on lisp.h,
- but it is not included as a dependency because
- it is so often changed in ways that do not require any recompilation
- and so rarely changed in ways that do require any. */
-
-abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h charset.h \
- $(config_h)
-buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \
- dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h charset.h \
- $(config_h)
-callint.o: callint.c window.h commands.h buffer.h mocklisp.h \
- keyboard.h dispextern.h $(config_h)
-callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \
- process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \
- composite.h
-casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h $(config_h)
-casetab.o: casetab.c buffer.h $(config_h)
-category.o: category.c category.h buffer.h charset.h $(config_h)
-ccl.o: ccl.c ccl.h charset.h coding.h $(config_h)
-charset.o: charset.c charset.h buffer.h coding.h composite.h disptab.h \
- $(config_h)
-coding.o: coding.c coding.h ccl.h buffer.h charset.h $(config_h)
-cm.o: cm.c cm.h termhooks.h $(config_h)
-cmds.o: cmds.c syntax.h buffer.h charset.h commands.h window.h $(config_h) \
- msdos.h dispextern.h
-pre-crt0.o: pre-crt0.c
-ecrt0.o: ecrt0.c $(config_h)
- CRT0_COMPILE ${srcdir}/ecrt0.c
-dired.o: dired.c commands.h buffer.h $(config_h) charset.h coding.h regex.h \
- systime.h
-dispnew.o: dispnew.c commands.h frame.h window.h buffer.h dispextern.h \
- termchar.h termopts.h termhooks.h cm.h disptab.h systty.h systime.h \
- xterm.h blockinput.h atimer.h charset.h msdos.h composite.h keyboard.h \
- $(config_h)
-doc.o: doc.c $(config_h) epaths.h buffer.h keyboard.h charset.h
-doprnt.o: doprnt.c charset.h $(config_h)
-dosfns.o: buffer.h termchar.h termhooks.h frame.h msdos.h dosfns.h $(config_h)
-editfns.o: editfns.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \
- coding.h dispextern.h $(config_h)
-emacs.o: emacs.c commands.h systty.h syssignal.h blockinput.h process.h \
- termhooks.h buffer.h atimer.h systime.h $(INTERVAL_SRC) $(config_h)
-fileio.o: fileio.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \
- coding.h ccl.h msdos.h dispextern.h $(config_h)
-filelock.o: filelock.c buffer.h systime.h epaths.h $(config_h)
-filemode.o: filemode.c $(config_h)
-frame.o: frame.c xterm.h window.h frame.h termhooks.h commands.h keyboard.h \
- buffer.h charset.h fontset.h msdos.h dosfns.h dispextern.h $(config_h)
-fontset.o: dispextern.h fontset.h fontset.c ccl.h charset.h frame.h \
- keyboard.h $(config_h)
-getloadavg.o: getloadavg.c $(config_h)
-indent.o: indent.c frame.h window.h indent.h buffer.h $(config_h) termchar.h \
- termopts.h disptab.h region-cache.h charset.h composite.h dispextern.h \
- keyboard.h
-insdel.o: insdel.c window.h buffer.h $(INTERVAL_SRC) blockinput.h charset.h\
- dispextern.h atimer.h systime.h $(config_h)
-keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h charset.h \
- commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \
- systty.h systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \
- atimer.h xterm.h puresize.h msdos.h $(config_h)
-keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \
- atimer.h systime.h puresize.h charset.h intervals.h $(config_h)
-lastfile.o: lastfile.c $(config_h)
-macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h \
- dispextern.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 charset.h $(config_h)
-minibuf.o: minibuf.c syntax.h dispextern.h frame.h window.h keyboard.h \
- buffer.h commands.h charset.h msdos.h $(config_h)
-mktime.o: mktime.c $(config_h)
-mocklisp.o: mocklisp.c buffer.h $(config_h)
-msdos.o: msdos.c msdos.h dosfns.h systime.h termhooks.h dispextern.h frame.h \
- termopts.h termchar.h charset.h coding.h ccl.h disptab.h window.h \
- keyboard.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 dispextern.h \
- blockinput.h atimer.h charset.h coding.h ccl.h msdos.h composite.h \
- keyboard.h $(config_h)
-regex.o: regex.c syntax.h buffer.h $(config_h) regex.h category.h charset.h
-region-cache.o: region-cache.c buffer.h region-cache.h
-scroll.o: scroll.c termchar.h dispextern.h frame.h msdos.h keyboard.h \
- $(config_h)
-search.o: search.c regex.h commands.h buffer.h region-cache.h syntax.h \
- blockinput.h atimer.h systime.h category.h charset.h composite.h $(config_h)
-strftime.o: strftime.c $(config_h)
-syntax.o: syntax.c syntax.h buffer.h commands.h category.h charset.h \
- composite.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 atimer.h \
- window.h msdos.h dosfns.h keyboard.h
-term.o: term.c termchar.h termhooks.h termopts.h $(config_h) cm.h frame.h \
- disptab.h dispextern.h keyboard.h charset.h coding.h ccl.h msdos.h
-termcap.o: termcap.c $(config_h)
-terminfo.o: terminfo.c $(config_h)
-tparam.o: tparam.c $(config_h)
-undo.o: undo.c buffer.h commands.h $(config_h)
-/* This hack is to discard any space that cpp might put at the beginning
- of UNEXEC when substituting it in. */
-UNEXEC_ALIAS=UNEXEC
-$(UNEXEC_ALIAS): UNEXEC_SRC $(config_h)
-w16select.o: w16select.c dispextern.h frame.h blockinput.h atimer.h systime.h \
- msdos.h $(config_h)
-widget.o: widget.c xterm.h frame.h dispextern.h widgetprv.h \
- $(srcdir)/../lwlib/lwlib.h $(config_h)
-window.o: window.c indent.h commands.h frame.h window.h buffer.h termchar.h \
- termhooks.h disptab.h keyboard.h dispextern.h msdos.h composite.h \
- $(config_h)
-xdisp.o: xdisp.c macros.h commands.h indent.h buffer.h dispextern.h coding.h \
- termchar.h frame.h window.h disptab.h termhooks.h charset.h $(config_h) \
- msdos.h composite.h fontset.h
-xfaces.o: xfaces.c dispextern.h frame.h xterm.h buffer.h blockinput.h \
- window.h charset.h msdos.h dosfns.h composite.h atimer.h systime.h $(config_h)
-xfns.o: xfns.c buffer.h frame.h window.h keyboard.h xterm.h dispextern.h \
- $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h epaths.h \
- charset.h $(config_h)
-xmenu.o: xmenu.c xterm.h termhooks.h window.h dispextern.h frame.h keyboard.h \
- $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h msdos.h \
- $(config_h)
-xterm.o: xterm.c xterm.h termhooks.h termopts.h termchar.h window.h \
- dispextern.h frame.h disptab.h blockinput.h atimer.h systime.h syssignal.h \
- keyboard.h gnu.h sink.h sinkmask.h charset.h ccl.h fontset.h composite.h \
- coding.h $(config_h)
-xselect.o: xselect.c dispextern.h frame.h xterm.h blockinput.h charset.h \
- coding.h ccl.h buffer.h atimer.h systime.h $(config_h)
-xrdb.o: xrdb.c $(config_h) epaths.h
-hftctl.o: hftctl.c $(config_h)
-sound.o: sound.c dispextern.h $(config_h)
-atimer.o: atimer.c atimer.h systime.h $(config_h)
-
-/* The files of Lisp proper */
-
-alloc.o: alloc.c frame.h window.h buffer.h puresize.h syssignal.h keyboard.h \
- blockinput.h atimer.h systime.h charset.h dispextern.h $(config_h) $(INTERVAL_SRC)
-bytecode.o: bytecode.c buffer.h syntax.h charset.h $(config_h)
-data.o: data.c buffer.h puresize.h charset.h syssignal.h keyboard.h $(config_h)
-eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h \
- $(config_h)
-floatfns.o: floatfns.c $(config_h)
-fns.o: fns.c commands.h $(config_h) frame.h buffer.h charset.h keyboard.h \
- frame.h window.h dispextern.h $(INTERVAL_SRC)
-print.o: print.c process.h frame.h window.h buffer.h keyboard.h charset.h\
- $(config_h) dispextern.h msdos.h composite.h
-lread.o: lread.c commands.h keyboard.h buffer.h epaths.h charset.h $(config_h) \
- termhooks.h msdos.h
-
-/* Text properties support */
-textprop.o: textprop.c buffer.h window.h dispextern.h $(INTERVAL_SRC) \
- $(config_h)
-intervals.o: intervals.c buffer.h $(INTERVAL_SRC) keyboard.h puresize.h $(config_h)
-composite.o: composite.c buffer.h charset.h $(INTERVAL_SRC) $(config_h)
-
-/* System-specific programs to be made.
- OTHER_FILES and OBJECTS_MACHINE
- select which of these should be compiled. */
-
-sunfns.o: sunfns.c buffer.h window.h dispextern.h $(config_h)
-
-${libsrc}emacstool: ${libsrc}emacstool.c
- cd ${libsrc}; ${MAKE} ${MFLAGS} emacstool
-mostlyclean:
- rm -f temacs prefix-args core *.core \#* *.o libXMenu11.a liblw.a
- rm -f ../etc/DOC
-clean: mostlyclean
- rm -f emacs-* emacs bootstrap-emacs
-/**/# This is used in making a distribution.
-/**/# Do not use it on development directories!
-distclean: clean
- rm -f epaths.h config.h Makefile Makefile.c config.stamp stamp-oldxmenu ../etc/DOC-*
-maintainer-clean: distclean
- @echo "This command is intended for maintainers to use;"
- @echo "it deletes files that may require special tools to rebuild."
- rm -f TAGS
-versionclean:
- -rm -f emacs emacs-* ../etc/DOC*
-extraclean: distclean
- -rm -f *~ \#* m/?*~ s/?*~
-
-/* The rule for the [sm] files has to be written a little funny to
- avoid looking like a C comment to CPP. */
-SOURCES = *.[ch] [sm]/?* COPYING Makefile.in \
- config.in epaths.in README COPYING ChangeLog vms.pp-trans
-unlock:
- chmod u+w $(SOURCES)
-
-relock:
- chmod -w $(SOURCES)
- chmod +w epaths.h
-
-/* Arrange to make a tags table TAGS-LISP for ../lisp,
- plus TAGS for the C files, which includes ../lisp/TAGS by reference. */
-ctagsfiles1 = [xyzXYZ]*.[hc]
-ctagsfiles2 = [a-wA-W]*.[hc]
-TAGS: $(srcdir)/$(ctagsfiles)
- ../lib-src/etags --include=TAGS-LISP --include=${lwlibdir}/TAGS \
- --regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' \
- $(srcdir)/$(ctagsfiles1) $(srcdir)/$(ctagsfiles2)
-frc:
-TAGS-LISP: frc
- $(MAKE) -f ${lispsource}Makefile TAGS-LISP ETAGS=../lib-src/etags
-tags: TAGS TAGS-LISP
-.PHONY: tags
-
-
-/* Bootstrapping. */
-
-bootstrap: bootstrap-emacs
-
-/* Build a temacs with a sufficiently large PURESIZE to load the
- Lisp files from loadup.el in source form. */
-
-bootstrap-temacs:
- LC_ALL=C $(MAKE) $(MFLAGS) temacs ALL_CFLAGS="$(ALL_CFLAGS) -DPURESIZE=5000000 -I../src"
-
-/* Dump an Emacs executable named bootstrap-emacs containing the
- files from loadup.el in source form. */
-
-bootstrap-emacs: bootstrap-temacs
-#ifdef CANNOT_DUMP
- ln temacs bootstrap-emacs
-#else
-#ifdef HAVE_SHM
- ./temacs -nl -batch -l loadup bootstrap
-#else /* ! defined (HAVE_SHM) */
- ./temacs --batch --load loadup bootstrap
-#endif /* ! defined (HAVE_SHM) */
-#endif /* ! defined (CANNOT_DUMP) */
- mv -f emacs bootstrap-emacs
- rm -f temacs
-
+++ /dev/null
-#include <X11/Xlib.h>
-#include <X11/X.h>
-#include <X11/Xutil.h>
-#include <X11/Xresource.h>
-#include "XTests.h"
-#include <stdio.h>
-
-static Display *dpy;
-
-static void
-quit (dpy)
- Display *dpy;
-{
- XCloseDisplay (dpy);
- exit (0);
-}
-
-static Colormap screen_colormap;
-
-static unsigned long
-obtain_color (color)
- char *color;
-{
- int exists;
- XColor color_def;
-
- if (!screen_colormap)
- screen_colormap = DefaultColormap (dpy, DefaultScreen (dpy));
-
- exists = XParseColor (dpy, screen_colormap, color, &color_def)
- && XAllocColor (dpy, screen_colormap, &color_def);
- if (exists)
- return color_def.pixel;
-
- fprintf (stderr, "Can't get color; using black.");
- return BlackPixel (dpy, DefaultScreen (dpy));
-}
-
-static char *visual_strings[] =
-{
- "StaticGray ",
- "GrayScale ",
- "StaticColor",
- "PseudoColor",
- "TrueColor ",
- "DirectColor"
-};
-
-main (argc,argv)
- int argc;
- char *argv[];
-{
- char *dpy_string;
- int n;
- long mask;
- Visual *my_visual;
- XVisualInfo *vinfo, visual_template;
- XEvent event;
- Window window;
- Screen *scr;
- XGCValues gc_values;
- GC fill_gc, pix_gc, line_xor_gc, line_xor_inv_gc;
- int i;
- int x, y, width, height, geometry, gravity;
- char *geo;
- char default_geo[] = "80x40+0+0";
- int depth;
- Pixmap pix;
- char *string = "Kill the head and the body will die.";
- char dash_list[] = {4, 4};
- int dashes = 2;
-
- if (argc < 2)
- dpy_string = "localhost:0.0";
- else
- dpy_string = argv[1];
-
- if (argc >= 3)
- {
- XSizeHints hints;
-
- printf ("Geometry: %s\t(default: %s)\n", argv[2], default_geo);
- geo = argv[2];
- XWMGeometry (dpy, DefaultScreen (dpy), geo, default_geo,
- 3, &hints, &x, &y, &width, &height, &gravity);
- }
-
- dpy = XOpenDisplay (dpy_string);
- if (!dpy)
- {
- printf ("Can' open display %s\n", dpy_string);
- exit (1);
- }
-
- window = XCreateSimpleWindow (dpy, DefaultRootWindow (dpy),
- 300, 300, 300, 300, 1,
- BlackPixel (dpy, DefaultScreen (dpy)),
- WhitePixel (dpy, DefaultScreen (dpy)));
- XSelectInput (dpy, window, ButtonPressMask | KeyPressMask
- | EnterWindowMask | LeaveWindowMask);
-
- gc_values.foreground = obtain_color ("blue");
- gc_values.background = WhitePixel (dpy, DefaultScreen (dpy));
- fill_gc = XCreateGC (dpy, window, GCForeground | GCBackground,
- &gc_values);
-
- gc_values.foreground = obtain_color ("red");
- gc_values.line_width = 3;
- gc_values.line_style = LineOnOffDash;
- gc_values.cap_style = CapRound;
- gc_values.join_style = JoinRound;
- line_xor_gc = XCreateGC (dpy, window,
- GCForeground | GCBackground | GCLineStyle
- | GCJoinStyle | GCCapStyle | GCLineWidth,
- &gc_values);
- XSetDashes (dpy, line_xor_gc, 0, dash_list, dashes);
-
- line_xor_inv_gc = XCreateGC (dpy, window,
- GCForeground | GCBackground | GCLineWidth,
- &gc_values);
-
- depth = DefaultDepthOfScreen (ScreenOfDisplay (dpy, DefaultScreen (dpy)));
- pix = XCreateBitmapFromData (dpy, window, page_glyf_bits,
- page_glyf_width, page_glyf_height);
-
- XMapWindow (dpy, window);
- XFlush (dpy);
-
- while (1)
- {
- XNextEvent (dpy, &event);
- switch (event.type)
- {
- case ButtonPress:
- switch (event.xbutton.button)
- {
- case Button1:
- XDrawLine (dpy, window, line_xor_gc, 25, 75, 300, 75);
- break;
-
- case Button2:
- XDrawLine (dpy, window, line_xor_inv_gc, 25, 25, 300, 25);
- break;
-
- case Button3:
- XDrawLine (dpy, window, line_xor_gc, 25, 25, 25, 125);
- break;
- }
- break;
-
- case KeyPress:
- {
- char buf[20];
- int n;
- XComposeStatus status;
- KeySym keysym;
-
- n = XLookupString (&event, buf, 20, &keysym,
- (XComposeStatus *) &status);
-
- if (n == 1 && buf[0] == 'q')
- quit (dpy);
- }
- break;
-
- case EnterNotify:
- XCopyPlane (dpy, pix, window, fill_gc, 0, 0,
- page_glyf_width, page_glyf_height, 100, 100, 1L);
- XFillRectangle (dpy, window, fill_gc, 50, 50, 50, 50);
- break;
-
- case LeaveNotify:
- XClearWindow (dpy, window);
- break;
- }
-
- XFlush (dpy);
- }
-}
+++ /dev/null
-#define page_glyf_width 30
-#define page_glyf_height 10
-static char page_glyf_bits[] = {
- 0xf0, 0xff, 0xff, 0x03, 0x08, 0x00, 0x00, 0x04, 0xc4, 0x19, 0xf3, 0x08,
- 0x42, 0xa5, 0x14, 0x10, 0xc1, 0xa5, 0x70, 0x20, 0x41, 0xbc, 0x16, 0x20,
- 0x42, 0xa4, 0x14, 0x10, 0x44, 0x24, 0xf3, 0x08, 0x08, 0x00, 0x00, 0x04,
- 0xf0, 0xff, 0xff, 0x03};
multibyte form later. */ \
extra_bytes++; \
} \
- else if (CHAR_VALID_P (ch, 0)) \
- dst += CHAR_STRING (ch, dst); \
else \
- CCL_INVALID_CMD; \
+ dst += CHAR_STRING (ch, dst); \
} \
else \
CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
bcopy (msg, dst, msglen);
dst += msglen;
}
- if (ccl->status == CCL_STAT_INVALID_CMD)
- {
- /* Copy the remaining source data. */
- int i = src_end - src;
- if (dst_bytes && (dst_end - dst) < i)
- i = dst_end - dst;
- bcopy (src, dst, i);
- src += i;
- dst += i;
- }
}
ccl_finish:
+++ /dev/null
-/* 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
\n\
A field is a region of text with the same `field' property.\n\
If NEW-POS is nil, then the current point is used instead, and set to the\n\
-constrained position if that is different.\n\
+constrained position if that is is different.\n\
\n\
If OLD-POS is at the boundary of two fields, then the allowable\n\
positions for NEW-POS depends on the value of the optional argument\n\
+++ /dev/null
-/* Environment-hacking for GNU Emacs subprocess
- 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. */
-
-
-#include "config.h"
-#include "lisp.h"
-
-#ifdef MAINTAIN_ENVIRONMENT
-
-#ifdef VMS
-you lose -- this is un*x-only
-#endif
-
-/* alist of (name-string . value-string) */
-Lisp_Object Venvironment_alist;
-extern char **environ;
-
-void
-set_environment_alist (str, val)
- register Lisp_Object str, val;
-{
- register Lisp_Object tem;
-
- tem = Fassoc (str, Venvironment_alist);
- if (NULL (tem))
- if (NULL (val))
- ;
- else
- Venvironment_alist = Fcons (Fcons (str, val), Venvironment_alist);
- else
- if (NULL (val))
- Venvironment_alist = Fdelq (tem, Venvironment_alist);
- else
- XCONS (tem)->cdr = val;
-}
-
-
-
-static void
-initialize_environment_alist ()
-{
- register unsigned char **e, *s;
- extern char *index ();
-
- for (e = (unsigned char **) environ; *e; e++)
- {
- s = (unsigned char *) index (*e, '=');
- if (s)
- set_environment_alist (make_string (*e, s - *e),
- build_string (s + 1));
- }
-}
-
-\f
-unsigned char *
-getenv_1 (str, ephemeral)
- register unsigned char *str;
- int ephemeral; /* if ephmeral, don't need to gc-proof */
-{
- register Lisp_Object env;
- int len = strlen (str);
-
- for (env = Venvironment_alist; CONSP (env); env = XCONS (env)->cdr)
- {
- register Lisp_Object car = XCONS (env)->car;
- register Lisp_Object tem = XCONS (car)->car;
-
- if ((len == XSTRING (tem)->size) &&
- (!bcmp (str, XSTRING (tem)->data, len)))
- {
- /* Found it in the lisp environment */
- tem = XCONS (car)->cdr;
- if (ephemeral)
- /* Caller promises that gc won't make him lose */
- return XSTRING (tem)->data;
- else
- {
- register unsigned char **e;
- unsigned char *s;
- int ll = XSTRING (tem)->size;
-
- /* Look for element in the original unix environment */
- for (e = (unsigned char **) environ; *e; e++)
- if (!bcmp (str, *e, len) && *(*e + len) == '=')
- {
- s = *e + len + 1;
- if (strlen (s) >= ll)
- /* User hasn't either hasn't munged it or has set it
- to something shorter -- we don't have to cons */
- goto copy;
- else
- goto cons;
- };
- cons:
- /* User has setenv'ed it to a diferent value, and our caller
- isn't guaranteeing that he won't stash it away somewhere.
- We can't just return a pointer to the lisp string, as that
- will be corrupted when gc happens. So, we cons (in such
- a way that it can't be freed -- though this isn't such a
- problem since the only callers of getenv (as opposed to
- those of egetenv) are very early, before the user -could-
- have frobbed the environment. */
- s = (unsigned char *) xmalloc (ll + 1);
- copy:
- bcopy (XSTRING (tem)->data, s, ll + 1);
- return (s);
- }
- }
- }
- return ((unsigned char *) 0);
-}
-
-/* unsigned -- stupid delcaration in lisp.h */ char *
-getenv (str)
- register unsigned char *str;
-{
- return ((char *) getenv_1 (str, 0));
-}
-
-unsigned char *
-egetenv (str)
- register unsigned char *str;
-{
- return (getenv_1 (str, 1));
-}
-\f
-
-#if (1 == 1) /* use caller-alloca versions, rather than callee-malloc */
-int
-size_of_current_environ ()
-{
- register int size;
- Lisp_Object tem;
-
- tem = Flength (Venvironment_alist);
-
- size = (XINT (tem) + 1) * sizeof (unsigned char *);
- /* + 1 for environment-terminating 0 */
-
- for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
- {
- register Lisp_Object str, val;
-
- str = XCONS (XCONS (tem)->car)->car;
- val = XCONS (XCONS (tem)->car)->cdr;
-
- size += (XSTRING (str)->size +
- XSTRING (val)->size +
- 2); /* 1 for '=', 1 for '\000' */
- }
- return size;
-}
-
-void
-get_current_environ (memory_block)
- unsigned char **memory_block;
-{
- register unsigned char **e, *s;
- register int len;
- register Lisp_Object tem;
-
- e = memory_block;
-
- tem = Flength (Venvironment_alist);
-
- s = (unsigned char *) memory_block
- + (XINT (tem) + 1) * sizeof (unsigned char *);
-
- for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
- {
- register Lisp_Object str, val;
-
- str = XCONS (XCONS (tem)->car)->car;
- val = XCONS (XCONS (tem)->car)->cdr;
-
- *e++ = s;
- len = XSTRING (str)->size;
- bcopy (XSTRING (str)->data, s, len);
- s += len;
- *s++ = '=';
- len = XSTRING (val)->size;
- bcopy (XSTRING (val)->data, s, len);
- s += len;
- *s++ = '\000';
- }
- *e = 0;
-}
-
-#else
-/* dead code (this function mallocs, caller frees) superseded by above (which allows caller to use alloca) */
-unsigned char **
-current_environ ()
-{
- unsigned char **env;
- register unsigned char **e, *s;
- register int len, env_len;
- Lisp_Object tem;
- Lisp_Object str, val;
-
- tem = Flength (Venvironment_alist);
-
- env_len = (XINT (tem) + 1) * sizeof (char *);
- /* + 1 for terminating 0 */
-
- len = 0;
- for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
- {
- str = XCONS (XCONS (tem)->car)->car;
- val = XCONS (XCONS (tem)->car)->cdr;
-
- len += (XSTRING (str)->size +
- XSTRING (val)->size +
- 2);
- }
-
- e = env = (unsigned char **) xmalloc (env_len + len);
- s = (unsigned char *) env + env_len;
-
- for (tem = Venvironment_alist; !NULL (tem); tem = XCONS (tem)->cdr)
- {
- str = XCONS (XCONS (tem)->car)->car;
- val = XCONS (XCONS (tem)->car)->cdr;
-
- *e++ = s;
- len = XSTRING (str)->size;
- bcopy (XSTRING (str)->data, s, len);
- s += len;
- *s++ = '=';
- len = XSTRING (val)->size;
- bcopy (XSTRING (val)->data, s, len);
- s += len;
- *s++ = '\000';
- }
- *e = 0;
-
- return env;
-}
-
-#endif /* dead code */
-
-\f
-DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, "sEnvironment variable: \np",
- "Return the value of environment variable VAR, as a string.\n\
-When invoked interactively, print the value in the echo area.\n\
-VAR is a string, the name of the variable,\n\
- or the symbol t, meaning to return an alist representing the\n\
- current environment.")
- (str, interactivep)
- Lisp_Object str, interactivep;
-{
- Lisp_Object val;
-
- if (str == Qt) /* If arg is t, return whole environment */
- return (Fcopy_alist (Venvironment_alist));
-
- CHECK_STRING (str, 0);
- val = Fcdr (Fassoc (str, Venvironment_alist));
- if (!NULL (interactivep))
- {
- if (NULL (val))
- message ("%s not defined in environment", XSTRING (str)->data);
- else
- message ("\"%s\"", XSTRING (val)->data);
- }
- return val;
-}
-
-DEFUN ("setenv", Fsetenv, Ssetenv, 1, 2,
- "sEnvironment variable: \nsSet %s to value: ",
- "Set the value of environment variable VAR to VALUE.\n\
-Both args must be strings. Returns VALUE.")
- (str, val)
- Lisp_Object str;
- Lisp_Object val;
-{
- Lisp_Object tem;
-
- CHECK_STRING (str, 0);
- if (!NULL (val))
- CHECK_STRING (val, 0);
-
- set_environment_alist (str, val);
- return val;
-}
-\f
-
-syms_of_environ ()
-{
- staticpro (&Venvironment_alist);
- defsubr (&Ssetenv);
- defsubr (&Sgetenv);
-}
-
-init_environ ()
-{
- Venvironment_alist = Qnil;
- initialize_environment_alist ();
-}
-
-#endif /* MAINTAIN_ENVIRONMENT */
DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
Smodify_frame_parameters, 2, 2, 0,
"Modify the parameters of frame FRAME according to ALIST.\n\
-If FRAME is nil, it defaults to the selected frame.\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.\n\
+++ /dev/null
-/* Machine description file for MS-DOS
-
- Copyright (C) 1993 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-
-/* Note: lots of stuff here was taken from m-dos386.h in demacs. */
-
-
-/* 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 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)
-
-/* 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 */
-/* 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 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
-
-/* We need a little extra space, see ../../lisp/loadup.el */
-#define PURESIZE 240000
-
-/* We have (the code to control) a mouse. */
-#define HAVE_MOUSE
+++ /dev/null
-/* 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: $(BLD) $(EMACS)
$(EMACS): $(DOC) $(TEMACS)
- "$(THISDIR)/$(BLD)/temacs.exe" -batch -l loadup dump
+ "./$(BLD)/temacs.exe" -batch -l loadup dump
#
# The undumped executable
# files from loadup.el in source form.
#
bootstrap-emacs: bootstrap-temacs
- "$(THISDIR)/$(BLD)/temacs.exe" -batch -l loadup bootstrap
+ "./$(BLD)/temacs.exe" -batch -l loadup bootstrap
- mkdir "../bin"
$(CP) $(EMACS) ../bin
+++ /dev/null
-/* Block-relocating memory allocator.
- 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 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 package works by allocating blocks from a zone of memory
- above that used by malloc (). When malloc needs more space that
- would enter our zone, we relocate blocks upward. The bottom of
- our zone is kept in the variable `virtual_break_value'. The top
- of our zone is indicated by `real_break_value'.
-
- As blocks are freed, a free list is maintained and we attempt
- to satisfy further requests for space using a first-fit policy.
- If there are holes, but none fit, memory is compacted and a new
- block is obtained at the top of the zone.
-
- NOTE that our blocks are always rounded to page boundaries. */
-
-/*
- NOTES:
-
- Once this is stable, I can speed things up by intially leaving a large
- gap between real_break_value and true_break_value, or maybe making
- a large hole before the first block.
-
- If we also kept track of size_wanted, we could gain some
- extra space upon compactification.
-
- Perhaps we should just note a hole when malloc does doing sbrk(-n)?
-
- Relocating downward upon freeing the first block would simplify
- other things.
-
- When r_alloc places a block in a hole, we could easily check if there's
- much more than required, and leave a hole.
- */
-\f
-#include "mem_limits.h"
-
-static POINTER r_alloc_sbrk ();
-static POINTER sbrk ();
-static POINTER brk ();
-
-/* Variable `malloc' uses for the function which gets more space
- from the system. */
-extern POINTER (*__morecore) ();
-
-/* List of variables which point into the associated data block. */
-struct other_pointer
-{
- POINTER *location;
- struct other_pointer *next;
-};
-
-/* List describing all the user's pointers to relocatable blocks. */
-typedef struct rel_pointers
-{
- struct rel_pointers *next;
- struct rel_pointers *prev;
- struct other_pointer *others; /* Other variables which use this block. */
- POINTER *location; /* Location of the block's pointer. */
- POINTER block; /* Address of the actual data. */
- int size; /* The size of the block. */
-} relocatable_pointer;
-
-#define REL_NIL ((struct rel_pointers *) 0)
-
-static relocatable_pointer *pointer_list;
-static relocatable_pointer *last_pointer;
-
-#define MAX_HOLES 2
-
-/* Vector of available holes among allocated blocks. This can include
- a hole at the beginning of the list, but never the end. */
-typedef struct
-{
- POINTER address;
- unsigned int size;
-} hole_descriptor;
-
-static hole_descriptor r_alloc_holes[MAX_HOLES];
-
-/* Number of holes currently available. */
-static int holes;
-
-/* The process break value (i.e., curbrk) */
-static POINTER real_break_value;
-
-/* The REAL (i.e., page aligned) break value. */
-static POINTER true_break_value;
-
-/* Address of start of data space in use by relocatable blocks.
- This is what `malloc' thinks is the process break value. */
-static POINTER virtual_break_value;
-
-/* Nonzero if we have told `malloc' to start using `r_alloc_sbrk'
- instead of calling `sbrk' directly. */
-int r_alloc_in_use;
-
-#define PAGE (getpagesize ())
-#define ALIGNED(addr) (((unsigned int) (addr) & (PAGE - 1)) == 0)
-#define ROUNDUP(size) (((unsigned int) (size) + PAGE) & ~(PAGE - 1))
-
-/*
- Level number of warnings already issued.
- 0 -- no warnings issued.
- 1 -- 75% warning already issued.
- 2 -- 85% warning already issued.
-*/
-static int warnlevel;
-
-/* Function to call to issue a warning;
- 0 means don't issue them. */
-static void (*warnfunction) ();
-\f
-/* Call this to start things off. It determines the current process
- break value, as well as the `true' break value--because the system
- allocates memory in page increments, if the break value is not page
- aligned it means that space up to the next page boundary is actually
- available. */
-
-void
-malloc_init (start, warn_func)
- POINTER start;
- void (*warn_func) ();
-{
- r_alloc_in_use = 1;
- __morecore = r_alloc_sbrk;
-
- virtual_break_value = real_break_value = sbrk (0);
- if (ALIGNED (real_break_value))
- true_break_value = real_break_value;
- else
- true_break_value = (POINTER) ROUNDUP (real_break_value);
-
- if (start)
- data_space_start = start;
- lim_data = 0;
- warnlevel = 0;
- warnfunction = warn_func;
-
- get_lim_data ();
-}
-
-/* Get more space for us to use. Return a pointer to SIZE more
- bytes of space. SIZE is internally rounded up to a page boundary,
- and requests for integral pages prefetch an extra page. */
-
-static POINTER
-get_more_space (size)
- unsigned int size;
-{
- unsigned int margin = true_break_value - real_break_value;
- unsigned int get;
- POINTER old_break = real_break_value;
-
- if (size == 0)
- return real_break_value;
-
- if (size <= margin)
- {
- real_break_value += size;
- return old_break;
- }
-
- get = ROUNDUP (size - margin);
- if (sbrk (get) < (POINTER) 0)
- return NULL;
-
- true_break_value += get;
- real_break_value = (old_break + size);
-
- return old_break;
-}
-
-/* Relinquish size bytes of space to the system. Space is only returned
- in page increments. If successful, return real_break_value. */
-
-static POINTER
-return_space (size)
- unsigned int size;
-{
- unsigned int margin = (true_break_value - real_break_value) + size;
- unsigned int to_return = (margin / PAGE) * PAGE;
- unsigned new_margin = margin % PAGE;
-
- true_break_value -= to_return;
- if (! brk (true_break_value))
- return NULL;
-
- real_break_value = true_break_value - new_margin;
- return real_break_value;
-}
-\f
-/* Record a new hole in memory beginning at ADDRESS of size SIZE.
- Holes are ordered by location. Adjacent holes are merged.
- Holes are zero filled before being noted. */
-
-static void
-note_hole (address, size)
- POINTER address;
- int size;
-{
- register int this_hole = holes - 1; /* Start at the last hole. */
- register POINTER end = address + size; /* End of the hole. */
- register int i;
-
- if (holes)
- {
- /* Find the hole which should precede this new one. */
- while (this_hole >= 0 && r_alloc_holes[this_hole].address > address)
- this_hole--;
-
- /* Can we merge with preceding? */
- if (this_hole >= 0
- && r_alloc_holes[this_hole].address + r_alloc_holes[this_hole].size
- == address)
- {
- r_alloc_holes[this_hole].size += size;
-
- if (this_hole == holes - 1)
- return;
-
- /* Can we also merge with following? */
- if (end == r_alloc_holes[this_hole + 1].address)
- {
- r_alloc_holes[this_hole].size
- += r_alloc_holes[this_hole + 1].size;
-
- for (i = this_hole + 1; i < holes - 1; i++)
- r_alloc_holes[i] = r_alloc_holes[i + 1];
- holes--;
- }
-
- return;
- }
-
- if (this_hole < holes - 1) /* there are following holes */
- {
- register int next_hole = this_hole + 1;
-
- /* Can we merge with the next hole? */
- if (end == r_alloc_holes[next_hole].address)
- {
- r_alloc_holes[next_hole].address = address;
- r_alloc_holes[next_hole].size += size;
- return;
- }
-
- /* Can't merge, so insert. */
- for (i = holes; i > next_hole; i--)
- r_alloc_holes[i] = r_alloc_holes[i - 1];
- r_alloc_holes[next_hole].address = address;
- r_alloc_holes[next_hole].size = size;
- holes++;
-
- return;
- }
- else /* Simply add this hole at the end. */
- {
- r_alloc_holes[holes].address = address;
- r_alloc_holes[holes].size = size;
- holes++;
-
- return;
- }
-
- abort ();
- }
- else /* Make the first hole. */
- {
- holes = 1;
- r_alloc_holes[0].address = address;
- r_alloc_holes[0].size = size;
- }
-}
-
-/* Mark hole HOLE as no longer available by re-organizing the vector.
- HOLE is the Nth hole, beginning with 0. This doesn *not* affect memory
- organization. */
-
-static void
-delete_hole (hole)
- int hole;
-{
- register int i;
-
- for (i = hole; i < holes - 1; i++)
- r_alloc_holes[i] = r_alloc_holes[i + 1];
-
- holes--;
-}
-\f
-/* Insert a newly allocated pointer, NEW_PTR, at the appropriate
- place in our list. */
-
-static void
-insert (new_ptr)
- register relocatable_pointer *new_ptr;
-{
- register relocatable_pointer *this_ptr = pointer_list;
-
- while (this_ptr != REL_NIL && this_ptr->block < new_ptr->block)
- this_ptr = this_ptr->next;
-
- if (this_ptr == REL_NIL)
- abort (); /* Use `attach' for appending. */
-
- new_ptr->next = this_ptr;
- new_ptr->prev = this_ptr->prev;
- this_ptr->prev = new_ptr;
-
- if (this_ptr == pointer_list)
- pointer_list = new_ptr;
- else
- new_ptr->prev->next = new_ptr;
-}
-
-/* Attach a newly allocated pointer, NEW_PTR, to the end of our list. */
-
-static void
-attach (new_ptr)
- relocatable_pointer *new_ptr;
-{
- if (pointer_list == REL_NIL)
- {
- pointer_list = new_ptr;
- last_pointer = new_ptr;
- new_ptr->next = new_ptr->prev = REL_NIL;
- }
- else
- {
- new_ptr->next = REL_NIL;
- last_pointer->next = new_ptr;
- new_ptr->prev = last_pointer;
- last_pointer = new_ptr;
- }
-}
-
-static relocatable_pointer *
-find_block (block)
- POINTER block;
-{
- register relocatable_pointer *this_ptr = pointer_list;
-
- while (this_ptr != REL_NIL && this_ptr->block != block)
- this_ptr = this_ptr->next;
-
- return this_ptr;
-}
-
-static relocatable_pointer *
-find_location (address)
- POINTER *address;
-{
- register relocatable_pointer *this_ptr = pointer_list;
-
- while (this_ptr != REL_NIL && this_ptr->location != address)
- {
- struct other_pointer *op = this_ptr->others;
-
- while (op != (struct other_pointer *) 0)
- {
- if (op->location == address)
- return this_ptr;
-
- op = op->next;
- }
-
- this_ptr = this_ptr->next;
- }
-
- return this_ptr;
-}
-
-\f
-static void compactify ();
-
-/* Record of last new block allocated. */
-static relocatable_pointer *last_record;
-
-/* Allocate a block of size SIZE and record that PTR points to it.
- If successful, store the address of the block in *PTR and return
- it as well. Otherwise return NULL. */
-
-POINTER
-r_alloc (ptr, size)
- POINTER *ptr;
- int size;
-{
- register relocatable_pointer *record
- = (relocatable_pointer *) malloc (sizeof (relocatable_pointer));
- register POINTER block;
-
- /* If we can't get space to record this pointer, fail. */
- if (record == 0)
- return NULL;
-
- last_record = record;
-
- if (holes) /* Search for a hole the right size. */
- {
- int i;
-
- for (i = 0; i < holes; i++)
- if (r_alloc_holes[i].size >= size)
- {
- record->location = ptr;
- record->others = (struct other_pointer *) 0;
- record->block = *ptr = r_alloc_holes[i].address;
- if (r_alloc_holes[i].size > ROUNDUP (size))
- {
- record->size = ROUNDUP (size);
- r_alloc_holes[i].size -= ROUNDUP (size);
- r_alloc_holes[i].address += ROUNDUP (size);
- }
- else
- {
- record->size = r_alloc_holes[i].size;
- delete_hole (i);
- }
- insert (record);
-
- *ptr = record->block;
- return record->block;
- }
-
- /* No holes large enough. Burp. */
- compactify ();
- }
-
- /* No holes: grow the process. */
- block = get_more_space (size);
- if (block == NULL)
- {
- free (record);
- return NULL;
- }
-
- /* Return the address of the block. */
- *ptr = block;
-
- /* Record and append this pointer to our list. */
- record->location = ptr;
- record->others = (struct other_pointer *) 0;
- record->block = block;
- record->size = size;
- attach (record);
-
- return block;
-}
-
-/* Declare VAR to be a pointer which points into the block of r_alloc'd
- memory at BLOCK.
-
- If VAR is already delcared for this block, simply return.
- If VAR currently points to some other block, remove that declaration
- of it, then install the new one.
-
- Return 0 if successful, -1 otherwise. */
-
-int
-r_alloc_declare (var, block)
- POINTER *var;
- register POINTER block;
-{
- register relocatable_pointer *block_ptr = find_block (block);
- relocatable_pointer *var_ptr = find_location (var);
- register struct other_pointer *other;
-
- if (block_ptr == REL_NIL)
- abort ();
-
- if (var_ptr != REL_NIL) /* Var already declared somewhere. */
- {
- register struct other_pointer *po;
-
- if (var_ptr == block_ptr) /* Var already points to this block. */
- return 0;
-
- po = (struct other_pointer *) 0;
- other = var_ptr->others;
- while (other && other->location != var)
- {
- po = other;
- other = other->next;
- }
-
- if (!other) /* This only happens if the location is */
- abort (); /* the main pointer and not an `other' */
-
- if (po) /* In the chain */
- {
- po->next = other->next;
- free (other);
- }
- else /* Only element of the chain */
- {
- free (var_ptr->others);
- var_ptr->others = (struct other_pointer *) 0;
- }
- }
-
- /* Install this variable as an `other' element */
-
- other = (struct other_pointer *) malloc (sizeof (struct other_pointer));
-
- if (other == 0)
- return -1;
-
- /* If the malloc relocated this data block, adjust this variable. */
- if (block != block_ptr->block)
- {
- int offset = block_ptr->block - block;
-
- *var += offset;
- }
-
- other->location = var;
- other->next = (struct other_pointer *) 0;
-
- if (block_ptr->others == (struct other_pointer *) 0)
- block_ptr->others = other;
- else
- {
- register struct other_pointer *op = block_ptr->others;
-
- while (op->next != (struct other_pointer *) 0)
- op = op->next;
- op->next = other;
- }
-
- return 0;
-}
-\f
-/* Recursively free the linked list of `other' pointers to a block. */
-
-static void
-free_others (another)
- struct other_pointer *another;
-{
- if (another == (struct other_pointer *) 0)
- return;
-
- free_others (another->next);
- free (another);
-}
-
-/* Remove the element pointed to by PTR from the doubly linked list.
- Record the newly freed space in `holes', unless it was at the end,
- in which case return that space to the system. Return 0 if successful,
- -1 otherwise. */
-
-int
-r_alloc_free (ptr)
- register POINTER *ptr;
-{
- register relocatable_pointer *this_ptr = find_block (*ptr);
-
- if (this_ptr == REL_NIL)
- return -1;
- else
- {
- register relocatable_pointer *prev = this_ptr->prev;
- register relocatable_pointer *next = this_ptr->next;
- if (next && prev) /* Somewhere in the middle */
- {
- next->prev = prev;
- prev->next = next;
- }
- else if (prev) /* Last block */
- {
- prev->next = REL_NIL;
- last_pointer = prev;
- return_space (this_ptr->size);
- free_others (this_ptr->others);
- free (this_ptr);
-
- return 0;
- }
- else if (next) /* First block */
- {
- next->prev = REL_NIL;
- pointer_list = next;
- }
- else if (this_ptr = pointer_list) /* ONLY block */
- {
- pointer_list = REL_NIL;
- last_pointer = REL_NIL;
- if (holes) /* A hole precedes this block. */
- {
- holes = 0;
- return_space (real_break_value - virtual_break_value);
- }
- else
- return_space (this_ptr->size);
-
- if (real_break_value != virtual_break_value)
- abort ();
-
- free_others (this_ptr->others);
- free (this_ptr);
- /* Turn off r_alloc_in_use? */
-
- return 0;
- }
- else
- abort (); /* Weird shit */
-
- free_others (this_ptr->others);
- free (this_ptr);
- bzero (this_ptr->block, this_ptr->size);
- note_hole (this_ptr->block, this_ptr->size);
-
- if (holes == MAX_HOLES)
- compactify ();
- }
-
- return 0;
-}
-
-/* Change the size of the block pointed to by the thing in PTR.
- If neccessary, r_alloc a new block and copy the data there.
- Return a pointer to the block if successfull, NULL otherwise.
-
- Note that if the size requested is less than the actual bloc size,
- nothing is done and the pointer is simply returned. */
-
-POINTER
-r_re_alloc (ptr, size)
- POINTER *ptr;
- int size;
-{
- register relocatable_pointer *this_ptr = find_block (*ptr);
- POINTER block;
-
- if (! this_ptr)
- return NULL;
-
- if (this_ptr->size >= size) /* Already have enough space. */
- return *ptr;
-
- /* Here we could try relocating the blocks just above... */
- block = r_alloc (ptr, size);
- if (block)
- {
- bcopy (this_ptr->block, block, this_ptr->size);
- if (this_ptr->others)
- last_record->others = this_ptr->others;
-
- if (! r_alloc_free (this_ptr->block))
- abort ();
-
- *ptr = block;
- return block;
- }
-
- return NULL;
-}
-\f
-
-/* Move and relocate all blocks from FIRST_PTR to LAST_PTR, inclusive,
- downwards to space starting at ADDRESS. */
-
-static int
-move_blocks_downward (first_ptr, last_ptr, address)
- relocatable_pointer *first_ptr, *last_ptr;
- POINTER address;
-{
- int size = (last_ptr->block + last_ptr->size) - first_ptr->block;
- register relocatable_pointer *this_ptr = first_ptr;
- register offset = first_ptr->block - address;
- register struct other_pointer *op;
-
- /* Move all the data. */
- bcopy (first_ptr->block, address, size);
-
- /* Now relocate all the pointers to those blocks. */
- while (1)
- {
- this_ptr->block -= offset;
- *this_ptr->location = this_ptr->block;
-
- op = this_ptr->others;
- while (op != (struct other_pointer *) 0)
- {
- *op->location -= offset;
- op = op->next;
- }
-
- if (this_ptr == last_ptr)
- return;
- else
- this_ptr = this_ptr->next;
- }
-
- return size;
-}
-
-/* Burp our memory zone. */
-
-static void
-compactify ()
-{
- register relocatable_pointer *this_ptr = pointer_list;
- relocatable_pointer *first_to_move;
- register relocatable_pointer *last_to_move;
- hole_descriptor *this_hole = &r_alloc_holes[0];
- register hole_descriptor *next_hole;
- register POINTER end; /* First address after hole */
- unsigned int space_regained = 0;
-
- while (holes) /* While there are holes */
- {
- /* Find the first block after this hole. */
- end = this_hole->address + this_hole->size;
- while (this_ptr && this_ptr->block != end)
- this_ptr = this_ptr->next;
-
- if (! this_ptr)
- abort ();
-
- next_hole = this_hole + 1;
- last_to_move = first_to_move = this_ptr;
- this_ptr = this_ptr->next;
-
- /* Note all blocks located before the next hole. */
- while (this_ptr && this_ptr->block < next_hole->address)
- {
- last_to_move = this_ptr;
- this_ptr = this_ptr->next;
- }
- space_regained +=
- move_blocks_downward (first_to_move, last_to_move, this_hole->address);
-
- holes--;
- this_hole = next_hole;
- }
-
- return_space (space_regained);
-}
-\f
-/* Relocate the list elements from the beginning of the list up to and
- including UP_TO_THIS_PTR to the area beginning at FREE_SPACE, which is
- after all current blocks.
-
- First copy all the data, then adjust the pointers and reorganize
- the list. NOTE that this *only* works for contiguous blocks. */
-
-static unsigned int
-relocate_to_end (up_to_this_ptr, free_space)
- register relocatable_pointer *up_to_this_ptr;
- POINTER free_space;
-{
- register relocatable_pointer *this_ptr;
- POINTER block_start = pointer_list->block;
- POINTER block_end = up_to_this_ptr->block + up_to_this_ptr->size;
- unsigned int total_size = block_end - block_start;
- unsigned int offset = (int) (free_space - block_start);
-
- bcopy (block_start, free_space, total_size);
- for (this_ptr = up_to_this_ptr; this_ptr; this_ptr = this_ptr->prev)
- {
- struct other_pointer *op = this_ptr->others;
-
- *this_ptr->location += offset;
- this_ptr->block += offset;
-
- while (op != (struct other_pointer *) 0)
- {
- *op->location += offset;
- op = op->next;
- }
- }
-
- /* Connect the head to the tail. */
- last_pointer->next = pointer_list;
- pointer_list->prev = last_pointer;
-
- /* Disconnect */
- up_to_this_ptr->next->prev = REL_NIL;
- pointer_list = up_to_this_ptr->next;
- up_to_this_ptr->next = REL_NIL;
- last_pointer = up_to_this_ptr;
-
- return total_size; /* of space relocated. */
-}
-\f
-/* Relocate the list elements from FROM_THIS_PTR to (and including)
- the last to the zone beginning at FREE_SPACE, which is located
- before any blocks.
-
- First copy all the data, then adjust the pointers and reorganize
- the list. NOTE that this *only* works for contiguous blocks. */
-
-static unsigned int
-relocate_to_beginning (from_this_ptr, free_space)
- register relocatable_pointer *from_this_ptr;
- POINTER free_space;
-{
- POINTER block_start = from_this_ptr->block;
- POINTER block_end = last_pointer->block + last_pointer->size;
- unsigned int total_size = (int) (block_end - block_start);
- unsigned int offset = (int) (from_this_ptr->block - free_space);
- register relocatable_pointer *this_ptr;
-
- bcopy (block_start, free_space, total_size);
- for (this_ptr = from_this_ptr; this_ptr; this_ptr = this_ptr->next)
- {
- struct other_pointer *op = this_ptr->others;
-
- *this_ptr->location -= offset;
- this_ptr->block -= offset;
-
- while (op != (struct other_pointer *) 0)
- {
- *op->location -= offset;
- op = op->next;
- }
- }
-
- /* Connect the end to the beginning. */
- last_pointer->next = pointer_list;
- pointer_list->prev = last_pointer;
-
- /* Disconnect and reset first and last. */
- from_this_ptr->prev->next = REL_NIL;
- last_pointer = from_this_ptr->prev;
- pointer_list = from_this_ptr;
- pointer_list->prev = REL_NIL;
-
- return total_size; /* of space moved. */
-}
-\f
-/* Relocate any blocks neccessary, either upwards or downwards,
- to obtain a space of SIZE bytes. Assumes we have at least one block. */
-
-static unsigned int
-relocate (size)
- register int size;
-{
- register relocatable_pointer *ptr;
- register int got = 0;
-
- if (size > 0) /* Up: Relocate enough blocs to get SIZE. */
- {
- register POINTER new_space;
-
- for (ptr = pointer_list; got < size && ptr; ptr = ptr->next)
- got += ptr->size;
-
- if (ptr == REL_NIL)
- ptr = last_pointer;
-
- new_space = get_more_space (size);
- if (!new_space)
- return 0;
-
- return (relocate_to_end (ptr, pointer_list->block + size));
- }
-
- if (size < 0) /* Down: relocate as many blocs as will
- fit in SIZE bytes of space. */
- {
- register POINTER to_zone;
- unsigned int moved;
-
- for (ptr = last_pointer; got >= size && ptr; ptr = ptr->prev)
- got -= ptr->size;
-
- if (ptr == REL_NIL)
- ptr = pointer_list;
- else
- {
- /* Back off one block to be <= size */
- got += ptr->size;
- ptr = ptr->next;
- }
-
- if (got >= size)
- {
- to_zone = virtual_break_value - size + got;
- moved = relocate_to_beginning (ptr, to_zone);
- if (moved)
- return_space (moved);
-
- return moved;
- }
-
- return 0;
- }
-
- abort ();
-}
-\f
-/* This function encapsulates `sbrk' to preserve the relocatable blocks.
- It is called just like `sbrk'. When relocatable blocks are in use,
- `malloc' must use this function instead of `sbrk'. */
-
-POINTER
-r_alloc_sbrk (size)
- unsigned int size;
-{
- POINTER new_zone; /* Start of the zone we will return. */
-
-#if 0
- if (! r_alloc_in_use)
- return (POINTER) sbrk (size);
-#endif
-
- if (size == 0)
- return virtual_break_value;
-
- if (size > 0) /* Get more space */
- {
- register unsigned int space;
-
- if (pointer_list == REL_NIL)
- {
- POINTER space = get_more_space (size);
-
- virtual_break_value = real_break_value;
- return space;
- }
-
- new_zone = virtual_break_value;
-
- /* Check if there is a hole just before the buffer zone. */
- if (holes && r_alloc_holes[0].address == virtual_break_value)
- {
- if (r_alloc_holes[0].size > size)
- {
- /* Adjust the hole size. */
- r_alloc_holes[0].size -= size;
- r_alloc_holes[0].address += size;
- virtual_break_value += size;
-
- return new_zone;
- }
-
- if (r_alloc_holes[0].size == size)
- {
- virtual_break_value += size;
- delete_hole (0);
-
- return new_zone;
- }
-
- /* Adjust the size requested by space
- already available in this hole. */
- size -= r_alloc_holes[0].size;
- virtual_break_value += r_alloc_holes[0].size;
- delete_hole (0);
- }
-
- space = relocate (size);
- if (!space)
- return (POINTER) -1;
-
-#ifdef REL_ALLOC_SAVE_SPACE
- move_blocks_downward
-#else
- bzero (new_zone, space);
- if (space > size)
- note_hole (new_zone + size, space - size);
-#endif /* REL_ALLOC_SAVE_SPACE */
-
- virtual_break_value += size;
- return new_zone;
- }
- else /* Return space to system */
- {
- int moved;
- int left_over;
- POINTER old_break_value;
-
- if (pointer_list == REL_NIL)
- {
- POINTER space = return_space (-size);
- virtual_break_value = real_break_value;
-
- return space;
- }
-
- if (holes && r_alloc_holes[0].address == virtual_break_value)
- {
- size -= r_alloc_holes[0].size;
- delete_hole (0);
- }
-
- moved = relocate (size);
- old_break_value = virtual_break_value;
-
- if (!moved)
- return (POINTER) -1;
-
- left_over = moved + size;
- virtual_break_value += size;
-
- if (left_over)
- {
-#ifdef REL_ALLOC_SAVE_SPACE
- move_blocks_downward
-#else
- bzero (virtual_break_value, left_over);
- note_hole (virtual_break_value, left_over);
-#endif /* not REL_ALLOC_SAVE_SPACE */
- }
-
- return old_break_value;
- }
-}
-
-/* For debugging */
-
-#include <stdio.h>
-
-void
-memory_trace ()
-{
- relocatable_pointer *ptr;
- int i;
-
- fprintf (stderr, "virtual: 0x%x\n real: 0x%x\n true: 0x%x\n\n",
- virtual_break_value, real_break_value, true_break_value);
- fprintf (stderr, "Blocks:\n");
- for (ptr = pointer_list; ptr; ptr = ptr->next)
- {
- fprintf (stderr, " address: 0x%x\n", ptr->block);
- fprintf (stderr, " size: 0x%x\n", ptr->size);
- if (ptr->others)
- {
- struct other_pointer *op = ptr->others;
- fprintf (stderr, " others:", ptr->size);
- while (op)
- {
- fprintf (stderr, " 0x%x", op->location);
- op = op->next;
- }
- fprintf (stderr, "\n");
- }
- }
-
- if (holes)
- {
- fprintf (stderr, "\nHoles:\n");
- for (i = 0; i < holes; i++)
- {
- fprintf (stderr, " address: 0x%x\n", r_alloc_holes[i].address);
- fprintf (stderr, " size: 0x%x\n", r_alloc_holes[i].size);
- }
- }
-
- fprintf (stderr, "\n\n");
-}
"Output the printed representation of OBJECT, any Lisp object.\n\
No quoting characters are used; no delimiters are printed around\n\
the contents of strings.\n\
-Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
+Output stream is PRINTCHARFUN, or value of standard-output (which see).")
(object, printcharfun)
Lisp_Object object, printcharfun;
{
/* Null string is found at starting position. */
if (len == 0 || n == 0)
{
- set_search_regs (pos_byte, 0);
+ set_search_regs (pos, 0);
return pos;
}
+++ /dev/null
-/* casper@fwi.uva.nl says this file is not needed
- and sol2.h should work. */
-
-#include "sol2.h"
-
-/* Take care of libucb.a as well as X Windows. */
-#undef LD_SWITCH_SYSTEM
-#ifndef __GNUC__
-#define LD_SWITCH_SYSTEM -R/usr/openwin/lib:/usr/ucblib
-#else /* GCC */
-#define LD_SWITCH_SYSTEM -Xlinker -R/usr/openwin/lib:/usr/ucblib
-#endif /* GCC */
-
-/* Link with libucb.a. */
-#ifdef LIB_STANDARD
-#undef LIB_STANDARD
-#define LIB_STANDARD -lc -L/usr/ucblib -lucb
-#endif
+++ /dev/null
-/* Copyright (C) 1985, 1986, 1987, 1988, 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, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, 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
-
-
- */
-\f
-/* 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
-
- */
-\f
-#include <sys/types.h>
-#include <stdio.h>
-#include <sys/stat.h>
-#include <memory.h>
-#include <string.h>
-#include <errno.h>
-#include <unistd.h>
-#include <fcntl.h>
-#include <elf.h>
-#include <sys/mman.h>
-
-#ifdef __alpha__
-# include <sym.h> /* get COFF debugging symbol table declaration */
-#endif
-
-#if __GNU_LIBRARY__ - 0 >= 6
-# include <link.h> /* get ElfW etc */
-#endif
-
-#ifndef ElfW
-# ifdef __STDC__
-# define ElfW(type) Elf32_##type
-# else
-# define ElfW(type) Elf32_/**/type
-# endif
-#endif
-
-#ifndef emacs
-#define fatal(a, b, c) fprintf (stderr, a, b, c), exit (1)
-#else
-#include <config.h>
-extern void fatal (char *, ...);
-#endif
-
-#ifndef ELF_BSS_SECTION_NAME
-#define ELF_BSS_SECTION_NAME ".bss"
-#endif
-
-/* Get the address of a particular section or program header entry,
- * accounting for the size of the entries.
- */
-/*
- On PPC Reference Platform running Solaris 2.5.1
- the plt section is also of type NOBI like the bss section.
- (not really stored) and therefore sections after the bss
- section start at the plt offset. The plt section is always
- the one just before the bss section.
- Thus, we modify the test from
- if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset)
- to
- if (NEW_SECTION_H (nn).sh_offset >=
- OLD_SECTION_H (old_bss_index-1).sh_offset)
- This is just a hack. We should put the new data section
- before the .plt section.
- And we should not have this routine at all but use
- the libelf library to read the old file and create the new
- file.
- The changed code is minimal and depends on prep set in m/prep.h
- Erik Deumens
- Quantum Theory Project
- University of Florida
- deumens@qtp.ufl.edu
- Apr 23, 1996
- */
-
-#define OLD_SECTION_H(n) \
- (*(ElfW(Shdr) *) ((byte *) old_section_h + old_file_h->e_shentsize * (n)))
-#define NEW_SECTION_H(n) \
- (*(ElfW(Shdr) *) ((byte *) new_section_h + new_file_h->e_shentsize * (n)))
-#define OLD_PROGRAM_H(n) \
- (*(ElfW(Phdr) *) ((byte *) old_program_h + old_file_h->e_phentsize * (n)))
-#define NEW_PROGRAM_H(n) \
- (*(ElfW(Phdr) *) ((byte *) new_program_h + new_file_h->e_phentsize * (n)))
-
-#define PATCH_INDEX(n) \
- do { \
- if ((int) (n) >= old_bss_index) \
- (n)++; } while (0)
-typedef unsigned char byte;
-
-/* Round X up to a multiple of Y. */
-
-int
-round_up (x, y)
- int x, y;
-{
- int rem = x % y;
- if (rem == 0)
- return x;
- return x - rem + y;
-}
-
-/* ****************************************************************
- * unexec
- *
- * driving logic.
- *
- * In ELF, this works by replacing the old .bss section with a new
- * .data section, and inserting an empty .bss immediately afterwards.
- *
- */
-void
-unexec (new_name, old_name, data_start, bss_start, entry_address)
- char *new_name, *old_name;
- unsigned data_start, bss_start, entry_address;
-{
- int new_file, old_file, new_file_size;
-
- /* Pointers to the base of the image of the two files. */
- caddr_t old_base, new_base;
-
- /* Pointers to the file, program and section headers for the old and new
- * files.
- */
- ElfW(Ehdr) *old_file_h, *new_file_h;
- ElfW(Phdr) *old_program_h, *new_program_h;
- ElfW(Shdr) *old_section_h, *new_section_h;
-
- /* Point to the section name table in the old file */
- char *old_section_names;
-
- ElfW(Addr) old_bss_addr, new_bss_addr;
- ElfW(Word) old_bss_size, new_data2_size;
- ElfW(Off) new_data2_offset;
- ElfW(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 = (ElfW(Ehdr) *) old_base;
- old_program_h = (ElfW(Phdr) *) ((byte *) old_base + old_file_h->e_phoff);
- old_section_h = (ElfW(Shdr) *) ((byte *) old_base + old_file_h->e_shoff);
- old_section_names = (char *) old_base
- + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset;
-
- /* Find the old .bss section. Figure out parameters of the new
- * data2 and bss sections.
- */
-
- for (old_bss_index = 1; old_bss_index < (int) old_file_h->e_shnum;
- old_bss_index++)
- {
-#ifdef DEBUG
- fprintf (stderr, "Looking for .bss - found %s\n",
- old_section_names + OLD_SECTION_H (old_bss_index).sh_name);
-#endif
- if (!strcmp (old_section_names + OLD_SECTION_H (old_bss_index).sh_name,
- ELF_BSS_SECTION_NAME))
- break;
- }
- if (old_bss_index == old_file_h->e_shnum)
- fatal ("Can't find .bss in %s.\n", old_name, 0);
-
- old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr;
- old_bss_size = OLD_SECTION_H (old_bss_index).sh_size;
-#if defined(emacs) || !defined(DEBUG)
- new_bss_addr = (ElfW(Addr)) sbrk (0);
-#else
- new_bss_addr = old_bss_addr + old_bss_size + 0x1234;
-#endif
- new_data2_addr = old_bss_addr;
- new_data2_size = new_bss_addr - old_bss_addr;
- new_data2_offset = OLD_SECTION_H (old_bss_index).sh_offset;
-
-#ifdef DEBUG
- fprintf (stderr, "old_bss_index %d\n", old_bss_index);
- fprintf (stderr, "old_bss_addr %x\n", old_bss_addr);
- fprintf (stderr, "old_bss_size %x\n", old_bss_size);
- fprintf (stderr, "new_bss_addr %x\n", new_bss_addr);
- fprintf (stderr, "new_data2_addr %x\n", new_data2_addr);
- fprintf (stderr, "new_data2_size %x\n", new_data2_size);
- fprintf (stderr, "new_data2_offset %x\n", new_data2_offset);
-#endif
-
- if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size)
- fatal (".bss shrank when undumping???\n", 0, 0);
-
- /* Set the output file to the right size and mmap it. Set
- * pointers to various interesting objects. stat_buf still has
- * old_file data.
- */
-
- new_file = open (new_name, O_RDWR | O_CREAT, 0666);
- if (new_file < 0)
- fatal ("Can't creat (%s): errno %d\n", new_name, errno);
-
- new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size;
-
- if (ftruncate (new_file, new_file_size))
- fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno);
-
-#ifdef UNEXEC_USE_MAP_PRIVATE
- new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_PRIVATE,
- new_file, 0);
-#else
- new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED,
- new_file, 0);
-#endif
-
- if (new_base == (caddr_t) -1)
- fatal ("Can't mmap (%s): errno %d\n", new_name, errno);
-
- new_file_h = (ElfW(Ehdr) *) new_base;
- new_program_h = (ElfW(Phdr) *) ((byte *) new_base + old_file_h->e_phoff);
- new_section_h = (ElfW(Shdr) *)
- ((byte *) new_base + old_file_h->e_shoff + new_data2_size);
-
- /* Make our new file, program and section headers as copies of the
- * originals.
- */
-
- memcpy (new_file_h, old_file_h, old_file_h->e_ehsize);
- memcpy (new_program_h, old_program_h,
- old_file_h->e_phnum * old_file_h->e_phentsize);
-
- /* Modify the e_shstrndx if necessary. */
- PATCH_INDEX (new_file_h->e_shstrndx);
-
- /* Fix up file header. We'll add one section. Section header is
- * further away now.
- */
-
- new_file_h->e_shoff += new_data2_size;
- new_file_h->e_shnum += 1;
-
-#ifdef DEBUG
- fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff);
- fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum);
- fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff);
- fprintf (stderr, "New section count %d\n", new_file_h->e_shnum);
-#endif
-
- /* Fix up a new program header. Extend the writable data segment so
- * that the bss area is covered too. Find that segment by looking
- * for a segment that ends just before the .bss area. Make sure
- * that no segments are above the new .data2. Put a loop at the end
- * to adjust the offset and address of any segment that is above
- * data2, just in case we decide to allow this later.
- */
-
- for (n = new_file_h->e_phnum - 1; n >= 0; n--)
- {
- /* Compute maximum of all requirements for alignment of section. */
- int alignment = (NEW_PROGRAM_H (n)).p_align;
- if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment)
- alignment = OLD_SECTION_H (old_bss_index).sh_addralign;
-
- if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr)
- fatal ("Program segment above .bss in %s\n", old_name, 0);
-
- if (NEW_PROGRAM_H (n).p_type == PT_LOAD
- && (round_up ((NEW_PROGRAM_H (n)).p_vaddr
- + (NEW_PROGRAM_H (n)).p_filesz,
- alignment)
- == round_up (old_bss_addr, alignment)))
- break;
- }
- if (n < 0)
- fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0);
-
- NEW_PROGRAM_H (n).p_filesz += new_data2_size;
- NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz;
-
-#if 0 /* Maybe allow section after data2 - does this ever happen? */
- for (n = new_file_h->e_phnum - 1; n >= 0; n--)
- {
- if (NEW_PROGRAM_H (n).p_vaddr
- && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr)
- NEW_PROGRAM_H (n).p_vaddr += new_data2_size - old_bss_size;
-
- if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset)
- NEW_PROGRAM_H (n).p_offset += new_data2_size;
- }
-#endif
-
- /* Fix up section headers based on new .data2 section. Any section
- * whose offset or virtual address is after the new .data2 section
- * gets its value adjusted. .bss size becomes zero and new address
- * is set. data2 section header gets added by copying the existing
- * .data header and modifying the offset, address and size.
- */
- for (old_data_index = 1; old_data_index < (int) old_file_h->e_shnum;
- old_data_index++)
- if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name,
- ".data"))
- break;
- if (old_data_index == old_file_h->e_shnum)
- fatal ("Can't find .data in %s.\n", old_name, 0);
-
- /* Walk through all section headers, insert the new data2 section right
- before the new bss section. */
- for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++)
- {
- caddr_t src;
- /* If it is bss section, insert the new data2 section before it. */
- if (n == old_bss_index)
- {
- /* Steal the data section header for this data2 section. */
- memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index),
- new_file_h->e_shentsize);
-
- NEW_SECTION_H (nn).sh_addr = new_data2_addr;
- NEW_SECTION_H (nn).sh_offset = new_data2_offset;
- NEW_SECTION_H (nn).sh_size = new_data2_size;
- /* Use the bss section's alignment. This will assure that the
- new data2 section always be placed in the same spot as the old
- bss section by any other application. */
- NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign;
-
- /* Now copy over what we have in the memory now. */
- memcpy (NEW_SECTION_H (nn).sh_offset + new_base,
- (caddr_t) OLD_SECTION_H (n).sh_addr,
- new_data2_size);
- nn++;
- }
-
- memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n),
- old_file_h->e_shentsize);
-
- /* The new bss section's size is zero, and its file offset and virtual
- address should be off by NEW_DATA2_SIZE. */
- if (n == old_bss_index)
- {
- /* NN should be `old_bss_index + 1' at this point. */
- NEW_SECTION_H (nn).sh_offset += new_data2_size;
- NEW_SECTION_H (nn).sh_addr += new_data2_size;
- /* Let the new bss section address alignment be the same as the
- section address alignment followed the old bss section, so
- this section will be placed in exactly the same place. */
- NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign;
- NEW_SECTION_H (nn).sh_size = 0;
- }
- else
- {
- /* Any section that was original placed AFTER the bss
- section should now be off by NEW_DATA2_SIZE. */
-#ifdef SOLARIS_POWERPC
- /* On PPC Reference Platform running Solaris 2.5.1
- the plt section is also of type NOBI like the bss section.
- (not really stored) and therefore sections after the bss
- section start at the plt offset. The plt section is always
- the one just before the bss section.
- It would be better to put the new data section before
- the .plt section, or use libelf instead.
- Erik Deumens, deumens@qtp.ufl.edu. */
- if (NEW_SECTION_H (nn).sh_offset
- >= OLD_SECTION_H (old_bss_index-1).sh_offset)
- NEW_SECTION_H (nn).sh_offset += new_data2_size;
-#else
- if (round_up (NEW_SECTION_H (nn).sh_offset,
- OLD_SECTION_H (old_bss_index).sh_addralign)
- >= new_data2_offset)
- NEW_SECTION_H (nn).sh_offset += new_data2_size;
-#endif
- /* Any section that was originally placed after the section
- header table should now be off by the size of one section
- header table entry. */
- if (NEW_SECTION_H (nn).sh_offset > new_file_h->e_shoff)
- NEW_SECTION_H (nn).sh_offset += new_file_h->e_shentsize;
- }
-
- /* If any section hdr refers to the section after the new .data
- section, make it refer to next one because we have inserted
- a new section in between. */
-
- PATCH_INDEX (NEW_SECTION_H (nn).sh_link);
- /* For symbol tables, info is a symbol table index,
- so don't change it. */
- if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB
- && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM)
- PATCH_INDEX (NEW_SECTION_H (nn).sh_info);
-
- /* Now, start to copy the content of sections. */
- if (NEW_SECTION_H (nn).sh_type == SHT_NULL
- || NEW_SECTION_H (nn).sh_type == SHT_NOBITS)
- continue;
-
- /* Write out the sections. .data and .data1 (and data2, called
- ".data" in the strings table) get copied from the current process
- instead of the old file. */
- if (!strcmp (old_section_names + NEW_SECTION_H (n).sh_name, ".data")
- || !strcmp ((old_section_names + NEW_SECTION_H (n).sh_name),
- ".data1"))
- src = (caddr_t) OLD_SECTION_H (n).sh_addr;
- else
- src = old_base + OLD_SECTION_H (n).sh_offset;
-
- memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src,
- NEW_SECTION_H (nn).sh_size);
-
-#ifdef __alpha__
- /* Update Alpha COFF symbol table: */
- if (strcmp (old_section_names + OLD_SECTION_H (n).sh_name, ".mdebug")
- == 0)
- {
- pHDRR symhdr = (pHDRR) (NEW_SECTION_H (nn).sh_offset + new_base);
-
- symhdr->cbLineOffset += new_data2_size;
- symhdr->cbDnOffset += new_data2_size;
- symhdr->cbPdOffset += new_data2_size;
- symhdr->cbSymOffset += new_data2_size;
- symhdr->cbOptOffset += new_data2_size;
- symhdr->cbAuxOffset += new_data2_size;
- symhdr->cbSsOffset += new_data2_size;
- symhdr->cbSsExtOffset += new_data2_size;
- symhdr->cbFdOffset += new_data2_size;
- symhdr->cbRfdOffset += new_data2_size;
- symhdr->cbExtOffset += new_data2_size;
- }
-#endif /* __alpha__ */
-
- /* 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)
- {
- ElfW(Shdr) *spt = &NEW_SECTION_H (nn);
- unsigned int num = spt->sh_size / spt->sh_entsize;
- ElfW(Sym) * sym = (ElfW(Sym) *) (NEW_SECTION_H (nn).sh_offset +
- new_base);
- for (; num--; sym++)
- {
- if ((sym->st_shndx == SHN_UNDEF)
- || (sym->st_shndx == SHN_ABS)
- || (sym->st_shndx == SHN_COMMON))
- continue;
-
- PATCH_INDEX (sym->st_shndx);
- }
- }
- }
-
- /* Update the symbol values of _edata and _end. */
- for (n = new_file_h->e_shnum - 1; n; n--)
- {
- byte *symnames;
- ElfW(Sym) *symp, *symendp;
-
- if (NEW_SECTION_H (n).sh_type != SHT_DYNSYM
- && NEW_SECTION_H (n).sh_type != SHT_SYMTAB)
- continue;
-
- symnames = ((byte *) new_base
- + NEW_SECTION_H (NEW_SECTION_H (n).sh_link).sh_offset);
- symp = (ElfW(Sym) *) (NEW_SECTION_H (n).sh_offset + new_base);
- symendp = (ElfW(Sym) *) ((byte *)symp + NEW_SECTION_H (n).sh_size);
-
- for (; symp < symendp; symp ++)
- if (strcmp ((char *) (symnames + symp->st_name), "_end") == 0
- || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0)
- memcpy (&symp->st_value, &new_bss_addr, sizeof (new_bss_addr));
- }
-
- /* This loop seeks out relocation sections for the data section, so
- that it can undo relocations performed by the runtime linker. */
- for (n = new_file_h->e_shnum - 1; n; n--)
- {
- ElfW(Shdr) section = NEW_SECTION_H (n);
- switch (section.sh_type) {
- default:
- break;
- case SHT_REL:
- case SHT_RELA:
- /* This code handles two different size structs, but there should
- be no harm in that provided that r_offset is always the first
- member. */
- nn = section.sh_info;
- if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data")
- || !strcmp ((old_section_names + NEW_SECTION_H (nn).sh_name),
- ".data1"))
- {
- ElfW(Addr) offset = NEW_SECTION_H (nn).sh_addr -
- NEW_SECTION_H (nn).sh_offset;
- caddr_t reloc = old_base + section.sh_offset, end;
- for (end = reloc + section.sh_size; reloc < end;
- reloc += section.sh_entsize)
- {
- ElfW(Addr) addr = ((ElfW(Rel) *) reloc)->r_offset - offset;
-#ifdef __alpha__
- /* The Alpha ELF binutils currently have a bug that
- sometimes results in relocs that contain all
- zeroes. Work around this for now... */
- if (((ElfW(Rel) *) reloc)->r_offset == 0)
- continue;
-#endif
- memcpy (new_base + addr, old_base + addr, sizeof(ElfW(Addr)));
- }
- }
- break;
- }
- }
-
-#ifdef UNEXEC_USE_MAP_PRIVATE
- if (lseek (new_file, 0, SEEK_SET) == -1)
- fatal ("Can't rewind (%s): errno %d\n", new_name, errno);
-
- if (write (new_file, new_base, new_file_size) != new_file_size)
- fatal ("Can't write (%s): errno %d\n", new_name, errno);
-#endif
-
- /* Close the files and make the new file executable. */
-
- if (close (old_file))
- fatal ("Can't close (%s): errno %d\n", old_name, errno);
-
- if (close (new_file))
- fatal ("Can't close (%s): errno %d\n", new_name, errno);
-
- if (stat (new_name, &stat_buf) == -1)
- fatal ("Can't stat (%s): errno %d\n", new_name, errno);
-
- n = umask (777);
- umask (n);
- stat_buf.st_mode |= 0111 & ~n;
- if (chmod (new_name, stat_buf.st_mode) == -1)
- fatal ("Can't chmod (%s): errno %d\n", new_name, errno);
-}
+++ /dev/null
-/* Copyright (C) 1985, 1986, 1987, 1988, 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, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, 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
-
-
- */
-\f
-/* 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
-
- */
-\f
-#include <config.h>
-#include <sys/types.h>
-#include <stdio.h>
-#include <sys/stat.h>
-#include <memory.h>
-#include <string.h>
-#include <errno.h>
-#include <unistd.h>
-#include <fcntl.h>
-#include <elf.h>
-#include <syms.h> /* for HDRR declaration */
-#include <sys/mman.h>
-
-#ifndef emacs
-#define fatal(a, b, c) fprintf(stderr, a, b, c), exit(1)
-#else
-extern void fatal(char *, ...);
-#endif
-
-/* Get the address of a particular section or program header entry,
- * accounting for the size of the entries.
- */
-
-#define OLD_SECTION_H(n) \
- (*(Elf32_Shdr *) ((byte *) old_section_h + old_file_h->e_shentsize * (n)))
-#define NEW_SECTION_H(n) \
- (*(Elf32_Shdr *) ((byte *) new_section_h + new_file_h->e_shentsize * (n)))
-#define OLD_PROGRAM_H(n) \
- (*(Elf32_Phdr *) ((byte *) old_program_h + old_file_h->e_phentsize * (n)))
-#define NEW_PROGRAM_H(n) \
- (*(Elf32_Phdr *) ((byte *) new_program_h + new_file_h->e_phentsize * (n)))
-
-#define PATCH_INDEX(n) \
- do { \
- if ((n) >= old_bss_index) \
- (n)++; } while (0)
-typedef unsigned char byte;
-
-/* Round X up to a multiple of Y. */
-
-int
-round_up (x, y)
- int x, y;
-{
- int rem = x % y;
- if (rem == 0)
- return x;
- return x - rem + y;
-}
-
-/* Return the index of the section named NAME.
- SECTION_NAMES, FILE_NAME and FILE_H give information
- about the file we are looking in.
-
- If we don't find the section NAME, that is a fatal error
- if NOERROR is 0; we return -1 if NOERROR is nonzero. */
-
-static int
-find_section (name, section_names, file_name, old_file_h, old_section_h, noerror)
- char *name;
- char *section_names;
- char *file_name;
- Elf32_Ehdr *old_file_h;
- Elf32_Shdr *old_section_h;
- int noerror;
-{
- int idx;
-
- for (idx = 1; idx < old_file_h->e_shnum; idx++)
- {
-#ifdef DEBUG
- fprintf (stderr, "Looking for %s - found %s\n", name,
- section_names + OLD_SECTION_H (idx).sh_name);
-#endif
- if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name,
- name))
- break;
- }
- if (idx == old_file_h->e_shnum)
- {
- if (noerror)
- return -1;
- else
- fatal ("Can't find .bss in %s.\n", file_name, 0);
- }
-
- return idx;
-}
-
-/* ****************************************************************
- * unexec
- *
- * driving logic.
- *
- * In ELF, this works by replacing the old .bss section with a new
- * .data section, and inserting an empty .bss immediately afterwards.
- *
- */
-void
-unexec (new_name, old_name, data_start, bss_start, entry_address)
- char *new_name, *old_name;
- unsigned data_start, bss_start, entry_address;
-{
- extern unsigned int bss_end;
- int new_file, old_file, new_file_size;
-
- /* Pointers to the base of the image of the two files. */
- caddr_t old_base, new_base;
-
- /* Pointers to the file, program and section headers for the old and new
- files. */
- Elf32_Ehdr *old_file_h, *new_file_h;
- Elf32_Phdr *old_program_h, *new_program_h;
- Elf32_Shdr *old_section_h, *new_section_h;
-
- /* Point to the section name table in the old file. */
- char *old_section_names;
-
- Elf32_Addr old_bss_addr, new_bss_addr;
- Elf32_Word old_bss_size, new_data2_size;
- Elf32_Off new_data2_offset;
- Elf32_Addr new_data2_addr;
- Elf32_Addr new_offsets_shift;
-
- int n, nn, old_bss_index, old_data_index, new_data2_index;
- int old_mdebug_index;
- struct stat stat_buf;
-
- /* Open the old file & map it into the address space. */
-
- old_file = open (old_name, O_RDONLY);
-
- if (old_file < 0)
- fatal ("Can't open %s for reading: errno %d\n", old_name, errno);
-
- if (fstat (old_file, &stat_buf) == -1)
- fatal ("Can't fstat(%s): errno %d\n", old_name, errno);
-
- old_base = mmap (0, stat_buf.st_size, PROT_READ, MAP_SHARED, old_file, 0);
-
- if (old_base == (caddr_t) -1)
- fatal ("Can't mmap(%s): errno %d\n", old_name, errno);
-
-#ifdef DEBUG
- fprintf (stderr, "mmap(%s, %x) -> %x\n", old_name, stat_buf.st_size,
- old_base);
-#endif
-
- /* Get pointers to headers & section names. */
-
- old_file_h = (Elf32_Ehdr *) old_base;
- old_program_h = (Elf32_Phdr *) ((byte *) old_base + old_file_h->e_phoff);
- old_section_h = (Elf32_Shdr *) ((byte *) old_base + old_file_h->e_shoff);
- old_section_names
- = (char *) old_base + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset;
-
- /* Find the mdebug section, if any. */
-
- old_mdebug_index = find_section (".mdebug", old_section_names,
- old_name, old_file_h, old_section_h, 1);
-
- /* Find the old .bss section. */
-
- old_bss_index = find_section (".bss", old_section_names,
- old_name, old_file_h, old_section_h, 0);
-
- /* Find the old .data section. Figure out parameters of
- the new data2 and bss sections. */
-
- old_data_index = find_section (".data", old_section_names,
- old_name, old_file_h, old_section_h, 0);
-
- old_bss_addr = OLD_SECTION_H (old_bss_index).sh_addr;
- old_bss_size = OLD_SECTION_H (old_bss_index).sh_size;
-#if defined(emacs) || !defined(DEBUG)
- bss_end = (unsigned int) sbrk (0);
- new_bss_addr = (Elf32_Addr) bss_end;
-#else
- new_bss_addr = old_bss_addr + old_bss_size + 0x1234;
-#endif
- new_data2_addr = old_bss_addr;
- new_data2_size = new_bss_addr - old_bss_addr;
- new_data2_offset = OLD_SECTION_H (old_data_index).sh_offset +
- (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr);
- new_offsets_shift = new_bss_addr -
- ((old_bss_addr & ~0xfff) + ((old_bss_addr & 0xfff) ? 0x1000 : 0));
-
-#ifdef DEBUG
- fprintf (stderr, "old_bss_index %d\n", old_bss_index);
- fprintf (stderr, "old_bss_addr %x\n", old_bss_addr);
- fprintf (stderr, "old_bss_size %x\n", old_bss_size);
- fprintf (stderr, "new_bss_addr %x\n", new_bss_addr);
- fprintf (stderr, "new_data2_addr %x\n", new_data2_addr);
- fprintf (stderr, "new_data2_size %x\n", new_data2_size);
- fprintf (stderr, "new_data2_offset %x\n", new_data2_offset);
- fprintf (stderr, "new_offsets_shift %x\n", new_offsets_shift);
-#endif
-
- if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size)
- fatal (".bss shrank when undumping???\n", 0, 0);
-
- /* Set the output file to the right size and mmap it. Set
- pointers to various interesting objects. stat_buf still has
- old_file data. */
-
- new_file = open (new_name, O_RDWR | O_CREAT, 0666);
- if (new_file < 0)
- fatal ("Can't creat (%s): errno %d\n", new_name, errno);
-
- new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_offsets_shift;
-
- if (ftruncate (new_file, new_file_size))
- fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno);
-
- new_base = mmap (0, new_file_size, PROT_READ | PROT_WRITE, MAP_SHARED,
- new_file, 0);
-
- if (new_base == (caddr_t) -1)
- fatal ("Can't mmap (%s): errno %d\n", new_name, errno);
-
- new_file_h = (Elf32_Ehdr *) new_base;
- new_program_h = (Elf32_Phdr *) ((byte *) new_base + old_file_h->e_phoff);
- new_section_h
- = (Elf32_Shdr *) ((byte *) new_base + old_file_h->e_shoff
- + new_offsets_shift);
-
- /* Make our new file, program and section headers as copies of the
- originals. */
-
- memcpy (new_file_h, old_file_h, old_file_h->e_ehsize);
- memcpy (new_program_h, old_program_h,
- old_file_h->e_phnum * old_file_h->e_phentsize);
-
- /* Modify the e_shstrndx if necessary. */
- PATCH_INDEX (new_file_h->e_shstrndx);
-
- /* Fix up file header. We'll add one section. Section header is
- further away now. */
-
- new_file_h->e_shoff += new_offsets_shift;
- new_file_h->e_shnum += 1;
-
-#ifdef DEBUG
- fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff);
- fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum);
- fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff);
- fprintf (stderr, "New section count %d\n", new_file_h->e_shnum);
-#endif
-
- /* Fix up a new program header. Extend the writable data segment so
- that the bss area is covered too. Find that segment by looking
- for a segment that ends just before the .bss area. Make sure
- that no segments are above the new .data2. Put a loop at the end
- to adjust the offset and address of any segment that is above
- data2, just in case we decide to allow this later. */
-
- for (n = new_file_h->e_phnum - 1; n >= 0; n--)
- {
- /* Compute maximum of all requirements for alignment of section. */
- int alignment = (NEW_PROGRAM_H (n)).p_align;
- if ((OLD_SECTION_H (old_bss_index)).sh_addralign > alignment)
- alignment = OLD_SECTION_H (old_bss_index).sh_addralign;
-
- /* Supposedly this condition is okay for the SGI. */
-#if 0
- if (NEW_PROGRAM_H (n).p_vaddr + NEW_PROGRAM_H (n).p_filesz > old_bss_addr)
- fatal ("Program segment above .bss in %s\n", old_name, 0);
-#endif
-
- if (NEW_PROGRAM_H (n).p_type == PT_LOAD
- && (round_up ((NEW_PROGRAM_H (n)).p_vaddr
- + (NEW_PROGRAM_H (n)).p_filesz,
- alignment)
- == round_up (old_bss_addr, alignment)))
- break;
- }
- if (n < 0)
- fatal ("Couldn't find segment next to .bss in %s\n", old_name, 0);
-
- NEW_PROGRAM_H (n).p_filesz += new_offsets_shift;
- NEW_PROGRAM_H (n).p_memsz = NEW_PROGRAM_H (n).p_filesz;
-
-#if 1 /* Maybe allow section after data2 - does this ever happen? */
- for (n = new_file_h->e_phnum - 1; n >= 0; n--)
- {
- if (NEW_PROGRAM_H (n).p_vaddr
- && NEW_PROGRAM_H (n).p_vaddr >= new_data2_addr)
- NEW_PROGRAM_H (n).p_vaddr += new_offsets_shift - old_bss_size;
-
- if (NEW_PROGRAM_H (n).p_offset >= new_data2_offset)
- NEW_PROGRAM_H (n).p_offset += new_offsets_shift;
- }
-#endif
-
- /* Fix up section headers based on new .data2 section. Any section
- whose offset or virtual address is after the new .data2 section
- gets its value adjusted. .bss size becomes zero and new address
- is set. data2 section header gets added by copying the existing
- .data header and modifying the offset, address and size. */
- for (old_data_index = 1; old_data_index < old_file_h->e_shnum;
- old_data_index++)
- if (!strcmp (old_section_names + OLD_SECTION_H (old_data_index).sh_name,
- ".data"))
- break;
- if (old_data_index == old_file_h->e_shnum)
- fatal ("Can't find .data in %s.\n", old_name, 0);
-
- /* Walk through all section headers, insert the new data2 section right
- before the new bss section. */
- for (n = 1, nn = 1; n < old_file_h->e_shnum; n++, nn++)
- {
- caddr_t src;
-
- /* If it is bss section, insert the new data2 section before it. */
- if (n == old_bss_index)
- {
- /* Steal the data section header for this data2 section. */
- memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (old_data_index),
- new_file_h->e_shentsize);
-
- NEW_SECTION_H (nn).sh_addr = new_data2_addr;
- NEW_SECTION_H (nn).sh_offset = new_data2_offset;
- NEW_SECTION_H (nn).sh_size = new_data2_size;
- /* Use the bss section's alignment. This will assure that the
- new data2 section always be placed in the same spot as the old
- bss section by any other application. */
- NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (n).sh_addralign;
-
- /* Now copy over what we have in the memory now. */
- memcpy (NEW_SECTION_H (nn).sh_offset + new_base,
- (caddr_t) OLD_SECTION_H (n).sh_addr,
- new_data2_size);
- nn++;
- memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n),
- old_file_h->e_shentsize);
-
- /* The new bss section's size is zero, and its file offset and virtual
- address should be off by NEW_OFFSETS_SHIFT. */
- NEW_SECTION_H (nn).sh_offset += new_offsets_shift;
- NEW_SECTION_H (nn).sh_addr = new_bss_addr;
- /* Let the new bss section address alignment be the same as the
- section address alignment followed the old bss section, so
- this section will be placed in exactly the same place. */
- NEW_SECTION_H (nn).sh_addralign = OLD_SECTION_H (nn).sh_addralign;
- NEW_SECTION_H (nn).sh_size = 0;
- }
- else
- {
- memcpy (&NEW_SECTION_H (nn), &OLD_SECTION_H (n),
- old_file_h->e_shentsize);
-
- /* Any section that was original placed AFTER the bss
- section must now be adjusted by NEW_OFFSETS_SHIFT. */
-
- if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset)
- NEW_SECTION_H (nn).sh_offset += new_offsets_shift;
- }
-
- /* If any section hdr refers to the section after the new .data
- section, make it refer to next one because we have inserted
- a new section in between. */
-
- PATCH_INDEX (NEW_SECTION_H (nn).sh_link);
- /* For symbol tables, info is a symbol table index,
- so don't change it. */
- if (NEW_SECTION_H (nn).sh_type != SHT_SYMTAB
- && NEW_SECTION_H (nn).sh_type != SHT_DYNSYM)
- PATCH_INDEX (NEW_SECTION_H (nn).sh_info);
-
- /* Now, start to copy the content of sections. */
- if (NEW_SECTION_H (nn).sh_type == SHT_NULL
- || NEW_SECTION_H (nn).sh_type == SHT_NOBITS)
- continue;
-
- /* Write out the sections. .data and .data1 (and data2, called
- ".data" in the strings table) get copied from the current process
- instead of the old file. */
- if (!strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data")
- || !strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".data1")
-#ifdef IRIX6_5
- /* Under IRIX 6.5 gcc places objects with adresses relative to
- shared symbols in the section .rodata, which are adjusted at
- startup time. Unfortunately they aren't adjusted after unexec,
- so with this configuration we must get .rodata also from memory.
- Do any other configurations need this, too?
- <Wolfgang.Glas@hfm.tu-graz.ac.at> 1999-06-08. */
- || !strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".rodata")
-#endif
- || !strcmp (old_section_names + NEW_SECTION_H (nn).sh_name, ".got"))
- src = (caddr_t) OLD_SECTION_H (n).sh_addr;
- else
- src = old_base + OLD_SECTION_H (n).sh_offset;
-
- memcpy (NEW_SECTION_H (nn).sh_offset + new_base, src,
- NEW_SECTION_H (nn).sh_size);
-
- /* Adjust the HDRR offsets in .mdebug and copy the
- line data if it's in its usual 'hole' in the object.
- Makes the new file debuggable with dbx.
- patches up two problems: the absolute file offsets
- in the HDRR record of .mdebug (see /usr/include/syms.h), and
- the ld bug that gets the line table in a hole in the
- elf file rather than in the .mdebug section proper.
- David Anderson. davea@sgi.com Jan 16,1994. */
- if (n == old_mdebug_index)
- {
-#define MDEBUGADJUST(__ct,__fileaddr) \
- if (n_phdrr->__ct > 0) \
- { \
- n_phdrr->__fileaddr += movement; \
- }
-
- HDRR * o_phdrr = (HDRR *)((byte *)old_base + OLD_SECTION_H (n).sh_offset);
- HDRR * n_phdrr = (HDRR *)((byte *)new_base + NEW_SECTION_H (nn).sh_offset);
- unsigned movement = new_offsets_shift;
-
- MDEBUGADJUST (idnMax, cbDnOffset);
- MDEBUGADJUST (ipdMax, cbPdOffset);
- MDEBUGADJUST (isymMax, cbSymOffset);
- MDEBUGADJUST (ioptMax, cbOptOffset);
- MDEBUGADJUST (iauxMax, cbAuxOffset);
- MDEBUGADJUST (issMax, cbSsOffset);
- MDEBUGADJUST (issExtMax, cbSsExtOffset);
- MDEBUGADJUST (ifdMax, cbFdOffset);
- MDEBUGADJUST (crfd, cbRfdOffset);
- MDEBUGADJUST (iextMax, cbExtOffset);
- /* The Line Section, being possible off in a hole of the object,
- requires special handling. */
- if (n_phdrr->cbLine > 0)
- {
- if (o_phdrr->cbLineOffset > (OLD_SECTION_H (n).sh_offset
- + OLD_SECTION_H (n).sh_size))
- {
- /* line data is in a hole in elf. do special copy and adjust
- for this ld mistake.
- */
- n_phdrr->cbLineOffset += movement;
-
- memcpy (n_phdrr->cbLineOffset + new_base,
- o_phdrr->cbLineOffset + old_base, n_phdrr->cbLine);
- }
- else
- {
- /* somehow line data is in .mdebug as it is supposed to be. */
- MDEBUGADJUST (cbLine, cbLineOffset);
- }
- }
- }
-
- /* If it is the symbol table, its st_shndx field needs to be patched. */
- if (NEW_SECTION_H (nn).sh_type == SHT_SYMTAB
- || NEW_SECTION_H (nn).sh_type == SHT_DYNSYM)
- {
- Elf32_Shdr *spt = &NEW_SECTION_H (nn);
- unsigned int num = spt->sh_size / spt->sh_entsize;
- Elf32_Sym * sym = (Elf32_Sym *) (NEW_SECTION_H (nn).sh_offset
- + new_base);
- for (; num--; sym++)
- {
- /* don't patch special section indices. */
- if (sym->st_shndx == SHN_UNDEF
- || sym->st_shndx >= SHN_LORESERVE)
- 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);
-}
\f
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\
-Interactively, if an argument is not given, make the window one line bigger.")
+From program, optional second arg non-nil means grow sideways ARG columns.")
(arg, side)
register Lisp_Object arg, side;
{
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\
-Interactively, if an argument is not given, make the window one line smaller.")
+From program, optional second arg non-nil means shrink sideways arg columns.")
(arg, side)
register Lisp_Object arg, side;
{
XSETINT (arg, XINT (arg) + lines);
}
-#if 0 /* I don't understand why this is done. Among other things,
- it means that C-u 0 M-r moves to line 1, and C-u -1 M-r
- moves to the line below the window end. 2000-02-05, gerd */
if (w->vscroll)
/* Skip past a partially visible first line. */
XSETINT (arg, XINT (arg) + 1);
-#endif
return Fvertical_motion (arg, window);
}
+++ /dev/null
-#include <X11/Xlib.h>
-#include <X11/Xatom.h>
-#include <X11/keysym.h>
-#include <X11/cursorfont.h>
-#include <X11/Xutil.h>
-#include <X11/X10.h>
-
-#define XMOUSEBUFSIZE 64
-
-#ifndef sigmask
-#define sigmask(no) (1L << ((no) - 1))
-#endif
-
-#define BLOCK_INPUT_DECLARE() int BLOCK_INPUT_mask
-#ifdef SIGIO
-#define BLOCK_INPUT() EMACS_SIGBLOCKX (SIGIO, BLOCK_INPUT_mask)
-#define UNBLOCK_INPUT() \
- do { int _dummy; EMACS_SIGSETMASK (BLOCK_INPUT_mask, _dummy); } while (0)
-#else /* not SIGIO */
-#define BLOCK_INPUT()
-#define UNBLOCK_INPUT()
-#endif /* SIGIO */
-
-#define CLASS "Emacs" /* class id for GNU Emacs, used in .Xdefaults, etc. */
it->dpend = v->contents + v->size;
it->current.dpvec_index = 0;
it->method = next_element_from_display_vector;
- success_p = get_next_display_element (it);
- }
- else
- {
- set_iterator_to_next (it, 0);
- success_p = get_next_display_element (it);
}
+
+ success_p = get_next_display_element (it);
}
/* Translate control characters into `\003' or `^C' form.
if (PT >= CHARPOS (scroll_margin_pos))
{
int y0;
+#if 0
+ int line_height;
+#endif
/* Point is in the scroll margin at the bottom of the window, or
below. Compute a new window start that makes point visible. */
y0 = it.current_y;
move_it_to (&it, PT, 0, it.last_visible_y, -1,
MOVE_TO_POS | MOVE_TO_X | MOVE_TO_Y);
-
+#if 0 /* Taking the line's height into account here looks wrong. */
+ line_height = (it.max_ascent + it.max_descent
+ ? it.max_ascent + it.max_descent
+ : last_height);
+ dy = it.current_y + line_height - y0;
+#else
/* With a scroll_margin of 0, scroll_margin_pos is at the window
end, which is one line below the window. The iterator's
current_y will be same as y0 in that case, but we have to
scroll a line to make PT visible. That's the reason why 1 is
added below. */
dy = 1 + it.current_y - y0;
+#endif
if (dy > scroll_max)
return 0;
start_display (&it, w, startp);
if (scroll_conservatively)
- amount_to_scroll
- = max (max (dy, CANON_Y_UNIT (f)),
- CANON_Y_UNIT (f) * max (scroll_step, temp_scroll_step));
+ amount_to_scroll =
+ max (dy, CANON_Y_UNIT (f) * max (scroll_step, temp_scroll_step));
else if (scroll_step || temp_scroll_step)
amount_to_scroll = scroll_max;
else
DEFUN ("clear-face-cache", Fclear_face_cache, Sclear_face_cache, 0, 1, 0,
"Clear face caches on all frames.\n\
Optional THOROUGHLY non-nil means try to free unused fonts, too.")
- (thoroughly)
- Lisp_Object thoroughly;
+ (thorougly)
+ Lisp_Object thorougly;
{
- clear_face_cache (!NILP (thoroughly));
+ clear_face_cache (!NILP (thorougly));
++face_change_count;
++windows_or_buffers_changed;
return Qnil;
error ("The characters of the given font have varying widths");
else if (STRINGP (result))
{
- if (!NILP (Fequal (result, oldval)))
- return;
store_frame_param (f, Qfont, result);
recompute_basic_faces (f);
}
int delta, nlines, root_height;
Lisp_Object root_window;
- /* Treat tool bars like menu bars. */
- if (FRAME_MINIBUF_ONLY_P (f))
- return;
-
/* Use VALUE only if an integer >= 0. */
if (INTEGERP (value) && XINT (value) >= 0)
nlines = XFASTINT (value);
+++ /dev/null
-/* Bitmaps and things for scrollbars.
- Copyright (C) 1989 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. */
-
-
-static void install_vertical_scrollbar ();
-static void install_horizontal_scrollbar ();
-static void x_set_horizontal_scrollbar ();
-static void x_set_vertical_scrollbar ();
-
-/* Prefix-characters for scroll bar commands in Vglobal_mouse_map.
- Choice of prefix depends on which region of the scroll bar. */
-
-enum scroll_bar_prefix
- { VSCROLL_BAR_PREFIX = 050, VSCROLL_SLIDER_PREFIX /* unused */,
- VSCROLL_THUMBUP_PREFIX, VSCROLL_THUMBDOWN_PREFIX,
- HSCROLL_BAR_PREFIX, HSCROLL_SLIDER_PREFIX /* unused */,
- HSCROLL_THUMBLEFT_PREFIX, HSCROLL_THUMBRIGHT_PREFIX };
-
-#define CROSS_WIDTH 16
-#define CROSS_HEIGHT 16
-
-#define CROSS_MASK_WIDTH 16
-#define CROSS_MASK_HEIGHT 16
-
-/* Vertical and Horizontal scroll bar widths. */
-#define VSCROLL_WIDTH 18
-#define HSCROLL_HEIGHT 18
-
-#ifdef HAVE_X11
-
-/* Arrow cursors for scroll bars. */
-
-Cursor up_arrow_cursor, down_arrow_cursor, v_double_arrow_cursor;
-Cursor left_arrow_cursor, right_arrow_cursor, h_double_arrow_cursor;
-
-static char cross_bits[] =
- {
- 0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0xfe, 0x7f, 0xfe, 0x7f, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00
- };
-
-static char gray_bits[] =
- {
- 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
- 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
- 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
- 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa
- };
-
-static char up_arrow_bits[] =
- {
- 0x00, 0x00, 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f, 0xf8, 0x1f,
- 0xfc, 0x3f, 0xfe, 0x7f, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0xff, 0xff
- };
-
-static char down_arrow_bits[] =
- {
- 0xff, 0xff, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0x80, 0x01, 0xfe, 0x7f, 0xfc, 0x3f, 0xf8, 0x1f, 0xf0, 0x0f,
- 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01, 0x00, 0x00
- };
-
-static char left_arrow_bits[] =
- {
- 0x00, 0x80, 0x80, 0x80, 0xc0, 0x80, 0xe0, 0x80, 0xf0, 0x80, 0xf8, 0x80,
- 0xfc, 0x80, 0xfe, 0xff, 0xfe, 0xff, 0xfc, 0x80, 0xf8, 0x80, 0xf0, 0x80,
- 0xe0, 0x80, 0xc0, 0x80, 0x80, 0x80, 0x00, 0x80
- };
-
-static char right_arrow_bits[] =
- {
- 0x01, 0x00, 0x01, 0x01, 0x01, 0x03, 0x01, 0x07, 0x01, 0x0f, 0x01, 0x1f,
- 0x01, 0x3f, 0xff, 0x7f, 0xff, 0x7f, 0x01, 0x3f, 0x01, 0x1f, 0x01, 0x0f,
- 0x01, 0x07, 0x01, 0x03, 0x01, 0x01, 0x01, 0x00
- };
-
-static char cross_mask_bits[] =
- {
- 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03,
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xc0, 0x03, 0xc0, 0x03,
- 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03, 0xc0, 0x03
- };
-#else /* not HAVE_X11 */
-static short cross_bits[] =
- {
- 0x0000, 0x0180, 0x0180, 0x0180,
- 0x0180, 0x0180, 0x0180, 0x7ffe,
- 0x7ffe, 0x0180, 0x0180, 0x0180,
- 0x0180, 0x0180, 0x0180, 0x0000,
- };
-
-static short gray_bits[] = {
- 0xaaaa, 0x5555, 0xaaaa, 0x5555,
- 0xaaaa, 0x5555, 0xaaaa, 0x5555,
- 0xaaaa, 0x5555, 0xaaaa, 0x5555,
- 0xaaaa, 0x5555, 0xaaaa, 0x5555};
-
-static short cross_mask_bits[] =
- {
- 0x03c0, 0x03c0, 0x03c0, 0x03c0,
- 0x03c0, 0x03c0, 0xffff, 0xffff,
- 0xffff, 0xffff, 0x03c0, 0x03c0,
- 0x03c0, 0x03c0, 0x03c0, 0x03c0,
- };
-#endif /* X10 */
+++ /dev/null
-/* X Selection processing for emacs
- Copyright (C) 1990, 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. */
-
-#include "config.h"
-#include "lisp.h"
-#include "xterm.h"
-#include "buffer.h"
-#include "frame.h"
-
-#ifdef HAVE_X11
-
-/* Macros for X Selections */
-#define MAX_SELECTION(dpy) (((dpy)->max_request_size << 2) - 100)
-#define SELECTION_LENGTH(len,format) ((len) * ((format) >> 2))
-
-/* The timestamp of the last input event we received from the X server. */
-unsigned long last_event_timestamp;
-
-/* t if a mouse button is depressed. */
-extern Lisp_Object Vmouse_grabbed;
-
-/* When emacs became the PRIMARY selection owner. */
-Time x_begin_selection_own;
-
-/* When emacs became the SECONDARY selection owner. */
-Time x_begin_secondary_selection_own;
-
-/* When emacs became the CLIPBOARD selection owner. */
-Time x_begin_clipboard_own;
-
-/* The value of the current CLIPBOARD selection. */
-Lisp_Object Vx_clipboard_value;
-
-/* The value of the current PRIMARY selection. */
-Lisp_Object Vx_selection_value;
-
-/* The value of the current SECONDARY selection. */
-Lisp_Object Vx_secondary_selection_value;
-
-/* Types of selections we may make. */
-Lisp_Object Qprimary, Qsecondary, Qclipboard;
-
-/* Emacs' selection property identifiers. */
-Atom Xatom_emacs_selection;
-Atom Xatom_emacs_secondary_selection;
-
-/* Clipboard selection atom. */
-Atom Xatom_clipboard_selection;
-
-/* Clipboard atom. */
-Atom Xatom_clipboard;
-
-/* Atom for indicating incremental selection transfer. */
-Atom Xatom_incremental;
-
-/* Atom for indicating multiple selection request list */
-Atom Xatom_multiple;
-
-/* Atom for what targets emacs handles. */
-Atom Xatom_targets;
-
-/* Atom for indicating timstamp selection request */
-Atom Xatom_timestamp;
-
-/* Atom requesting we delete our selection. */
-Atom Xatom_delete;
-
-/* Selection magic. */
-Atom Xatom_insert_selection;
-
-/* Type of property for INSERT_SELECTION. */
-Atom Xatom_pair;
-
-/* More selection magic. */
-Atom Xatom_insert_property;
-
-/* Atom for indicating property type TEXT */
-Atom Xatom_text;
-
-/* Kinds of protocol things we may receive. */
-Atom Xatom_wm_take_focus;
-Atom Xatom_wm_save_yourself;
-Atom Xatom_wm_delete_window;
-
-/* Communication with window managers. */
-Atom Xatom_wm_protocols;
-
-/* These are to handle incremental selection transfer. */
-Window incr_requestor;
-Atom incr_property;
-int incr_nbytes;
-unsigned char *incr_value;
-unsigned char *incr_ptr;
-
-/* Declarations for handling cut buffers.
-
- Whenever we set a cut buffer or read a cut buffer's value, we cache
- it in cut_buffer_value. We look for PropertyNotify events about
- the CUT_BUFFER properties, and invalidate our cache accordingly.
- We ignore PropertyNotify events that we suspect were caused by our
- own changes to the cut buffers, so we can keep the cache valid
- longer.
-
- IS ALL THIS HAIR WORTH IT? Well, these functions get called every
- time an element goes into or is retrieved from the kill ring, and
- those ought to be quick. It's not fun in time or space to wait for
- 50k cut buffers to fly back and forth across the net. */
-
-/* The number of CUT_BUFFER properties defined under X. */
-#define NUM_CUT_BUFFERS (8)
-
-/* cut_buffer_atom[n] is the atom naming the nth cut buffer. */
-static Atom cut_buffer_atom[NUM_CUT_BUFFERS] = {
- XA_CUT_BUFFER0, XA_CUT_BUFFER1, XA_CUT_BUFFER2, XA_CUT_BUFFER3,
- XA_CUT_BUFFER4, XA_CUT_BUFFER5, XA_CUT_BUFFER6, XA_CUT_BUFFER7
-};
-
-/* cut_buffer_value is an eight-element vector;
- (aref cut_buffer_value n) is the cached value of cut buffer n, or
- Qnil if cut buffer n is unset. */
-static Lisp_Object cut_buffer_value;
-
-/* Bit N of cut_buffer_cached is true if (aref cut_buffer_value n) is
- known to be valid. This is cleared by PropertyNotify events
- handled by x_invalidate_cut_buffer_cache. It would be wonderful if
- that routine could just set the appropriate element of
- cut_buffer_value to some special value meaning "uncached", but that
- would lose if a GC happened to be in progress.
-
- Bit N of cut_buffer_just_set is true if cut buffer N has been set since
- the last PropertyNotify event; since we get an event even when we set
- the property ourselves, we should ignore one event after setting
- a cut buffer, so we don't have to throw away our cache. */
-#ifdef __STDC__
-volatile
-#endif
-static cut_buffer_cached, cut_buffer_just_set;
-
-\f
-/* Acquiring ownership of a selection. */
-
-
-/* Request selection ownership if we do not already have it. */
-
-static int
-own_selection (selection_type, time)
- Atom selection_type;
- Time time;
-{
- Window owner_window, selecting_window;
-
- if ((selection_type == XA_PRIMARY
- && !NILP (Vx_selection_value))
- || (selection_type == XA_SECONDARY
- && !NILP (Vx_secondary_selection_value))
- || (selection_type == Xatom_clipboard
- && !NILP (Vx_clipboard_value)))
- return 1;
-
- selecting_window = FRAME_X_WINDOW (selected_frame);
- XSetSelectionOwner (x_current_display, selection_type,
- selecting_window, time);
- owner_window = XGetSelectionOwner (x_current_display, selection_type);
-
- if (owner_window != selecting_window)
- return 0;
-
- return 1;
-}
-
-/* Become the selection owner and make our data the selection value.
- If we are already the owner, merely change data and timestamp values.
- This avoids generating SelectionClear events for ourselves. */
-
-DEFUN ("x-set-selection", Fx_set_selection, Sx_set_selection,
- 2, 2, "",
- "Set the value of SELECTION to STRING.\n\
-SELECTION may be `primary', `secondary', or `clipboard'.\n\
-\n\
-Selections are a mechanism for cutting and pasting information between\n\
-X Windows clients. Emacs's kill ring commands set the `primary'\n\
-selection to the top string of the kill ring, making it available to\n\
-other clients, like xterm. Those commands also use the `primary'\n\
-selection to retrieve information from other clients.\n\
-\n\
-According to the Inter-Client Communications Conventions Manual:\n\
-\n\
-The `primary' selection \"... is used for all commands that take only a\n\
- single argument and is the principal means of communication between\n\
- clients that use the selection mechanism.\" In Emacs, this means\n\
- that the kill ring commands set the primary selection to the text\n\
- put in the kill ring.\n\
-\n\
-The `secondary' selection \"... is used as the second argument to\n\
- commands taking two arguments (for example, `exchange primary and\n\
- secondary selections'), and as a means of obtaining data when there\n\
- is a primary selection and the user does not want to disturb it.\"\n\
- I am not sure how Emacs should use the secondary selection; if you\n\
- come up with ideas, this function will at least let you get at it.\n\
-\n\
-The `clipboard' selection \"... is used to hold data that is being\n\
- transferred between clients, that is, data that usually is being\n\
- cut or copied, and then pasted.\" It seems that the `clipboard'\n\
- selection is for the most part equivalent to the `primary'\n\
- selection, so Emacs sets them both.\n\
-\n\
-Also see `x-selection', and the `interprogram-cut-function' variable.")
- (selection, string)
- register Lisp_Object selection, string;
-{
- Atom selection_type;
- Lisp_Object val;
- Time event_time = last_event_timestamp;
- CHECK_STRING (string, 0);
-
- val = Qnil;
-
- if (NILP (selection) || EQ (selection, Qprimary))
- {
- BLOCK_INPUT;
- if (own_selection (XA_PRIMARY, event_time))
- {
- x_begin_selection_own = event_time;
- val = Vx_selection_value = string;
- }
- UNBLOCK_INPUT;
- }
- else if (EQ (selection, Qsecondary))
- {
- BLOCK_INPUT;
- if (own_selection (XA_SECONDARY, event_time))
- {
- x_begin_secondary_selection_own = event_time;
- val = Vx_secondary_selection_value = string;
- }
- UNBLOCK_INPUT;
- }
- else if (EQ (selection, Qclipboard))
- {
- BLOCK_INPUT;
- if (own_selection (Xatom_clipboard, event_time))
- {
- x_begin_clipboard_own = event_time;
- val = Vx_clipboard_value = string;
- }
- UNBLOCK_INPUT;
- }
- else
- error ("Invalid X selection type");
-
- return val;
-}
-
-/* Clear our selection ownership data, as some other client has
- become the owner. */
-
-void
-x_disown_selection (old_owner, selection, changed_owner_time)
- Window *old_owner;
- Atom selection;
- Time changed_owner_time;
-{
- struct frame *s = x_window_to_frame (old_owner);
-
- if (s) /* We are the owner */
- {
- if (selection == XA_PRIMARY)
- {
- x_begin_selection_own = 0;
- Vx_selection_value = Qnil;
- }
- else if (selection == XA_SECONDARY)
- {
- x_begin_secondary_selection_own = 0;
- Vx_secondary_selection_value = Qnil;
- }
- else if (selection == Xatom_clipboard)
- {
- x_begin_clipboard_own = 0;
- Vx_clipboard_value = Qnil;
- }
- else
- abort ();
- }
- else
- abort (); /* Inconsistent state. */
-}
-
-\f
-/* Answering selection requests. */
-
-int x_selection_alloc_error;
-int x_converting_selection;
-
-/* Reply to some client's request for our selection data.
- Data is placed in a property supplied by the requesting window.
-
- If the data exceeds the maximum amount the server can send,
- then prepare to send it incrementally, and reply to the client with
- the total size of the data.
-
- But first, check for all the other crufty stuff we could get. */
-
-void
-x_answer_selection_request (event)
- XSelectionRequestEvent event;
-{
- Time emacs_own_time;
- Lisp_Object selection_value;
- XSelectionEvent evt;
- int format = 8; /* We have only byte sized (text) data. */
-
- evt.type = SelectionNotify; /* Construct reply event */
- evt.display = event.display;
- evt.requestor = event.requestor;
- evt.selection = event.selection;
- evt.time = event.time;
- evt.target = event.target;
-
- if (event.selection == XA_PRIMARY)
- {
- emacs_own_time = x_begin_selection_own;
- selection_value = Vx_selection_value;
- }
- else if (event.selection == XA_SECONDARY)
- {
- emacs_own_time = x_begin_secondary_selection_own;
- selection_value = Vx_secondary_selection_value;
- }
- else if (event.selection == Xatom_clipboard)
- {
- emacs_own_time = x_begin_clipboard_own;
- selection_value = Vx_clipboard_value;
- }
- else
- abort ();
-
- if (event.time != CurrentTime
- && event.time < emacs_own_time)
- evt.property = None;
- else
- {
- if (event.property == None) /* obsolete client */
- evt.property = event.target;
- else
- evt.property = event.property;
- }
-
- if (event.target == Xatom_targets) /* Send List of target atoms */
- {
- }
- else if (event.target == Xatom_multiple) /* Recvd list: <target, prop> */
- {
- Atom type;
- int return_format;
- unsigned long items, bytes_left;
- unsigned char *data;
- int result, i;
-
- if (event.property == 0 /* 0 == NILP */
- || event.property == None)
- return;
-
- result = XGetWindowProperty (event.display, event.requestor,
- event.property, 0L, 10000000L,
- True, Xatom_pair, &type, &return_format,
- &items, &bytes_left, &data);
-
- if (result == Success && type == Xatom_pair)
- for (i = items; i > 0; i--)
- {
- /* Convert each element of the list. */
- }
-
- (void) XSendEvent (x_current_display, evt.requestor, False,
- 0L, (XEvent *) &evt);
- return;
- }
- else if (event.target == Xatom_timestamp) /* Send ownership timestamp */
- {
- if (! emacs_own_time)
- abort ();
-
- format = 32;
- XChangeProperty (evt.display, evt.requestor, evt.property,
- evt.target, format, PropModeReplace,
- (unsigned char *) &emacs_own_time, 1);
- return;
- }
- else if (event.target == Xatom_delete) /* Delete our selection. */
- {
- if (EQ (Qnil, selection_value))
- abort ();
-
- x_disown_selection (event.owner, event.selection, event.time);
-
- /* Now return property of type NILP, length 0. */
- XChangeProperty (event.display, event.requestor, event.property,
- 0, format, PropModeReplace, (unsigned char *) 0, 0);
- return;
- }
- else if (event.target == Xatom_insert_selection)
- {
- Atom type;
- int return_format;
- unsigned long items, bytes_left;
- unsigned char *data;
- int result = XGetWindowProperty (event.display, event.requestor,
- event.property, 0L, 10000000L,
- True, Xatom_pair, &type, &return_format,
- &items, &bytes_left, &data);
- if (result == Success && type == Xatom_pair)
- {
- /* Convert the first atom to (a selection) to the target
- indicated by the second atom. */
- }
- }
- else if (event.target == Xatom_insert_property)
- {
- Atom type;
- int return_format;
- unsigned long items, bytes_left;
- unsigned char *data;
- int result = XGetWindowProperty (event.display, event.requestor,
- event.property, 0L, 10000000L,
- True, XA_STRING, &type, &return_format,
- &items, &bytes_left, &data);
-
- if (result == Success && type == XA_STRING && return_format == 8)
- {
- if (event.selection == Xatom_emacs_selection)
- Vx_selection_value = make_string (data);
- else if (event.selection == Xatom_emacs_secondary_selection)
- Vx_secondary_selection_value = make_string (data);
- else if (event.selection == Xatom_clipboard_selection)
- Vx_clipboard_value = make_string (data);
- else
- abort ();
- }
-
- return;
- }
- else if ((event.target == Xatom_text
- || event.target == XA_STRING))
- {
- int size = XSTRING (selection_value)->size;
- unsigned char *data = XSTRING (selection_value)->data;
-
- if (EQ (Qnil, selection_value))
- abort ();
-
- /* Place data on requestor window's property. */
- if (SELECTION_LENGTH (size, format)
- <= MAX_SELECTION (x_current_display))
- {
- x_converting_selection = 1;
- XChangeProperty (evt.display, evt.requestor, evt.property,
- evt.target, format, PropModeReplace,
- data, size);
- if (x_selection_alloc_error)
- {
- x_selection_alloc_error = 0;
- abort ();
- }
- x_converting_selection = 0;
- }
- else /* Send incrementally */
- {
- evt.target = Xatom_incremental;
- incr_requestor = evt.requestor;
- incr_property = evt.property;
- x_converting_selection = 1;
-
- /* Need to handle Alloc errors on these requests. */
- XChangeProperty (evt.display, incr_requestor, incr_property,
- Xatom_incremental, 32,
- PropModeReplace,
- (unsigned char *) &size, 1);
- if (x_selection_alloc_error)
- {
- x_selection_alloc_error = 0;
- x_converting_selection = 0;
- abort ();
- /* Now abort the send. */
- }
-
- incr_nbytes = size;
- incr_value = data;
- incr_ptr = data;
-
- /* Ask for notification when requestor deletes property. */
- XSelectInput (x_current_display, incr_requestor, PropertyChangeMask);
-
- /* If we're sending incrementally, perhaps block here
- until all sent? */
- }
- }
- else
- evt.property = None;
-
- /* Don't do this if there was an Alloc error: abort the transfer
- by sending None. */
- (void) XSendEvent (x_current_display, evt.requestor, False,
- 0L, (XEvent *) &evt);
-}
-
-/* Send an increment of selection data in response to a PropertyNotify event.
- The increment is placed in a property on the requestor's window.
- When the requestor has processed the increment, it deletes the property,
- which sends us another PropertyNotify event.
-
- When there is no more data to send, we send a zero-length increment. */
-
-void
-x_send_incremental (event)
- XPropertyEvent event;
-{
- if (incr_requestor
- && incr_requestor == event.window
- && incr_property == event.atom
- && event.state == PropertyDelete)
- {
- int format = 8;
- int length = MAX_SELECTION (x_current_display);
- int bytes_left = (incr_nbytes - (incr_ptr - incr_value));
-
- if (length > bytes_left) /* Also sends 0 len when finished. */
- length = bytes_left;
- XChangeProperty (x_current_display, incr_requestor,
- incr_property, XA_STRING, format,
- PropModeAppend, incr_ptr, length);
- if (x_selection_alloc_error)
- {
- x_selection_alloc_error = 0;
- x_converting_selection = 0;
- /* Abandon the transmission. */
- abort ();
- }
- if (length > 0)
- incr_ptr += length;
- else
- { /* Everything's sent */
- XSelectInput (x_current_display, incr_requestor, 0L);
- incr_requestor = (Window) 0;
- incr_property = (Atom) 0;
- incr_nbytes = 0;
- incr_value = (unsigned char *) 0;
- incr_ptr = (unsigned char *) 0;
- x_converting_selection = 0;
- }
- }
-}
-
-\f
-/* Requesting the value of a selection. */
-
-static Lisp_Object x_selection_arrival ();
-
-/* Predicate function used to match a requested event. */
-
-Bool
-XCheckSelectionEvent (dpy, event, window)
- Display *dpy;
- XEvent *event;
- char *window;
-{
- if (event->type == SelectionNotify)
- if (event->xselection.requestor == (Window) window)
- return True;
-
- return False;
-}
-
-/* Request a selection value from its owner. This will block until
- all the data is arrived. */
-
-static Lisp_Object
-get_selection_value (type)
- Atom type;
-{
- XEvent event;
- Lisp_Object val;
- Time requestor_time; /* Timestamp of selection request. */
- Window requestor_window;
-
- BLOCK_INPUT;
- requestor_time = last_event_timestamp;
- requestor_window = FRAME_X_WINDOW (selected_frame);
- XConvertSelection (x_current_display, type, XA_STRING,
- Xatom_emacs_selection, requestor_window, requestor_time);
- XIfEvent (x_current_display,
- &event,
- XCheckSelectionEvent,
- (char *) requestor_window);
- val = x_selection_arrival (&event, requestor_window, requestor_time);
- UNBLOCK_INPUT;
-
- return val;
-}
-
-/* Request a 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-selection", Fx_selection, Sx_selection,
- 1, 1, "",
- "Return the value of SELECTION.\n\
-SELECTION is one of `primary', `secondary', or `clipboard'.\n\
-\n\
-Selections are a mechanism for cutting and pasting information between\n\
-X Windows clients. When the user selects text in an X application,\n\
-the application should set the primary selection to that text; Emacs's\n\
-kill ring commands will then check the value of the `primary'\n\
-selection, and return it as the most recent kill.\n\
-The documentation for `x-set-selection' gives more information on how\n\
-the different selection types are intended to be used.\n\
-Also see the `interprogram-paste-function' variable.")
- (selection)
- register Lisp_Object selection;
-{
- Atom selection_type;
-
- if (NILP (selection) || EQ (selection, Qprimary))
- {
- if (!NILP (Vx_selection_value))
- return Vx_selection_value;
-
- return get_selection_value (XA_PRIMARY);
- }
- else if (EQ (selection, Qsecondary))
- {
- if (!NILP (Vx_secondary_selection_value))
- return Vx_secondary_selection_value;
-
- return get_selection_value (XA_SECONDARY);
- }
- else if (EQ (selection, Qclipboard))
- {
- if (!NILP (Vx_clipboard_value))
- return Vx_clipboard_value;
-
- return get_selection_value (Xatom_clipboard);
- }
- else
- error ("Invalid X selection type");
-}
-
-static Lisp_Object
-x_selection_arrival (event, requestor_window, requestor_time)
- register XSelectionEvent *event;
- Window requestor_window;
- Time requestor_time;
-{
- int result;
- Atom type, selection;
- int format;
- unsigned long items;
- unsigned long bytes_left;
- unsigned char *data = 0;
- int offset = 0;
-
- if (event->selection == XA_PRIMARY)
- selection = Xatom_emacs_selection;
- else if (event->selection == XA_SECONDARY)
- selection = Xatom_emacs_secondary_selection;
- else if (event->selection == Xatom_clipboard)
- selection = Xatom_clipboard_selection;
- else
- abort ();
-
- if (event->requestor == requestor_window
- && event->time == requestor_time
- && event->property != None)
- if (event->target != Xatom_incremental)
- {
- unsigned char *return_string =
- (unsigned char *) alloca (MAX_SELECTION (x_current_display));
-
- do
- {
- result = XGetWindowProperty (x_current_display, requestor_window,
- event->property, 0L,
- 10000000L, True, XA_STRING,
- &type, &format, &items,
- &bytes_left, &data);
- if (result == Success && type == XA_STRING && format == 8
- && offset < MAX_SELECTION (x_current_display))
- {
- bcopy (data, return_string + offset, items);
- offset += items;
- }
- XFree ((char *) data);
- }
- while (bytes_left);
-
- return make_string (return_string, offset);
- }
- else /* Prepare incremental transfer. */
- {
- unsigned char *increment_value;
- unsigned char *increment_ptr;
- int total_size;
- int *increment_nbytes = 0;
-
- result = XGetWindowProperty (x_current_display, requestor_window,
- selection, 0L, 10000000L, False,
- event->property, &type, &format,
- &items, &bytes_left,
- (unsigned char **) &increment_nbytes);
- if (result == Success)
- {
- XPropertyEvent property_event;
-
- total_size = *increment_nbytes;
- increment_value = (unsigned char *) alloca (total_size);
- increment_ptr = increment_value;
-
- XDeleteProperty (x_current_display, event->requestor,
- event->property);
- XFlush (x_current_display);
- XFree ((char *) increment_nbytes);
-
- do
- { /* NOTE: this blocks. */
- XWindowEvent (x_current_display, requestor_window,
- PropertyChangeMask,
- (XEvent *) &property_event);
-
- if (property_event.atom == selection
- && property_event.state == PropertyNewValue)
- do
- {
- result = XGetWindowProperty (x_current_display,
- requestor_window,
- selection, 0L,
- 10000000L, True,
- AnyPropertyType,
- &type, &format,
- &items, &bytes_left,
- &data);
- if (result == Success && type == XA_STRING
- && format == 8)
- {
- bcopy (data, increment_ptr, items);
- increment_ptr += items;
- }
- }
- while (bytes_left);
-
- }
- while (increment_ptr < (increment_value + total_size));
-
- return make_string (increment_value,
- (increment_ptr - increment_value));
- }
- }
-
- return Qnil;
-}
-
-\f
-/* Cut buffer management. */
-
-DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 1, "",
- "Return the value of cut buffer N, or nil if it is unset.\n\
-If N is omitted, it defaults to zero.\n\
-Note that cut buffers have some problems that selections don't; try to\n\
-write your code to use cut buffers only for backward compatibility,\n\
-and use selections for the serious work.")
- (n)
- Lisp_Object n;
-{
- int buf_num;
-
- if (NILP (n))
- buf_num = 0;
- else
- {
- CHECK_NUMBER (n, 0);
- buf_num = XINT (n);
- }
-
- if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
- error ("cut buffer numbers must be from zero to seven");
-
- {
- Lisp_Object value;
-
- /* Note that no PropertyNotify events will be processed while
- input is blocked. */
- BLOCK_INPUT;
-
- if (cut_buffer_cached & (1 << buf_num))
- value = XVECTOR (cut_buffer_value)->contents[buf_num];
- else
- {
- /* Our cache is invalid; retrieve the property's value from
- the server. */
- int buf_len;
- char *buf = XFetchBuffer (x_current_display, &buf_len, buf_num);
-
- if (buf_len == 0)
- value = Qnil;
- else
- value = make_string (buf, buf_len);
-
- XVECTOR (cut_buffer_value)->contents[buf_num] = value;
- cut_buffer_cached |= (1 << buf_num);
-
- XFree (buf);
- }
-
- UNBLOCK_INPUT;
-
- return value;
- }
-}
-
-DEFUN ("x-set-cut-buffer", Fx_set_cut_buffer, Sx_set_cut_buffer, 2, 2, "",
- "Set the value of cut buffer N to STRING.\n\
-Note that cut buffers have some problems that selections don't; try to\n\
-write your code to use cut buffers only for backward compatibility,\n\
-and use selections for the serious work.")
- (n, string)
- Lisp_Object n, string;
-{
- int buf_num;
-
- CHECK_NUMBER (n, 0);
- CHECK_STRING (string, 1);
-
- buf_num = XINT (n);
-
- if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
- error ("cut buffer numbers must be from zero to seven");
-
- BLOCK_INPUT;
-
- /* DECwindows and some other servers don't seem to like setting
- properties to values larger than about 20k. For very large
- values, they signal an error, but for intermediate values they
- just seem to hang.
-
- We could just truncate the request, but it's better to let the
- user know that the strategy he/she's using isn't going to work
- than to have it work partially, but incorrectly. */
-
- if (XSTRING (string)->size == 0
- || XSTRING (string)->size > MAX_SELECTION (x_current_display))
- {
- XStoreBuffer (x_current_display, (char *) 0, 0, buf_num);
- string = Qnil;
- }
- else
- {
- XStoreBuffer (x_current_display,
- (char *) XSTRING (string)->data, XSTRING (string)->size,
- buf_num);
- }
-
- XVECTOR (cut_buffer_value)->contents[buf_num] = string;
- cut_buffer_cached |= (1 << buf_num);
- cut_buffer_just_set |= (1 << buf_num);
-
- UNBLOCK_INPUT;
-
- return string;
-}
-
-/* Ask the server to send us an event if any cut buffer is modified. */
-
-void
-x_watch_cut_buffer_cache ()
-{
- XSelectInput (x_current_display, ROOT_WINDOW, PropertyChangeMask);
-}
-
-/* The server has told us that a cut buffer has been modified; deal with that.
- Note that this function is called at interrupt level. */
-void
-x_invalidate_cut_buffer_cache (XPropertyEvent *event)
-{
- int i;
-
- /* See which cut buffer this is about, if any. */
- for (i = 0; i < NUM_CUT_BUFFERS; i++)
- if (event->atom == cut_buffer_atom[i])
- {
- int mask = (1 << i);
-
- if (cut_buffer_just_set & mask)
- cut_buffer_just_set &= ~mask;
- else
- cut_buffer_cached &= ~mask;
-
- break;
- }
-}
-
-\f
-/* Bureaucracy. */
-
-void
-syms_of_xselect ()
-{
- DEFVAR_LISP ("x-selection-value", &Vx_selection_value,
- "The value of emacs' last cut-string.");
- Vx_selection_value = Qnil;
-
- DEFVAR_LISP ("x-secondary-selection-value", &Vx_secondary_selection_value,
- "The value of emacs' last secondary cut-string.");
- Vx_secondary_selection_value = Qnil;
-
- DEFVAR_LISP ("x-clipboard-value", &Vx_clipboard_value,
- "The string emacs last sent to the clipboard.");
- Vx_clipboard_value = Qnil;
-
- Qprimary = intern ("primary");
- staticpro (&Qprimary);
- Qsecondary = intern ("secondary");
- staticpro (&Qsecondary);
- Qclipboard = intern ("clipboard");
- staticpro (&Qclipboard);
-
- defsubr (&Sx_set_selection);
- defsubr (&Sx_selection);
-
- cut_buffer_value = Fmake_vector (make_number (NUM_CUT_BUFFERS), Qnil);
- staticpro (&cut_buffer_value);
-
- defsubr (&Sx_get_cut_buffer);
- defsubr (&Sx_set_cut_buffer);
-}
-#endif /* X11 */
}
else
{
- if (f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame
- || w != XWINDOW (f->selected_window))
+ if (w != XWINDOW (selected_window)
+ || f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame)
{
extern int cursor_in_non_selected_windows;
+++ /dev/null
-/* Merge parameters into a termcap entry string.
- Copyright (C) 1985, 87, 93, 95 Free Software Foundation, Inc.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-/* Emacs config.h may rename various library functions such as malloc. */
-#ifdef HAVE_CONFIG_H
-#include <config.h>
-#endif
-
-#ifndef emacs
-#if defined(HAVE_STRING_H) || defined(STDC_HEADERS)
-#define bcopy(s, d, n) memcpy ((d), (s), (n))
-#endif
-
-#ifdef STDC_HEADERS
-#include <stdlib.h>
-#include <string.h>
-#else
-char *malloc ();
-char *realloc ();
-#endif
-
-#endif /* not emacs */
-
-#ifndef NULL
-#define NULL (char *) 0
-#endif
-\f
-#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 */
-\f
-/* Assuming STRING is the value of a termcap string entry
- containing `%' constructs to expand parameters,
- merge in parameter values and store result in block OUTSTRING points to.
- LEN is the length of OUTSTRING. If more space is needed,
- a block is allocated with `malloc'.
-
- The value returned is the address of the resulting string.
- This may be OUTSTRING or may be the address of a block got with `malloc'.
- In the latter case, the caller must free the block.
-
- The fourth and following args to tparam serve as the parameter values. */
-
-static char *tparam1 ();
-
-/* VARARGS 2 */
-char *
-tparam (string, outstring, len, arg0, arg1, arg2, arg3)
- char *string;
- char *outstring;
- int len;
- int arg0, arg1, arg2, arg3;
-{
- int arg[4];
-
- arg[0] = arg0;
- arg[1] = arg1;
- arg[2] = arg2;
- arg[3] = arg3;
- return tparam1 (string, outstring, len, NULL, NULL, arg);
-}
-
-char *BC;
-char *UP;
-
-static char tgoto_buf[50];
-
-char *
-tgoto (cm, hpos, vpos)
- char *cm;
- int hpos, vpos;
-{
- int args[2];
- if (!cm)
- return NULL;
- args[0] = vpos;
- args[1] = hpos;
- return tparam1 (cm, tgoto_buf, 50, UP, BC, args);
-}
-
-static char *
-tparam1 (string, outstring, len, up, left, argp)
- char *string;
- char *outstring;
- int len;
- char *up, *left;
- register int *argp;
-{
- register int c;
- register char *p = string;
- register char *op = outstring;
- char *outend;
- int outlen = 0;
-
- register int tem;
- int *old_argp = argp;
- int doleft = 0;
- int doup = 0;
-
- outend = outstring + len;
-
- while (1)
- {
- /* If the buffer might be too short, make it bigger. */
- if (op + 5 >= outend)
- {
- register char *new;
- if (outlen == 0)
- {
- outlen = len + 40;
- new = (char *) xmalloc (outlen);
- outend += 40;
- bcopy (outstring, new, op - outstring);
- }
- else
- {
- outend += outlen;
- outlen *= 2;
- new = (char *) xrealloc (outstring, outlen);
- }
- op += new - outstring;
- outend += new - outstring;
- outstring = new;
- }
- c = *p++;
- if (!c)
- break;
- if (c == '%')
- {
- c = *p++;
- tem = *argp;
- switch (c)
- {
- case 'd': /* %d means output in decimal. */
- if (tem < 10)
- goto onedigit;
- if (tem < 100)
- goto twodigit;
- case '3': /* %3 means output in decimal, 3 digits. */
- if (tem > 999)
- {
- *op++ = tem / 1000 + '0';
- tem %= 1000;
- }
- *op++ = tem / 100 + '0';
- case '2': /* %2 means output in decimal, 2 digits. */
- twodigit:
- tem %= 100;
- *op++ = tem / 10 + '0';
- onedigit:
- *op++ = tem % 10 + '0';
- argp++;
- break;
-
- case 'C':
- /* For c-100: print quotient of value by 96, if nonzero,
- then do like %+. */
- if (tem >= 96)
- {
- *op++ = tem / 96;
- tem %= 96;
- }
- case '+': /* %+x means add character code of char x. */
- tem += *p++;
- case '.': /* %. means output as character. */
- if (left)
- {
- /* If want to forbid output of 0 and \n and \t,
- and this is one of them, increment it. */
- while (tem == 0 || tem == '\n' || tem == '\t')
- {
- tem++;
- if (argp == old_argp)
- doup++, outend -= strlen (up);
- else
- doleft++, outend -= strlen (left);
- }
- }
- *op++ = tem ? tem : 0200;
- case 'f': /* %f means discard next arg. */
- argp++;
- break;
-
- case 'b': /* %b means back up one arg (and re-use it). */
- argp--;
- break;
-
- case 'r': /* %r means interchange following two args. */
- argp[0] = argp[1];
- argp[1] = tem;
- old_argp++;
- break;
-
- case '>': /* %>xy means if arg is > char code of x, */
- if (argp[0] > *p++) /* then add char code of y to the arg, */
- argp[0] += *p; /* and in any case don't output. */
- p++; /* Leave the arg to be output later. */
- break;
-
- case 'a': /* %a means arithmetic. */
- /* Next character says what operation.
- Add or subtract either a constant or some other arg. */
- /* First following character is + to add or - to subtract
- or = to assign. */
- /* Next following char is 'p' and an arg spec
- (0100 plus position of that arg relative to this one)
- or 'c' and a constant stored in a character. */
- tem = p[2] & 0177;
- if (p[1] == 'p')
- tem = argp[tem - 0100];
- if (p[0] == '-')
- argp[0] -= tem;
- else if (p[0] == '+')
- argp[0] += tem;
- else if (p[0] == '*')
- argp[0] *= tem;
- else if (p[0] == '/')
- argp[0] /= tem;
- else
- argp[0] = tem;
-
- p += 3;
- break;
-
- case 'i': /* %i means add one to arg, */
- argp[0] ++; /* and leave it to be output later. */
- argp[1] ++; /* Increment the following arg, too! */
- break;
-
- case '%': /* %% means output %; no arg. */
- goto ordinary;
-
- case 'n': /* %n means xor each of next two args with 140. */
- argp[0] ^= 0140;
- argp[1] ^= 0140;
- break;
-
- case 'm': /* %m means xor each of next two args with 177. */
- argp[0] ^= 0177;
- argp[1] ^= 0177;
- break;
-
- case 'B': /* %B means express arg as BCD char code. */
- argp[0] += 6 * (tem / 10);
- break;
-
- case 'D': /* %D means weird Delta Data transformation. */
- argp[0] -= 2 * (tem % 16);
- break;
- }
- }
- else
- /* Ordinary character in the argument string. */
- ordinary:
- *op++ = c;
- }
- *op = 0;
- while (doup-- > 0)
- strcat (op, up);
- while (doleft-- > 0)
- strcat (op, left);
- return outstring;
-}
-\f
-#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 */
projects / emacs.git / commitdiff