annotate lisp/subr.el @ 5046:6edbd7807a6e

(remove-hook): Doc fix.
author Richard M. Stallman <rms@gnu.org>
date Tue, 16 Nov 1993 08:44:51 +0000
parents 78c13f3054e5
children d39a061f984a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 648
diff changeset
1 ;;; subr.el --- basic lisp subroutines for Emacs
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
2
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
3 ;;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
4
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
5 ;; This file is part of GNU Emacs.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
6
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
8 ;; it under the terms of the GNU General Public License as published by
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
9 ;; the Free Software Foundation; either version 2, or (at your option)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
10 ;; any later version.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
11
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
12 ;; GNU Emacs is distributed in the hope that it will be useful,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
15 ;; GNU General Public License for more details.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
16
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
17 ;; You should have received a copy of the GNU General Public License
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
20
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
21 ;;; Code:
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
22
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
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
56 (defun one-window-p (&optional nomini)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
57 "Returns non-nil if there is only one window.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
58 Optional arg NOMINI non-nil means don't count the minibuffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
59 even if it is active."
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
60 (let ((base-window (selected-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
61 (if (and nomini (eq base-window (minibuffer-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
62 (setq base-window (next-window base-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
63 (eq base-window
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
64 (next-window base-window (if nomini 'arg)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
65
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
66 (defun walk-windows (proc &optional minibuf all-frames)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
67 "Cycle through all visible windows, calling PROC for each one.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
68 PROC is called with a window as argument.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
69 Optional second arg MINIBUF t means count the minibuffer window
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
70 even if not active. If MINIBUF is neither t nor nil it means
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
71 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
72
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
73 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
74 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
75 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
76 frame uses, even if it is on another frame.
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
77 If ALL-FRAMES is neither nil nor t, stick strictly to the selected frame."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
78 (let* ((walk-windows-start (selected-window))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
79 (walk-windows-current walk-windows-start))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
80 (while (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
81 (setq walk-windows-current
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
82 (next-window walk-windows-current minibuf all-frames))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
83 (funcall proc walk-windows-current)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
84 (not (eq walk-windows-current walk-windows-start))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
85
4491
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
86 (defun minibuffer-window-active-p (window)
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
87 "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
88 ;; nil nil means include WINDOW's frame
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
89 ;; and other frames using WINDOW as minibuffer,
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
90 ;; and include minibuffer if active.
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
91 (let ((prev (previous-window window nil nil)))
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
92 ;; 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
93 ;; 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
94 (and (not (eq window prev))
1e30d38d5c74 (minibuffer-window-active-p): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4414
diff changeset
95 (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
96 ;; 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
97 ;; 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
98 (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
99
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
100 ;;;; Keymap support.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
101
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
102 (defun undefined ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
103 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
104 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
105
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
106 ;Prevent the \{...} documentation construct
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
107 ;from mentioning keys that run this command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
108 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
109
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
110 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
111 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
112 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
113 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
114 (substitute-key-definition 'self-insert-command 'undefined map global-map)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
115 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
116 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
117 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
118 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
119 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
120 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
121 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
122 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
123
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
124 ;Moved to keymap.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
125 ;(defun copy-keymap (keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
126 ; "Return a copy of KEYMAP"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
127 ; (while (not (keymapp keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
128 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
129 ; (if (vectorp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
130 ; (copy-sequence keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
131 ; (copy-alist keymap)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
132
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
133 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
134 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
135 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
136 If optional fourth argument OLDMAP is specified, we redefine
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
137 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
138 (or prefix (setq prefix ""))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
139 (let* ((scan (or oldmap keymap))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
140 (vec1 (vector nil))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
141 (prefix1 (vconcat prefix vec1)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
142 ;; Scan OLDMAP, finding each char or event-symbol that
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
143 ;; has any definition, and act on it with hack-key.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
144 (while (consp scan)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
145 (if (consp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
146 (let ((char (car (car scan)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
147 (defn (cdr (car scan))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
148 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
149 ;; the inside of the following let that handles array elements.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
150 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
151 (aset prefix1 (length prefix) char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
152 (let (inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
153 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
154 (while (stringp (car-safe defn))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
155 (setq defn (cdr defn)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
156 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
157 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
158 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
159 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
160 (if (eq defn olddef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
161 (define-key keymap prefix1 newdef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
162 (if (keymapp defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
163 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
164 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
165 prefix1)))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
166 (if (arrayp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
167 (let* ((array (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
168 (len (length array))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
169 (i 0))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
170 (while (< i len)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
171 (let ((char i) (defn (aref array i)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
172 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
173 ;; the inside of the previous let.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
174 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
175 (aset prefix1 (length prefix) char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
176 (let (inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
177 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
178 (while (stringp (car-safe defn))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
179 (setq defn (cdr defn)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
180 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
181 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
182 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
183 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
184 (if (eq defn olddef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
185 (define-key keymap prefix1 newdef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
186 (if (keymapp defn)
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 (setq i (1+ i))))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
191 (setq scan (cdr scan)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
192
3902
717f2e24975e (define-key-after): Renamed from define-key-in-sequence.
Richard M. Stallman <rms@gnu.org>
parents: 3901
diff changeset
193 (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
194 "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
195 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
196 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
197 of the map.
4070
5a97f81baf65 (define-key-after): Error if KEY has two elements.
Richard M. Stallman <rms@gnu.org>
parents: 3991
diff changeset
198 The order matters when the keymap is used as a menu.
5a97f81baf65 (define-key-after): Error if KEY has two elements.
Richard M. Stallman <rms@gnu.org>
parents: 3991
diff changeset
199 KEY must contain just one event type--it must be a string or vector
5a97f81baf65 (define-key-after): Error if KEY has two elements.
Richard M. Stallman <rms@gnu.org>
parents: 3991
diff changeset
200 of length 1."
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
201 (or (keymapp keymap)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
202 (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
203 (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
204 (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
205 (let ((tail keymap) done inserted
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
206 (first (aref key 0)))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
207 (while (and (not done) tail)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
208 ;; 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
209 (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
210 (setcdr tail (cdr (cdr tail))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
211 ;; 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
212 ;; 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
213 ;; 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
214 (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
215 (eq (car (cdr tail)) 'keymap)
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
216 (null (cdr tail)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
217 (progn
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
218 ;; 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
219 ;; 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
220 ;; 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
221 (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
222 (setq done t))
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
223 ;; 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
224 (or inserted
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
225 (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
226 (setq inserted t)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
227 (setq tail (cdr tail)))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
228
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
229 (defun keyboard-translate (from to)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
230 "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
231 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
232 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
233 (or (arrayp keyboard-translate-table)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
234 (setq keyboard-translate-table ""))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
235 (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
236 (> to (length keyboard-translate-table)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
237 (progn
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
238 (let* ((i (length keyboard-translate-table))
4235
55182207415d (keyboard-translate): Properly lengthen existing table.
Richard M. Stallman <rms@gnu.org>
parents: 4188
diff changeset
239 (table (concat keyboard-translate-table
55182207415d (keyboard-translate): Properly lengthen existing table.
Richard M. Stallman <rms@gnu.org>
parents: 4188
diff changeset
240 (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
241 (while (< i 256)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
242 (aset table i i)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
243 (setq i (1+ i)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
244 (setq keyboard-translate-table table))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
245 (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
246
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
247
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
248 ;;;; The global keymap tree.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
249
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
250 ;;; 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
251 ;;; 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
252
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
253 (defvar global-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
254 "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
255 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
256 global map.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
257
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
258 (defvar esc-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
259 "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
260 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
261
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
262 (defvar ctl-x-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
263 "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
264 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
265
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
266 (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
267 "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
268 (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
269 (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
270
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
271 (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
272 "Keymap for frame commands.")
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
273 (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
274 (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
275
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
276
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
277 ;;;; Event manipulation functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
278
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
279 ;; 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
280 ;; 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
281 ;; 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
282 (defconst listify-key-sequence-1
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
283 (lsh 1 7))
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
284 (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
285
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
286 (defun listify-key-sequence (key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
287 "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
288 (if (vectorp key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
289 (append key nil)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
290 (mapcar (function (lambda (c)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
291 (if (> c 127)
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
292 (logxor c listify-key-sequence-1)
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
293 c)))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
294 (append key nil))))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
295
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
296 (defsubst eventp (obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
297 "True if the argument is an event object."
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
298 (or (integerp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
299 (and (symbolp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
300 (get obj 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
301 (and (consp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
302 (symbolp (car obj))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
303 (get (car obj) 'event-symbol-elements))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
304
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
305 (defun event-modifiers (event)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
306 "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
307 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
308 `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
309 and `down'."
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
310 (let ((type event))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
311 (if (listp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
312 (setq type (car type)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
313 (if (symbolp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
314 (cdr (get type 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
315 (let ((list nil))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
316 (or (zerop (logand type (lsh 1 23)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
317 (setq list (cons 'meta list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
318 (or (and (zerop (logand type (lsh 1 22)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
319 (>= (logand type 127) 32))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
320 (setq list (cons 'control list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
321 (or (and (zerop (logand type (lsh 1 21)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
322 (= (logand type 255) (downcase (logand type 255))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
323 (setq list (cons 'shift list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
324 (or (zerop (logand type (lsh 1 20)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
325 (setq list (cons 'hyper list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
326 (or (zerop (logand type (lsh 1 19)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
327 (setq list (cons 'super list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
328 (or (zerop (logand type (lsh 1 18)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
329 (setq list (cons 'alt list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
330 list))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
331
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
332 (defun event-basic-type (event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
333 "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
334 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
335 (if (consp event)
d2df5ca46b39 * subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
336 (setq event (car event)))
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
337 (if (symbolp event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
338 (car (get event 'event-symbol-elements))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
339 (let ((base (logand event (1- (lsh 1 18)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
340 (downcase (if (< base 32) (logior base 64) base)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
341
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
342 (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
343 "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
344 (and (consp object)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
345 (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
346
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
347 (defsubst event-start (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
348 "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
349 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
350 of the event.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
351 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
352 The return value is of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
353 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
354 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
355 (nth 1 event))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
356
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
357 (defsubst event-end (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
358 "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
359 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
360 The return value is of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
361 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
362 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
363 (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
364
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
365 (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
366 "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
367 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
368 (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
369
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
370 (defsubst posn-window (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
371 "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
372 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
373 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
374 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
375 (nth 0 position))
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 posn-point (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
378 "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
379 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
380 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
381 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
382 (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
383 (car (nth 1 position))
ad2bd545983e * subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents: 3927
diff changeset
384 (nth 1 position)))
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
385
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
386 (defsubst posn-col-row (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
387 "Return the row and column in POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
388 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
389 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
390 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
391 (nth 2 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
392
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
393 (defsubst posn-timestamp (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
394 "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
395 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
396 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
3411
d91b3097bb76 (posn-timestamp): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3210
diff changeset
397 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
398 (nth 3 position))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
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
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
401 ;;;; Obsolescent names for functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
402
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
403 (defalias 'make-syntax-table 'copy-syntax-table)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
404 (defalias 'dot 'point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
405 (defalias 'dot-marker 'point-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
406 (defalias 'dot-min 'point-min)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
407 (defalias 'dot-max 'point-max)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
408 (defalias 'window-dot 'window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
409 (defalias 'set-window-dot 'set-window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
410 (defalias 'read-input 'read-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
411 (defalias 'send-string 'process-send-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
412 (defalias 'send-region 'process-send-region)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
413 (defalias 'show-buffer 'set-window-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
414 (defalias 'buffer-flush-undo 'buffer-disable-undo)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
415 (defalias 'eval-current-buffer 'eval-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
416 (defalias 'compiled-function-p 'byte-code-function-p)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
417
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
418 ;; 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
419 (defun baud-rate ()
3210
3176c6395ada (baud-rate): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3153
diff changeset
420 "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
421 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
422 baud-rate)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
423
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
424
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
425 ;;;; 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
426
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
427 (defalias 'string= 'string-equal)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
428 (defalias 'string< 'string-lessp)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
429 (defalias 'move-marker 'set-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
430 (defalias 'eql 'eq)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
431 (defalias 'not 'null)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
432 (defalias 'rplaca 'setcar)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
433 (defalias 'rplacd 'setcdr)
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3411
diff changeset
434 (defalias 'beep 'ding) ;preserve lingual purity
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
435 (defalias 'indent-to-column 'indent-to)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
436 (defalias 'backward-delete-char 'delete-backward-char)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
437 (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
438 (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
439 (defalias 'int-to-string 'number-to-string)
1903
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
440
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
441 ;;; 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
442 ;;; 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
443 (defalias 'string-to-int 'string-to-number)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
444
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
445 ;;;; Hook manipulation functions.
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
446
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
447 (defun run-hooks (&rest hooklist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
448 "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
449 Each argument should be a symbol, a hook variable.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
450 These symbols are processed in the order specified.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
451 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
452 or a list of functions to be called to run the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
453 If the value is a function, it is called with no arguments.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
454 If it is a list, the elements are called, in order, with no arguments."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
455 (while hooklist
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
456 (let ((sym (car hooklist)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
457 (and (boundp sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
458 (symbol-value sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
459 (let ((value (symbol-value sym)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
460 (if (and (listp value) (not (eq (car value) 'lambda)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
461 (mapcar 'funcall value)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
462 (funcall value)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
463 (setq hooklist (cdr hooklist))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
464
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
465 ;; Tell C code how to call this function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
466 (defconst run-hooks 'run-hooks
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
467 "Variable by which C primitives find the function `run-hooks'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
468 Don't change it.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
469
2383
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
470 (defun add-hook (hook function &optional append)
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
471 "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
472 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
473 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
474 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
475 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
476
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
477 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
478 HOOK is void, it is first set to nil. If HOOK's value is a single
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
479 function, it is changed to a list of functions."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
480 (or (boundp hook) (set hook nil))
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
481 ;; 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
482 (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
483 (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
484 (set hook (list old))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
485 (or (if (consp function)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
486 ;; Clever way to tell whether a given lambda-expression
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
487 ;; is equal to anything in the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
488 (let ((tail (assoc (cdr function) (symbol-value hook))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
489 (equal function tail))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
490 (memq function (symbol-value hook)))
2383
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
491 (set hook
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
492 (if append
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
493 (nconc (symbol-value hook) (list function))
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
494 (cons function (symbol-value hook))))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
495
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
496 (defun remove-hook (hook function)
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
497 "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
498 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
499 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
5046
6edbd7807a6e (remove-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 4964
diff changeset
500 list of hooks to run in HOOK, then nothing is done. See `add-hook'."
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
501 (if (or (not (boundp hook)) ;unbound symbol, or
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
502 (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
503 (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
504 nil ;Do nothing.
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
505 (let ((hook-value (symbol-value hook)))
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
506 (if (consp hook-value)
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
507 (setq hook-value (delete function hook-value))
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
508 (if (eq hook-value function)
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
509 (setq hook-value nil)))
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
510 (set hook hook-value))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
511
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
512 ;;;; 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
513
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
514 (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
515 "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
516 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
517 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
518 (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
519 (setq after-load-alist (cons (list file) after-load-alist)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
520 (nconc (assoc file after-load-alist) (list form))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
521 form)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
522
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
523 (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
524 "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
525 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
526 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
527 (eval-after-load file (read)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
528
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
529
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
530 ;;;; Input and display facilities.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
531
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
532 (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
533 "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
534 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
535 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
536 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
537 (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
538 (while (< count 3)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
539 (let ((inhibit-quit (zerop count))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
540 (help-form nil))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
541 (and prompt (message "%s-" prompt))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
542 (setq char (read-char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
543 (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
544 (cond ((null char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
545 ((and (<= ?0 char) (<= char ?7))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
546 (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
547 count (1+ count))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
548 (and prompt (message (setq prompt
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
549 (format "%s %c" prompt char)))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
550 ((> count 0)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
551 (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
552 (t (setq code char count 259))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
553 (logand 255 code)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
554
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
555 (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
556 "Force the mode-line of the current buffer to be redisplayed.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
557 With optional non-nil ALL then force then force redisplay of all mode-lines."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
558 (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
559 (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
560
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
561 (defun momentary-string-display (string pos &optional exit-char message)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
562 "Momentarily display STRING in the buffer at POS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
563 Display remains until next character is typed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
564 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
565 otherwise it is then available as input (as a command if nothing else).
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
566 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
567 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
568 (or exit-char (setq exit-char ?\ ))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
569 (let ((buffer-read-only nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
570 (modified (buffer-modified-p))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
571 (name buffer-file-name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
572 insert-end)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
573 (unwind-protect
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
574 (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
575 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
576 (goto-char pos)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
577 ;; defeat file locking... don't try this at home, kids!
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
578 (setq buffer-file-name nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
579 (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
580 (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
581 ;; 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
582 (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
583 (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
584 ;; 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
585 ;; 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
586 (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
587 (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
588 (progn
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
589 (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
590 (recenter 0))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
591 (message (or message "Type %s to continue editing.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
592 (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
593 (let ((char (read-event)))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
594 (or (eq char exit-char)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1695
diff changeset
595 (setq unread-command-events (list char)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
596 (if insert-end
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
597 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
598 (delete-region pos insert-end)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
599 (setq buffer-file-name name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
600 (set-buffer-modified-p modified))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
601
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
602
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
603 ;;;; Miscellanea.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
604
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
605 (defun ignore (&rest ignore)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
606 "Do nothing.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
607 Accept any number of arguments, but ignore them."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
608 nil)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
609
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
610 (defun error (&rest args)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
611 "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
612 (while t
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
613 (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
614
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
615 (defun user-original-login-name ()
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
616 "Return user's login name from original login.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
617 This tries to remain unaffected by `su', by looking in environment variables."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
618 (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
619
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
620 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
621 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
622 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
623 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
624 BUFFER is the buffer or (buffer-name) to associate with the process.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
625 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
626 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
627 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
628 with any buffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
629 Third arg is command name, the name of a shell command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
630 Remaining arguments are the arguments for the command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
631 Wildcards and redirection are handle as usual in the shell."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
632 (if (eq system-type 'vax-vms)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
633 (apply 'start-process name buffer args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
634 (start-process name buffer shell-file-name "-c"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
635 (concat "exec " (mapconcat 'identity args " ")))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
636
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
637 (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
638 "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
639 (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
640 (list
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
641 '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
642 (list 'unwind-protect
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
643 (cons 'progn body)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
644 (list 'store-match-data original)))))
144
535ec1aa78ef *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 114
diff changeset
645
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
646 ;; now in fns.c
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
647 ;(defun nth (n list)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
648 ; "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
649 ;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
650 ; (car (nthcdr n list)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
651 ;
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
652 ;(defun copy-alist (alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
653 ; "Return a copy of ALIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
654 ;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
655 ;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
656 ;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
657 ;are shared, however."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
658 ; (setq alist (copy-sequence alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
659 ; (let ((tail alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
660 ; (while tail
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
661 ; (if (consp (car tail))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
662 ; (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
663 ; (setq tail (cdr tail))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
664 ; alist)
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
665
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
666 ;;; subr.el ends here
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
667