annotate lisp/subr.el @ 1360:9cb1a4b90b5c

Cleaned up rmail-first-unseen-message.
author Joseph Arceneaux <jla@gnu.org>
date Wed, 07 Oct 1992 19:25:24 +0000
parents 60e0dc538df3
children acdf9d64d086
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 648
diff changeset
1 ;;; subr.el --- basic lisp subroutines for Emacs
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
2
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
3 ;;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
4
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
5 ;; This file is part of GNU Emacs.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
6
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
8 ;; it under the terms of the GNU General Public License as published by
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
9 ;; the Free Software Foundation; either version 2, or (at your option)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
10 ;; any later version.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
11
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
12 ;; GNU Emacs is distributed in the hope that it will be useful,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
15 ;; GNU General Public License for more details.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
16
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
17 ;; You should have received a copy of the GNU General Public License
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
20
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
21 ;;; Code:
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
22
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
23 (defun one-window-p (&optional nomini)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
24 "Returns non-nil if there is only one window.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
25 Optional arg NOMINI non-nil means don't count the minibuffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
26 even if it is active."
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
27 (let ((base-window (selected-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
28 (if (and nomini (eq base-window (minibuffer-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
29 (setq base-window (next-window base-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
30 (eq base-window
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
31 (next-window base-window (if nomini 'arg)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
32
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
33 (defun walk-windows (proc &optional minibuf all-frames)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
34 "Cycle through all visible windows, calling PROC for each one.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
35 PROC is called with a window as argument.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
36 Optional second arg MINIBUF t means count the minibuffer window
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
37 even if not active. If MINIBUF is neither t nor nil it means
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
38 not to count the minibuffer even if it is active.
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
39 Optional third arg ALL-FRAMES t means include all windows in all frames;
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
40 otherwise cycle within the selected frame."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
41 (let* ((walk-windows-start (selected-window))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
42 (walk-windows-current walk-windows-start))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
43 (while (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
44 (setq walk-windows-current
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
45 (next-window walk-windows-current minibuf all-frames))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
46 (funcall proc walk-windows-current)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
47 (not (eq walk-windows-current walk-windows-start))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
48
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
49 (defun read-quoted-char (&optional prompt)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
50 "Like `read-char', except that if the first character read is an octal
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
51 digit, we read up to two more octal digits and return the character
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
52 represented by the octal number consisting of those digits.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
53 Optional argument PROMPT specifies a string to use to prompt the user."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
54 (let ((count 0) (code 0) char)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
55 (while (< count 3)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
56 (let ((inhibit-quit (zerop count))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
57 (help-form nil))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
58 (and prompt (message "%s-" prompt))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
59 (setq char (read-char))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
60 (if inhibit-quit (setq quit-flag nil)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
61 (cond ((null char))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
62 ((and (<= ?0 char) (<= char ?7))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
63 (setq code (+ (* code 8) (- char ?0))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
64 count (1+ count))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
65 (and prompt (message (setq prompt
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
66 (format "%s %c" prompt char)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
67 ((> count 0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
68 (setq unread-command-char char count 259))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
69 (t (setq code char count 259))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
70 (logand 255 code)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
71
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
72 (defun error (&rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
73 "Signal an error, making error message by passing all args to `format'."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
74 (while t
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
75 (signal 'error (list (apply 'format args)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
76
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
77 (defun undefined ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
78 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
79 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
80
1166
45fbb83b8160 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1130
diff changeset
81 ;; Some programs still use this as a function.
45fbb83b8160 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1130
diff changeset
82 (defun baud-rate ()
45fbb83b8160 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1130
diff changeset
83 "Obsolete function returning the value of the `baud-rate' variable."
45fbb83b8160 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1130
diff changeset
84 baud-rate)
45fbb83b8160 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1130
diff changeset
85
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
86 ;Prevent the \{...} documentation construct
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
87 ;from mentioning keys that run this command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
88 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
89
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
90 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
91 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
92 Normally, as an exception, digits and minus-sign are set to make prefix args,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
93 but optional second arg NODIGITS non-nil treats them like other chars."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
94 (let ((i 0))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
95 (while (<= i 127)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
96 (if (eql (lookup-key global-map (char-to-string i)) 'self-insert-command)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
97 (define-key map (char-to-string i) 'undefined))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
98 (setq i (1+ i))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
99 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
100 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
101 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
102 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
103 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
104 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
105 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
106 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
107
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
108 ;; now in fns.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
109 ;(defun nth (n list)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
110 ; "Returns the Nth element of LIST.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
111 ;N counts from zero. If LIST is not that long, nil is returned."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
112 ; (car (nthcdr n list)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
113 ;
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
114 ;(defun copy-alist (alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
115 ; "Return a copy of ALIST.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
116 ;This is a new alist which represents the same mapping
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
117 ;from objects to objects, but does not share the alist structure with ALIST.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
118 ;The objects mapped (cars and cdrs of elements of the alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
119 ;are shared, however."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
120 ; (setq alist (copy-sequence alist))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
121 ; (let ((tail alist))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
122 ; (while tail
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
123 ; (if (consp (car tail))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
124 ; (setcar tail (cons (car (car tail)) (cdr (car tail)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
125 ; (setq tail (cdr tail))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
126 ; alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
127
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
128 ;Moved to keymap.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
129 ;(defun copy-keymap (keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
130 ; "Return a copy of KEYMAP"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
131 ; (while (not (keymapp keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
132 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
133 ; (if (vectorp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
134 ; (copy-sequence keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
135 ; (copy-alist keymap)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
136
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
137 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
138 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
139 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
140 If optional fourth argument OLDMAP is specified, we redefine
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
141 in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
142 (or prefix (setq prefix ""))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
143 (let* ((scan (or oldmap keymap))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
144 (vec1 (vector nil))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
145 (prefix1 (vconcat prefix vec1)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
146 ;; Scan OLDMAP, finding each char or event-symbol that
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
147 ;; has any definition, and act on it with hack-key.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
148 (while (consp scan)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
149 (if (consp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
150 (let ((char (car (car scan)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
151 (defn (cdr (car scan))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
152 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
153 ;; the inside of the following let that handles array elements.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
154 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
155 (aset prefix1 (length prefix) char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
156 (let (inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
157 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
158 (while (stringp (car-safe defn))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
159 (setq defn (cdr defn)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
160 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
161 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
162 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
163 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
164 (if (eq defn olddef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
165 (define-key keymap prefix1 newdef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
166 (if (keymapp defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
167 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
168 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
169 prefix1)))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
170 (if (arrayp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
171 (let* ((array (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
172 (len (length array))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
173 (i 0))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
174 (while (< i len)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
175 (let ((char i) (defn (aref array i)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
176 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
177 ;; the inside of the previous let.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
178 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
179 (aset prefix1 (length prefix) char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
180 (let (inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
181 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
182 (while (stringp (car-safe defn))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
183 (setq defn (cdr defn)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
184 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
185 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
186 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
187 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
188 (if (eq defn olddef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
189 (define-key keymap prefix1 newdef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
190 (if (keymapp defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
191 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
192 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
193 prefix1)))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
194 (setq i (1+ i))))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
195 (setq scan (cdr scan)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
196
1130
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
197 (defmacro save-match-data (&rest body)
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
198 "Execute the BODY forms, restoring the global value of the match data."
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
199 (let ((original (make-symbol "match-data")))
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
200 (list
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
201 'let (list (list original '(match-data)))
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
202 (list 'unwind-protect
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
203 (cons 'progn body)
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
204 (list 'store-match-data original)))))
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
205
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
206 ;; Avoids useless byte-compilation.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
207 ;; In the future, would be better to fix byte compiler
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
208 ;; not to really compile in cases like this,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
209 ;; and use defun here.
293
7e7575d7b6d0 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 144
diff changeset
210 (fset 'ignore '(lambda (&rest ignore)
7e7575d7b6d0 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 144
diff changeset
211 "Do nothing.
7e7575d7b6d0 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 144
diff changeset
212 Accept any number of arguments, but ignore them."
7e7575d7b6d0 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 144
diff changeset
213 nil))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
214
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
215
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
216 ; old names
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
217 (fset 'make-syntax-table 'copy-syntax-table)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
218 (fset 'dot 'point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
219 (fset 'dot-marker 'point-marker)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
220 (fset 'dot-min 'point-min)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
221 (fset 'dot-max 'point-max)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
222 (fset 'window-dot 'window-point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
223 (fset 'set-window-dot 'set-window-point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
224 (fset 'read-input 'read-string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
225 (fset 'send-string 'process-send-string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
226 (fset 'send-region 'process-send-region)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
227 (fset 'show-buffer 'set-window-buffer)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
228 (fset 'buffer-flush-undo 'buffer-disable-undo)
675
85fd29f25c75 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 668
diff changeset
229 (fset 'eval-current-buffer 'eval-buffer)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
230
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
231 ; alternate names
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
232 (fset 'string= 'string-equal)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
233 (fset 'string< 'string-lessp)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
234 (fset 'move-marker 'set-marker)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
235 (fset 'eql 'eq)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
236 (fset 'not 'null)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
237 (fset 'numberp 'integerp)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
238 (fset 'rplaca 'setcar)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
239 (fset 'rplacd 'setcdr)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
240 (fset 'beep 'ding) ;preserve lingual purtity
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
241 (fset 'indent-to-column 'indent-to)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
242 (fset 'backward-delete-char 'delete-backward-char)
353
38d331b3a0b8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 293
diff changeset
243 (fset 'search-forward-regexp (symbol-function 're-search-forward))
38d331b3a0b8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 293
diff changeset
244 (fset 'search-backward-regexp (symbol-function 're-search-backward))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
245
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
246 ;;; global-map, esc-map, and ctl-x-map have their values set up
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
247 ;;; in keymap.c.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
248 (defvar global-map nil
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
249 "Default global keymap mapping Emacs keyboard input into commands.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
250 The value is a keymap which is usually (but not necessarily) Emacs's
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
251 global map.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
252
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
253 (defvar esc-map nil
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
254 "Default keymap for ESC (meta) commands.
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
255 The normal global definition of the character ESC indirects to this keymap.")
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
256
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
257 (defvar ctl-x-map nil
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
258 "Default keymap for C-x commands.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
259 The normal global definition of the character C-x indirects to this keymap.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
260
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
261 (defvar ctl-x-4-map (make-sparse-keymap)
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
262 "Keymap for subcommands of C-x 4")
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
263 (fset 'ctl-x-4-prefix ctl-x-4-map)
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
264 (define-key ctl-x-map "4" 'ctl-x-4-prefix)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
265
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
266 (defvar ctl-x-5-map (make-sparse-keymap)
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
267 "Keymap for frame commands.")
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
268 (fset 'ctl-x-5-prefix ctl-x-5-map)
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
269 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
270
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
271
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
272 (defun run-hooks (&rest hooklist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
273 "Takes hook names and runs each one in turn. Major mode functions use this.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
274 Each argument should be a symbol, a hook variable.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
275 These symbols are processed in the order specified.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
276 If a hook symbol has a non-nil value, that value may be a function
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
277 or a list of functions to be called to run the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
278 If the value is a function, it is called with no arguments.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
279 If it is a list, the elements are called, in order, with no arguments."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
280 (while hooklist
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
281 (let ((sym (car hooklist)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
282 (and (boundp sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
283 (symbol-value sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
284 (let ((value (symbol-value sym)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
285 (if (and (listp value) (not (eq (car value) 'lambda)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
286 (mapcar 'funcall value)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
287 (funcall value)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
288 (setq hooklist (cdr hooklist))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
289
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
290 ;; Tell C code how to call this function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
291 (defconst run-hooks 'run-hooks
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
292 "Variable by which C primitives find the function `run-hooks'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
293 Don't change it.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
294
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
295 (defun add-hook (hook function)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
296 "Add to the value of HOOK the function FUNCTION unless already present.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
297 HOOK should be a symbol, and FUNCTION may be any valid function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
298 HOOK's value should be a list of functions, not a single function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
299 If HOOK is void, it is first set to nil."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
300 (or (boundp hook) (set hook nil))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
301 (or (if (consp function)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
302 ;; Clever way to tell whether a given lambda-expression
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
303 ;; is equal to anything in the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
304 (let ((tail (assoc (cdr function) (symbol-value hook))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
305 (equal function tail))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
306 (memq function (symbol-value hook)))
384
9dab5ca1890f *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 353
diff changeset
307 (set hook (cons function (symbol-value hook)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
308
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
309 (defun momentary-string-display (string pos &optional exit-char message)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
310 "Momentarily display STRING in the buffer at POS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
311 Display remains until next character is typed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
312 If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
313 otherwise it is then available as input (as a command if nothing else).
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
314 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
315 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
316 (or exit-char (setq exit-char ?\ ))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
317 (let ((buffer-read-only nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
318 (modified (buffer-modified-p))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
319 (name buffer-file-name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
320 insert-end)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
321 (unwind-protect
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
322 (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
323 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
324 (goto-char pos)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
325 ;; defeat file locking... don't try this at home, kids!
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
326 (setq buffer-file-name nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
327 (insert-before-markers string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
328 (setq insert-end (point)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
329 (message (or message "Type %s to continue editing.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
330 (single-key-description exit-char))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
331 (let ((char (read-char)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
332 (or (eq char exit-char)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
333 (setq unread-command-char char))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
334 (if insert-end
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
335 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
336 (delete-region pos insert-end)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
337 (setq buffer-file-name name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
338 (set-buffer-modified-p modified))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
339
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
340 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
341 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
342 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
343 NAME is name for process. It is modified if necessary to make it unique.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
344 BUFFER is the buffer or (buffer-name) to associate with the process.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
345 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
346 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
347 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
348 with any buffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
349 Third arg is command name, the name of a shell command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
350 Remaining arguments are the arguments for the command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
351 Wildcards and redirection are handle as usual in the shell."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
352 (if (eq system-type 'vax-vms)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
353 (apply 'start-process name buffer args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
354 (start-process name buffer shell-file-name "-c"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
355 (concat "exec " (mapconcat 'identity args " ")))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
356
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
357 (defun eval-after-load (file form)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
358 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
359 This makes or adds to an entry on `after-load-alist'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
360 FILE should be the name of a library, with no directory name."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
361 (or (assoc file after-load-alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
362 (setq after-load-alist (cons (list file) after-load-alist)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
363 (nconc (assoc file after-load-alist) (list form))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
364 form)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
365
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
366 (defun eval-next-after-load (file)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
367 "Read the following input sexp, and run it whenever FILE is loaded.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
368 This makes or adds to an entry on `after-load-alist'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
369 FILE should be the name of a library, with no directory name."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
370 (eval-after-load file (read)))
144
535ec1aa78ef *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 114
diff changeset
371
861
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
372 ;;(defmacro defun-inline (name args &rest body)
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
373 ;; "Create an \"inline defun\" (actually a macro).
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
374 ;;Use just like `defun'."
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
375 ;; (nconc (list 'defmacro name '(&rest args))
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
376 ;; (if (stringp (car body))
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
377 ;; (prog1 (list (car body))
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
378 ;; (setq body (or (cdr body) body))))
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
379 ;; (list (list 'cons (list 'quote
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
380 ;; (cons 'lambda (cons args body)))
345296f94a1e *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 840
diff changeset
381 ;; 'args))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
382
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
383 (defun user-original-login-name ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
384 "Return user's login name from original login.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
385 This tries to remain unaffected by `su', by looking in environment variables."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
386 (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
387
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
388 (defun force-mode-line-update (&optional all)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
389 "Force the mode-line of the current buffer to be redisplayed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
390 With optional non-nil ALL then force then force redisplay of all mode-lines."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
391 (if all (save-excursion (set-buffer (other-buffer))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
392 (set-buffer-modified-p (buffer-modified-p)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
393
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
394 (defun keyboard-translate (from to)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
395 "Translate character FROM to TO at a low level.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
396 This function creates a `keyboard-translate-table' if necessary
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
397 and then modifies one entry in it."
1112
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
398 (or (arrayp keyboard-translate-table)
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
399 (setq keyboard-translate-table ""))
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
400 (if (or (> from (length keyboard-translate-table))
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
401 (> to (length keyboard-translate-table)))
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
402 (progn
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
403 (let* ((i (length keyboard-translate-table))
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
404 (table (make-string (- 256 i) 0)))
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
405 (while (< i 256)
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
406 (aset table i i)
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
407 (setq i (1+ i)))
1dba066c1e0a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 861
diff changeset
408 (setq keyboard-translate-table table))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
409 (aset keyboard-translate-table from to))
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 388
diff changeset
410
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 388
diff changeset
411
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 388
diff changeset
412 (defmacro lambda (&rest cdr)
668
47871343371e *** empty log message ***
Noah Friedman <friedman@splode.com>
parents: 667
diff changeset
413 "Macro which allows one to write (lambda ...) for anonymous functions
47871343371e *** empty log message ***
Noah Friedman <friedman@splode.com>
parents: 667
diff changeset
414 instead of having to write (function (lambda ...)) or '(lambda ...), the
47871343371e *** empty log message ***
Noah Friedman <friedman@splode.com>
parents: 667
diff changeset
415 latter of which won't get byte-compiled."
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 388
diff changeset
416 (` (function (lambda (,@ cdr)))))
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
417
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
418 ;;; subr.el ends here