|
658
|
1 ;;; subr.el --- basic lisp subroutines for Emacs
|
|
787
|
2
|
|
7298
|
3 ;;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
|
|
114
|
4
|
|
|
5 ;; This file is part of GNU Emacs.
|
|
|
6
|
|
|
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
8 ;; it under the terms of the GNU General Public License as published by
|
|
707
|
9 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
114
|
10 ;; any later version.
|
|
|
11
|
|
|
12 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 ;; GNU General Public License for more details.
|
|
|
16
|
|
|
17 ;; You should have received a copy of the GNU General Public License
|
|
|
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
20
|
|
787
|
21 ;;; Code:
|
|
114
|
22
|
|
2504
|
23
|
|
|
24 ;;;; Lisp language features.
|
|
|
25
|
|
|
26 (defmacro lambda (&rest cdr)
|
|
|
27 "Return a lambda expression.
|
|
|
28 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
|
|
|
29 self-quoting; the result of evaluating the lambda expression is the
|
|
|
30 expression itself. The lambda expression may then be treated as a
|
|
|
31 function, i. e. stored as the function value of a symbol, passed to
|
|
|
32 funcall or mapcar, etcetera.
|
|
|
33 ARGS should take the same form as an argument list for a `defun'.
|
|
|
34 DOCSTRING should be a string, as described for `defun'. It may be omitted.
|
|
|
35 INTERACTIVE should be a call to the function `interactive', which see.
|
|
|
36 It may also be omitted.
|
|
|
37 BODY should be a list of lisp expressions."
|
|
|
38 ;; Note that this definition should not use backquotes; subr.el should not
|
|
|
39 ;; depend on backquote.el.
|
|
|
40 (list 'function (cons 'lambda cdr)))
|
|
|
41
|
|
|
42 ;;(defmacro defun-inline (name args &rest body)
|
|
|
43 ;; "Create an \"inline defun\" (actually a macro).
|
|
|
44 ;;Use just like `defun'."
|
|
|
45 ;; (nconc (list 'defmacro name '(&rest args))
|
|
|
46 ;; (if (stringp (car body))
|
|
|
47 ;; (prog1 (list (car body))
|
|
|
48 ;; (setq body (or (cdr body) body))))
|
|
|
49 ;; (list (list 'cons (list 'quote
|
|
|
50 ;; (cons 'lambda (cons args body)))
|
|
|
51 ;; 'args))))
|
|
|
52
|
|
|
53
|
|
|
54 ;;;; Window tree functions.
|
|
|
55
|
|
6441
|
56 (defun one-window-p (&optional nomini all-frames)
|
|
114
|
57 "Returns non-nil if there is only one window.
|
|
|
58 Optional arg NOMINI non-nil means don't count the minibuffer
|
|
6441
|
59 even if it is active.
|
|
|
60
|
|
|
61 The optional arg ALL-FRAMES t means count windows on all frames.
|
|
|
62 If it is `visible', count windows on all visible frames.
|
|
|
63 ALL-FRAMES nil or omitted means count only the selected frame,
|
|
|
64 plus the minibuffer it uses (which may be on another frame).
|
|
|
65 If ALL-FRAMES is neither nil nor t, count only the selected frame."
|
|
707
|
66 (let ((base-window (selected-window)))
|
|
|
67 (if (and nomini (eq base-window (minibuffer-window)))
|
|
|
68 (setq base-window (next-window base-window)))
|
|
|
69 (eq base-window
|
|
6441
|
70 (next-window base-window (if nomini 'arg) all-frames))))
|
|
114
|
71
|
|
779
|
72 (defun walk-windows (proc &optional minibuf all-frames)
|
|
114
|
73 "Cycle through all visible windows, calling PROC for each one.
|
|
|
74 PROC is called with a window as argument.
|
|
|
75 Optional second arg MINIBUF t means count the minibuffer window
|
|
|
76 even if not active. If MINIBUF is neither t nor nil it means
|
|
|
77 not to count the minibuffer even if it is active.
|
|
1959
|
78
|
|
|
79 Optional third arg ALL-FRAMES, if t, means include all frames.
|
|
|
80 ALL-FRAMES nil or omitted means cycle within the selected frame,
|
|
|
81 but include the minibuffer window (if MINIBUF says so) that that
|
|
|
82 frame uses, even if it is on another frame.
|
|
|
83 If ALL-FRAMES is neither nil nor t, stick strictly to the selected frame."
|
|
5157
|
84 ;; If we start from the minibuffer window, don't fail to come back to it.
|
|
|
85 (if (window-minibuffer-p (selected-window))
|
|
|
86 (setq minibuf t))
|
|
114
|
87 (let* ((walk-windows-start (selected-window))
|
|
|
88 (walk-windows-current walk-windows-start))
|
|
|
89 (while (progn
|
|
|
90 (setq walk-windows-current
|
|
779
|
91 (next-window walk-windows-current minibuf all-frames))
|
|
114
|
92 (funcall proc walk-windows-current)
|
|
|
93 (not (eq walk-windows-current walk-windows-start))))))
|
|
|
94
|
|
4491
|
95 (defun minibuffer-window-active-p (window)
|
|
|
96 "Return t if WINDOW (a minibuffer window) is now active."
|
|
|
97 ;; nil nil means include WINDOW's frame
|
|
|
98 ;; and other frames using WINDOW as minibuffer,
|
|
|
99 ;; and include minibuffer if active.
|
|
|
100 (let ((prev (previous-window window nil nil)))
|
|
|
101 ;; If PREV equals WINDOW, WINDOW must be on a minibuffer-only frame
|
|
|
102 ;; and it's not currently being used. So return nil.
|
|
|
103 (and (not (eq window prev))
|
|
|
104 (let ((should-be-same (next-window prev nil nil)))
|
|
|
105 ;; If next-window doesn't reverse previous-window,
|
|
|
106 ;; WINDOW must be outside the cycle specified by nil nil.
|
|
|
107 (eq should-be-same window)))))
|
|
2504
|
108
|
|
|
109 ;;;; Keymap support.
|
|
114
|
110
|
|
|
111 (defun undefined ()
|
|
|
112 (interactive)
|
|
|
113 (ding))
|
|
|
114
|
|
|
115 ;Prevent the \{...} documentation construct
|
|
|
116 ;from mentioning keys that run this command.
|
|
|
117 (put 'undefined 'suppress-keymap t)
|
|
|
118
|
|
|
119 (defun suppress-keymap (map &optional nodigits)
|
|
|
120 "Make MAP override all normally self-inserting keys to be undefined.
|
|
|
121 Normally, as an exception, digits and minus-sign are set to make prefix args,
|
|
|
122 but optional second arg NODIGITS non-nil treats them like other chars."
|
|
4767
|
123 (substitute-key-definition 'self-insert-command 'undefined map global-map)
|
|
114
|
124 (or nodigits
|
|
|
125 (let (loop)
|
|
|
126 (define-key map "-" 'negative-argument)
|
|
|
127 ;; Make plain numbers do numeric args.
|
|
|
128 (setq loop ?0)
|
|
|
129 (while (<= loop ?9)
|
|
|
130 (define-key map (char-to-string loop) 'digit-argument)
|
|
|
131 (setq loop (1+ loop))))))
|
|
|
132
|
|
|
133 ;Moved to keymap.c
|
|
|
134 ;(defun copy-keymap (keymap)
|
|
|
135 ; "Return a copy of KEYMAP"
|
|
|
136 ; (while (not (keymapp keymap))
|
|
|
137 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
|
|
|
138 ; (if (vectorp keymap)
|
|
|
139 ; (copy-sequence keymap)
|
|
|
140 ; (copy-alist keymap)))
|
|
|
141
|
|
6167
|
142 (defvar key-substitution-in-progress nil
|
|
|
143 "Used internally by substitute-key-definition.")
|
|
|
144
|
|
1176
|
145 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
|
|
114
|
146 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
|
|
|
147 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
|
|
1176
|
148 If optional fourth argument OLDMAP is specified, we redefine
|
|
|
149 in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
|
|
|
150 (or prefix (setq prefix ""))
|
|
|
151 (let* ((scan (or oldmap keymap))
|
|
|
152 (vec1 (vector nil))
|
|
6167
|
153 (prefix1 (vconcat prefix vec1))
|
|
|
154 (key-substitution-in-progress
|
|
|
155 (cons scan key-substitution-in-progress)))
|
|
1176
|
156 ;; Scan OLDMAP, finding each char or event-symbol that
|
|
|
157 ;; has any definition, and act on it with hack-key.
|
|
|
158 (while (consp scan)
|
|
|
159 (if (consp (car scan))
|
|
|
160 (let ((char (car (car scan)))
|
|
|
161 (defn (cdr (car scan))))
|
|
|
162 ;; The inside of this let duplicates exactly
|
|
|
163 ;; the inside of the following let that handles array elements.
|
|
|
164 (aset vec1 0 char)
|
|
|
165 (aset prefix1 (length prefix) char)
|
|
6005
|
166 (let (inner-def skipped)
|
|
1176
|
167 ;; Skip past menu-prompt.
|
|
|
168 (while (stringp (car-safe defn))
|
|
6005
|
169 (setq skipped (cons (car defn) skipped))
|
|
1176
|
170 (setq defn (cdr defn)))
|
|
7615
|
171 ;; Skip past cached key-equivalence data for menu items.
|
|
|
172 (and (consp defn) (consp (car defn))
|
|
|
173 (setq defn (cdr defn)))
|
|
1176
|
174 (setq inner-def defn)
|
|
7615
|
175 ;; Look past a symbol that names a keymap.
|
|
1176
|
176 (while (and (symbolp inner-def)
|
|
|
177 (fboundp inner-def))
|
|
|
178 (setq inner-def (symbol-function inner-def)))
|
|
|
179 (if (eq defn olddef)
|
|
6005
|
180 (define-key keymap prefix1 (nconc (nreverse skipped) newdef))
|
|
7615
|
181 ;; Avoid recursively rescanning a keymap being scanned.
|
|
6167
|
182 (if (and (keymapp defn)
|
|
|
183 (not (memq inner-def
|
|
|
184 key-substitution-in-progress)))
|
|
7615
|
185 ;; If this one isn't being scanned already,
|
|
|
186 ;; scan it now.
|
|
1176
|
187 (substitute-key-definition olddef newdef keymap
|
|
|
188 inner-def
|
|
|
189 prefix1)))))
|
|
|
190 (if (arrayp (car scan))
|
|
|
191 (let* ((array (car scan))
|
|
|
192 (len (length array))
|
|
|
193 (i 0))
|
|
|
194 (while (< i len)
|
|
|
195 (let ((char i) (defn (aref array i)))
|
|
|
196 ;; The inside of this let duplicates exactly
|
|
|
197 ;; the inside of the previous let.
|
|
|
198 (aset vec1 0 char)
|
|
|
199 (aset prefix1 (length prefix) char)
|
|
6005
|
200 (let (inner-def skipped)
|
|
1176
|
201 ;; Skip past menu-prompt.
|
|
|
202 (while (stringp (car-safe defn))
|
|
6005
|
203 (setq skipped (cons (car defn) skipped))
|
|
1176
|
204 (setq defn (cdr defn)))
|
|
7615
|
205 (and (consp defn) (consp (car defn))
|
|
|
206 (setq defn (cdr defn)))
|
|
1176
|
207 (setq inner-def defn)
|
|
|
208 (while (and (symbolp inner-def)
|
|
|
209 (fboundp inner-def))
|
|
|
210 (setq inner-def (symbol-function inner-def)))
|
|
|
211 (if (eq defn olddef)
|
|
6005
|
212 (define-key keymap prefix1
|
|
|
213 (nconc (nreverse skipped) newdef))
|
|
6167
|
214 (if (and (keymapp defn)
|
|
|
215 (not (memq inner-def
|
|
|
216 key-substitution-in-progress)))
|
|
1176
|
217 (substitute-key-definition olddef newdef keymap
|
|
|
218 inner-def
|
|
|
219 prefix1)))))
|
|
|
220 (setq i (1+ i))))))
|
|
|
221 (setq scan (cdr scan)))))
|
|
2504
|
222
|
|
3902
|
223 (defun define-key-after (keymap key definition after)
|
|
3901
|
224 "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
|
|
|
225 This is like `define-key' except that the binding for KEY is placed
|
|
|
226 just after the binding for the event AFTER, instead of at the beginning
|
|
|
227 of the map.
|
|
4070
|
228 The order matters when the keymap is used as a menu.
|
|
6725
|
229 KEY must contain just one event type--that is to say, it must be
|
|
|
230 a string or vector of length 1."
|
|
3901
|
231 (or (keymapp keymap)
|
|
|
232 (signal 'wrong-type-argument (list 'keymapp keymap)))
|
|
4188
|
233 (if (> (length key) 1)
|
|
4070
|
234 (error "multi-event key specified in `define-key-after'"))
|
|
3927
|
235 (let ((tail keymap) done inserted
|
|
3901
|
236 (first (aref key 0)))
|
|
|
237 (while (and (not done) tail)
|
|
|
238 ;; Delete any earlier bindings for the same key.
|
|
|
239 (if (eq (car-safe (car (cdr tail))) first)
|
|
|
240 (setcdr tail (cdr (cdr tail))))
|
|
|
241 ;; When we reach AFTER's binding, insert the new binding after.
|
|
|
242 ;; If we reach an inherited keymap, insert just before that.
|
|
3927
|
243 ;; If we reach the end of this keymap, insert at the end.
|
|
3901
|
244 (if (or (eq (car-safe (car tail)) after)
|
|
3927
|
245 (eq (car (cdr tail)) 'keymap)
|
|
|
246 (null (cdr tail)))
|
|
3901
|
247 (progn
|
|
3927
|
248 ;; Stop the scan only if we find a parent keymap.
|
|
|
249 ;; Keep going past the inserted element
|
|
|
250 ;; so we can delete any duplications that come later.
|
|
|
251 (if (eq (car (cdr tail)) 'keymap)
|
|
|
252 (setq done t))
|
|
|
253 ;; Don't insert more than once.
|
|
|
254 (or inserted
|
|
|
255 (setcdr tail (cons (cons (aref key 0) definition) (cdr tail))))
|
|
|
256 (setq inserted t)))
|
|
3901
|
257 (setq tail (cdr tail)))))
|
|
|
258
|
|
2504
|
259 (defun keyboard-translate (from to)
|
|
|
260 "Translate character FROM to TO at a low level.
|
|
|
261 This function creates a `keyboard-translate-table' if necessary
|
|
|
262 and then modifies one entry in it."
|
|
|
263 (or (arrayp keyboard-translate-table)
|
|
|
264 (setq keyboard-translate-table ""))
|
|
|
265 (if (or (> from (length keyboard-translate-table))
|
|
|
266 (> to (length keyboard-translate-table)))
|
|
|
267 (progn
|
|
|
268 (let* ((i (length keyboard-translate-table))
|
|
4235
|
269 (table (concat keyboard-translate-table
|
|
|
270 (make-string (- 256 i) 0))))
|
|
2504
|
271 (while (< i 256)
|
|
|
272 (aset table i i)
|
|
|
273 (setq i (1+ i)))
|
|
|
274 (setq keyboard-translate-table table))))
|
|
|
275 (aset keyboard-translate-table from to))
|
|
|
276
|
|
2071
|
277
|
|
2504
|
278 ;;;; The global keymap tree.
|
|
|
279
|
|
|
280 ;;; global-map, esc-map, and ctl-x-map have their values set up in
|
|
|
281 ;;; keymap.c; we just give them docstrings here.
|
|
|
282
|
|
|
283 (defvar global-map nil
|
|
|
284 "Default global keymap mapping Emacs keyboard input into commands.
|
|
|
285 The value is a keymap which is usually (but not necessarily) Emacs's
|
|
|
286 global map.")
|
|
|
287
|
|
|
288 (defvar esc-map nil
|
|
|
289 "Default keymap for ESC (meta) commands.
|
|
|
290 The normal global definition of the character ESC indirects to this keymap.")
|
|
|
291
|
|
|
292 (defvar ctl-x-map nil
|
|
|
293 "Default keymap for C-x commands.
|
|
|
294 The normal global definition of the character C-x indirects to this keymap.")
|
|
|
295
|
|
|
296 (defvar ctl-x-4-map (make-sparse-keymap)
|
|
|
297 "Keymap for subcommands of C-x 4")
|
|
2569
|
298 (defalias 'ctl-x-4-prefix ctl-x-4-map)
|
|
2504
|
299 (define-key ctl-x-map "4" 'ctl-x-4-prefix)
|
|
|
300
|
|
|
301 (defvar ctl-x-5-map (make-sparse-keymap)
|
|
|
302 "Keymap for frame commands.")
|
|
2569
|
303 (defalias 'ctl-x-5-prefix ctl-x-5-map)
|
|
2504
|
304 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
|
|
|
305
|
|
|
306
|
|
|
307 ;;;; Event manipulation functions.
|
|
|
308
|
|
3153
|
309 ;; This code exists specifically to make sure that the
|
|
|
310 ;; resulting number does not appear in the .elc file.
|
|
|
311 ;; The number is negative on most machines, but not on all!
|
|
|
312 (defconst listify-key-sequence-1
|
|
|
313 (lsh 1 7))
|
|
|
314 (setq listify-key-sequence-1 (logior (lsh 1 23) listify-key-sequence-1))
|
|
|
315
|
|
2021
|
316 (defun listify-key-sequence (key)
|
|
|
317 "Convert a key sequence to a list of events."
|
|
|
318 (if (vectorp key)
|
|
|
319 (append key nil)
|
|
|
320 (mapcar (function (lambda (c)
|
|
|
321 (if (> c 127)
|
|
3153
|
322 (logxor c listify-key-sequence-1)
|
|
2021
|
323 c)))
|
|
|
324 (append key nil))))
|
|
|
325
|
|
2040
|
326 (defsubst eventp (obj)
|
|
|
327 "True if the argument is an event object."
|
|
|
328 (or (integerp obj)
|
|
|
329 (and (symbolp obj)
|
|
|
330 (get obj 'event-symbol-elements))
|
|
|
331 (and (consp obj)
|
|
|
332 (symbolp (car obj))
|
|
|
333 (get (car obj) 'event-symbol-elements))))
|
|
|
334
|
|
|
335 (defun event-modifiers (event)
|
|
|
336 "Returns a list of symbols representing the modifier keys in event EVENT.
|
|
|
337 The elements of the list may include `meta', `control',
|
|
4414
|
338 `shift', `hyper', `super', `alt', `click', `double', `triple', `drag',
|
|
|
339 and `down'."
|
|
2040
|
340 (let ((type event))
|
|
|
341 (if (listp type)
|
|
|
342 (setq type (car type)))
|
|
|
343 (if (symbolp type)
|
|
|
344 (cdr (get type 'event-symbol-elements))
|
|
|
345 (let ((list nil))
|
|
|
346 (or (zerop (logand type (lsh 1 23)))
|
|
|
347 (setq list (cons 'meta list)))
|
|
|
348 (or (and (zerop (logand type (lsh 1 22)))
|
|
|
349 (>= (logand type 127) 32))
|
|
|
350 (setq list (cons 'control list)))
|
|
|
351 (or (and (zerop (logand type (lsh 1 21)))
|
|
|
352 (= (logand type 255) (downcase (logand type 255))))
|
|
|
353 (setq list (cons 'shift list)))
|
|
|
354 (or (zerop (logand type (lsh 1 20)))
|
|
|
355 (setq list (cons 'hyper list)))
|
|
|
356 (or (zerop (logand type (lsh 1 19)))
|
|
|
357 (setq list (cons 'super list)))
|
|
|
358 (or (zerop (logand type (lsh 1 18)))
|
|
|
359 (setq list (cons 'alt list)))
|
|
|
360 list))))
|
|
|
361
|
|
2063
|
362 (defun event-basic-type (event)
|
|
|
363 "Returns the basic type of the given event (all modifiers removed).
|
|
|
364 The value is an ASCII printing character (not upper case) or a symbol."
|
|
3784
|
365 (if (consp event)
|
|
|
366 (setq event (car event)))
|
|
2063
|
367 (if (symbolp event)
|
|
|
368 (car (get event 'event-symbol-elements))
|
|
|
369 (let ((base (logand event (1- (lsh 1 18)))))
|
|
|
370 (downcase (if (< base 32) (logior base 64) base)))))
|
|
|
371
|
|
2071
|
372 (defsubst mouse-movement-p (object)
|
|
|
373 "Return non-nil if OBJECT is a mouse movement event."
|
|
|
374 (and (consp object)
|
|
|
375 (eq (car object) 'mouse-movement)))
|
|
|
376
|
|
|
377 (defsubst event-start (event)
|
|
|
378 "Return the starting position of EVENT.
|
|
|
379 If EVENT is a mouse press or a mouse click, this returns the location
|
|
|
380 of the event.
|
|
|
381 If EVENT is a drag, this returns the drag's starting position.
|
|
|
382 The return value is of the form
|
|
6039
|
383 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
|
|
2071
|
384 The `posn-' functions access elements of such lists."
|
|
|
385 (nth 1 event))
|
|
|
386
|
|
|
387 (defsubst event-end (event)
|
|
|
388 "Return the ending location of EVENT. EVENT should be a click or drag event.
|
|
|
389 If EVENT is a click event, this function is the same as `event-start'.
|
|
|
390 The return value is of the form
|
|
6039
|
391 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
|
|
2071
|
392 The `posn-' functions access elements of such lists."
|
|
3860
|
393 (nth (if (consp (nth 2 event)) 2 1) event))
|
|
2071
|
394
|
|
4414
|
395 (defsubst event-click-count (event)
|
|
|
396 "Return the multi-click count of EVENT, a click or drag event.
|
|
|
397 The return value is a positive integer."
|
|
|
398 (if (integerp (nth 2 event)) (nth 2 event) 1))
|
|
|
399
|
|
2071
|
400 (defsubst posn-window (position)
|
|
|
401 "Return the window in POSITION.
|
|
|
402 POSITION should be a list of the form
|
|
6039
|
403 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
|
|
2071
|
404 as returned by the `event-start' and `event-end' functions."
|
|
|
405 (nth 0 position))
|
|
|
406
|
|
|
407 (defsubst posn-point (position)
|
|
|
408 "Return the buffer location in POSITION.
|
|
|
409 POSITION should be a list of the form
|
|
6039
|
410 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
|
|
2071
|
411 as returned by the `event-start' and `event-end' functions."
|
|
3991
|
412 (if (consp (nth 1 position))
|
|
|
413 (car (nth 1 position))
|
|
|
414 (nth 1 position)))
|
|
2071
|
415
|
|
6039
|
416 (defsubst posn-x-y (position)
|
|
|
417 "Return the x and y coordinates in POSITION.
|
|
2071
|
418 POSITION should be a list of the form
|
|
6039
|
419 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
|
|
2071
|
420 as returned by the `event-start' and `event-end' functions."
|
|
|
421 (nth 2 position))
|
|
|
422
|
|
7636
|
423 (defun posn-col-row (position)
|
|
7693
|
424 "Return the column and row in POSITION, measured in characters.
|
|
6039
|
425 POSITION should be a list of the form
|
|
|
426 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
|
|
7636
|
427 as returned by the `event-start' and `event-end' functions.
|
|
|
428 For a scroll-bar event, the result column is 0, and the row
|
|
|
429 corresponds to the vertical position of the click in the scroll bar."
|
|
|
430 (let ((pair (nth 2 position))
|
|
|
431 (window (posn-window position)))
|
|
7693
|
432 (if (eq (if (consp (nth 1 position))
|
|
|
433 (car (nth 1 position))
|
|
|
434 (nth 1 position))
|
|
7636
|
435 'vertical-scroll-bar)
|
|
|
436 (cons 0 (scroll-bar-scale pair (1- (window-height window))))
|
|
7693
|
437 (if (eq (if (consp (nth 1 position))
|
|
|
438 (car (nth 1 position))
|
|
|
439 (nth 1 position))
|
|
7636
|
440 'horizontal-scroll-bar)
|
|
|
441 (cons (scroll-bar-scale pair (window-width window)) 0)
|
|
7640
|
442 (let* ((frame (if (framep window) window (window-frame window)))
|
|
|
443 (x (/ (car pair) (frame-char-width frame)))
|
|
|
444 (y (/ (cdr pair) (frame-char-height frame))))
|
|
7636
|
445 (cons x y))))))
|
|
6039
|
446
|
|
2071
|
447 (defsubst posn-timestamp (position)
|
|
|
448 "Return the timestamp of POSITION.
|
|
|
449 POSITION should be a list of the form
|
|
6039
|
450 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
|
|
3411
|
451 as returned by the `event-start' and `event-end' functions."
|
|
2071
|
452 (nth 3 position))
|
|
2504
|
453
|
|
2071
|
454
|
|
2504
|
455 ;;;; Obsolescent names for functions.
|
|
|
456
|
|
2569
|
457 (defalias 'dot 'point)
|
|
|
458 (defalias 'dot-marker 'point-marker)
|
|
|
459 (defalias 'dot-min 'point-min)
|
|
|
460 (defalias 'dot-max 'point-max)
|
|
|
461 (defalias 'window-dot 'window-point)
|
|
|
462 (defalias 'set-window-dot 'set-window-point)
|
|
|
463 (defalias 'read-input 'read-string)
|
|
|
464 (defalias 'send-string 'process-send-string)
|
|
|
465 (defalias 'send-region 'process-send-region)
|
|
|
466 (defalias 'show-buffer 'set-window-buffer)
|
|
|
467 (defalias 'buffer-flush-undo 'buffer-disable-undo)
|
|
|
468 (defalias 'eval-current-buffer 'eval-buffer)
|
|
|
469 (defalias 'compiled-function-p 'byte-code-function-p)
|
|
114
|
470
|
|
2504
|
471 ;; Some programs still use this as a function.
|
|
|
472 (defun baud-rate ()
|
|
3210
|
473 "Obsolete function returning the value of the `baud-rate' variable.
|
|
|
474 Please convert your programs to use the variable `baud-rate' directly."
|
|
2504
|
475 baud-rate)
|
|
|
476
|
|
|
477
|
|
|
478 ;;;; Alternate names for functions - these are not being phased out.
|
|
|
479
|
|
2569
|
480 (defalias 'string= 'string-equal)
|
|
|
481 (defalias 'string< 'string-lessp)
|
|
|
482 (defalias 'move-marker 'set-marker)
|
|
|
483 (defalias 'eql 'eq)
|
|
|
484 (defalias 'not 'null)
|
|
|
485 (defalias 'rplaca 'setcar)
|
|
|
486 (defalias 'rplacd 'setcdr)
|
|
3591
|
487 (defalias 'beep 'ding) ;preserve lingual purity
|
|
2569
|
488 (defalias 'indent-to-column 'indent-to)
|
|
|
489 (defalias 'backward-delete-char 'delete-backward-char)
|
|
|
490 (defalias 'search-forward-regexp (symbol-function 're-search-forward))
|
|
|
491 (defalias 'search-backward-regexp (symbol-function 're-search-backward))
|
|
|
492 (defalias 'int-to-string 'number-to-string)
|
|
6551
|
493 (defalias 'set-match-data 'store-match-data)
|
|
1903
|
494
|
|
|
495 ;;; Should this be an obsolete name? If you decide it should, you get
|
|
|
496 ;;; to go through all the sources and change them.
|
|
2569
|
497 (defalias 'string-to-int 'string-to-number)
|
|
114
|
498
|
|
2504
|
499 ;;;; Hook manipulation functions.
|
|
388
|
500
|
|
114
|
501 (defun run-hooks (&rest hooklist)
|
|
|
502 "Takes hook names and runs each one in turn. Major mode functions use this.
|
|
|
503 Each argument should be a symbol, a hook variable.
|
|
|
504 These symbols are processed in the order specified.
|
|
|
505 If a hook symbol has a non-nil value, that value may be a function
|
|
|
506 or a list of functions to be called to run the hook.
|
|
|
507 If the value is a function, it is called with no arguments.
|
|
|
508 If it is a list, the elements are called, in order, with no arguments."
|
|
|
509 (while hooklist
|
|
|
510 (let ((sym (car hooklist)))
|
|
|
511 (and (boundp sym)
|
|
|
512 (symbol-value sym)
|
|
|
513 (let ((value (symbol-value sym)))
|
|
|
514 (if (and (listp value) (not (eq (car value) 'lambda)))
|
|
7110
|
515 (let ((functions value))
|
|
|
516 (while value
|
|
|
517 (funcall (car value))
|
|
|
518 (setq value (cdr value))))
|
|
114
|
519 (funcall value)))))
|
|
|
520 (setq hooklist (cdr hooklist))))
|
|
|
521
|
|
7110
|
522 (defun run-hook-with-args (hook &rest args)
|
|
|
523 "Run HOOK with the specified arguments ARGS.
|
|
|
524 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
|
|
|
525 value, that value may be a function or a list of functions to be
|
|
|
526 called to run the hook. If the value is a function, it is called with
|
|
|
527 the given arguments and its return value is returned. If it is a list
|
|
|
528 of functions, those functions are called, in order,
|
|
|
529 with the given arguments ARGS.
|
|
|
530 It is best not to depend on the value return by `run-hook-with-args',
|
|
|
531 as that may change."
|
|
|
532 (and (boundp hook)
|
|
|
533 (symbol-value hook)
|
|
|
534 (let ((value (symbol-value hook)))
|
|
|
535 (if (and (listp value) (not (eq (car value) 'lambda)))
|
|
|
536 (mapcar '(lambda (foo) (apply foo args))
|
|
|
537 value)
|
|
|
538 (apply value args)))))
|
|
|
539
|
|
114
|
540 ;; Tell C code how to call this function.
|
|
|
541 (defconst run-hooks 'run-hooks
|
|
|
542 "Variable by which C primitives find the function `run-hooks'.
|
|
|
543 Don't change it.")
|
|
|
544
|
2383
b7941d286c3f
(add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
545 (defun add-hook (hook function &optional append)
|
|
4414
|
546 "Add to the value of HOOK the function FUNCTION.
|
|
|
547 FUNCTION is not added if already present.
|
|
|
548 FUNCTION is added (if necessary) at the beginning of the hook list
|
|
|
549 unless the optional argument APPEND is non-nil, in which case
|
|
|
550 FUNCTION is added at the end.
|
|
|
551
|
|
|
552 HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
553 HOOK is void, it is first set to nil. If HOOK's value is a single
|
|
|
554 function, it is changed to a list of functions."
|
|
114
|
555 (or (boundp hook) (set hook nil))
|
|
4414
|
556 ;; If the hook value is a single function, turn it into a list.
|
|
|
557 (let ((old (symbol-value hook)))
|
|
|
558 (if (or (not (listp old)) (eq (car old) 'lambda))
|
|
|
559 (set hook (list old))))
|
|
114
|
560 (or (if (consp function)
|
|
5302
|
561 (member function (symbol-value hook))
|
|
114
|
562 (memq function (symbol-value hook)))
|
2383
b7941d286c3f
(add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
563 (set hook
|
b7941d286c3f
(add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
564 (if append
|
b7941d286c3f
(add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
565 (nconc (symbol-value hook) (list function))
|
b7941d286c3f
(add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
diff
changeset
|
566 (cons function (symbol-value hook))))))
|
|
2504
|
567
|
|
4964
|
568 (defun remove-hook (hook function)
|
|
|
569 "Remove from the value of HOOK the function FUNCTION.
|
|
|
570 HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
571 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
|
|
5046
|
572 list of hooks to run in HOOK, then nothing is done. See `add-hook'."
|
|
4964
|
573 (if (or (not (boundp hook)) ;unbound symbol, or
|
|
|
574 (null (symbol-value hook)) ;value is nil, or
|
|
|
575 (null function)) ;function is nil, then
|
|
|
576 nil ;Do nothing.
|
|
|
577 (let ((hook-value (symbol-value hook)))
|
|
|
578 (if (consp hook-value)
|
|
|
579 (setq hook-value (delete function hook-value))
|
|
5302
|
580 (if (equal hook-value function)
|
|
4964
|
581 (setq hook-value nil)))
|
|
|
582 (set hook hook-value))))
|
|
114
|
583
|
|
2504
|
584 ;;;; Specifying things to do after certain files are loaded.
|
|
|
585
|
|
|
586 (defun eval-after-load (file form)
|
|
|
587 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
|
|
|
588 This makes or adds to an entry on `after-load-alist'.
|
|
5440
|
589 It does nothing if FORM is already on the list for FILE.
|
|
2504
|
590 FILE should be the name of a library, with no directory name."
|
|
|
591 (or (assoc file after-load-alist)
|
|
|
592 (setq after-load-alist (cons (list file) after-load-alist)))
|
|
5440
|
593 (let ((elt (assoc file after-load-alist)))
|
|
|
594 (or (member form (cdr elt))
|
|
|
595 (nconc elt (list form))))
|
|
2504
|
596 form)
|
|
|
597
|
|
|
598 (defun eval-next-after-load (file)
|
|
|
599 "Read the following input sexp, and run it whenever FILE is loaded.
|
|
|
600 This makes or adds to an entry on `after-load-alist'.
|
|
|
601 FILE should be the name of a library, with no directory name."
|
|
|
602 (eval-after-load file (read)))
|
|
|
603
|
|
|
604
|
|
|
605 ;;;; Input and display facilities.
|
|
|
606
|
|
|
607 (defun read-quoted-char (&optional prompt)
|
|
|
608 "Like `read-char', except that if the first character read is an octal
|
|
|
609 digit, we read up to two more octal digits and return the character
|
|
|
610 represented by the octal number consisting of those digits.
|
|
|
611 Optional argument PROMPT specifies a string to use to prompt the user."
|
|
|
612 (let ((count 0) (code 0) char)
|
|
|
613 (while (< count 3)
|
|
|
614 (let ((inhibit-quit (zerop count))
|
|
|
615 (help-form nil))
|
|
|
616 (and prompt (message "%s-" prompt))
|
|
|
617 (setq char (read-char))
|
|
|
618 (if inhibit-quit (setq quit-flag nil)))
|
|
|
619 (cond ((null char))
|
|
|
620 ((and (<= ?0 char) (<= char ?7))
|
|
|
621 (setq code (+ (* code 8) (- char ?0))
|
|
|
622 count (1+ count))
|
|
|
623 (and prompt (message (setq prompt
|
|
|
624 (format "%s %c" prompt char)))))
|
|
|
625 ((> count 0)
|
|
|
626 (setq unread-command-events (list char) count 259))
|
|
|
627 (t (setq code char count 259))))
|
|
6838
|
628 ;; Turn a meta-character into a character with the 0200 bit set.
|
|
|
629 (logior (if (/= (logand code (lsh 1 23)) 0) 128 0)
|
|
|
630 (logand 255 code))))
|
|
2504
|
631
|
|
|
632 (defun force-mode-line-update (&optional all)
|
|
|
633 "Force the mode-line of the current buffer to be redisplayed.
|
|
6795
|
634 With optional non-nil ALL, force redisplay of all mode-lines."
|
|
2504
|
635 (if all (save-excursion (set-buffer (other-buffer))))
|
|
|
636 (set-buffer-modified-p (buffer-modified-p)))
|
|
|
637
|
|
114
|
638 (defun momentary-string-display (string pos &optional exit-char message)
|
|
|
639 "Momentarily display STRING in the buffer at POS.
|
|
|
640 Display remains until next character is typed.
|
|
|
641 If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;
|
|
|
642 otherwise it is then available as input (as a command if nothing else).
|
|
|
643 Display MESSAGE (optional fourth arg) in the echo area.
|
|
|
644 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
|
|
|
645 (or exit-char (setq exit-char ?\ ))
|
|
|
646 (let ((buffer-read-only nil)
|
|
6553
|
647 ;; Don't modify the undo list at all.
|
|
|
648 (buffer-undo-list t)
|
|
114
|
649 (modified (buffer-modified-p))
|
|
|
650 (name buffer-file-name)
|
|
|
651 insert-end)
|
|
|
652 (unwind-protect
|
|
|
653 (progn
|
|
|
654 (save-excursion
|
|
|
655 (goto-char pos)
|
|
|
656 ;; defeat file locking... don't try this at home, kids!
|
|
|
657 (setq buffer-file-name nil)
|
|
|
658 (insert-before-markers string)
|
4620
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
659 (setq insert-end (point))
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
660 ;; If the message end is off screen, recenter now.
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
661 (if (> (window-end) insert-end)
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
662 (recenter (/ (window-height) 2)))
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
663 ;; If that pushed message start off the screen,
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
664 ;; scroll to start it at the top of the screen.
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
665 (move-to-window-line 0)
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
666 (if (> (point) pos)
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
667 (progn
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
668 (goto-char pos)
|
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
669 (recenter 0))))
|
|
114
|
670 (message (or message "Type %s to continue editing.")
|
|
|
671 (single-key-description exit-char))
|
2033
10cdd2928c7d
(momentary-string-display): Handle any event when flushing the display.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
672 (let ((char (read-event)))
|
|
114
|
673 (or (eq char exit-char)
|
|
1821
|
674 (setq unread-command-events (list char)))))
|
|
114
|
675 (if insert-end
|
|
|
676 (save-excursion
|
|
|
677 (delete-region pos insert-end)))
|
|
|
678 (setq buffer-file-name name)
|
|
|
679 (set-buffer-modified-p modified))))
|
|
|
680
|
|
2504
|
681
|
|
|
682 ;;;; Miscellanea.
|
|
|
683
|
|
|
684 (defun ignore (&rest ignore)
|
|
7400
|
685 (interactive)
|
|
2504
|
686 "Do nothing.
|
|
|
687 Accept any number of arguments, but ignore them."
|
|
|
688 nil)
|
|
|
689
|
|
|
690 (defun error (&rest args)
|
|
|
691 "Signal an error, making error message by passing all args to `format'."
|
|
|
692 (while t
|
|
|
693 (signal 'error (list (apply 'format args)))))
|
|
|
694
|
5912
909b94d547c4
(user-original-login-name): Reduce to a defalias, since it's redundant with
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
695 (defalias 'user-original-login-name 'user-login-name)
|
|
2504
|
696
|
|
114
|
697 (defun start-process-shell-command (name buffer &rest args)
|
|
|
698 "Start a program in a subprocess. Return the process object for it.
|
|
|
699 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
|
|
|
700 NAME is name for process. It is modified if necessary to make it unique.
|
|
|
701 BUFFER is the buffer or (buffer-name) to associate with the process.
|
|
|
702 Process output goes at end of that buffer, unless you specify
|
|
|
703 an output stream or filter function to handle the output.
|
|
|
704 BUFFER may be also nil, meaning that this process is not associated
|
|
|
705 with any buffer
|
|
|
706 Third arg is command name, the name of a shell command.
|
|
|
707 Remaining arguments are the arguments for the command.
|
|
5460
|
708 Wildcards and redirection are handled as usual in the shell."
|
|
114
|
709 (if (eq system-type 'vax-vms)
|
|
|
710 (apply 'start-process name buffer args)
|
|
|
711 (start-process name buffer shell-file-name "-c"
|
|
|
712 (concat "exec " (mapconcat 'identity args " ")))))
|
|
|
713
|
|
2504
|
714 (defmacro save-match-data (&rest body)
|
|
|
715 "Execute the BODY forms, restoring the global value of the match data."
|
|
|
716 (let ((original (make-symbol "match-data")))
|
|
|
717 (list
|
|
|
718 'let (list (list original '(match-data)))
|
|
|
719 (list 'unwind-protect
|
|
|
720 (cons 'progn body)
|
|
|
721 (list 'store-match-data original)))))
|
|
144
|
722
|
|
5385
|
723 (defun shell-quote-argument (argument)
|
|
|
724 "Quote an argument for passing as argument to an inferior shell."
|
|
|
725 ;; Quote everything except POSIX filename characters.
|
|
|
726 ;; This should be safe enough even for really weird shells.
|
|
|
727 (let ((result "") (start 0) end)
|
|
6309
|
728 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
|
|
5385
|
729 (setq end (match-beginning 0)
|
|
|
730 result (concat result (substring argument start end)
|
|
|
731 "\\" (substring argument end (1+ end)))
|
|
|
732 start (1+ end)))
|
|
|
733 (concat result (substring argument start))))
|
|
|
734
|
5844
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
735 (defun make-syntax-table (&optional oldtable)
|
|
5421
|
736 "Return a new syntax table.
|
|
|
737 It inherits all letters and control characters from the standard
|
|
|
738 syntax table; other characters are copied from the standard syntax table."
|
5844
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
739 (if oldtable
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
740 (copy-syntax-table oldtable)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
741 (let ((table (copy-syntax-table))
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
742 i)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
743 (setq i 0)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
744 (while (<= i 31)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
745 (aset table i 13)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
746 (setq i (1+ i)))
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
747 (setq i ?A)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
748 (while (<= i ?Z)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
749 (aset table i 13)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
750 (setq i (1+ i)))
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
751 (setq i ?a)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
752 (while (<= i ?z)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
753 (aset table i 13)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
754 (setq i (1+ i)))
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
755 (setq i 128)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
756 (while (<= i 255)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
757 (aset table i 13)
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
758 (setq i (1+ i)))
|
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
759 table)))
|
|
5421
|
760
|
|
2504
|
761 ;; now in fns.c
|
|
|
762 ;(defun nth (n list)
|
|
|
763 ; "Returns the Nth element of LIST.
|
|
|
764 ;N counts from zero. If LIST is not that long, nil is returned."
|
|
|
765 ; (car (nthcdr n list)))
|
|
|
766 ;
|
|
|
767 ;(defun copy-alist (alist)
|
|
|
768 ; "Return a copy of ALIST.
|
|
|
769 ;This is a new alist which represents the same mapping
|
|
|
770 ;from objects to objects, but does not share the alist structure with ALIST.
|
|
|
771 ;The objects mapped (cars and cdrs of elements of the alist)
|
|
|
772 ;are shared, however."
|
|
|
773 ; (setq alist (copy-sequence alist))
|
|
|
774 ; (let ((tail alist))
|
|
|
775 ; (while tail
|
|
|
776 ; (if (consp (car tail))
|
|
|
777 ; (setcar tail (cons (car (car tail)) (cdr (car tail)))))
|
|
|
778 ; (setq tail (cdr tail))))
|
|
|
779 ; alist)
|
|
787
|
780
|
|
|
781 ;;; subr.el ends here
|
|
2504
|
782
|
