annotate lisp/subr.el @ 114:899728e6052a

Initial revision
author David Lawrence <tale@gnu.org>
date Mon, 05 Nov 1990 10:06:02 +0000
parents
children 535ec1aa78ef
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1 ;; Basic lisp subroutines for Emacs
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
3
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
4 ;; This file is part of GNU Emacs.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
5
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
6 ;; GNU Emacs is free software; you can redistribute it and/or modify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
7 ;; it under the terms of the GNU General Public License as published by
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
8 ;; the Free Software Foundation; either version 1, or (at your option)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
9 ;; any later version.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
10
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is distributed in the hope that it will be useful,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
14 ;; GNU General Public License for more details.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
15
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
16 ;; You should have received a copy of the GNU General Public License
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
17 ;; along with GNU Emacs; see the file COPYING. If not, write to
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
19
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
20
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
21 (defun one-window-p (&optional arg)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
22 "Returns non-nil if there is only one window.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
23 Optional arg NOMINI non-nil means don't count the minibuffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
24 even if it is active."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
25 (eq (selected-window)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
26 (next-window (selected-window) (if arg 'arg))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
27
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
28 (defun walk-windows (proc &optional minibuf all-screens)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
29 "Cycle through all visible windows, calling PROC for each one.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
30 PROC is called with a window as argument.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
31 Optional second arg MINIBUF t means count the minibuffer window
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
32 even if not active. If MINIBUF is neither t nor nil it means
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
33 not to count the minibuffer even if it is active.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
34 Optional third arg ALL-SCREENS t means include all windows in all screens;
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
35 otherwise cycle within the selected screen."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
36 (let* ((walk-windows-start (selected-window))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
37 (walk-windows-current walk-windows-start))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
38 (while (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
39 (setq walk-windows-current
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
40 (next-window walk-windows-current minibuf all-screens))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
41 (funcall proc walk-windows-current)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
42 (not (eq walk-windows-current walk-windows-start))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
43
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
44 (defun read-quoted-char (&optional prompt)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
45 "Like `read-char', except that if the first character read is an octal
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
46 digit, we read up to two more octal digits and return the character
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
47 represented by the octal number consisting of those digits.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
48 Optional argument PROMPT specifies a string to use to prompt the user."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
49 (let ((count 0) (code 0) char)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
50 (while (< count 3)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
51 (let ((inhibit-quit (zerop count))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
52 (help-form nil))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
53 (and prompt (message "%s-" prompt))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
54 (setq char (read-char))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
55 (if inhibit-quit (setq quit-flag nil)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
56 (cond ((null char))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
57 ((and (<= ?0 char) (<= char ?7))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
58 (setq code (+ (* code 8) (- char ?0))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
59 count (1+ count))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
60 (and prompt (message (setq prompt
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
61 (format "%s %c" prompt char)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
62 ((> count 0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
63 (setq unread-command-char char count 259))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
64 (t (setq code char count 259))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
65 (logand 255 code)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
66
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
67 (defun error (&rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
68 "Signal an error, making error message by passing all args to `format'."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
69 (while t
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
70 (signal 'error (list (apply 'format args)))))
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 undefined ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
73 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
74 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
75
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
76 ;Prevent the \{...} documentation construct
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
77 ;from mentioning keys that run this command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
78 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
79
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
80 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
81 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
82 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
83 but optional second arg NODIGITS non-nil treats them like other chars."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
84 (let ((i 0))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
85 (while (<= i 127)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
86 (if (eql (lookup-key global-map (char-to-string i)) 'self-insert-command)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
87 (define-key map (char-to-string i) 'undefined))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
88 (setq i (1+ i))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
89 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
90 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
91 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
92 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
93 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
94 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
95 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
96 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
97
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
98 ;; now in fns.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
99 ;(defun nth (n list)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
100 ; "Returns the Nth element of LIST.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
101 ;N counts from zero. If LIST is not that long, nil is returned."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
102 ; (car (nthcdr n list)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
103 ;
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
104 ;(defun copy-alist (alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
105 ; "Return a copy of ALIST.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
106 ;This is a new alist which represents the same mapping
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
107 ;from objects to objects, but does not share the alist structure with ALIST.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
108 ;The objects mapped (cars and cdrs of elements of the alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
109 ;are shared, however."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
110 ; (setq alist (copy-sequence alist))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
111 ; (let ((tail alist))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
112 ; (while tail
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
113 ; (if (consp (car tail))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
114 ; (setcar tail (cons (car (car tail)) (cdr (car tail)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
115 ; (setq tail (cdr tail))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
116 ; alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
117
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
118 ;Moved to keymap.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
119 ;(defun copy-keymap (keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
120 ; "Return a copy of KEYMAP"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
121 ; (while (not (keymapp keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
122 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
123 ; (if (vectorp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
124 ; (copy-sequence keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
125 ; (copy-alist keymap)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
126
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
127 (defun substitute-key-definition (olddef newdef keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
128 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
129 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
130 Prefix keymaps reached from KEYMAP are not checked recursively;
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
131 perhaps they ought to be."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
132 (if (arrayp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
133 (let ((len (length keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
134 (i 0))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
135 (while (< i len)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
136 (if (eq (aref keymap i) olddef)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
137 (aset keymap i newdef))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
138 (setq i (1+ i))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
139 (while keymap
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
140 (if (eq (cdr-safe (car-safe keymap)) olddef)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
141 (setcdr (car keymap) newdef))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
142 (setq keymap (cdr keymap)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
143
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
144 ;; Avoids useless byte-compilation.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
145 ;; In the future, would be better to fix byte compiler
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
146 ;; not to really compile in cases like this,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
147 ;; and use defun here.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
148 (fset 'ignore '(lambda (&rest ignore) nil))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
149
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
150
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
151 ; old names
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
152 (fset 'make-syntax-table 'copy-syntax-table)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
153 (fset 'dot 'point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
154 (fset 'dot-marker 'point-marker)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
155 (fset 'dot-min 'point-min)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
156 (fset 'dot-max 'point-max)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
157 (fset 'window-dot 'window-point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
158 (fset 'set-window-dot 'set-window-point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
159 (fset 'read-input 'read-string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
160 (fset 'send-string 'process-send-string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
161 (fset 'send-region 'process-send-region)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
162 (fset 'show-buffer 'set-window-buffer)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
163 (fset 'buffer-flush-undo 'buffer-disable-undo)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
164
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
165 ; alternate names
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
166 (fset 'string= 'string-equal)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
167 (fset 'string< 'string-lessp)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
168 (fset 'move-marker 'set-marker)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
169 (fset 'eql 'eq)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
170 (fset 'not 'null)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
171 (fset 'numberp 'integerp)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
172 (fset 'rplaca 'setcar)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
173 (fset 'rplacd 'setcdr)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
174 (fset 'beep 'ding) ;preserve lingual purtity
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
175 (fset 'indent-to-column 'indent-to)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
176 (fset 'backward-delete-char 'delete-backward-char)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
177
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
178 (defvar global-map nil
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
179 "Default global keymap mapping Emacs keyboard input into commands.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
180 The value is a keymap which is usually (but not necessarily) Emacs's
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
181 global map.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
182
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
183 (defvar ctl-x-map nil
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
184 "Default keymap for C-x commands.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
185 The normal global definition of the character C-x indirects to this keymap.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
186
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
187 (defvar esc-map nil
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
188 "Default keymap for ESC (meta) commands.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
189 The normal global definition of the character ESC indirects to this keymap.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
190
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
191 (defvar mouse-map nil
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
192 "Keymap for mouse commands from the X window system.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
193
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
194 (defun run-hooks (&rest hooklist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
195 "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
196 Each argument should be a symbol, a hook variable.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
197 These symbols are processed in the order specified.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
198 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
199 or a list of functions to be called to run the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
200 If the value is a function, it is called with no arguments.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
201 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
202 (while hooklist
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
203 (let ((sym (car hooklist)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
204 (and (boundp sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
205 (symbol-value sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
206 (let ((value (symbol-value sym)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
207 (if (and (listp value) (not (eq (car value) 'lambda)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
208 (mapcar 'funcall value)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
209 (funcall value)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
210 (setq hooklist (cdr hooklist))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
211
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
212 ;; Tell C code how to call this function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
213 (defconst run-hooks 'run-hooks
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
214 "Variable by which C primitives find the function `run-hooks'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
215 Don't change it.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
216
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
217 (defun add-hook (hook function)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
218 "Add to the value of HOOK the function FUNCTION unless already present.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
219 HOOK should be a symbol, and FUNCTION may be any valid function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
220 HOOK's value should be a list of functions, not a single function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
221 If HOOK is void, it is first set to nil."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
222 (or (boundp hook) (set hook nil))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
223 (or (if (consp function)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
224 ;; Clever way to tell whether a given lambda-expression
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
225 ;; is equal to anything in the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
226 (let ((tail (assoc (cdr function) (symbol-value hook))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
227 (equal function tail))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
228 (memq function (symbol-value hook)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
229 (set hook (cons function hook))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
230
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
231 (defun momentary-string-display (string pos &optional exit-char message)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
232 "Momentarily display STRING in the buffer at POS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
233 Display remains until next character is typed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
234 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
235 otherwise it is then available as input (as a command if nothing else).
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
236 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
237 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
238 (or exit-char (setq exit-char ?\ ))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
239 (let ((buffer-read-only nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
240 (modified (buffer-modified-p))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
241 (name buffer-file-name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
242 insert-end)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
243 (unwind-protect
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
244 (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
245 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
246 (goto-char pos)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
247 ;; defeat file locking... don't try this at home, kids!
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
248 (setq buffer-file-name nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
249 (insert-before-markers string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
250 (setq insert-end (point)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
251 (message (or message "Type %s to continue editing.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
252 (single-key-description exit-char))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
253 (let ((char (read-char)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
254 (or (eq char exit-char)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
255 (setq unread-command-char char))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
256 (if insert-end
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
257 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
258 (delete-region pos insert-end)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
259 (setq buffer-file-name name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
260 (set-buffer-modified-p modified))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
261
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
262 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
263 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
264 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
265 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
266 BUFFER is the buffer or (buffer-name) to associate with the process.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
267 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
268 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
269 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
270 with any buffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
271 Third arg is command name, the name of a shell command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
272 Remaining arguments are the arguments for the command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
273 Wildcards and redirection are handle as usual in the shell."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
274 (if (eq system-type 'vax-vms)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
275 (apply 'start-process name buffer args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
276 (start-process name buffer shell-file-name "-c"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
277 (concat "exec " (mapconcat 'identity args " ")))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
278
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
279 (defun eval-after-load (file form)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
280 "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
281 This makes or adds to an entry on `after-load-alist'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
282 FILE should be the name of a library, with no directory name."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
283 (or (assoc file after-load-alist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
284 (setq after-load-alist (cons (list file) after-load-alist)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
285 (nconc (assoc file after-load-alist) (list form))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
286 form)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
287
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
288 (defun eval-next-after-load (file)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
289 "Read the following input sexp, and run it whenever FILE is loaded.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
290 This makes or adds to an entry on `after-load-alist'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
291 FILE should be the name of a library, with no directory name."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
292 (eval-after-load file (read)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
293
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
294 (defun user-original-login-name ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
295 "Return user's login name from original login.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
296 This tries to remain unaffected by `su', by looking in environment variables."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
297 (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
298
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
299 (defun force-mode-line-update (&optional all)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
300 "Force the mode-line of the current buffer to be redisplayed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
301 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
302 (if all (save-excursion (set-buffer (other-buffer))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
303 (set-buffer-modified-p (buffer-modified-p)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
304
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
305 (defun keyboard-translate (from to)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
306 "Translate character FROM to TO at a low level.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
307 This function creates a `keyboard-translate-table' if necessary
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
308 and then modifies one entry in it."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
309 (or (boundp 'keyboard-translate-table)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
310 (let ((table (make-string 256))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
311 (i 0))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
312 (while (< i 256)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
313 (aset table i i)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
314 (setq i (1+ i)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
315 (setq keyboard-translate-table table)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
316 (aset keyboard-translate-table from to))