annotate lisp/subr.el @ 9881:02cd4dde69e1

(tracking_off): Test old value with NILP. Restore the old value whatever it may be. (syms_of_keyboard): Use DEFVAR_LISP for track-mouse.
author Richard M. Stallman <rms@gnu.org>
date Thu, 10 Nov 1994 03:46:33 +0000
parents 248462096d25
children df605fcd1e75
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
7298
4fd40bd394fe Update copyright.
Karl Heuer <kwzh@gnu.org>
parents: 7110
diff changeset
3 ;;; Copyright (C) 1985, 1986, 1992, 1994 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
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
23
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
24 ;;;; Lisp language features.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
25
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
26 (defmacro lambda (&rest cdr)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
27 "Return a lambda expression.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
28 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
29 self-quoting; the result of evaluating the lambda expression is the
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
30 expression itself. The lambda expression may then be treated as a
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
31 function, i. e. stored as the function value of a symbol, passed to
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
32 funcall or mapcar, etcetera.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
33 ARGS should take the same form as an argument list for a `defun'.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
34 DOCSTRING should be a string, as described for `defun'. It may be omitted.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
35 INTERACTIVE should be a call to the function `interactive', which see.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
36 It may also be omitted.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
37 BODY should be a list of lisp expressions."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
38 ;; Note that this definition should not use backquotes; subr.el should not
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
39 ;; depend on backquote.el.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
40 (list 'function (cons 'lambda cdr)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
41
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
42 ;;(defmacro defun-inline (name args &rest body)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
43 ;; "Create an \"inline defun\" (actually a macro).
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
44 ;;Use just like `defun'."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
45 ;; (nconc (list 'defmacro name '(&rest args))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
46 ;; (if (stringp (car body))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
47 ;; (prog1 (list (car body))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
48 ;; (setq body (or (cdr body) body))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
49 ;; (list (list 'cons (list 'quote
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
50 ;; (cons 'lambda (cons args body)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
51 ;; 'args))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
52
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
53
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
54 ;;;; Window tree functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
55
6441
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
56 (defun one-window-p (&optional nomini all-frames)
8518
44ff33b29c3e (one-window-p): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 8211
diff changeset
57 "Returns non-nil if the selected window is the only window (in its frame).
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
58 Optional arg NOMINI non-nil means don't count the minibuffer
6441
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
59 even if it is active.
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
60
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
61 The optional arg ALL-FRAMES t means count windows on all frames.
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
62 If it is `visible', count windows on all visible frames.
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
63 ALL-FRAMES nil or omitted means count only the selected frame,
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
64 plus the minibuffer it uses (which may be on another frame).
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
65 If ALL-FRAMES is neither nil nor t, count only the selected frame."
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
66 (let ((base-window (selected-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
67 (if (and nomini (eq base-window (minibuffer-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
68 (setq base-window (next-window base-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
69 (eq base-window
6441
6ca895922340 (one-window-p): New argument all-frames.
Richard M. Stallman <rms@gnu.org>
parents: 6309
diff changeset
70 (next-window base-window (if nomini 'arg) all-frames))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
71
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
72 (defun walk-windows (proc &optional minibuf all-frames)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
73 "Cycle through all visible windows, calling PROC for each one.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
74 PROC is called with a window as argument.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
75 Optional second arg MINIBUF t means count the minibuffer window
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
76 even if not active. If MINIBUF is neither t nor nil it means
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
77 not to count the minibuffer even if it is active.
1959
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
78
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
79 Optional third arg ALL-FRAMES, if t, means include all frames.
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
80 ALL-FRAMES nil or omitted means cycle within the selected frame,
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
81 but include the minibuffer window (if MINIBUF says so) that that
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
82 frame uses, even if it is on another frame.
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
83 If ALL-FRAMES is neither nil nor t, stick strictly to the selected frame."
5157
d39a061f984a (walk-windows): If start at minibuf window, do return to it.
Richard M. Stallman <rms@gnu.org>
parents: 5046
diff changeset
84 ;; If we start from the minibuffer window, don't fail to come back to it.
d39a061f984a (walk-windows): If start at minibuf window, do return to it.
Richard M. Stallman <rms@gnu.org>
parents: 5046
diff changeset
85 (if (window-minibuffer-p (selected-window))
d39a061f984a (walk-windows): If start at minibuf window, do return to it.
Richard M. Stallman <rms@gnu.org>
parents: 5046
diff changeset
86 (setq minibuf t))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
87 (let* ((walk-windows-start (selected-window))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
88 (walk-windows-current walk-windows-start))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
89 (while (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
90 (setq walk-windows-current
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
91 (next-window walk-windows-current minibuf all-frames))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
92 (funcall proc walk-windows-current)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
93 (not (eq walk-windows-current walk-windows-start))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
94
4491
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
95 (defun minibuffer-window-active-p (window)
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
96 "Return t if WINDOW (a minibuffer window) is now active."
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
97 ;; nil nil means include WINDOW's frame
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
98 ;; and other frames using WINDOW as minibuffer,
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
99 ;; and include minibuffer if active.
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
100 (let ((prev (previous-window window nil nil)))
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
101 ;; If PREV equals WINDOW, WINDOW must be on a minibuffer-only frame
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
102 ;; and it's not currently being used. So return nil.
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
103 (and (not (eq window prev))
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
104 (let ((should-be-same (next-window prev nil nil)))
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
105 ;; If next-window doesn't reverse previous-window,
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
106 ;; WINDOW must be outside the cycle specified by nil nil.
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
107 (eq should-be-same window)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
108
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
109 ;;;; Keymap support.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
110
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
111 (defun undefined ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
112 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
113 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
115 ;Prevent the \{...} documentation construct
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
116 ;from mentioning keys that run this command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
117 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
118
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
119 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
120 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
121 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
122 but optional second arg NODIGITS non-nil treats them like other chars."
4767
12ff77449baa (suppress-keymap): Use substitute-key-definition instead of manually
Brian Fox <bfox@gnu.org>
parents: 4620
diff changeset
123 (substitute-key-definition 'self-insert-command 'undefined map global-map)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
124 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
125 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
126 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
127 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
128 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
129 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
130 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
131 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
132
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
133 ;Moved to keymap.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
134 ;(defun copy-keymap (keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
135 ; "Return a copy of KEYMAP"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
136 ; (while (not (keymapp keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
137 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
138 ; (if (vectorp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
139 ; (copy-sequence keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
140 ; (copy-alist keymap)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
141
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
142 (defvar key-substitution-in-progress nil
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
143 "Used internally by substitute-key-definition.")
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
144
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
145 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
146 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
147 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
148 If optional fourth argument OLDMAP is specified, we redefine
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
149 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
150 (or prefix (setq prefix ""))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
151 (let* ((scan (or oldmap keymap))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
152 (vec1 (vector nil))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
153 (prefix1 (vconcat prefix vec1))
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
154 (key-substitution-in-progress
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
155 (cons scan key-substitution-in-progress)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
156 ;; Scan OLDMAP, finding each char or event-symbol that
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
157 ;; has any definition, and act on it with hack-key.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
158 (while (consp scan)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
159 (if (consp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
160 (let ((char (car (car scan)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
161 (defn (cdr (car scan))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
162 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
163 ;; the inside of the following let that handles array elements.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
164 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
165 (aset prefix1 (length prefix) char)
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
166 (let (inner-def skipped)
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
167 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
168 (while (stringp (car-safe defn))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
169 (setq skipped (cons (car defn) skipped))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
170 (setq defn (cdr defn)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
171 ;; Skip past cached key-equivalence data for menu items.
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
172 (and (consp defn) (consp (car defn))
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
173 (setq defn (cdr defn)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
174 (setq inner-def defn)
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
175 ;; Look past a symbol that names a keymap.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
176 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
177 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
178 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
179 (if (eq defn olddef)
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
180 (define-key keymap prefix1 (nconc (nreverse skipped) newdef))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
181 ;; Avoid recursively rescanning a keymap being scanned.
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
182 (if (and (keymapp defn)
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
183 (not (memq inner-def
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
184 key-substitution-in-progress)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
185 ;; If this one isn't being scanned already,
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
186 ;; scan it now.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
187 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
188 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
189 prefix1)))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
190 (if (arrayp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
191 (let* ((array (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
192 (len (length array))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
193 (i 0))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
194 (while (< i len)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
195 (let ((char i) (defn (aref array i)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
196 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
197 ;; the inside of the previous let.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
198 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
199 (aset prefix1 (length prefix) char)
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
200 (let (inner-def skipped)
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
201 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
202 (while (stringp (car-safe defn))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
203 (setq skipped (cons (car defn) skipped))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
204 (setq defn (cdr defn)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
205 (and (consp defn) (consp (car defn))
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
206 (setq defn (cdr defn)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
207 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
208 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
209 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
210 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
211 (if (eq defn olddef)
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
212 (define-key keymap prefix1
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
213 (nconc (nreverse skipped) newdef))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
214 (if (and (keymapp defn)
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
215 (not (memq inner-def
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
216 key-substitution-in-progress)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
217 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
218 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
219 prefix1)))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
220 (setq i (1+ i))))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
221 (setq scan (cdr scan)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
222
3902
717f2e24975e (define-key-after): Renamed from define-key-in-sequence.
Richard M. Stallman <rms@gnu.org>
parents: 3901
diff changeset
223 (defun define-key-after (keymap key definition after)
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
224 "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
225 This is like `define-key' except that the binding for KEY is placed
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
226 just after the binding for the event AFTER, instead of at the beginning
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
227 of the map.
4070
5a97f81baf65 (define-key-after): Error if KEY has two elements.
Richard M. Stallman <rms@gnu.org>
parents: 3991
diff changeset
228 The order matters when the keymap is used as a menu.
6725
e044bd05a1da (define-key-after): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6553
diff changeset
229 KEY must contain just one event type--that is to say, it must be
e044bd05a1da (define-key-after): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6553
diff changeset
230 a string or vector of length 1."
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
231 (or (keymapp keymap)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
232 (signal 'wrong-type-argument (list 'keymapp keymap)))
4188
10fd517cb2e9 (define-key-after): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents: 4070
diff changeset
233 (if (> (length key) 1)
4070
5a97f81baf65 (define-key-after): Error if KEY has two elements.
Richard M. Stallman <rms@gnu.org>
parents: 3991
diff changeset
234 (error "multi-event key specified in `define-key-after'"))
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
235 (let ((tail keymap) done inserted
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
236 (first (aref key 0)))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
237 (while (and (not done) tail)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
238 ;; Delete any earlier bindings for the same key.
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
239 (if (eq (car-safe (car (cdr tail))) first)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
240 (setcdr tail (cdr (cdr tail))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
241 ;; When we reach AFTER's binding, insert the new binding after.
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
242 ;; If we reach an inherited keymap, insert just before that.
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
243 ;; If we reach the end of this keymap, insert at the end.
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
244 (if (or (eq (car-safe (car tail)) after)
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
245 (eq (car (cdr tail)) 'keymap)
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
246 (null (cdr tail)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
247 (progn
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
248 ;; Stop the scan only if we find a parent keymap.
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
249 ;; Keep going past the inserted element
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
250 ;; so we can delete any duplications that come later.
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
251 (if (eq (car (cdr tail)) 'keymap)
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
252 (setq done t))
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
253 ;; Don't insert more than once.
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
254 (or inserted
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
255 (setcdr tail (cons (cons (aref key 0) definition) (cdr tail))))
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
256 (setq inserted t)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
257 (setq tail (cdr tail)))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
258
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
259 (defun keyboard-translate (from to)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
260 "Translate character FROM to TO at a low level.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
261 This function creates a `keyboard-translate-table' if necessary
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
262 and then modifies one entry in it."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
263 (or (arrayp keyboard-translate-table)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
264 (setq keyboard-translate-table ""))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
265 (if (or (> from (length keyboard-translate-table))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
266 (> to (length keyboard-translate-table)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
267 (progn
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
268 (let* ((i (length keyboard-translate-table))
4235
55182207415d (keyboard-translate): Properly lengthen existing table.
Richard M. Stallman <rms@gnu.org>
parents: 4188
diff changeset
269 (table (concat keyboard-translate-table
55182207415d (keyboard-translate): Properly lengthen existing table.
Richard M. Stallman <rms@gnu.org>
parents: 4188
diff changeset
270 (make-string (- 256 i) 0))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
271 (while (< i 256)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
272 (aset table i i)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
273 (setq i (1+ i)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
274 (setq keyboard-translate-table table))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
275 (aset keyboard-translate-table from to))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
276
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
277
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
278 ;;;; The global keymap tree.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
279
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
280 ;;; global-map, esc-map, and ctl-x-map have their values set up in
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
281 ;;; keymap.c; we just give them docstrings here.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
282
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
283 (defvar global-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
284 "Default global keymap mapping Emacs keyboard input into commands.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
285 The value is a keymap which is usually (but not necessarily) Emacs's
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
286 global map.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
287
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
288 (defvar esc-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
289 "Default keymap for ESC (meta) commands.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
290 The normal global definition of the character ESC indirects to this keymap.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
291
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
292 (defvar ctl-x-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
293 "Default keymap for C-x commands.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
294 The normal global definition of the character C-x indirects to this keymap.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
295
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
296 (defvar ctl-x-4-map (make-sparse-keymap)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
297 "Keymap for subcommands of C-x 4")
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
298 (defalias 'ctl-x-4-prefix ctl-x-4-map)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
299 (define-key ctl-x-map "4" 'ctl-x-4-prefix)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
300
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
301 (defvar ctl-x-5-map (make-sparse-keymap)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
302 "Keymap for frame commands.")
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
303 (defalias 'ctl-x-5-prefix ctl-x-5-map)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
304 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
305
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
306
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
307 ;;;; Event manipulation functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
308
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
309 ;; This code exists specifically to make sure that the
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
310 ;; resulting number does not appear in the .elc file.
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
311 ;; The number is negative on most machines, but not on all!
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
312 (defconst listify-key-sequence-1
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
313 (lsh 1 7))
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
314 (setq listify-key-sequence-1 (logior (lsh 1 23) listify-key-sequence-1))
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
315
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
316 (defun listify-key-sequence (key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
317 "Convert a key sequence to a list of events."
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
318 (if (vectorp key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
319 (append key nil)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
320 (mapcar (function (lambda (c)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
321 (if (> c 127)
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
322 (logxor c listify-key-sequence-1)
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
323 c)))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
324 (append key nil))))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
325
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
326 (defsubst eventp (obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
327 "True if the argument is an event object."
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
328 (or (integerp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
329 (and (symbolp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
330 (get obj 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
331 (and (consp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
332 (symbolp (car obj))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
333 (get (car obj) 'event-symbol-elements))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
334
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
335 (defun event-modifiers (event)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
336 "Returns a list of symbols representing the modifier keys in event EVENT.
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
337 The elements of the list may include `meta', `control',
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
338 `shift', `hyper', `super', `alt', `click', `double', `triple', `drag',
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
339 and `down'."
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
340 (let ((type event))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
341 (if (listp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
342 (setq type (car type)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
343 (if (symbolp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
344 (cdr (get type 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
345 (let ((list nil))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
346 (or (zerop (logand type (lsh 1 23)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
347 (setq list (cons 'meta list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
348 (or (and (zerop (logand type (lsh 1 22)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
349 (>= (logand type 127) 32))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
350 (setq list (cons 'control list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
351 (or (and (zerop (logand type (lsh 1 21)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
352 (= (logand type 255) (downcase (logand type 255))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
353 (setq list (cons 'shift list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
354 (or (zerop (logand type (lsh 1 20)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
355 (setq list (cons 'hyper list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
356 (or (zerop (logand type (lsh 1 19)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
357 (setq list (cons 'super list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
358 (or (zerop (logand type (lsh 1 18)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
359 (setq list (cons 'alt list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
360 list))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
361
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
362 (defun event-basic-type (event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
363 "Returns the basic type of the given event (all modifiers removed).
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
364 The value is an ASCII printing character (not upper case) or a symbol."
3784
d2df5ca46b39 * subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
365 (if (consp event)
d2df5ca46b39 * subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
366 (setq event (car event)))
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
367 (if (symbolp event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
368 (car (get event 'event-symbol-elements))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
369 (let ((base (logand event (1- (lsh 1 18)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
370 (downcase (if (< base 32) (logior base 64) base)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
371
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
372 (defsubst mouse-movement-p (object)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
373 "Return non-nil if OBJECT is a mouse movement event."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
374 (and (consp object)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
375 (eq (car object) 'mouse-movement)))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
376
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
377 (defsubst event-start (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
378 "Return the starting position of EVENT.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
379 If EVENT is a mouse press or a mouse click, this returns the location
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
380 of the event.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
381 If EVENT is a drag, this returns the drag's starting position.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
382 The return value is of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
383 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
384 The `posn-' functions access elements of such lists."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
385 (nth 1 event))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
386
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
387 (defsubst event-end (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
388 "Return the ending location of EVENT. EVENT should be a click or drag event.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
389 If EVENT is a click event, this function is the same as `event-start'.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
390 The return value is of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
391 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
392 The `posn-' functions access elements of such lists."
3860
70bdc91ef161 * subr.el (event-end): Modified to account for multi-click events.
Jim Blandy <jimb@redhat.com>
parents: 3784
diff changeset
393 (nth (if (consp (nth 2 event)) 2 1) event))
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
394
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
395 (defsubst event-click-count (event)
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
396 "Return the multi-click count of EVENT, a click or drag event.
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
397 The return value is a positive integer."
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
398 (if (integerp (nth 2 event)) (nth 2 event) 1))
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
399
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
400 (defsubst posn-window (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
401 "Return the window in POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
402 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
403 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
404 as returned by the `event-start' and `event-end' functions."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
405 (nth 0 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
406
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
407 (defsubst posn-point (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
408 "Return the buffer location in POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
409 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
410 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
411 as returned by the `event-start' and `event-end' functions."
3991
ad2bd545983e * subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents: 3927
diff changeset
412 (if (consp (nth 1 position))
ad2bd545983e * subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents: 3927
diff changeset
413 (car (nth 1 position))
ad2bd545983e * subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents: 3927
diff changeset
414 (nth 1 position)))
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
415
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
416 (defsubst posn-x-y (position)
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
417 "Return the x and y coordinates in POSITION.
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
418 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
419 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
420 as returned by the `event-start' and `event-end' functions."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
421 (nth 2 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
422
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
423 (defun posn-col-row (position)
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
424 "Return the column and row in POSITION, measured in characters.
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
425 POSITION should be a list of the form
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
426 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
427 as returned by the `event-start' and `event-end' functions.
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
428 For a scroll-bar event, the result column is 0, and the row
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
429 corresponds to the vertical position of the click in the scroll bar."
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
430 (let ((pair (nth 2 position))
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
431 (window (posn-window position)))
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
432 (if (eq (if (consp (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
433 (car (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
434 (nth 1 position))
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
435 'vertical-scroll-bar)
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
436 (cons 0 (scroll-bar-scale pair (1- (window-height window))))
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
437 (if (eq (if (consp (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
438 (car (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
439 (nth 1 position))
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
440 'horizontal-scroll-bar)
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
441 (cons (scroll-bar-scale pair (window-width window)) 0)
7640
9b1194796ef5 (posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents: 7636
diff changeset
442 (let* ((frame (if (framep window) window (window-frame window)))
9b1194796ef5 (posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents: 7636
diff changeset
443 (x (/ (car pair) (frame-char-width frame)))
9b1194796ef5 (posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents: 7636
diff changeset
444 (y (/ (cdr pair) (frame-char-height frame))))
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
445 (cons x y))))))
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
446
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
447 (defsubst posn-timestamp (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
448 "Return the timestamp of POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
449 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
450 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
3411
d91b3097bb76 (posn-timestamp): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3210
diff changeset
451 as returned by the `event-start' and `event-end' functions."
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
452 (nth 3 position))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
453
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
454
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
455 ;;;; Obsolescent names for functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
456
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
457 (defalias 'dot 'point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
458 (defalias 'dot-marker 'point-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
459 (defalias 'dot-min 'point-min)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
460 (defalias 'dot-max 'point-max)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
461 (defalias 'window-dot 'window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
462 (defalias 'set-window-dot 'set-window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
463 (defalias 'read-input 'read-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
464 (defalias 'send-string 'process-send-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
465 (defalias 'send-region 'process-send-region)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
466 (defalias 'show-buffer 'set-window-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
467 (defalias 'buffer-flush-undo 'buffer-disable-undo)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
468 (defalias 'eval-current-buffer 'eval-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
469 (defalias 'compiled-function-p 'byte-code-function-p)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
470
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
471 ;; Some programs still use this as a function.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
472 (defun baud-rate ()
3210
3176c6395ada (baud-rate): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3153
diff changeset
473 "Obsolete function returning the value of the `baud-rate' variable.
3176c6395ada (baud-rate): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3153
diff changeset
474 Please convert your programs to use the variable `baud-rate' directly."
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
475 baud-rate)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
476
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
477
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
478 ;;;; Alternate names for functions - these are not being phased out.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
479
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
480 (defalias 'string= 'string-equal)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
481 (defalias 'string< 'string-lessp)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
482 (defalias 'move-marker 'set-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
483 (defalias 'eql 'eq)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
484 (defalias 'not 'null)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
485 (defalias 'rplaca 'setcar)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
486 (defalias 'rplacd 'setcdr)
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3411
diff changeset
487 (defalias 'beep 'ding) ;preserve lingual purity
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
488 (defalias 'indent-to-column 'indent-to)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
489 (defalias 'backward-delete-char 'delete-backward-char)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
490 (defalias 'search-forward-regexp (symbol-function 're-search-forward))
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
491 (defalias 'search-backward-regexp (symbol-function 're-search-backward))
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
492 (defalias 'int-to-string 'number-to-string)
6551
99ca8123a3ca (set-match-data): New alias.
Richard M. Stallman <rms@gnu.org>
parents: 6441
diff changeset
493 (defalias 'set-match-data 'store-match-data)
1903
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
494
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
495 ;;; Should this be an obsolete name? If you decide it should, you get
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
496 ;;; to go through all the sources and change them.
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
497 (defalias 'string-to-int 'string-to-number)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
498
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
499 ;;;; Hook manipulation functions.
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
500
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
501 (defun run-hooks (&rest hooklist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
502 "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
503 Each argument should be a symbol, a hook variable.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
504 These symbols are processed in the order specified.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
505 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
506 or a list of functions to be called to run the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
507 If the value is a function, it is called with no arguments.
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
508 If it is a list, the elements are called, in order, with no arguments.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
509
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
510 To make a hook variable buffer-local, use `make-local-hook', not
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
511 `make-local-variable'."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
512 (while hooklist
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
513 (let ((sym (car hooklist)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
514 (and (boundp sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
515 (symbol-value sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
516 (let ((value (symbol-value sym)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
517 (if (and (listp value) (not (eq (car value) 'lambda)))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
518 (while value
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
519 (if (eq (car value) t)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
520 ;; t indicates this hook has a local binding;
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
521 ;; it means to run the global binding too.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
522 (let ((functions (default-value sym)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
523 (while functions
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
524 (funcall (car functions))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
525 (setq functions (cdr functions))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
526 (funcall (car value)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
527 (setq value (cdr value)))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
528 (funcall value)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
529 (setq hooklist (cdr hooklist))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
530
7110
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
531 (defun run-hook-with-args (hook &rest args)
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
532 "Run HOOK with the specified arguments ARGS.
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
533 HOOK should be a symbol, a hook variable. If HOOK has a non-nil
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
534 value, that value may be a function or a list of functions to be
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
535 called to run the hook. If the value is a function, it is called with
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
536 the given arguments and its return value is returned. If it is a list
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
537 of functions, those functions are called, in order,
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
538 with the given arguments ARGS.
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
539 It is best not to depend on the value return by `run-hook-with-args',
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
540 as that may change.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
541
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
542 To make a hook variable buffer-local, use `make-local-hook', not
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
543 `make-local-variable'."
7110
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
544 (and (boundp hook)
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
545 (symbol-value hook)
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
546 (let ((value (symbol-value hook)))
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
547 (if (and (listp value) (not (eq (car value) 'lambda)))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
548 (while value
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
549 (if (eq (car value) t)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
550 ;; t indicates this hook has a local binding;
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
551 ;; it means to run the global binding too.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
552 (let ((functions (default-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
553 (while functions
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
554 (apply (car functions) args)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
555 (setq functions (cdr functions))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
556 (apply (car value) args))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
557 (setq value (cdr value)))
7110
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
558 (apply value args)))))
ea2aef9d9f0e (run-hooks): Don't use mapcar--save consing.
Richard M. Stallman <rms@gnu.org>
parents: 6838
diff changeset
559
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
560 (defun run-hook-with-args-until-success (hook &rest args)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
561 "Run HOOK with the specified arguments ARGS.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
562 HOOK should be a symbol, a hook variable. Its value should
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
563 be a list of functions. We call those functions, one by one,
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
564 passing arguments ARGS to each of them, until one of them
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
565 returns a non-nil value. Then we return that value.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
566 If all the functions return nil, we return nil.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
567
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
568 To make a hook variable buffer-local, use `make-local-hook', not
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
569 `make-local-variable'."
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
570 (and (boundp hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
571 (symbol-value hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
572 (let ((value (symbol-value hook))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
573 success)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
574 (while (and value (not success))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
575 (if (eq (car value) t)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
576 ;; t indicates this hook has a local binding;
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
577 ;; it means to run the global binding too.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
578 (let ((functions (default-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
579 (while (and functions (not success))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
580 (setq success (apply (car functions) args))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
581 (setq functions (cdr functions))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
582 (setq success (apply (car value) args)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
583 (setq value (cdr value)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
584 success)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
585
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
586 (defun run-hook-with-args-until-failure (hook &rest args)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
587 "Run HOOK with the specified arguments ARGS.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
588 HOOK should be a symbol, a hook variable. Its value should
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
589 be a list of functions. We call those functions, one by one,
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
590 passing arguments ARGS to each of them, until one of them
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
591 returns nil. Then we return nil.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
592 If all the functions return non-nil, we return non-nil.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
593
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
594 To make a hook variable buffer-local, use `make-local-hook', not
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
595 `make-local-variable'."
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
596 (and (boundp hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
597 (symbol-value hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
598 (let ((value (symbol-value hook))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
599 (success t))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
600 (while (and value success)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
601 (if (eq (car value) t)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
602 ;; t indicates this hook has a local binding;
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
603 ;; it means to run the global binding too.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
604 (let ((functions (default-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
605 (while (and functions success)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
606 (setq success (apply (car functions) args))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
607 (setq functions (cdr functions))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
608 (setq success (apply (car value) args)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
609 (setq value (cdr value)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
610 success)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
611
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
612 ;; Tell C code how to call this function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
613 (defconst run-hooks 'run-hooks
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
614 "Variable by which C primitives find the function `run-hooks'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
615 Don't change it.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
616
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
617 (defun make-local-hook (hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
618 "Make the hook HOOK local to the current buffer.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
619 When a hook is local, its local and global values
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
620 work in concert: running the hook actually runs all the hook
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
621 functions listed in *either* the local value *or* the global value
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
622 of the hook variable.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
623
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
624 This function does nothing if HOOK is already local in the current buffer.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
625
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
626 Do not use `make-local-variable' to make a hook variable buffer-local."
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
627 (if (local-variable-p hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
628 nil
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
629 (or (boundp hook) (set hook nil))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
630 (make-local-variable hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
631 (set hook (list t))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
632
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
633 (defun add-hook (hook function &optional append local)
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
634 "Add to the value of HOOK the function FUNCTION.
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
635 FUNCTION is not added if already present.
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
636 FUNCTION is added (if necessary) at the beginning of the hook list
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
637 unless the optional argument APPEND is non-nil, in which case
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
638 FUNCTION is added at the end.
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
639
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
640 The optional fourth argument, LOCAL, if non-nil, says to modify
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
641 the hook's buffer-local value rather than its default value.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
642 This makes no difference if the hook is not buffer-local.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
643 To make a hook variable buffer-local, always use
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
644 `make-local-hook', not `make-local-variable'.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
645
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
646 HOOK should be a symbol, and FUNCTION may be any valid function. If
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
647 HOOK is void, it is first set to nil. If HOOK's value is a single
8959
d33302427a47 (remove-hook, add-hook): Copy existing list before modifying.
Richard M. Stallman <rms@gnu.org>
parents: 8928
diff changeset
648 function, it is changed to a list of functions."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
649 (or (boundp hook) (set hook nil))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
650 (or (default-boundp hook) (set-default hook nil))
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
651 ;; If the hook value is a single function, turn it into a list.
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
652 (let ((old (symbol-value hook)))
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
653 (if (or (not (listp old)) (eq (car old) 'lambda))
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
654 (set hook (list old))))
9202
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
655 (if (or local
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
656 ;; Detect the case where make-local-variable was used on a hook
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
657 ;; and do what we used to do.
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
658 (and (local-variable-p hook)
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
659 (not (memq t (symbol-value hook)))))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
660 ;; Alter the local value only.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
661 (or (if (consp function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
662 (member function (symbol-value hook))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
663 (memq function (symbol-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
664 (set hook
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
665 (if append
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
666 (append (symbol-value hook) (list function))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
667 (cons function (symbol-value hook)))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
668 ;; Alter the global value (which is also the only value,
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
669 ;; if the hook doesn't have a local value).
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
670 (or (if (consp function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
671 (member function (default-value hook))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
672 (memq function (default-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
673 (set-default hook
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
674 (if append
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
675 (append (default-value hook) (list function))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
676 (cons function (default-value hook)))))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
677
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
678 (defun remove-hook (hook function &optional local)
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
679 "Remove from the value of HOOK the function FUNCTION.
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
680 HOOK should be a symbol, and FUNCTION may be any valid function. If
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
681 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
682 list of hooks to run in HOOK, then nothing is done. See `add-hook'.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
683
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
684 The optional third argument, LOCAL, if non-nil, says to modify
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
685 the hook's buffer-local value rather than its default value.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
686 This makes no difference if the hook is not buffer-local.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
687 To make a hook variable buffer-local, always use
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
688 `make-local-hook', not `make-local-variable'."
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
689 (if (or (not (boundp hook)) ;unbound symbol, or
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
690 (not (default-boundp 'hook))
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
691 (null (symbol-value hook)) ;value is nil, or
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
692 (null function)) ;function is nil, then
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
693 nil ;Do nothing.
9202
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
694 (if (or local
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
695 ;; Detect the case where make-local-variable was used on a hook
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
696 ;; and do what we used to do.
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
697 (and (local-variable-p hook)
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
698 (not (memq t (symbol-value hook)))))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
699 (let ((hook-value (symbol-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
700 (if (consp hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
701 (if (member function hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
702 (setq hook-value (delete function (copy-sequence hook-value))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
703 (if (equal hook-value function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
704 (setq hook-value nil)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
705 (set hook hook-value))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
706 (let ((hook-value (default-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
707 (if (consp hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
708 (if (member function hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
709 (setq hook-value (delete function (copy-sequence hook-value))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
710 (if (equal hook-value function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
711 (setq hook-value nil)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
712 (set-default hook hook-value)))))
9510
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
713
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
714 (defun add-to-list (list-var element)
9535
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
715 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
716 If you want to use `add-to-list' on a variable that is not defined
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
717 until a certain package is loaded, you should put the call to `add-to-list'
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
718 into a hook function that will be run only after loading the package.
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
719 `eval-after-load' provides one way to do this. In some cases
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
720 other hooks, such as major mode hooks, can do the job."
9510
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
721 (or (member element (symbol-value list-var))
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
722 (set list-var (cons element (symbol-value list-var)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
723
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
724 ;;;; Specifying things to do after certain files are loaded.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
725
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
726 (defun eval-after-load (file form)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
727 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
728 This makes or adds to an entry on `after-load-alist'.
5440
856ecdc5228a (eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents: 5421
diff changeset
729 It does nothing if FORM is already on the list for FILE.
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
730 FILE should be the name of a library, with no directory name."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
731 (or (assoc file after-load-alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
732 (setq after-load-alist (cons (list file) after-load-alist)))
5440
856ecdc5228a (eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents: 5421
diff changeset
733 (let ((elt (assoc file after-load-alist)))
856ecdc5228a (eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents: 5421
diff changeset
734 (or (member form (cdr elt))
856ecdc5228a (eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents: 5421
diff changeset
735 (nconc elt (list form))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
736 form)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
737
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
738 (defun eval-next-after-load (file)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
739 "Read the following input sexp, and run it whenever FILE is loaded.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
740 This makes or adds to an entry on `after-load-alist'.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
741 FILE should be the name of a library, with no directory name."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
742 (eval-after-load file (read)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
743
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
744
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
745 ;;;; Input and display facilities.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
746
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
747 (defun read-quoted-char (&optional prompt)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
748 "Like `read-char', except that if the first character read is an octal
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
749 digit, we read up to two more octal digits and return the character
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
750 represented by the octal number consisting of those digits.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
751 Optional argument PROMPT specifies a string to use to prompt the user."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
752 (let ((count 0) (code 0) char)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
753 (while (< count 3)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
754 (let ((inhibit-quit (zerop count))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
755 (help-form nil))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
756 (and prompt (message "%s-" prompt))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
757 (setq char (read-char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
758 (if inhibit-quit (setq quit-flag nil)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
759 (cond ((null char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
760 ((and (<= ?0 char) (<= char ?7))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
761 (setq code (+ (* code 8) (- char ?0))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
762 count (1+ count))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
763 (and prompt (message (setq prompt
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
764 (format "%s %c" prompt char)))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
765 ((> count 0)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
766 (setq unread-command-events (list char) count 259))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
767 (t (setq code char count 259))))
6838
ff8e7580e32d (read-quoted-char): Convert meta chars into 128+ chars.
Richard M. Stallman <rms@gnu.org>
parents: 6795
diff changeset
768 ;; Turn a meta-character into a character with the 0200 bit set.
ff8e7580e32d (read-quoted-char): Convert meta chars into 128+ chars.
Richard M. Stallman <rms@gnu.org>
parents: 6795
diff changeset
769 (logior (if (/= (logand code (lsh 1 23)) 0) 128 0)
ff8e7580e32d (read-quoted-char): Convert meta chars into 128+ chars.
Richard M. Stallman <rms@gnu.org>
parents: 6795
diff changeset
770 (logand 255 code))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
771
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
772 (defun force-mode-line-update (&optional all)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
773 "Force the mode-line of the current buffer to be redisplayed.
6795
a379e974be7c (force-mode-line-update): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6725
diff changeset
774 With optional non-nil ALL, force redisplay of all mode-lines."
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
775 (if all (save-excursion (set-buffer (other-buffer))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
776 (set-buffer-modified-p (buffer-modified-p)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
777
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
778 (defun momentary-string-display (string pos &optional exit-char message)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
779 "Momentarily display STRING in the buffer at POS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
780 Display remains until next character is typed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
781 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
782 otherwise it is then available as input (as a command if nothing else).
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
783 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
784 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
785 (or exit-char (setq exit-char ?\ ))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
786 (let ((buffer-read-only nil)
6553
fca6271b0983 (momentary-string-display): Avoid modifying the undo list.
Richard M. Stallman <rms@gnu.org>
parents: 6551
diff changeset
787 ;; Don't modify the undo list at all.
fca6271b0983 (momentary-string-display): Avoid modifying the undo list.
Richard M. Stallman <rms@gnu.org>
parents: 6551
diff changeset
788 (buffer-undo-list t)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
789 (modified (buffer-modified-p))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
790 (name buffer-file-name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
791 insert-end)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
792 (unwind-protect
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
793 (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
794 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
795 (goto-char pos)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
796 ;; defeat file locking... don't try this at home, kids!
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
797 (setq buffer-file-name nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
798 (insert-before-markers string)
4620
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
799 (setq insert-end (point))
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
800 ;; 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>
parents: 4518
diff changeset
801 (if (> (window-end) insert-end)
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
802 (recenter (/ (window-height) 2)))
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
803 ;; 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>
parents: 4518
diff changeset
804 ;; 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>
parents: 4518
diff changeset
805 (move-to-window-line 0)
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
806 (if (> (point) pos)
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
807 (progn
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
808 (goto-char pos)
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
809 (recenter 0))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
810 (message (or message "Type %s to continue editing.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
811 (single-key-description exit-char))
2033
10cdd2928c7d (momentary-string-display): Handle any event when flushing the display.
Richard M. Stallman <rms@gnu.org>
parents: 2021
diff changeset
812 (let ((char (read-event)))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
813 (or (eq char exit-char)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1695
diff changeset
814 (setq unread-command-events (list char)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
815 (if insert-end
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
816 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
817 (delete-region pos insert-end)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
818 (setq buffer-file-name name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
819 (set-buffer-modified-p modified))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
820
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
821
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
822 ;;;; Miscellanea.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
823
8211
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
824 (defun ignore (&rest ignore)
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
825 "Do nothing and return nil.
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
826 This function accepts any number of arguments, but ignores them."
7400
c415ff549eed (ignore): Allow interactive call.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
827 (interactive)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
828 nil)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
829
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
830 (defun error (&rest args)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
831 "Signal an error, making error message by passing all args to `format'."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
832 (while t
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
833 (signal 'error (list (apply 'format args)))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
834
5912
909b94d547c4 (user-original-login-name): Reduce to a defalias, since it's redundant with
Karl Heuer <kwzh@gnu.org>
parents: 5844
diff changeset
835 (defalias 'user-original-login-name 'user-login-name)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
836
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
837 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
838 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
839 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
840 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
841 BUFFER is the buffer or (buffer-name) to associate with the process.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
842 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
843 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
844 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
845 with any buffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
846 Third arg is command name, the name of a shell command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
847 Remaining arguments are the arguments for the command.
5460
3bd42ee22d1f (start-process-shell-command): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5440
diff changeset
848 Wildcards and redirection are handled as usual in the shell."
9822
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
849 (cond
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
850 ((eq system-type 'vax-vms)
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
851 (apply 'start-process name buffer args))
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
852 ((eq system-type 'windows-nt)
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
853 (start-process name buffer shell-file-name shell-command-switch
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
854 (mapconcat 'identity args " ")))
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
855 (t
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
856 (start-process name buffer shell-file-name shell-command-switch
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
857 (concat "exec " (mapconcat 'identity args " "))))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
858
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
859 (defmacro save-match-data (&rest body)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
860 "Execute the BODY forms, restoring the global value of the match data."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
861 (let ((original (make-symbol "match-data")))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
862 (list
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
863 'let (list (list original '(match-data)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
864 (list 'unwind-protect
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
865 (cons 'progn body)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
866 (list 'store-match-data original)))))
144
535ec1aa78ef *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 114
diff changeset
867
5385
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
868 (defun shell-quote-argument (argument)
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
869 "Quote an argument for passing as argument to an inferior shell."
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
870 ;; Quote everything except POSIX filename characters.
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
871 ;; This should be safe enough even for really weird shells.
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
872 (let ((result "") (start 0) end)
6309
9217f29851c2 Don't use triple-hyphen in a character class.
Karl Heuer <kwzh@gnu.org>
parents: 6167
diff changeset
873 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
5385
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
874 (setq end (match-beginning 0)
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
875 result (concat result (substring argument start end)
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
876 "\\" (substring argument end (1+ end)))
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
877 start (1+ end)))
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
878 (concat result (substring argument start))))
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
879
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
880 (defun make-syntax-table (&optional oldtable)
5421
a248a39fa4b8 (make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents: 5385
diff changeset
881 "Return a new syntax table.
a248a39fa4b8 (make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents: 5385
diff changeset
882 It inherits all letters and control characters from the standard
a248a39fa4b8 (make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents: 5385
diff changeset
883 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>
parents: 5460
diff changeset
884 (if oldtable
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
885 (copy-syntax-table oldtable)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
886 (let ((table (copy-syntax-table))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
887 i)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
888 (setq i 0)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
889 (while (<= i 31)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
890 (aset table i 13)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
891 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
892 (setq i ?A)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
893 (while (<= i ?Z)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
894 (aset table i 13)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
895 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
896 (setq i ?a)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
897 (while (<= i ?z)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
898 (aset table i 13)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
899 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
900 (setq i 128)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
901 (while (<= i 255)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
902 (aset table i 13)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
903 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
904 table)))
5421
a248a39fa4b8 (make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents: 5385
diff changeset
905
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
906 ;; now in fns.c
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
907 ;(defun nth (n list)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
908 ; "Returns the Nth element of LIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
909 ;N counts from zero. If LIST is not that long, nil is returned."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
910 ; (car (nthcdr n list)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
911 ;
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
912 ;(defun copy-alist (alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
913 ; "Return a copy of ALIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
914 ;This is a new alist which represents the same mapping
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
915 ;from objects to objects, but does not share the alist structure with ALIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
916 ;The objects mapped (cars and cdrs of elements of the alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
917 ;are shared, however."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
918 ; (setq alist (copy-sequence alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
919 ; (let ((tail alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
920 ; (while tail
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
921 ; (if (consp (car tail))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
922 ; (setcar tail (cons (car (car tail)) (cdr (car tail)))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
923 ; (setq tail (cdr tail))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
924 ; alist)
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
925
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
926 ;;; subr.el ends here
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
927